diff options
| author | IOhannes m zmölnig (Debian/GNU) <umlaeute@debian.org> | 2019-07-15 09:34:48 +0200 |
|---|---|---|
| committer | IOhannes m zmölnig (Debian/GNU) <umlaeute@debian.org> | 2019-07-15 09:34:48 +0200 |
| commit | d38474bc2411ceea33e718a81ba3d56b627a114a (patch) | |
| tree | 3d0d8924df35086199d1ea3395deaee8de1f710d | |
| parent | f9fab3386a764a20c4a8d1069802c760bcfd2dc4 (diff) | |
New upstream version 19.3
| -rw-r--r-- | HISTORY.Snd | 1 | ||||
| -rw-r--r-- | NEWS | 12 | ||||
| -rw-r--r-- | clm2xen.c | 2 | ||||
| -rw-r--r-- | cload.scm | 30 | ||||
| -rwxr-xr-x | configure | 20 | ||||
| -rw-r--r-- | configure.ac | 4 | ||||
| -rw-r--r-- | fm.html | 10 | ||||
| -rw-r--r-- | index.html | 700 | ||||
| -rw-r--r-- | lint.scm | 43 | ||||
| -rw-r--r-- | mockery.scm | 1364 | ||||
| -rw-r--r-- | peak-phases.scm | 72 | ||||
| -rw-r--r-- | profile.scm | 2 | ||||
| -rw-r--r-- | r7rs.scm | 13 | ||||
| -rw-r--r-- | reactive.scm | 31 | ||||
| -rw-r--r-- | repl.scm | 4 | ||||
| -rw-r--r-- | s7.c | 5796 | ||||
| -rw-r--r-- | s7.h | 19 | ||||
| -rw-r--r-- | s7.html | 74 | ||||
| -rw-r--r-- | s7test.scm | 1107 | ||||
| -rw-r--r-- | singer.scm | 11 | ||||
| -rw-r--r-- | snd-sig.c | 43 | ||||
| -rw-r--r-- | snd-test.scm | 18 | ||||
| -rw-r--r-- | snd-xref.c | 575 | ||||
| -rw-r--r-- | snd.h | 6 | ||||
| -rw-r--r-- | sndscm.html | 148 | ||||
| -rw-r--r-- | stuff.scm | 425 | ||||
| -rw-r--r-- | tools/auto-tester.scm | 449 | ||||
| -rwxr-xr-x | tools/compsnd | 6 | ||||
| -rw-r--r-- | tools/make-index.scm | 6 | ||||
| -rw-r--r-- | tools/tauto.scm | 6 | ||||
| -rw-r--r-- | tools/tbig.scm | 83 | ||||
| -rw-r--r-- | tools/teq.scm | 64 | ||||
| -rw-r--r-- | tools/thash.scm | 4 | ||||
| -rw-r--r-- | tools/titer.scm | 4 | ||||
| -rw-r--r-- | tools/tmap.scm | 4 | ||||
| -rw-r--r-- | tools/tread.scm | 14 | ||||
| -rw-r--r-- | tools/trec.scm | 13 | ||||
| -rw-r--r-- | tools/tset.scm | 12 | ||||
| -rw-r--r-- | tools/tshoot.scm | 27 | ||||
| -rw-r--r-- | tools/tvect.scm | 2 | ||||
| -rw-r--r-- | tools/valcall.scm | 6 |
41 files changed, 5516 insertions, 5714 deletions
diff --git a/HISTORY.Snd b/HISTORY.Snd index de34cc4..6994caa 100644 --- a/HISTORY.Snd +++ b/HISTORY.Snd @@ -1,5 +1,6 @@ Snd change log + 15-Apr: Snd 19.3. 11-Mar: Snd 19.2. 7-Feb: Snd 19.1. 2-Jan-19: Snd 19.0. @@ -1,8 +1,10 @@ -Snd 19.2: +Snd 19.3: -in s7, added (*s7* 'undefined-constant-warnings) to flag typos like #ff or #_input_port? - added coverlets and openlets (an experiment) +clm: Anders added support for 64-bit lispworks. -checked: sbcl 1.5.0 +s7: port-position and port-file (for libc.scm). + deleted Display and sequence->string (stuff.scm) -Thanks!: Kjetil +checked: sbcl 1.5.1 + +Thanks!: Daniel Hensel, Anders Vinjar.
\ No newline at end of file @@ -11541,6 +11541,8 @@ static mus_float_t mus_src_two(mus_any *p, mus_float_t x) {return(mus_src(p, x, 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));} */ +/* almost no error checking here; for example all the s7_c_object_value calls should check that their argument is a c-object */ + #define GEN_1(Type, Func) \ static bool is_ ## Type ## _b(s7_pointer p) \ { \ @@ -103,11 +103,13 @@ ;;; (* 1024 mem))))) ;;; -------------------------------------------------------------------------------- -(define *cload-cflags* "") +(define *cload-cflags* (if (provided? 'clang) "-fPIC" "")) (define *cload-ldflags* "") (if (not (defined? '*cload-directory*)) (define *cload-directory* "")) +(define *cload-c-compiler* (if (provided? 'gcc) "gcc" (if (provided? 'clang) "clang" "cc"))) + (define-macro (defvar name value) `(if (not (defined? ',name)) @@ -580,10 +582,10 @@ (cond ((provided? 'osx) ;; I assume the caller is also compiled with these flags? - (system (format #f "gcc -c ~A -o ~A ~A ~A" - c-file-name o-file-name *cload-cflags* cflags)) - (system (format #f "gcc ~A -o ~A -dynamic -bundle -undefined suppress -flat_namespace ~A ~A" - o-file-name so-file-name *cload-ldflags* ldflags))) + (system (format #f "~A -c ~A -o ~A ~A ~A" + *cload-c-compiler* c-file-name o-file-name *cload-cflags* cflags)) + (system (format #f "~A ~A -o ~A -dynamic -bundle -undefined suppress -flat_namespace ~A ~A" + *cload-c-compiler* o-file-name so-file-name *cload-ldflags* ldflags))) ((provided? 'freebsd) (system (format #f "cc -fPIC -c ~A -o ~A ~A ~A" @@ -592,10 +594,10 @@ o-file-name so-file-name *cload-ldflags* ldflags))) ((provided? 'openbsd) - (system (format #f "gcc -fPIC -ftrampolines -c ~A -o ~A ~A ~A" - c-file-name o-file-name *cload-cflags* cflags)) - (system (format #f "gcc ~A -shared -o ~A ~A ~A" - o-file-name so-file-name *cload-ldflags* ldflags))) + (system (format #f "~A -fPIC -ftrampolines -c ~A -o ~A ~A ~A" + *cload-c-compiler* c-file-name o-file-name *cload-cflags* cflags)) + (system (format #f "~A ~A -shared -o ~A ~A ~A" + *cload-c-compiler* o-file-name so-file-name *cload-ldflags* ldflags))) ((provided? 'sunpro_c) ; just guessing here... (system (format #f "cc -c ~A -o ~A ~A ~A" @@ -603,13 +605,11 @@ (system (format #f "cc ~A -G -o ~A ~A ~A" o-file-name so-file-name *cload-ldflags* ldflags))) - ;; what about clang? Maybe use cc below, not gcc (and in osx case above) - (else - (system (format #f "gcc -fPIC -c ~A -o ~A ~A ~A" - c-file-name o-file-name *cload-cflags* cflags)) - (system (format #f "gcc ~A -shared -o ~A ~A ~A" - o-file-name so-file-name *cload-ldflags* ldflags))))) + (system (format #f "~A -fPIC -c ~A -o ~A ~A ~A" + *cload-c-compiler* c-file-name o-file-name *cload-cflags* cflags)) + (system (format #f "~A ~A -shared -o ~A ~A ~A" + *cload-c-compiler* o-file-name so-file-name *cload-ldflags* ldflags))))) (define handle-declaration (let () @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for snd 19.2. +# Generated by GNU Autoconf 2.69 for snd 19.3. # # Report bugs to <bil@ccrma.stanford.edu>. # @@ -580,8 +580,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='snd' PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-19.tar.gz' -PACKAGE_VERSION='19.2' -PACKAGE_STRING='snd 19.2' +PACKAGE_VERSION='19.3' +PACKAGE_STRING='snd 19.3' PACKAGE_BUGREPORT='bil@ccrma.stanford.edu' PACKAGE_URL='' @@ -1324,7 +1324,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 19.2 to adapt to many kinds of systems. +\`configure' configures snd 19.3 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1395,7 +1395,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of snd 19.2:";; + short | recursive ) echo "Configuration of snd 19.3:";; esac cat <<\_ACEOF @@ -1514,7 +1514,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -snd configure 19.2 +snd configure 19.3 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1975,7 +1975,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 19.2, which was +It was created by snd $as_me 19.3, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -3322,7 +3322,7 @@ LOCAL_LANGUAGE="None" GRAPHICS_TOOLKIT="None" PACKAGE=Snd -VERSION=19.2 +VERSION=19.3 #-------------------------------------------------------------------------------- # configuration options @@ -6906,7 +6906,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 19.2, which was +This file was extended by snd $as_me 19.3, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -6968,7 +6968,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 19.2 +snd config.status 19.3 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index 5c1e80c..232ba77 100644 --- a/configure.ac +++ b/configure.ac @@ -5,7 +5,7 @@ # gmp, mpfr, and mpc deliberately have none! -AC_INIT(snd, 19.2, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-19.tar.gz) +AC_INIT(snd, 19.3, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-19.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=19.2 +VERSION=19.3 #-------------------------------------------------------------------------------- # configuration options @@ -663,7 +663,7 @@ the 15 main components, with their sum in black: (let* ((angle 0.0) (incr (hz->radians 1.0)) (n (ceiling (+ index 5))) - (cur-phases (make-vct (* (+ n 1) 3 2)))) + (cur-phases (make-float-vector (* (+ n 1) 3 2)))) (do ((i 0 (+ i 1)) (j 0 (+ j 3))) @@ -1319,7 +1319,7 @@ examples which come from a collection of "imaginary machines": :duration dur :scaler (hz->radians (abs gliss))))) (do ((i start (+ i 1))) ((= i stop)) - (set! (fmssb-index gen) (env indf)) + (set! (gen 'index) (env indf)) (outa i (* (env ampf) (fmssb gen (env frqf))))))) (with-sound (:play #t) @@ -1546,7 +1546,7 @@ In general: (cr (make-oscil freq carrier-phase)) (n (length mc-ratios)) (modulators (make-vector n)) - (fm-indices (make-vct n))) + (fm-indices (make-float-vector n))) (do ((i 0 (+ i 1))) ((= i n)) (set! (modulators i) (make-oscil (* freq (mc-ratios i)) (mod-phases i))) @@ -2496,10 +2496,10 @@ used in "Colony" and other pieces: (car-os (make-oscil 0)) (evens (make-vector 3)) (odds (make-vector 3)) - (amps (apply vct formant-amps)) + (amps (apply float-vector formant-amps)) (ampf (make-env '(0 0 25 1 75 1 100 0) :scaler amp :duration dur)) (frmfs (make-vector 3)) - (indices (apply vct indexes)) + (indices (apply float-vector indexes)) (per-vib (make-triangle-wave 6 :amplitude (* freq .03))) (ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02)))) (do ((i 0 (+ i 1))) @@ -37,355 +37,359 @@ </head> <body class="body"> <div class="topheader">Index</div> -<!-- created 23-Feb-19 13:46 PST --> +<!-- created 25-Mar-19 10:05 PDT --> <table> - <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</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#mussoundsamples">mus-sound-samples</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> </em></td><td></td><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#macroexpand">macroexpand</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></tr> - <tr><td class="green"><div class="centered">A</div></td><td></td><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</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#mussoundtypespecifier">mus-sound-type-specifier</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> </em></td><td></td><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</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#mussoundwritedate">mus-sound-write-date</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="sndclm.html#abcos">abcos</a></em></td><td></td><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-abcos">make-abcos</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#dspdocscanned">scanned synthesis</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#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="sndclm.html#mus-width">mus-width</a></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#abort">abort</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-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</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#scratch">scratch</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#epsbottommargin">eps-bottom-margin</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="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></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="sndclm.html#absin?">absin?</a></em></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-triangle-wave">make-adjustable-triangle-wave</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#scriptargs">script-args</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#epsleftmargin">eps-left-margin</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#mus-ycoeffs">mus-ycoeffs</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#addcolormap">add-colormap</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#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab> </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="sndscm.html#adddeleteoption">add-delete-option</a></em></td><td></td><td><em class=tab><a href="s7.html#equivalentp">equivalent?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td class="green"><div class="centered">N</div></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#adddirectorytoviewfileslist">add-directory-to-view-files-list</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-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab> </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="extsnd.html#addfilefilter">add-file-filter</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="sndscm.html#makebandpass">make-bandpass</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="sndclm.html#secondstosamples">seconds->samples</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="s7.html#errorhook">*error-hook*</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#n1cos?">n1cos?</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="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</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="sndclm.html#make-bess">make-bess</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#selectchannel">select-channel</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#erssb?">erssb?</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#nchoosekcos">nchoosekcos</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="sndscm.html#addmarkpane">add-mark-pane</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="sndscm.html#makebirds">make-birds</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="extsnd.html#addplayer">add-player</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="sndclm.html#make-blackman">make-blackman</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#selectsoundhook">select-sound-hook</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="sndscm.html#everysample">every-sample?</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#ncos2?">ncos2?</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="extsnd.html#addsourcefileextension">add-source-file-extension</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="s7.html#makebytevector">make-byte-vector</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#selecteddatacolor">selected-data-color</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#exithook">exit-hook</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#ncos?">ncos?</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#addtomenu">add-to-menu</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="extsnd.html#makecolor">make-color</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#selectedsound">selected-sound</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="extsnd.html#expandcontrolbounds">expand-control-bounds</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="extsnd.html#newsounddialog">new-sound-dialog</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#addtransform">add-transform</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="sndclm.html#makecombbank">make-comb-bank</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#selectiontomix">selection->mix</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="extsnd.html#expandcontroljitter">expand-control-jitter</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#newwidgethook">new-widget-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="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</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-delay">make-delay</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#selectioncolor">selection-color</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="extsnd.html#expandcontrolramp">expand-control-ramp</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#nkssb">nkssb</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="sndclm.html#adjustable-square-wave">adjustable-square-wave</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-env">make-env</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#selectioncreatesregion">selection-creates-region</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#explodesf2">explode-sf2</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#nkssb?">nkssb?</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="sndclm.html#adjustable-triangle-wave">adjustable-triangle-wave</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-ercos">make-ercos</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#selectionmaxamp">selection-maxamp</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#expsnd">expsnd</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="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#afterapplycontrolshook">after-apply-controls-hook</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-fft-window">make-fft-window</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#selectionmember">selection-member?</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> </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#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#aftergraphhook">after-graph-hook</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-filetosample">make-file->sample</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#selectionposition">selection-position</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> </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#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="extsnd.html#afteropenhook">after-open-hook</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-filtered-comb">make-filtered-comb</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#selectionsrate">selection-srate</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="sndscm.html#cellon">feedback fm</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="sndscm.html#cleandoc"><b>Noise Reduction</b></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="extsnd.html#aftersavestatehook">after-save-state-hook</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-fir-coeffs">make-fir-coeffs</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#selectionstuff"><b>Selections</b></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#fftcancel">fft-cancel</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="sndscm.html#normalizeenvelope">normalize-envelope</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#allchans">all-chans</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-firmant">make-firmant</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="s7.html#setter">setter</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="sndscm.html#fftenvedit">fft-env-edit</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="sndscm.html#normalizesound">normalize-sound</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#allpassbank">all-pass-bank</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-flocsig">make-flocsig</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#showaxes">show-axes</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#fftlogfrequency">fft-log-frequency</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#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="sndclm.html#all-pass?">all-pass?</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-formant">make-formant</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="sndscm.html#showdiskspace">show-disk-space</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#fftsmoother">fft-smoother</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="sndscm.html#notchselection">notch-selection</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#ampcontrol">amp-control</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-frampletofile">make-frample->file</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#showfullrange">show-full-range</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#fftwindow">fft-window</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="sndclm.html#notch?">notch?</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#amplitude-modulate">amplitude-modulate</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="extsnd.html#makegraphdata">make-graph-data</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#showindices">show-indices</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#fftbeta">fft-window-beta</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="sndclm.html#nrcos">nrcos</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="sndscm.html#anoi">anoi</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="sndclm.html#make-green-noise-interp">make-green-noise-interp</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#showmarks">show-marks</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#fftexamples"><b>FFTs</b></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#nrev">nrev</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="sndscm.html#anyrandom">any-random</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="sndscm.html#makehighpass">make-highpass</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#showselection">show-selection</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="sndclm.html#filetoarray">file->array</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#nrsin?">nrsin?</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="grfsnd.html#applyladspa">apply-ladspa</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#makehook">make-hook</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#showsonogramcursor">show-sonogram-cursor</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="sndclm.html#filetoframple?">file->frample?</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#nrssbinterp">nrssb-interp</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="s7.html#arity">arity</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#makeintvector">make-int-vector</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#arraytofile">array->file</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#makeiterator">make-iterator</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#showyzero">show-y-zero</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#filename">file-name</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#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="s7.html#signature">signature</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#genericfilename"><b>file-name (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#nrxysin">nrxysin</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="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</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-j0j1cos">make-j0j1cos</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="sndscm.html#silencemixes">silence-mixes</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#genericfill"><b>fill! (generic)</b></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#nsin">nsin</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#asyfmI">asyfm-I</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-jjcos">make-jjcos</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="sndclm.html#sinc-train?">sinc-train?</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#fillrectangle">fill-rectangle</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#nsincos">nsincos</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="sndclm.html#asyfm?">asyfm?</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-jpcos">make-jpcos</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#sineenvchannel">sine-env-channel</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#filterchannel">filter-channel</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#nssb">nssb</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="sndclm.html#asymmetric-fm?">asymmetric-fm?</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-k2cos">make-k2cos</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="sndscm.html#singerdoc">singer</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#filtercontrolenvelope">filter-control-envelope</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#nxy1cos">nxy1cos</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="sndscm.html#autosavedoc">auto-save</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-k2ssb">make-k2ssb</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#smoothselection">smooth-selection</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#filtercontrolinhz">filter-control-in-hz</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#nxy1sin">nxy1sin</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="extsnd.html#autoupdateinterval">auto-update-interval</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-krksin">make-krksin</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#smoothexamples"><b>Smoothing</b></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="extsnd.html#filterwaveformcolor">filter-control-waveform-color</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#nxycos">nxycos</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="s7.html#autoload"><b>autoload</b></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="sndscm.html#makelowpass">make-lowpass</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#snapmarktobeat">snap-mark-to-beat</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#filterfft">filter-fft</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#nxysin">nxysin</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#axisinfo">axis-info</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-move-sound">make-move-sound</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#snapmixtobeat">snap-mix-to-beat</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="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</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> </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#axisnumbersfont">axis-numbers-font</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-average">make-moving-average</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</a></em></td></tr> - <tr><td><em class=tab> </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-fft">make-moving-fft</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr> - <tr><td class="green"><div class="centered">B</div></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-max">make-moving-max</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#snderror">snd-error</a></em></td></tr> - <tr><td><em class=tab> </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-norm">make-moving-norm</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#snderrorhook">snd-error-hook</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="sndclm.html#filteredcombbankp">filtered-comb-bank?</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#oddmultiple">odd-multiple</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#badheaderhook">bad-header-hook</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><em class=tab><a href="sndclm.html#oddweight">odd-weight</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="sndscm.html#bagpipe">bagpipe</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-spectrum">make-moving-spectrum</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#sndhelp">snd-help</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#finddialog">find-dialog</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="sndscm.html#offsetsound">offset-sound</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#beatspermeasure">beats-per-measure</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-nchoosekcos">make-nchoosekcos</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="extsnd.html#beatsperminute">beats-per-minute</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-ncos">make-ncos</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#sndprint">snd-print</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#findsound">find-sound</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#one-pole-all-pass?">one-pole-all-pass?</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="extsnd.html#beforeexithook">before-exit-hook</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-noddcos">make-noddcos</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#beforesaveashook">before-save-as-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-noddsin">make-noddsin</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#sndurl">snd-url</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="sndclm.html#fir-filter">fir-filter</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-zero?">one-zero?</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#beforetransformhook">before-transform-hook</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-noid">make-noid</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#sndversion">snd-version</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="sndclm.html#firmant">firmant</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="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</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="sndclm.html#bess">bess</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-nrcos">make-nrcos</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#sndwarninghook">snd-warning-hook</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="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</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#opennextfileindirectory">open-next-file-in-directory</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#analogfilterdoc">bessel filters</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-nrssb">make-nrssb</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="s7.html#sortb">sort!</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#fv">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="extsnd.html#openrawsoundhook">open-raw-sound-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="s7.html#bignum">bignum</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-nrxysin">make-nrxysin</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#soundtoamp_env">sound->amp-env</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#fvplus">float-vector+</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="s7.html#openlet">openlet</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="sndscm.html#binaryiodoc">binary files</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-nsincos">make-nsincos</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="extsnd.html#soundfileextensions">sound-file-extensions</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#fvtolist">float-vector->list</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="s7.html#openlets">openlets</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#bird">bird</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-nxy1cos">make-nxy1cos</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#soundfilesindirectory">sound-files-in-directory</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#fvabs">float-vector-abs!</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="sndclm.html#oscil">oscil</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="sndscm.html#blackman4envchannel">blackman4-env-channel</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-nxycos">make-nxycos</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#soundloopinfo">sound-loop-info</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#fvequal">float-vector-equal?</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="sndclm.html#oscil-bank?">oscil-bank?</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#boldpeaksfont">bold-peaks-font</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-one-pole">make-one-pole</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#soundproperty">sound-property</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#fvlength">float-vector-length</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#out-any">out-any</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="sndclm.html#brown-noise">brown-noise</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-zero">make-one-zero</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#soundp">sound?</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#fvmin">float-vector-min</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#outa">outa</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="sndscm.html#analogfilterdoc">butterworth filters</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-oscil-bank">make-oscil-bank</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#sounds">sounds</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#fvmultiply">float-vector-multiply!</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#*output*">*output*</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="s7.html#bytevectortostring">byte-vector->string</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-pink-noise">make-pink-noise</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#spectra">spectra</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#fvpeak">float-vector-peak</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="sndscm.html#overlayrmsenv">overlay-rms-env</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#bytevectorset">byte-vector-set!</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="extsnd.html#makeplayer">make-player</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="sndscm.html#spectralpolynomial">spectral-polynomial</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#fvref">float-vector-ref</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> </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="s7.html#bytep">byte?</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-polyshape">make-polyshape</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr> - <tr><td><em class=tab> </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-polywave">make-polywave</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 class="green"><div class="centered">C</div></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-pulse-train">make-pulse-train</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#spectroyangle">spectro-y-angle</a></em></td></tr> - <tr><td><em class=tab> </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-pulsed-env">make-pulsed-env</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#spectroyscale">spectro-y-scale</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="extsnd.html#fvsubtract">float-vector-subtract!</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="sndscm.html#padsound">pad-sound</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#cgp">c-g?</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-r2k2cos">make-r2k2cos</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#spectrozscale">spectro-z-scale</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cobjecttypew">c-object-type</a></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="sndscm.html#makeramp">make-ramp</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="sndclm.html#spectrum">spectrum</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#flocsig">flocsig</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#panmix">pan-mix</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="s7.html#cpoint">c-pointer</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-rand-interp">make-rand-interp</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#spectrumend">spectrum-end</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cpointertolist">c-pointer->list</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-rcos">make-rcos</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#spectrumstart">spectrum-start</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cpointinfo">c-pointer-info</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-readin">make-readin</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#speedcontrol">speed-control</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cpointtype">c-pointer-type</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="extsnd.html#makeregion">make-region</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#speedcontrolbounds">speed-control-bounds</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cpointweak1">c-pointer-weak1</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="extsnd.html#makeregionsampler">make-region-sampler</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#speedstyle">speed-control-style</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="sndclm.html#make-rk!cos">make-rk!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#speedtones">speed-control-tones</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="sndclm.html#make-rk!ssb">make-rk!ssb</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="sndscm.html#spotfreq">spot-freq</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-rkcos">make-rkcos</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="sndclm.html#square-wave">square-wave</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-rkoddssb">make-rkoddssb</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="sndclm.html#square-wave?">square-wave?</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-rksin">make-rksin</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#squelchupdate">squelch-update</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-rkssb">make-rkssb</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#squelchvowels">squelch-vowels</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-round-interp">make-round-interp</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="extsnd.html#srate">srate</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-rssb">make-rssb</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#genericsrate"><b>srate (generic)</b></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-rxycos">make-rxycos</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#src">src</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-rxyk!cos">make-rxyk!cos</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="extsnd.html#srcchannel">src-channel</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-rxyk!sin">make-rxyk!sin</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#srcduration">src-duration</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-rxysin">make-rxysin</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="sndscm.html#srcfitenvelope">src-fit-envelope</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-sampletofile">make-sample->file</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="sndscm.html#srcmixes">src-mixes</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="extsnd.html#makesampler">make-sampler</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#srcsoundselection">src-selection</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-sawtooth-wave">make-sawtooth-wave</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="extsnd.html#srcsound">src-sound</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="sndscm.html#makeselection">make-selection</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#src?">src?</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-sinc-train">make-sinc-train</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="sndclm.html#ssb-am">ssb-am</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="extsnd.html#makesndtosample">make-snd->sample</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="sndclm.html#ssb-am?">ssb-am?</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="sndscm.html#makesoundbox">make-sound-box</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#ssbbank">ssb-bank</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="sndscm.html#makespencerfilter">make-spencer-filter</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#ssbbankenv">ssb-bank-env</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="sndclm.html#make-square-wave">make-square-wave</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="sndscm.html#ssbfm">ssb-fm</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="sndclm.html#make-src">make-src</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="sndscm.html#startdac">start-dac</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-ssb-am">make-ssb-am</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#startplaying">start-playing</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-table-lookup">make-table-lookup</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#startplayinghook">start-playing-hook</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-table-lookup-with-env">make-table-lookup-with-env</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#startplayingselectionhook">start-playing-selection-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="sndclm.html#frampletoframple">frample->frample</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="extsnd.html#playerQ">player?</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="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-triangle-wave">make-triangle-wave</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#statusreport">status-report</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-two-pole">make-two-pole</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#stdinprompt">stdin-prompt</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-two-zero">make-two-zero</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#stereotomono">stereo->mono</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="sndscm.html#makevariabledisplay">make-variable-display</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="sndscm.html#stereoflute">stereo-flute</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="extsnd.html#makevariablegraph">make-variable-graph</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#stopplayer">stop-player</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="s7.html#makevector">make-vector</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#stopplaying">stop-playing</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="sndclm.html#make-wave-train">make-wave-train</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="extsnd.html#stopplayinghook">stop-playing-hook</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-with-env">make-wave-train-with-env</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="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</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="s7.html#makeweakhashtable">make-weak-hash-table</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="sndscm.html#stretchenvelope">stretch-envelope</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="sndclm.html#polyoidenv">polyoid-env</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#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="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="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="sndclm.html#polyshape">polyshape</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="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="sndclm.html#polyshape?">polyshape?</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#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="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="s7.html#subvector">subvector</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="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorposition">subvector-position</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="s7.html#portfilename">port-filename</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorvector">subvector-vector</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="s7.html#portlinenumber">port-line-number</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorp">subvector?</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="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="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="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="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="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#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="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#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="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="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="sndscm.html#pqwvox">pqw-vox</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#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="extsnd.html#preferencesdialog">preferences-dialog</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#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="extsnd.html#previoussample">previous-sample</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#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="extsnd.html#printdialog">print-dialog</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#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="extsnd.html#printlength">print-length</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#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#proceduresource">procedure-source</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="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#progressreport">progress-report</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="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="sndclm.html#pulse-train">pulse-train</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="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="sndclm.html#pulse-train?">pulse-train?</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#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="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td><em class=tab> </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="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td class="green"><div class="centered">T</div></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> </em></td><td></td><td><em class=tab> </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 class="green"><div class="centered">R</div></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="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> </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="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="sndclm.html#r2k!cos">r2k!cos</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="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="sndclm.html#r2k!cos?">r2k!cos?</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#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="sndclm.html#r2k2cos">r2k2cos</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#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="sndclm.html#r2k2cos?">r2k2cos?</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="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="sndclm.html#radianstodegrees">radians->degrees</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#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="sndclm.html#radianstohz">radians->hz</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#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#rampchannel">ramp-channel</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="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#rand">rand</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#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#rand-interp">rand-interp</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="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#rand-interp?">rand-interp?</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#contrastsound">contrast-sound</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="extsnd.html#mix">mix</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="sndclm.html#timestosamples">times->samples</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#hashtableref">hash-table-ref</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><a href="s7.html#random">random</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#controlstochannel">controls->channel</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#mixtointeger">mix->integer</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="sndscm.html#telephone">touch-tone</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#hashtablep">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="s7.html#randomstate">random-state</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="extsnd.html#convolvewith">convolution reverb</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#mixampenv">mix-amp-env</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#trackingcursors"><b>Tracking cursors</b></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="snd.html#formats"><b>Headers and sample types</b></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#rcos">rcos</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="sndclm.html#convolvefiles">convolve-files</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#mixclickhook">mix-click-hook</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#transformtofv">transform->float-vector</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="extsnd.html#helpdialog">help-dialog</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="s7.html#readerrorhook">*read-error-hook*</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#convolvewith">convolve-with</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="sndscm.html#mixclicksetsamp">mix-click-sets-amp</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#transformdialog">transform-dialog</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#hidewidget">hide-widget</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="extsnd.html#readmixsample">read-mix-sample</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#fvcopy">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#mixdialogmix">mix-dialog-mix</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#transformgraphstyle">transform-graph-style</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="sndscm.html#hilberttransform">hilbert-transform</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="extsnd.html#readregionsample">read-region-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#genericcopy"><b>copy (generic)</b></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#mixfiledialog">mix-file-dialog</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#transformgraphp">transform-graph?</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="sndscm.html#hookmember">hook-member</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="extsnd.html#readsamplewithdirection">read-sample-with-direction</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#copysampler">copy-sampler</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#mixhome">mix-home</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#transformsample">transform-sample</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="sndscm.html#html">html</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#readin">readin</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#correlate">correlate</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="sndscm.html#mixmaxamp">mix-maxamp</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#transformtype">transform-type</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#htmlprogram">html-program</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="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</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="s7.html#coverlets">coverlets</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="sndscm.html#mixnametoid">mix-name->id</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="sndscm.html#transposemixes">transpose-mixes</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> </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#redo">redo</a></em></td><td></td><td><em class=tab><a href="s7.html#treecount">tree-count</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td class="green"><div class="centered">I</div></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#regiontofv">region->float-vector</a></em></td><td></td><td><em class=tab><a href="s7.html#treecyclic">tree-cyclic?</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#mixproperty">mix-property</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="s7.html#treeleaves">tree-leaves</a></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#iir-filter">iir-filter</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#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="s7.html#treememq">tree-memq</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#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#regionframples">region-framples</a></em></td><td></td><td><em class=tab><a href="s7.html#treesetmemq">tree-set-memq</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="s7.html#immutableb">immutable!</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#regiongraphstyle">region-graph-style</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="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="s7.html#immutablep">immutable?</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#regionhome">region-home</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="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="sndscm.html#mixsound">mix-sound</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="sndscm.html#tubebell">tubebell</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="extsnd.html#mixspeed">mix-speed</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="sndscm.html#tubebell">tubular bell</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#mixsync">mix-sync</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="sndclm.html#two-pole">two-pole</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#mixsyncmax">mix-sync-max</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="sndclm.html#two-pole?">two-pole?</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#mixtagheight">mix-tag-height</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="sndscm.html#twotab">two-tab</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#mixtagwidth">mix-tag-width</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="sndclm.html#two-zero">two-zero</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#mixtagy">mix-tag-y</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="sndclm.html#two-zero?">two-zero?</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#mixwaveformheight">mix-waveform-height</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="s7.html#typeof">type-of</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#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab> </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#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td class="green"><div class="centered">U</div></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#sndmixes"><b>Mixing</b></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> </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="sndscm.html#monotostereo">mono->stereo</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#unbindkey">unbind-key</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#moogfilter">moog-filter</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="s7.html#unboundvariablehook">*unbound-variable-hook*</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="extsnd.html#mouseclickhook">mouse-click-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><a href="sndscm.html#unclipchannel">unclip-channel</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="extsnd.html#mousedraghook">mouse-drag-hook</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#undo">undo</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#mouseentergraphhook">mouse-enter-graph-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><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></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#mouseenterlabelhook">mouse-enter-label-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="extsnd.html#undohook">undo-hook</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="extsnd.html#insertsilence">insert-silence</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#resampleexamples"><b>Resampling</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="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#mouseentertexthook">mouse-enter-text-hook</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="extsnd.html#unselectall">unselect-all</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#insertionexamples"><b>Insertions</b></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#resetcontrols">reset-controls</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#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#mouseleavelabelhook">mouse-leave-label-hook</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#updatehook">update-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#mousleavelistenerhook">mouse-leave-listener-hook</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#updatelispgraph">update-lisp-graph</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#mousleavetexthook">mouse-leave-text-hook</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#updatesound">update-sound</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#mousepresshook">mouse-press-hook</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#updatetimegraph">update-time-graph</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="sndclm.html#move-locsig">move-locsig</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#updatetransformgraph">update-transform-graph</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="sndscm.html#movemixes">move-mixes</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="sndscm.html#uponsaveyourself">upon-save-yourself</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-sound">move-sound</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#sndmotifdoc">user interface extensions</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="sndclm.html#move-sound?">move-sound?</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> </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="sndscm.html#movesyncdmarks">move-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td class="green"><div class="centered">V</div></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#moving-autocorrelation">moving-autocorrelation</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> </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="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</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="sndscm.html#variabledisplay">variable-display</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-average">moving-average</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#variablegraphp">variable-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-average?">moving-average?</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="s7.html#varlet">varlet</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-fft">moving-fft</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="sndscm.html#vibratinguniformcircularstring">vibrating-uniform-circular-string</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-fft?">moving-fft?</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#viewfilesamp">view-files-amp</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-length">moving-length</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#viewfilesampenv">view-files-amp-env</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="s7.html#iteratorp">iterator?</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#reverseenvelope">reverse-envelope</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="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-max?">moving-max?</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#viewfilesfiles">view-files-files</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#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#reversesound">reverse-sound</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#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-norm?">moving-norm?</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#viewfilesselectedfiles">view-files-selected-files</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-pitch">moving-pitch</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#viewfilessort">view-files-sort</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-pitch?">moving-pitch?</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#viewfilesspeed">view-files-speed</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-rms">moving-rms</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#viewfilesspeedstyle">view-files-speed-style</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-scentroid">moving-scentroid</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#viewmixesdialog">view-mixes-dialog</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-scentroid?">moving-scentroid?</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#viewregionsdialog">view-regions-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-spectrum">moving-spectrum</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#viewsound">view-sound</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-spectrum?">moving-spectrum?</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="sndscm.html#singerdoc">voice physical model</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-sum">moving-sum</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#voicedtounvoiced">voiced->unvoiced</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="sndscm.html#mpg">mpg</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#volterrafilter">volterra-filter</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="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</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#fmvox">vox</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="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td><em class=tab> </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#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td class="green"><div class="centered">W</div></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#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td><em class=tab> </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#musalsaplaybackdevice">mus-alsa-playback-device</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="sndclm.html#wave-train">wave-train</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#musalsasquelchwarning">mus-alsa-squelch-warning</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="sndclm.html#wave-train?">wave-train?</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="sndclm.html#musarrayprintlength">mus-array-print-length</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#wavelettype">wavelet-type</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#musbytespersample">mus-bytes-per-sample</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="sndscm.html#pqwvox">waveshaping voice</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#mus-channel">mus-channel</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#wavohop">wavo-hop</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="sndclm.html#mus-channels">mus-channels</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#wavotrace">wavo-trace</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> </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="s7.html#rootletredefinitionhook">*rootlet-redefinition-hook*</a></em></td><td></td><td><em class=tab><a href="s7.html#weakhashtable">weak-hash-table</a></em></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="extsnd.html#musclipping">mus-clipping</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="s7.html#weakhashtablep">weak-hash-table?</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> </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#round-interp?">round-interp?</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#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="sndclm.html#mus-copy">mus-copy</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#widgetposition">widget-position</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-data">mus-data</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="extsnd.html#widgetsize">widget-size</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-describe">mus-describe</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#widgettext">widget-text</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#documentation">documentation</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#muserrorhook">mus-error-hook</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#movingwindows"><b>Window size and position</b></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#k2ssb">k2ssb</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="grfsnd.html#sndandruby"><b>Ruby</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="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="extsnd.html#musexpandfilename">mus-expand-filename</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="sndscm.html#windowsamples">window-samples</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#k3sin">k3sin</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#rxycos?">rxycos?</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="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="sndclm.html#mus-feedforward">mus-feedforward</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#windowx">window-x</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="sndscm.html#kalmanfilterchannel">kalman-filter-channel</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#rxyk!cos?">rxyk!cos?</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="extsnd.html#drawdot">draw-dot</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#musfilebuffersize">mus-file-buffer-size</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#withbackgroundprocesses">with-background-processes</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#keybinding">key-binding</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="sndclm.html#rxyk!sin?">rxyk!sin?</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#drawline">draw-line</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="sndscm.html#musfilemix">mus-file-mix</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#withfilemonitor">with-file-monitor</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="sndclm.html#krksin">krksin</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#rxysin?">rxysin?</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#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="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab> </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#drawmixhook">draw-mix-hook</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 class="green"><div class="centered">S</div></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#drawstring">draw-string</a></em></td><td></td><td class="green"><div class="centered">L</div></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab> </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="sndscm.html#drone">drone</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="s7.html#s7doc"><b>s7 scheme</b></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="sndscm.html#makedropsite">drop sites</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="extsnd.html#musheadertypetostring">mus-header-type->string</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#withmenuicons">with-menu-icons</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="extsnd.html#ladspadir">ladspa-dir</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#sampletofile">sample->file</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#duringopenhook">during-open-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-hop">mus-hop</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#withpointerfocus">with-pointer-focus</a></em></td></tr> - <tr><td><em class=tab> </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-increment">mus-increment</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#withrelativepanes">with-relative-panes</a></em></td></tr> - <tr><td class="green"><div class="centered">E</div></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-input?">mus-input?</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#withsmptelabel">with-smpte-label</a></em></td></tr> - <tr><td><em class=tab> </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-interp-type">mus-interp-type</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="sndscm.html#withsound">with-sound</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="s7.html#lettolist">let->list</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="extsnd.html#samplerposition">sampler-position</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="extsnd.html#editfragment">edit-fragment</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-length">mus-length</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#withtoolbar">with-toolbar</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#letset">let-set!</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="extsnd.html#samplers"><b>samplers</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="extsnd.html#edithook">edit-hook</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="extsnd.html#musmaxmalloc">mus-max-malloc</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#withtrackingcursor">with-tracking-cursor</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#letp">let?</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="sndclm.html#samplestoseconds">samples->seconds</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#editposition">edit-position</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-name">mus-name</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> </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="sndscm.html#linearsrcchannel">linear-src-channel</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#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td class="green"><div class="centered">X</div></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#lintdoc">lint for scheme</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#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab> </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="extsnd.html#lispgraphhook">lisp-graph-hook</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#savecontrols">save-controls</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#edits">edits</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-output?">mus-output?</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#xaxislabel">x-axis-label</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#lispgraphp">lisp-graph?</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#saveedithistory">save-edit-history</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="extsnd.html#effectshook">effects-hook</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-ramp">mus-ramp</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#xbounds">x-bounds</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="grfsnd.html#listladspa">list-ladspa</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#savehook">save-hook</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="grfsnd.html#emacssnd"><b>Emacs and Snd</b></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-random">mus-random</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#xzoomslider">x-zoom-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="extsnd.html#listenercolor">listener-color</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="sndscm.html#savemarkproperties">save-mark-properties</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="sndclm.html#env-any">env-any</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-run">mus-run</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#xrampchannel">xramp-channel</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#listenerfont">listener-font</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#savemix">save-mix</a></em></td><td></td><td><em class=tab> </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#listenerprompt">listener-prompt</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#saveregion">save-region</a></em></td><td></td><td class="green"><div class="centered">Y</div></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#listenerselection">listener-selection</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#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab> </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#listenertextcolor">listener-text-color</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#saveselection">save-selection</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="sndscm.html#envmixes">env-mixes</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#mussoundcomment">mus-sound-comment</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#yaxislabel">y-axis-label</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="s7.html#loadhook">*load-hook*</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#savesound">save-sound</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#envsound">env-sound</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#mussounddatumsize">mus-sound-datum-size</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#ypositionslider">y-position-slider</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="sndscm.html#locatezero">locate-zero</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#savesounddialog">save-sound-dialog</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="sndscm.html#envsquaredchannel">env-squared-channel</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#mussoundforget">mus-sound-forget</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> </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-ref">locsig-ref</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#savestatefile">save-state-file</a></em></td><td></td><td class="green"><div class="centered">Z</div></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-reverb-ref">locsig-reverb-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#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab> </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-set!">locsig-reverb-set!</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#saveexamples"><b>Saving</b></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#enveddialog">enved-dialog</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#mussoundloopinfo">mus-sound-loop-info</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><a href="sndscm.html#zecho">zecho</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-type">locsig-type</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="sndclm.html#sawtooth-wave">sawtooth-wave</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#filterenv">enved-filter</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#mussoundmaxamp">mus-sound-maxamp</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><a href="extsnd.html#zeropad">zero-pad</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="extsnd.html#logfreqstart">log-freq-start</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#scaleby">scale-by</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#envedhook">enved-hook</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#mussoundpath">mus-sound-path</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="sndscm.html#zipsound">zip-sound</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="sndscm.html#lpcpredict">lpc-predict</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="sndscm.html#scaleenvelope">scale-envelope</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#envedpower">enved-power</a></em></td><td></td><td><em class=tab> </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="sndscm.html#scalemixes">scale-mixes</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#envedstyle">enved-style</a></em></td><td></td><td class="green"><div class="centered">M</div></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="extsnd.html#scaleselectionby">scale-selection-by</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="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab> </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#scaleselectionto">scale-selection-to</a></em></td><td></td> + <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</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#mussoundwritedate">mus-sound-write-date</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> </em></td><td></td><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</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="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td></tr> + <tr><td class="green"><div class="centered">A</div></td><td></td><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-abcos">make-abcos</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#dspdocscanned">scanned synthesis</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><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-absin">make-absin</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#scentroid">scentroid</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#eoddcos">eoddcos</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="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</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#eoddcos?">eoddcos?</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="sndclm.html#mus-ycoeff">mus-ycoeff</a></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#abort">abort</a></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-triangle-wave">make-adjustable-triangle-wave</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="extsnd.html#scriptargs">script-args</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#epsfile">eps-file</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> </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="sndclm.html#absin?">absin?</a></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#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td class="green"><div class="centered">N</div></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="sndscm.html#addampcontrols">add-amp-controls</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-asyfm">make-asyfm</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></tr> + <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="s7.html#equivalentp">equivalent?</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#n1cos">n1cos</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#adddeleteoption">add-delete-option</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="sndscm.html#makebandpass">make-bandpass</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="sndclm.html#secondstosamples">seconds->samples</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="sndclm.html#ercos?">ercos?</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="extsnd.html#nameclickhook">name-click-hook</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="extsnd.html#addfilefilter">add-file-filter</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-bess">make-bess</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#selectchannel">select-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="sndclm.html#erssb">erssb</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#nchoosekcos?">nchoosekcos?</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="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</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#makebirds">make-birds</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#selectsound">select-sound</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#evenmultiple">even-multiple</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#ncos2?">ncos2?</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="sndscm.html#addmarkpane">add-mark-pane</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="sndclm.html#make-brown-noise">make-brown-noise</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#selectedchannel">selected-channel</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#everysample">every-sample?</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="sndclm.html#ncos?">ncos?</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="extsnd.html#addsoundfileextension">add-sound-file-extension</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="sndscm.html#makedropsite">make-channel-drop-site</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#selectedgraphcolor">selected-graph-color</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#exithook">exit-hook</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="extsnd.html#newsounddialog">new-sound-dialog</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#addtomainmenu">add-to-main-menu</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-comb">make-comb</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#selection">selection</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="extsnd.html#expandcontrolbounds">expand-control-bounds</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="extsnd.html#newwidgethook">new-widget-hook</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="sndscm.html#addtooltip">add-tooltip</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="sndclm.html#make-convolve">make-convolve</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#selectionchans">selection-chans</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#expandcontroljitter">expand-control-jitter</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#nkssb">nkssb</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="sndscm.html#spectra">additive synthesis</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="sndscm.html#makedifferentiator">make-differentiator</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#selectioncontext">selection-context</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="extsnd.html#expandcontrolramp">expand-control-ramp</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#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="sndclm.html#adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</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-eoddcos">make-eoddcos</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#selectionframples">selection-framples</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#explodesf2">explode-sf2</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#noddcos?">noddcos?</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#adjustable-square-wave?">adjustable-square-wave?</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-erssb">make-erssb</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#selectionmaxampposition">selection-maxamp-position</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#expsnd">expsnd</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#noddsin?">noddsin?</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#adjustable-triangle-wave?">adjustable-triangle-wave?</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-filetoframple">make-file->frample</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#selectionmembers">selection-members</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> </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#noddssb?">noddssb?</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#afteredithook">after-edit-hook</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-filter">make-filter</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="sndscm.html#selectionrms">selection-rms</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> </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="sndscm.html#cleandoc"><b>Noise Reduction</b></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#afterlispgraphhook">after-lisp-graph-hook</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#makefilteredcombbank">make-filtered-comb-bank</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#selectionok">selection?</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="sndscm.html#cellon">feedback fm</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="sndscm.html#normalizeenvelope">normalize-envelope</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="extsnd.html#aftersaveashook">after-save-as-hook</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-fir-filter">make-fir-filter</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#setsamples">set-samples</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#fftcancel">fft-cancel</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="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#setter">setter</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#fftedit">fft-edit</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="sndscm.html#normalizedmix">normalized-mix</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#allchans">all-chans</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-flocsig">make-flocsig</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#showaxes">show-axes</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="sndscm.html#fftenvinterp">fft-env-interp</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="sndscm.html#notchchannel">notch-channel</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#allpassbank">all-pass-bank</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-formant">make-formant</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="sndscm.html#showdiskspace">show-disk-space</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#fftlogmagnitude">fft-log-magnitude</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="sndscm.html#notchsound">notch-sound</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="sndclm.html#all-pass?">all-pass?</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-frampletofile">make-frample->file</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#showfullrange">show-full-range</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#fftsquelch">fft-squelch</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="sndclm.html#npcos?">npcos?</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#ampcontrol">amp-control</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="extsnd.html#makegraphdata">make-graph-data</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#showindices">show-indices</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#fftalpha">fft-window-alpha</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="sndclm.html#nrcos?">nrcos?</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="sndclm.html#amplitude-modulate">amplitude-modulate</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-green-noise-interp">make-green-noise-interp</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#showmarks">show-marks</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#fftwithphases">fft-with-phases</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="sndclm.html#nrsin">nrsin</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="sndscm.html#anoi">anoi</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="sndscm.html#makehighpass">make-highpass</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#showselection">show-selection</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="sndscm.html#nbdoc">file database</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#nrssb">nrssb</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#anyrandom">any-random</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#makehook">make-hook</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#showsonogramcursor">show-sonogram-cursor</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="sndclm.html#filetoframple">file->frample</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#nrssb?">nrssb?</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="grfsnd.html#applyladspa">apply-ladspa</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#makeintvector">make-int-vector</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#showwidget">show-widget</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="sndclm.html#filetosample">file->sample</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#nrxycos?">nrxycos?</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="s7.html#arity">arity</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-izcos">make-izcos</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="s7.html#signature">signature</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#filename">file-name</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#nrxysin?">nrxysin?</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="sndclm.html#array-interp">array-interp</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-j0j1cos">make-j0j1cos</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#silencemixes">silence-mixes</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="s7.html#fillb">fill!</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#nsin?">nsin?</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#askaboutunsavededits">ask-about-unsaved-edits</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-jjcos">make-jjcos</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#askbeforeoverwrite">ask-before-overwrite</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-jncos">make-jncos</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#sincwidth">sinc-width</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#fillrectangle">fill-rectangle</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#nssb">nssb</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="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-jycos">make-jycos</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="sndscm.html#sineramp">sine-ramp</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#filterchannel">filter-channel</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#nxy1cos">nxy1cos</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="sndclm.html#asymmetric-fm">asymmetric-fm</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-k2sin">make-k2sin</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#smoothchannel">smooth-channel</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#filtercontrolenvelope">filter-control-envelope</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#nxy1sin">nxy1sin</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="extsnd.html#autoresize">auto-resize</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-k3sin">make-k3sin</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#smoothsound">smooth-sound</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#filtercontrolinhz">filter-control-in-hz</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#nxycos">nxycos</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="extsnd.html#autoupdate">auto-update</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-locsig">make-locsig</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#pins">SMS synthesis</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#filterwaveformcolor">filter-control-waveform-color</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#nxysin">nxysin</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#autocorrelate">autocorrelate</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="extsnd.html#makemixsampler">make-mix-sampler</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#snapmarks">snap-marks</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="sndscm.html#filterfft">filter-fft</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> </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#axiscolor">axis-color</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-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td class="green"><div class="centered">O</div></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#axisinfo">axis-info</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-average">make-moving-average</a></em></td><td></td><td><em class=tab> </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#axislabelfont">axis-label-font</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-fft">make-moving-fft</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#sndcolor">snd-color</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#filter?">filter?</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="s7.html#objecttostring">object->string</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> </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#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-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#filteredcombbank">filtered-comb-bank</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#oddweight">odd-weight</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> </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-scentroid">make-moving-scentroid</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#sndgcs">snd-gcs</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="sndclm.html#filtered-comb?">filtered-comb?</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="sndscm.html#offsetsound">offset-sound</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#badheaderhook">bad-header-hook</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-n1cos">make-n1cos</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="sndscm.html#sndscmhooks">snd-hooks</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#finddialog">find-dialog</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#one-pole-all-pass">one-pole-all-pass</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#basiccolor">basic-color</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-ncos">make-ncos</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#sndprint">snd-print</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="sndscm.html#findmix">find-mix</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#one-pole?">one-pole?</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="extsnd.html#beatsperminute">beats-per-minute</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-noddcos">make-noddcos</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#sndtempnam">snd-tempnam</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#finfo">finfo</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="sndclm.html#one-zero?">one-zero?</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#beforeexithook">before-exit-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-noddssb">make-noddssb</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#sndurls">snd-urls</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="sndclm.html#fir-filter">fir-filter</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="extsnd.html#openfiledialogdirectory">open-file-dialog-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#beforesavestatehook">before-save-state-hook</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-notch">make-notch</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#sndwarning">snd-warning</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="sndclm.html#firmant">firmant</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#opennextfileindirectory">open-next-file-in-directory</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="extsnd.html#besj0">bes-j0</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-nrsin">make-nrsin</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="sndscm.html#sndwarp">sndwarp</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="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</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="extsnd.html#openrawsoundhook">open-raw-sound-hook</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#bess?">bess?</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-nrxycos">make-nrxycos</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="sndclm.html#make-locsig"><b>Sound placement</b></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#fv">float-vector</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="s7.html#openlet">openlet</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#bigbird">bigbird</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-nsin">make-nsin</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="extsnd.html#soundtointeger">sound->integer</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#fvplus">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="s7.html#openlets">openlets</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="s7.html#bignump">bignum?</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-nssb">make-nssb</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#soundfilep">sound-file?</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#fvtolist">float-vector->list</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="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="extsnd.html#bindkey">bind-key</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-nxy1sin">make-nxy1sin</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="sndscm.html#soundinterp">sound-interp</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#fvabs">float-vector-abs!</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="sndclm.html#oscil-bank?">oscil-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="sndclm.html#blackman">blackman</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-nxysin">make-nxysin</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="sndscm.html#blackman4envchannel">blackman4-env-channel</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-one-pole">make-one-pole</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#soundproperty">sound-property</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#fvfill">float-vector-fill!</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#outbank">out-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#boldpeaksfont">bold-peaks-font</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-one-zero">make-one-zero</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#soundp">sound?</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#fvmax">float-vector-max</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#outlet">outlet</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#brown-noise">brown-noise</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-oscil-bank">make-oscil-bank</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#sounds">sounds</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#fvmove">float-vector-move!</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#outputcommenthook">output-comment-hook</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#analogfilterdoc">butterworth filters</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-pink-noise">make-pink-noise</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="sndscm.html#spectra">spectra</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#fvoffset">float-vector-offset!</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="s7.html#owlet">owlet</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#bytevectortostring">byte-vector->string</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="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab> </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#bytevectorref">byte-vector-ref</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-polyoid">make-polyoid</a></em></td><td></td><td class="green"><div class="centered">P</div></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="s7.html#bytevectorset">byte-vector-set!</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-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab> </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="s7.html#bytevectorp">byte-vector?</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-polywave">make-polywave</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#spectroxscale">spectro-x-scale</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bytep">byte?</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-pulse-train">make-pulse-train</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#spectroyangle">spectro-y-angle</a></em></td></tr> + <tr><td><em class=tab> </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-pulsed-env">make-pulsed-env</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#spectroyscale">spectro-y-scale</a></em></td></tr> + <tr><td class="green"><div class="centered">C</div></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-r2k!cos">make-r2k!cos</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#spectrozangle">spectro-z-angle</a></em></td></tr> + <tr><td><em class=tab> </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-r2k2cos">make-r2k2cos</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#spectrozscale">spectro-z-scale</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="extsnd.html#fvp">float-vector?</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#panmix">pan-mix</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#cgp">c-g?</a></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-rand">make-rand</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="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cobjecttypew">c-object-type</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-rand-interp">make-rand-interp</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#spectrumend">spectrum-end</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#flocsig?">flocsig?</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="sndclm.html#partialstowave">partials->wave</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#cpoint">c-pointer</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-readin">make-readin</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#speedcontrol">speed-control</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointertolist">c-pointer->list</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="extsnd.html#makeregion">make-region</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#speedcontrolbounds">speed-control-bounds</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointinfo">c-pointer-info</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="extsnd.html#makeregionsampler">make-region-sampler</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#speedstyle">speed-control-style</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointtype">c-pointer-type</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-rk!cos">make-rk!cos</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#speedtones">speed-control-tones</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointweak1">c-pointer-weak1</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="sndclm.html#make-rk!ssb">make-rk!ssb</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="sndscm.html#spotfreq">spot-freq</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#fmvox">fm-talker</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="sndclm.html#phase-vocoder">phase-vocoder</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#callwithexit">call-with-exit</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-rkoddssb">make-rkoddssb</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="sndclm.html#square-wave?">square-wave?</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#vdoc">fm-violin</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#prc95doc"><b>Physical Models</b></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#cascadetocanonical">cascade->canonical</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-rkssb">make-rkssb</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="sndscm.html#squelchvowels">squelch-vowels</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="sndclm.html#fmssb">fmssb</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#pink-noise">pink-noise</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="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-rssb">make-rssb</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#genericsrate"><b>srate (generic)</b></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#focuswidget">focus-widget</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="sndscm.html#pins">pins</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#channeltofv">channel->float-vector</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-rxyk!cos">make-rxyk!cos</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#srcchannel">src-channel</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">fofins</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#play">play</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="extsnd.html#channeldata">channel-data</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-rxysin">make-rxysin</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="sndscm.html#srcfitenvelope">src-fit-envelope</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#foreachsoundfile">for-each-sound-file</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="extsnd.html#playarrowsize">play-arrow-size</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#channelpolynomial">channel-polynomial</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="extsnd.html#makesampler">make-sampler</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="extsnd.html#srcsoundselection">src-selection</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="extsnd.html#foregroundcolor">foreground-color</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="extsnd.html#playhook">play-hook</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#channelproperty">channel-property</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="sndscm.html#makeselection">make-selection</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="sndclm.html#src?">src?</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="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="sndscm.html#playoften">play-often</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#channelstyle">channel-style</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="extsnd.html#makesndtosample">make-snd->sample</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="sndclm.html#ssb-am?">ssb-am?</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#formantbankp">formant-bank?</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#playsine">play-sine</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#channelwidgets">channel-widgets</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#makespencerfilter">make-spencer-filter</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="sndscm.html#ssbbankenv">ssb-bank-env</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="s7.html#format">format</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#playsyncdmarks">play-syncd-marks</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#genericchannels"><b>channels (generic)</b></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-src">make-src</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#startdac">start-dac</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="sndscm.html#fp">fp</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#playwithenvs">play-with-envs</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="sndscm.html#channelseq">channels=?</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-table-lookup">make-table-lookup</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#startplayinghook">start-playing-hook</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="sndclm.html#frampletofile">frample->file</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#playerQ">player?</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="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-tanhsin">make-tanhsin</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#startprogressreport">start-progress-report</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#frampletoframple">frample->frample</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="extsnd.html#playing">playing</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#analogfilterdoc">chebyshev filters</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-two-pole">make-two-pole</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#stdinprompt">stdin-prompt</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#genericframples"><b>framples (generic)</b></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#pluck">pluck</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#chordalize">chordalize</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="sndscm.html#makevariabledisplay">make-variable-display</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="sndscm.html#stereoflute">stereo-flute</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#freesampler">free-sampler</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="sndclm.html#polartorectangular">polar->rectangular</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="sndscm.html#cleanchannel">clean-channel</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="s7.html#makevector">make-vector</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="extsnd.html#stopplaying">stop-playing</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="fm.html#fmintro"><b>Frequency Modulation</b></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#polydoc">polynomial operations</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#clearlistener">clear-listener</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="sndclm.html#make-wave-train-with-env">make-wave-train-with-env</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#stopplayingselectionhook">stop-playing-selection-hook</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="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="s7.html#makeweakhashtable">make-weak-hash-table</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="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab> </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="sndclm.html#polyoid?">polyoid?</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#clmchannel">clm-channel</a></em></td><td></td><td class="green"><div class="centered">G</div></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#polyshape">polyshape</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#clmexpsrc">clm-expsrc</a></em></td><td></td><td><em class=tab> </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#polyshape?">polyshape?</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="extsnd.html#closehook">close-hook</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#marktointeger">mark->integer</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#sublet">sublet</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#gcoff">gc-off</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="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#subvector">subvector</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#gcon">gc-on</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="s7.html#portfile">port-file</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorposition">subvector-position</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="sndclm.html#generators"><b>Generators</b></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="s7.html#portfilename">port-filename</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorvector">subvector-vector</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="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="s7.html#portlinenumber">port-line-number</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorp">subvector?</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#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#portposition">port-position</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="sndscm.html#colormixes">color-mixes</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#markexplode">mark-explode</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="extsnd.html#swapchannels">swap-channels</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#glspectrogram">glSpectrogram</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="extsnd.html#positiontoy">position->y</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#colorscale">color-scale</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#markhook">mark-hook</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="s7.html#symboltodynamicvalue">symbol->dynamic-value</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#gotolistenerend">goto-listener-end</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="sndscm.html#powerenv">power-env</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#colormap">colormap</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#markname">mark-name</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#symboltable">symbol-table</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="sndclm.html#grains"><b>Granular synthesis</b></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="sndscm.html#pqwvox">pqw-vox</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#colormapname">colormap-name</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="extsnd.html#preferencesdialog">preferences-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="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="extsnd.html#markproperty">mark-property</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#sync-everything">sync-everything</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="sndscm.html#granulatedsoundinterp">granulated-sound-interp</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="extsnd.html#printdialog">print-dialog</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="extsnd.html#colormapp">colormap?</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#marksync">mark-sync</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="extsnd.html#syncstyle">sync-style</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#graphtops">graph->ps</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="s7.html#proceduresource">procedure-source</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="sndclm.html#comb">comb</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#marksyncmax">mark-sync-max</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#syncdmixes">syncd-mixes</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#graphcursor">graph-cursor</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="sndclm.html#pulse-train">pulse-train</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="sndclm.html#combbankp">comb-bank?</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#marktagwidth">mark-tag-width</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="sndclm.html#comb?">comb?</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#markp">mark?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td class="green"><div class="centered">T</div></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#graphstyle">graph-style</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="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab> </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="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</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="grfsnd.html#sndwithcm"><b>Common Music</b></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="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td class="green"><div class="centered">R</div></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="sndscm.html#complexify">complexify</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#maxenvelope">max-envelope</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="sndscm.html#concatenateenvelopes">concatenate-envelopes</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="sndclm.html#r2k!cos">r2k!cos</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="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="extsnd.html#maxfftpeaks">max-transform-peaks</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="s7.html#continuationp">continuation?</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#r2k2cos">r2k2cos</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#continue-frampletofile">continue-frample->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#genericmaxamp"><b>maxamp (generic)</b></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="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab> </em></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="sndclm.html#radianstodegrees">radians->degrees</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="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td class="green"><div class="centered">H</div></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="sndclm.html#radianstohz">radians->hz</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="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab> </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="extsnd.html#rampchannel">ramp-channel</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#contrastcontrolamp">contrast-control-amp</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#menusdoc">menus, optional</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#timegraphtype">time-graph-type</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#dht">Hartley transform</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#rand-interp">rand-interp</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#contrastcontrolp">contrast-control?</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#mix">mix</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="sndclm.html#contrast-enhancement">contrast-enhancement</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><a href="sndclm.html#rand?">rand?</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="sndscm.html#contrastsound">contrast-sound</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><em class=tab><a href="s7.html#random">random</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="snd.html#controls"><b>Control Panel</b></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><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></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="extsnd.html#controlstochannel">controls->channel</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="s7.html#randomstate">random-state</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="sndclm.html#convolution">convolution</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="s7.html#randomstatep">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="extsnd.html#convolvewith">convolution reverb</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#rcos">rcos</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="sndclm.html#convolve">convolve</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#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="sndclm.html#convolvefiles">convolve-files</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="s7.html#readerrorhook">*read-error-hook*</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#convolveselectionwith">convolve-selection-with</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="extsnd.html#readhook">read-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#convolvewith">convolve-with</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#readmixsample">read-mix-sample</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="sndclm.html#convolve?">convolve?</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="extsnd.html#readonly">read-only</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#fvcopy">copy</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="extsnd.html#readregionsample">read-region-sample</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="s7.html#s7copy">copy</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="extsnd.html#readsample">read-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#genericcopy"><b>copy (generic)</b></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="extsnd.html#readsamplewithdirection">read-sample-with-direction</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#copycontext">copy-context</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#readercond">reader-cond</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#copysampler">copy-sampler</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="sndclm.html#readin">readin</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#copying"><b>Copying</b></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="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="sndclm.html#correlate">correlate</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="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</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="s7.html#coverlet">coverlet</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#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab><a href="s7.html#treecount">tree-count</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#coverlets">coverlets</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="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="s7.html#treecyclic">tree-cyclic?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</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="extsnd.html#regiontofv">region->float-vector</a></em></td><td></td><td><em class=tab><a href="s7.html#treeleaves">tree-leaves</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> </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#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab><a href="s7.html#treememq">tree-memq</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><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#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="s7.html#treesetmemq">tree-set-memq</a></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#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#regionframples">region-framples</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="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="s7.html#immutableb">immutable!</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#regiongraphstyle">region-graph-style</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="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="s7.html#immutablep">immutable?</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#regionhome">region-home</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#cursorcolor">cursor-color</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#mixspeed">mix-speed</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="sndscm.html#tubebell">tubular bell</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="sndclm.html#in-any">in-any</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#regionmaxampposition">region-maxamp-position</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#cursorlocationoffset">cursor-location-offset</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#mixsyncmax">mix-sync-max</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="sndclm.html#two-pole?">two-pole?</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#inb">inb</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#regionposition">region-position</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#cursorsize">cursor-size</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#mixtagwidth">mix-tag-width</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="sndclm.html#two-zero">two-zero</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="grfsnd.html#initladspa">init-ladspa</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#regionsample">region-sample</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#cursorupdateinterval">cursor-update-interval</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#mixwaveformheight">mix-waveform-height</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="s7.html#typeof">type-of</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#initialdur">initial-dur</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#regionsrate">region-srate</a></em></td><td></td><td><em class=tab> </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#initialgraphhook">initial-graph-hook</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#regionok">region?</a></em></td><td></td><td class="green"><div class="centered">U</div></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="grfsnd.html#sndinitfile"><b>Initialization file</b></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#eregions">regions</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab> </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="sndscm.html#monotostereo">mono->stereo</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#unbindkey">unbind-key</a></em></td></tr> + <tr><td class="green"><div class="centered">D</div></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="sndscm.html#moogfilter">moog-filter</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="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr> + <tr><td><em class=tab> </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#mouseclickhook">mouse-click-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#unclipchannel">unclip-channel</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#insertregion">insert-region</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#removefrommenu">remove-from-menu</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#dacsize">dac-size</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#mouseentergraphhook">mouse-enter-graph-hook</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#undoexamples"><b>Undo and Redo</b></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#insertsamples">insert-samples</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="sndscm.html#reportmarknames">report-mark-names</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#datalocation">data-location</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#mouseenterlistenerhook">mouse-enter-listener-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="s7.html#unlet">unlet</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#insertsilence">insert-silence</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#resampleexamples"><b>Resampling</b></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="sndclm.html#dbtolinear">db->linear</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#mouseleavegraphhook">mouse-leave-graph-hook</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#updategraphs">update-graphs</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#insertionexamples"><b>Insertions</b></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#resetcontrols">reset-controls</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="sndscm.html#variabledisplay"><b>Debugging (instruments)</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#mousleavelistenerhook">mouse-leave-listener-hook</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#updatelispgraph">update-lisp-graph</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#intvectorref">int-vector-ref</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#reson">reson</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="extsnd.html#defaultoutputchans">default-output-chans</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#mousepresshook">mouse-press-hook</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#updatetimegraph">update-time-graph</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#intvectorp">int-vector?</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="sndscm.html#reverbexamples"><b>Reverb</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="extsnd.html#defaultoutputsampletype">default-output-sample-type</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="sndscm.html#movemixes">move-mixes</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="sndscm.html#uponsaveyourself">upon-save-yourself</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#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#reverbdecay">reverb-control-decay</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#defgenerator">defgenerator</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-sound?">move-sound?</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> </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#integertoregion">integer->region</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="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td class="green"><div class="centered">V</div></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#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="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab> </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#integertotransform">integer->transform</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#reverbcontrollowpass">reverb-control-lowpass</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="s7.html#expansion">define-expansion</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#reverbcontrolscale">reverb-control-scale</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="s7.html#definemacro">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-average?">moving-average?</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="s7.html#varlet">varlet</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="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#reverbcontrolp">reverb-control?</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="sndscm.html#defineselectionviamarks">define-selection-via-marks</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-fft?">moving-fft?</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#viewfilesamp">view-files-amp</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#iteratoratend">iterator-at-end?</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="sndscm.html#reversebyblocks">reverse-by-blocks</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="sndclm.html#degreestoradians">degrees->radians</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#reversechannel">reverse-channel</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="sndclm.html#delay">delay</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-max?">moving-max?</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#viewfilesfiles">view-files-files</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#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#reverseselection">reverse-selection</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="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-norm?">moving-norm?</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#viewfilesselectedfiles">view-files-selected-files</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-pitch">moving-pitch</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#viewfilessort">view-files-sort</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</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-pitch?">moving-pitch?</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#viewfilesspeed">view-files-speed</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> </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#rightsample">right-sample</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="extsnd.html#deletefilesorter">delete-file-sorter</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="sndclm.html#ring-modulate">ring-modulate</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="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-scentroid?">moving-scentroid?</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#viewregionsdialog">view-regions-dialog</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#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="sndclm.html#rk!cos?">rk!cos?</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#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-spectrum?">moving-spectrum?</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="sndscm.html#singerdoc">voice physical model</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#j2cos">j2cos</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="sndclm.html#rk!ssb?">rk!ssb?</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="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="sndscm.html#mpg">mpg</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#volterrafilter">volterra-filter</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="grfsnd.html#sndandjack"><b>Jack</b></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#rkcos?">rkcos?</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="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</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#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab> </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#jjcos">jjcos</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#rkoddssb?">rkoddssb?</a></em></td><td></td><td class="green"><div class="centered">W</div></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="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab> </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#jncos">jncos</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#rksin?">rksin?</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#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#musalsasquelchwarning">mus-alsa-squelch-warning</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="sndclm.html#wave-train?">wave-train?</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#jpcos">jpcos</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#rkssb?">rkssb?</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#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#musbytespersample">mus-bytes-per-sample</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="sndscm.html#pqwvox">waveshaping voice</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="extsnd.html#justsounds">just-sounds</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="sndscm.html#rmsgain">rms, gain, balance gens</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="sndscm.html#disablecontrolpanel">disable-control-panel</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-channels">mus-channels</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#wavotrace">wavo-trace</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#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</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="s7.html#weakhashtable">weak-hash-table</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> </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="s7.html#rootletredefinitionhook">*rootlet-redefinition-hook*</a></em></td><td></td><td><em class=tab><a href="s7.html#weakhashtablep">weak-hash-table?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</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-close">mus-close</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="sndclm.html#weighted-moving-average">weighted-moving-average</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> </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#round-interp?">round-interp?</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="sndscm.html#displayenergy">display-energy</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-data">mus-data</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#widgetsize">widget-size</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="sndclm.html#mus-describe">mus-describe</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="extsnd.html#widgettext">widget-text</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#k2sin">k2sin</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#rssb?">rssb?</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="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="extsnd.html#muserrortypetostring">mus-error-type->string</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#windowheight">window-height</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#documentation">documentation</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#musexpandfilename">mus-expand-filename</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="sndscm.html#windowsamples">window-samples</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#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#rxycos">rxycos</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="sndclm.html#dot-product">dot-product</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#mus-feedforward">mus-feedforward</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#windowx">window-x</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#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#rxyk!cos">rxyk!cos</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#downoct">down-oct</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#musfilebuffersize">mus-file-buffer-size</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#withbackgroundprocesses">with-background-processes</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="extsnd.html#key">key</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="sndclm.html#rxyk!sin">rxyk!sin</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#drawdot">draw-dot</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="sndscm.html#musfilemix">mus-file-mix</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#withfilemonitor">with-file-monitor</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#keypresshook">key-press-hook</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#rxysin">rxysin</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#drawline">draw-line</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#musfloatequalfudgefactor">mus-float-equal-fudge-factor</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#withinsetgraph">with-inset-graph</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="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> </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#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td class="green"><div class="centered">S</div></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#drawmixhook">draw-mix-hook</a></em></td><td></td><td class="green"><div class="centered">L</div></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> </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#drawstring">draw-string</a></em></td><td></td><td><em class=tab> </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="s7.html#s7doc"><b>s7 scheme</b></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="sndscm.html#drone">drone</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="extsnd.html#musheadertypename">mus-header-type-name</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#withmixtags">with-mix-tags</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#ladspadir">ladspa-dir</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#sampletofile">sample->file</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#drophook">drop-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-increment">mus-increment</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#withrelativepanes">with-relative-panes</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="sndscm.html#lbjpiano">lbj-piano</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="extsnd.html#sampletype">sample-type</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> </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-interp-type">mus-interp-type</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="sndscm.html#withsound">with-sound</a></em></td></tr> + <tr><td class="green"><div class="centered">E</div></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-interpolate">mus-interpolate</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="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr> + <tr><td><em class=tab> </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-length">mus-length</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#withtoolbar">with-toolbar</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="s7.html#letref">let-ref</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="extsnd.html#samplerQ">sampler?</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="extsnd.html#editfragment">edit-fragment</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="extsnd.html#musmaxmalloc">mus-max-malloc</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#withtrackingcursor">with-tracking-cursor</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#lettemporarily">let-temporarily</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#samples">samples</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#edithook">edit-hook</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-name">mus-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> </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="sndclm.html#lineartodb">linear->db</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#sashcolor">sash-color</a></em></td><td></td><td class="green"><div class="centered">X</div></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="sndscm.html#linearsrcchannel">linear-src-channel</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#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td><em class=tab> </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="sndscm.html#lintdoc">lint for scheme</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#saveasdialogsrc">save-as-dialog-src</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#editproperty">edit-property</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-output?">mus-output?</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#xaxislabel">x-axis-label</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="extsnd.html#lispgraphstyle">lisp-graph-style</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#savedir">save-dir</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="extsnd.html#edits">edits</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-ramp">mus-ramp</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#xbounds">x-bounds</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#listtofv">list->float-vector</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#saveenvelopes">save-envelopes</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="extsnd.html#effectshook">effects-hook</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-random">mus-random</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#xzoomslider">x-zoom-slider</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#listenerclickhook">listener-click-hook</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#savelistener">save-listener</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="grfsnd.html#emacssnd"><b>Emacs and Snd</b></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-run">mus-run</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#xrampchannel">xramp-channel</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#listenercolorized">listener-colorized</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#savemarks">save-marks</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#listenerfont">listener-font</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#savemix">save-mix</a></em></td><td></td><td class="green"><div class="centered">Y</div></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#listenerprompt">listener-prompt</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#saveregion">save-region</a></em></td><td></td><td><em class=tab> </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#listenerselection">listener-selection</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#saveregiondialog">save-region-dialog</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="sndscm.html#envexptchannel">env-expt-channel</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#saveselection">save-selection</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="sndclm.html#env-interp">env-interp</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#saveselectiondialog">save-selection-dialog</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="sndscm.html#envmixes">env-mixes</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#savesound">save-sound</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#envselection">env-selection</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#savesoundas">save-sound-as</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#envsound">env-sound</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#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab> </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">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#savestate">save-state</a></em></td><td></td><td class="green"><div class="centered">Z</div></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-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#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab> </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-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#savestatehook">save-state-hook</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#envedbase">enved-base</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#saveexamples"><b>Saving</b></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#envedclipping">enved-clip?</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="sndscm.html#sgfilter">savitzky-golay-filter</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#enveddialog">enved-dialog</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="sndclm.html#sawtooth-wave">sawtooth-wave</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#envedenvelope">enved-envelope</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="sndclm.html#sawtooth-wave?">sawtooth-wave?</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#filterenv">enved-filter</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#mussoundpath">mus-sound-path</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="sndscm.html#zipsound">zip-sound</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="sndscm.html#lpccoeffs">lpc-coeffs</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#scalechannel">scale-channel</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#envedhook">enved-hook</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#mussoundprune">mus-sound-prune</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#zoomcolor">zoom-color</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> </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#zoomfocusstyle">zoom-focus-style</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td class="green"><div class="centered">M</div></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> +</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#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> +</tr> + <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</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#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></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="s7.html#macroexpand">macroexpand</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#scaletempo">scale-tempo</a></em></td><td></td> </tr> </table> @@ -18,6 +18,7 @@ (define *report-any-!-as-setter* #t) ; unknown funcs/macros ending in ! are treated as setters (define *report-doc-strings* #f) ; old-style (CL) doc strings (definstrument ignores this switch -- see ws.scm) (define *report-func-as-arg-arity-mismatch* #f) ; as it says... +(define *report-combinable-lets* #t) ; report lets that can be combined (define *report-ridiculous-variable-names* 50) ; max length of var name (define *report-bad-variable-names* '(l ll .. O ~ else)) ; bad names -- a list to check such as: @@ -417,13 +418,13 @@ (denote (lint-format str caller . args) (let ((outstr (apply format #f - (string-append (if line-number + (string-append (if (and line-number (> line-number 0)) "~NC~A (line ~D): " "~NC~A: ") str "~%") lint-left-margin #\space (truncated-list->string caller) - (if line-number + (if (and line-number (> line-number 0)) (values line-number args) args)))) (set! made-suggestion (+ made-suggestion 1)) @@ -434,6 +435,7 @@ (denote (local-line-number tree) (let ((tree-line (and (pair? tree) (pair-line-number tree)))) (if (and (integer? tree-line) + (> tree-line 0) (not (= tree-line line-number))) (format #f " (line ~D)" tree-line) ""))) @@ -2478,7 +2480,7 @@ (format outport "~NCin ~A~A,~%~NCperhaps change ~S to ~S~A~%" lint-left-margin #\space (truncated-list->string form) - (if ln (format #f " (line ~D)" ln) "") + (if (and ln (> ln 0)) (format #f " (line ~D)" ln) "") (+ lint-left-margin 4) #\space old-arg new-arg comment)))))))) @@ -2665,7 +2667,7 @@ (format outport "~NCin ~A~A,~%~NCperhaps change ~S to ~S~A~%" lint-left-margin #\space (truncated-list->string form) - (if ln (format #f " (line ~D)" ln) "") + (if (and ln (> ln 0)) (format #f " (line ~D)" ln) "") (+ lint-left-margin 4) #\space old-arg new-arg comment))))))) @@ -2704,7 +2706,7 @@ (format outport "~NCin ~A~A,~%~NCperhaps change ~A to ~A~%" lint-left-margin #\space (truncated-list->string form) - (if ln (format #f " (line ~D)" ln) "") + (if (and ln (> ln 0)) (format #f " (line ~D)" ln) "") (+ lint-left-margin 4) #\space (truncated-list->string a2) (list new-e '...))))))))) @@ -3666,7 +3668,7 @@ (format outport "~NCin ~A~A,~%~NCperhaps change ~S to ~S~%" lint-left-margin #\space (truncated-list->string form) - (if ln (format #f " (line ~D)" ln) "") + (if (and ln (> ln 0)) (format #f " (line ~D)" ln) "") (+ lint-left-margin 4) #\space (list 'and '... val '... p) nval) @@ -4327,7 +4329,7 @@ (format outport "~NCin ~A~A, ~A is ~A, but ~A wants ~A" lint-left-margin #\space (truncated-list->string form) - (if ln (format #f " (line ~D)" ln) "") + (if (and ln (> ln 0)) (format #f " (line ~D)" ln) "") (cadr arg1) (prettify-checker-unq (car arg1)) (car arg2) @@ -5844,7 +5846,7 @@ (hash-table-set! h 'min nummax)) h)) ; define numerics-table - (lambda (form env) + (lambda (form env) ; simplify-numerics?? (define (simplify-arg x) (if (or (null? x) ; constants and the like look dumb if simplified (not (proper-list? x)) @@ -10135,7 +10137,7 @@ (hash-table-set! h f #t)) '(print-length safety cpu-time heap-size max-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 memory-usage - gc-protected-objects file-names rootlet-size c-types stack-top stack-size stacktrace-defaults + gc-protected-objects file-names rootlet-size c-types stack-top stack-size stacktrace-defaults history-enabled max-stack-size stack catches float-format-precision bignum-precision default-rationalize-error default-random-state equivalent-float-epsilon hash-table-float-epsilon undefined-identifier-warnings undefined-constant-warnings gc-stats history-size history profile-info autoloading? max-format-length)) @@ -12147,7 +12149,7 @@ ((null? (cdr clause))) ; ignore the initial value which depends on a different env (let ((call (car clause))) (if (pair? call) - (set! line-number (or (pair-line-number call) line-number))) + (set! line-number (or (pair-line-number call) (if (> line-number 0) line-number 0)))) (when (pair? call) (let ((func (car call)) @@ -14137,7 +14139,7 @@ (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) - (if line (format #f "(line ~D): " line) "") + (if (and line (> line 0)) (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 @@ -14924,7 +14926,7 @@ (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) - (if line (format #f "(line ~D): " line) "") + (if (and line (> line 0)) (format #f "(line ~D): " line) "") (truncated-list->string (var-initial-value v)))))) ((and (not lint-in-with-let) @@ -18870,10 +18872,10 @@ (lint-format "perhaps ~A" caller (lists->string form (list 'do new-cadr '...))))))) - ;; let->do -- sometimes a bad idea, set *max-cdr-len* to #f to disable this. + ;; let->do -- sometimes a bad idea, set *report-combinable-lets* to #f to disable this. ;; (the main objection is that the s7/clm optimizer can't handle it, and ;; instruments using it look kinda dumb -- the power of habit or something) - (when (and (integer? *max-cdr-len*) + (when (and *report-combinable-lets* (not (len>1? (cdr body))) ;; moving more than one expr here is usually ugly -- the only exception I've ;; seen is where the do body is enormous and the end stuff very short, and @@ -19929,7 +19931,8 @@ (set! env (cdr es))) (when (pair? vars) - (unless named-let + (unless (or named-let + (not *report-combinable-lets*)) (evert-function-locals form vars env)) (when (and (pair? (cadr form)) (pair? (caadr form))) @@ -19962,7 +19965,7 @@ (let ((body (cddr form)) (varlist (cadr form))) ;; let*->do (could go further down) - (when (and (integer? *max-cdr-len*) + (when (and *report-combinable-lets* (pair? body) (pair? (car body)) (eq? (caar body) 'do) @@ -21269,7 +21272,8 @@ ((not (var-member vname env)) (lint-format "~A is the same as ~A" caller func-name - (if (pair-line-number (var-initial-value v)) + (if (and (pair-line-number (var-initial-value v)) + (> (pair-line-number (var-initial-value v)) 0)) (format #f "~A (line ~D)" vname (pair-line-number (var-initial-value v))) (if (eq? func-name vname) (format #f "previous ~A" vname) @@ -22209,7 +22213,7 @@ ;; -------- lint-walk-pair -------- (lambda (caller form env) (let ((head (car form))) - (set! line-number (or (pair-line-number form) line-number)) + (set! line-number (or (pair-line-number form) (if (> line-number 0) line-number 0))) (if *report-repeated-code-fragments* (lint-fragment form env)) @@ -22460,7 +22464,8 @@ (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) + (if (and (pair-line-number form) + (> (pair-line-number form) 0)) (format #f "(line ~D) " (pair-line-number form)) "") f (truncated-list->string form))))) diff --git a/mockery.scm b/mockery.scm index de18c72..0c8a592 100644 --- a/mockery.scm +++ b/mockery.scm @@ -1,6 +1,5 @@ (provide 'mockery.scm) - ;;; the exported mock data classes (define *mock-vector* #f) (define *mock-pair* #f) @@ -23,16 +22,6 @@ (obj 'value) obj)) - (define (cover-lets args) ; TODO: replace this - (let ((opens ())) - (for-each (lambda (arg) - (when (openlet? arg) - (coverlet arg) - (set! opens (cons arg opens)))) - args) - opens)) - - (define (mock? obj) (and (let? obj) (symbol? (obj 'mock-type)))) @@ -71,82 +60,76 @@ ;; one tricky thing here is that a mock object can be the let of with-let: (with-let (mock-port ...) ...) ;; so a mock object's method can be called even when no argument is a mock object. Even trickier, the ;; mock object can be a closure's containing (open)let: (display (openlet (with-let (mock-c-pointer 0) (lambda () 1)))) - - ;; TODO: still need display et al for port? - ;; and with-mock-wrapper - ;; and everything is a mess... - ;; and char-ci* / string-ci* - ;; -------------------------------------------------------------------------------- (set! *mock-vector* - (let ((mock-vector? #f)) - (let ((mock-vector-class - (inlet 'local-set! (lambda (obj i val) ; reactive-vector uses this as a hook into vector-set! - (if (mock-vector? i) - (error 'wrong-type-arg "stray mock-vector? ~S" i)) - (#_vector-set! (->value obj) i val)) - - 'vector-set! (lambda (obj i val) ((obj 'local-set!) obj i val) val) - - 'let-set-fallback (lambda (obj i val) - (if (and (integer? i) - (defined? 'value obj)) - (begin - ((obj 'local-set!) obj i val) - val) - (error 'out-of-range "unknown field: ~S" i))) - - 'let-ref-fallback (lambda (obj i) - (if (and (integer? i) - (defined? 'value obj)) - (#_vector-ref (obj 'value) i) ; the implicit case - (error 'out-of-range "unknown field: ~S" i))) - - 'equivalent? (with-mock-wrapper* #_equivalent?) - 'vector-ref (with-mock-wrapper* #_vector-ref) - 'vector-length (with-mock-wrapper #_length) - 'reverse (with-mock-wrapper #_reverse) - 'sort! (with-mock-wrapper* #_sort!) - 'make-iterator (with-mock-wrapper #_make-iterator) - 'arity (with-mock-wrapper #_arity) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - 'vector-dimensions (with-mock-wrapper #_vector-dimensions) - 'fill! (with-mock-wrapper* #_fill!) - 'vector-fill! (with-mock-wrapper* #_vector-fill!) - 'vector->list (with-mock-wrapper* #_vector->list) - 'subvector (with-mock-wrapper* #_subvector) - 'copy (with-mock-wrapper* #_copy) - 'vector? (with-mock-wrapper #_vector?) - 'int-vector? (with-mock-wrapper #_int-vector?) - 'byte-vector? (with-mock-wrapper #_byte-vector?) - 'float-vector? (with-mock-wrapper #_float-vector?) - 'length (with-mock-wrapper #_length) - 'vector-append (with-mock-wrapper* #_vector-append) - 'append (with-mock-wrapper* #_append) - 'class-name '*mock-vector*))) - - (define (make-mock-vector len . rest) - (openlet - (sublet mock-vector-class - 'value (apply #_make-vector len rest) - 'mock-type 'mock-vector?))) - - (define (mock-vector . args) - (openlet - (sublet mock-vector-class - 'value (apply #_vector args) - 'mock-type 'mock-vector?))) - - (set! mock-vector? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-vector?)))) - - (curlet)))) + (let* ((mock-vector? #f) + (mock-vector-class + (inlet 'local-set! (lambda (obj i val) ; reactive-vector uses this as a hook into vector-set! + (if (mock-vector? i) + (error 'wrong-type-arg "stray mock-vector? ~S" i)) + (#_vector-set! (->value obj) i val)) + + 'vector-set! (lambda (obj i val) ((obj 'local-set!) obj i val) val) + + 'let-set-fallback (lambda (obj i val) + (if (and (integer? i) + (defined? 'value obj)) + (begin + ((obj 'local-set!) obj i val) + val) + (error 'out-of-range "unknown field: ~S" i))) + + 'let-ref-fallback (lambda (obj i) + (if (and (integer? i) + (defined? 'value obj)) + (#_vector-ref (obj 'value) i) ; the implicit case + (error 'out-of-range "unknown field: ~S" i))) + + 'equivalent? (with-mock-wrapper* #_equivalent?) + 'vector-ref (with-mock-wrapper* #_vector-ref) + 'vector-length (with-mock-wrapper #_length) + 'reverse (with-mock-wrapper #_reverse) + 'sort! (with-mock-wrapper* #_sort!) + 'make-iterator (with-mock-wrapper #_make-iterator) + 'arity (with-mock-wrapper #_arity) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + 'vector-dimensions (with-mock-wrapper #_vector-dimensions) + 'fill! (with-mock-wrapper* #_fill!) + 'vector-fill! (with-mock-wrapper* #_vector-fill!) + 'vector->list (with-mock-wrapper* #_vector->list) + 'subvector (with-mock-wrapper* #_subvector) + 'copy (with-mock-wrapper* #_copy) + 'vector? (with-mock-wrapper #_vector?) + 'int-vector? (with-mock-wrapper #_int-vector?) + 'byte-vector? (with-mock-wrapper #_byte-vector?) + 'float-vector? (with-mock-wrapper #_float-vector?) + 'length (with-mock-wrapper #_length) + 'vector-append (with-mock-wrapper* #_vector-append) + 'append (with-mock-wrapper* #_append) + 'class-name '*mock-vector*))) + + (define (make-mock-vector len . rest) + (openlet + (sublet mock-vector-class + 'value (apply #_make-vector len rest) + 'mock-type 'mock-vector?))) + + (define (mock-vector . args) + (openlet + (sublet mock-vector-class + 'value (apply #_vector args) + 'mock-type 'mock-vector?))) + + (set! mock-vector? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-vector?)))) + + (curlet))) #| @@ -175,60 +158,60 @@ ;; -------------------------------------------------------------------------------- (set! *mock-hash-table* - (let ((mock-hash-table? #f)) - (let ((mock-hash-table-class - (inlet 'let-ref-fallback (lambda (obj key) - (if (defined? 'value obj) - (#_hash-table-ref (obj 'value) key))) - - 'let-set-fallback (lambda (obj key val) + (let* ((mock-hash-table? #f) + (mock-hash-table-class + (inlet 'let-ref-fallback (lambda (obj key) (if (defined? 'value obj) - (#_hash-table-set! (obj 'value) key val))) - - ;; the fallbacks are needed because hash-tables and lets use exactly the same syntax in implicit indexing: - ;; (x 'y) but s7 can't tell that in this one case, we actually want the 'y to be a key not a field. - ;; So, to avoid infinite recursion in let-ref (implicit index), if let-ref can't find the let field, - ;; and the let has 'let-ref|set!-fallback, let-ref|set! passes the argument to that function rather than - ;; return #<undefined>. - ;; - ;; (round (openlet (inlet 'round (lambda (obj) (#_round (obj 'value))) 'let-ref-fallback (lambda args 3)))) -> 3 - - 'hash-table-ref (with-mock-wrapper* #_hash-table-ref) - 'hash-table-set! (with-mock-wrapper* #_hash-table-set!) - 'equivalent? (with-mock-wrapper* #_equivalent?) - 'hash-table-entries (with-mock-wrapper #_hash-table-entries) - 'make-iterator (with-mock-wrapper #_make-iterator) - 'fill! (with-mock-wrapper* #_fill!) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - 'reverse (with-mock-wrapper #_reverse) - 'arity (with-mock-wrapper #_arity) - 'copy (with-mock-wrapper* #_copy) - 'hash-table? (with-mock-wrapper #_hash-table?) - 'length (with-mock-wrapper #_length) - 'append (with-mock-wrapper* #_append) - 'class-name '*mock-hash-table*))) - - (define (make-mock-hash-table . rest) - (openlet - (sublet mock-hash-table-class - 'value (apply #_make-hash-table rest) - 'mock-type 'mock-hash-table?))) - - (define (mock-hash-table . args) - (openlet - (sublet mock-hash-table-class - 'value (apply #_hash-table args) - 'mock-type 'mock-hash-table?))) - - (set! mock-hash-table? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-hash-table?)))) - - (curlet)))) + (#_hash-table-ref (obj 'value) key))) + + 'let-set-fallback (lambda (obj key val) + (if (defined? 'value obj) + (#_hash-table-set! (obj 'value) key val))) + + ;; the fallbacks are needed because hash-tables and lets use exactly the same syntax in implicit indexing: + ;; (x 'y) but s7 can't tell that in this one case, we actually want the 'y to be a key not a field. + ;; So, to avoid infinite recursion in let-ref (implicit index), if let-ref can't find the let field, + ;; and the let has 'let-ref|set!-fallback, let-ref|set! passes the argument to that function rather than + ;; return #<undefined>. + ;; + ;; (round (openlet (inlet 'round (lambda (obj) (#_round (obj 'value))) 'let-ref-fallback (lambda args 3)))) -> 3 + + 'hash-table-ref (with-mock-wrapper* #_hash-table-ref) + 'hash-table-set! (with-mock-wrapper* #_hash-table-set!) + 'equivalent? (with-mock-wrapper* #_equivalent?) + 'hash-table-entries (with-mock-wrapper #_hash-table-entries) + 'make-iterator (with-mock-wrapper #_make-iterator) + 'fill! (with-mock-wrapper* #_fill!) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + 'reverse (with-mock-wrapper #_reverse) + 'arity (with-mock-wrapper #_arity) + 'copy (with-mock-wrapper* #_copy) + 'hash-table? (with-mock-wrapper #_hash-table?) + 'length (with-mock-wrapper #_length) + 'append (with-mock-wrapper* #_append) + 'class-name '*mock-hash-table*))) + + (define (make-mock-hash-table . rest) + (openlet + (sublet mock-hash-table-class + 'value (apply #_make-hash-table rest) + 'mock-type 'mock-hash-table?))) + + (define (mock-hash-table . args) + (openlet + (sublet mock-hash-table-class + 'value (apply #_hash-table args) + 'mock-type 'mock-hash-table?))) + + (set! mock-hash-table? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-hash-table?)))) + + (curlet))) #| @@ -263,98 +246,98 @@ ;; -------------------------------------------------------------------------------- (set! *mock-string* - (let ((mock-string? #f)) - (let ((mock-string-class - (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) - 'reverse (with-mock-wrapper #_reverse) - 'arity (with-mock-wrapper #_arity) - 'make-iterator (with-mock-wrapper* #_make-iterator) - - 'let-ref-fallback (lambda (obj i) - (if (and (integer? i) - (defined? 'value obj)) - (#_string-ref (obj 'value) i) ; these are the implicit cases - (error 'out-of-range "unknown field: ~S" i))) - - 'let-set-fallback (lambda (obj i val) - (if (and (integer? i) - (defined? 'value obj)) - (#_string-set! (obj 'value) i val) - (error 'out-of-range "unknown field: ~S" i))) - - 'string-length (with-mock-wrapper #_length) - 'string-append (with-mock-wrapper* #_string-append) - 'string-copy (with-mock-wrapper #_copy) - - 'string=? (with-mock-wrapper* #_string=?) - 'string<? (with-mock-wrapper* #_string<?) - 'string>? (with-mock-wrapper* #_string>?) - 'string<=? (with-mock-wrapper* #_string<=?) - 'string>=? (with-mock-wrapper* #_string>=?) - - 'string-downcase (with-mock-wrapper #_string-downcase) - 'string-upcase (with-mock-wrapper #_string-upcase) - 'string->symbol (with-mock-wrapper #_string->symbol) - 'symbol (with-mock-wrapper #_symbol) - 'string->keyword (with-mock-wrapper #_string->keyword) - 'open-input-string (with-mock-wrapper #_open-input-string) - 'directory? (with-mock-wrapper #_directory?) - 'file-exists? (with-mock-wrapper #_file-exists?) - 'getenv (with-mock-wrapper #_getenv) - 'delete-file (with-mock-wrapper #_delete-file) - 'string->byte-vector (with-mock-wrapper #_string->byte-vector) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - 'char-position (with-mock-wrapper* #_char-position) - 'string-fill! (with-mock-wrapper* #_string-fill!) - 'gensym (with-mock-wrapper* #_gensym) - 'call-with-input-string (with-mock-wrapper* #_call-with-input-string) - 'with-input-from-string (with-mock-wrapper* #_with-input-from-string) - 'system (with-mock-wrapper* #_system) - 'load (with-mock-wrapper* #_load) - 'eval-string (with-mock-wrapper* #_eval-string) - 'string->list (with-mock-wrapper* #_string->list) - 'bignum (with-mock-wrapper #_bignum) - 'fill! (with-mock-wrapper* #_fill!) - 'write-string (with-mock-wrapper* #_write-string) - 'copy (with-mock-wrapper* #_copy) - 'substring (with-mock-wrapper* #_substring) - 'string->number (with-mock-wrapper* #_string->number) - 'string-position (with-mock-wrapper* #_string-position) - 'string-ref (with-mock-wrapper* #_string-ref) - 'string-set! (with-mock-wrapper* #_string-set!) - 'string-ci=? (with-mock-wrapper* #_string-ci=?) - 'string-ci<? (with-mock-wrapper* #_string-ci<?) - 'string-ci>? (with-mock-wrapper* #_string-ci>?) - 'string-ci<=? (with-mock-wrapper* #_string-ci<=?) - 'string-ci>=? (with-mock-wrapper* #_string-ci>=?) - 'string? (with-mock-wrapper #_string?) - 'length (with-mock-wrapper #_string-length) - 'append (with-mock-wrapper* #_append) - 'class-name '*mock-string*))) - - (define* (make-mock-string len (init #\null)) - (openlet - (sublet mock-string-class - 'value (#_make-string len init) - 'mock-type 'mock-string?))) - - (define (mock-string . args) - (let ((v (make-mock-string 0))) - (set! (v 'value) - (if (string? (car args)) - (car args) - (apply #_string args))) - v)) - - (set! mock-string? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-string?)))) - - (curlet)))) + (let* ((mock-string? #f) + (mock-string-class + (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) + 'reverse (with-mock-wrapper #_reverse) + 'arity (with-mock-wrapper #_arity) + 'make-iterator (with-mock-wrapper* #_make-iterator) + + 'let-ref-fallback (lambda (obj i) + (if (and (integer? i) + (defined? 'value obj)) + (#_string-ref (obj 'value) i) ; these are the implicit cases + (error 'out-of-range "unknown field: ~S" i))) + + 'let-set-fallback (lambda (obj i val) + (if (and (integer? i) + (defined? 'value obj)) + (#_string-set! (obj 'value) i val) + (error 'out-of-range "unknown field: ~S" i))) + + 'string-length (with-mock-wrapper #_length) + 'string-append (with-mock-wrapper* #_string-append) + 'string-copy (with-mock-wrapper #_copy) + + 'string=? (with-mock-wrapper* #_string=?) + 'string<? (with-mock-wrapper* #_string<?) + 'string>? (with-mock-wrapper* #_string>?) + 'string<=? (with-mock-wrapper* #_string<=?) + 'string>=? (with-mock-wrapper* #_string>=?) + + 'string-downcase (with-mock-wrapper #_string-downcase) + 'string-upcase (with-mock-wrapper #_string-upcase) + 'string->symbol (with-mock-wrapper #_string->symbol) + 'symbol (with-mock-wrapper #_symbol) + 'string->keyword (with-mock-wrapper #_string->keyword) + 'open-input-string (with-mock-wrapper #_open-input-string) + 'directory? (with-mock-wrapper #_directory?) + 'file-exists? (with-mock-wrapper #_file-exists?) + 'getenv (with-mock-wrapper #_getenv) + 'delete-file (with-mock-wrapper #_delete-file) + 'string->byte-vector (with-mock-wrapper #_string->byte-vector) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + 'char-position (with-mock-wrapper* #_char-position) + 'string-fill! (with-mock-wrapper* #_string-fill!) + 'gensym (with-mock-wrapper* #_gensym) + 'call-with-input-string (with-mock-wrapper* #_call-with-input-string) + 'with-input-from-string (with-mock-wrapper* #_with-input-from-string) + 'system (with-mock-wrapper* #_system) + 'load (with-mock-wrapper* #_load) + 'eval-string (with-mock-wrapper* #_eval-string) + 'string->list (with-mock-wrapper* #_string->list) + 'bignum (with-mock-wrapper #_bignum) + 'fill! (with-mock-wrapper* #_fill!) + 'write-string (with-mock-wrapper* #_write-string) + 'copy (with-mock-wrapper* #_copy) + 'substring (with-mock-wrapper* #_substring) + 'string->number (with-mock-wrapper* #_string->number) + 'string-position (with-mock-wrapper* #_string-position) + 'string-ref (with-mock-wrapper* #_string-ref) + 'string-set! (with-mock-wrapper* #_string-set!) + 'string-ci=? (with-mock-wrapper* #_string-ci=?) + 'string-ci<? (with-mock-wrapper* #_string-ci<?) + 'string-ci>? (with-mock-wrapper* #_string-ci>?) + 'string-ci<=? (with-mock-wrapper* #_string-ci<=?) + 'string-ci>=? (with-mock-wrapper* #_string-ci>=?) + 'string? (with-mock-wrapper #_string?) + 'length (with-mock-wrapper #_string-length) + 'append (with-mock-wrapper* #_append) + 'class-name '*mock-string*))) + + (define* (make-mock-string len (init #\null)) + (openlet + (sublet mock-string-class + 'value (#_make-string len init) + 'mock-type 'mock-string?))) + + (define (mock-string . args) + (let ((v (make-mock-string 0))) + (set! (v 'value) + (if (string? (car args)) + (car args) + (apply #_string args))) + v)) + + (set! mock-string? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-string?)))) + + (curlet))) #| ;; string that is always the current time of day @@ -383,59 +366,59 @@ ;; -------------------------------------------------------------------------------- (set! *mock-char* - (let ((mock-char? #f)) - (let ((mock-char-class - (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) - 'char-upcase (with-mock-wrapper #_char-upcase) - 'char-downcase (with-mock-wrapper #_char-downcase) - 'char->integer (with-mock-wrapper #_char->integer) - 'char-upper-case? (with-mock-wrapper #_char-upper-case?) - 'char-lower-case? (with-mock-wrapper #_char-lower-case?) - 'char-alphabetic? (with-mock-wrapper #_char-alphabetic?) - 'char-numeric? (with-mock-wrapper #_char-numeric?) - 'char-whitespace? (with-mock-wrapper #_char-whitespace?) - 'char=? (with-mock-wrapper* #_char=?) - 'char<? (with-mock-wrapper* #_char<?) - 'char>? (with-mock-wrapper* #_char>?) - 'char<=? (with-mock-wrapper* #_char<=?) - 'char>=? (with-mock-wrapper* #_char>=?) - 'char-ci=? (with-mock-wrapper* #_char-ci=?) - 'char-ci<? (with-mock-wrapper* #_char-ci<?) - 'char-ci>? (with-mock-wrapper* #_char-ci>?) - 'char-ci<=? (with-mock-wrapper* #_char-ci<=?) - 'char-ci>=? (with-mock-wrapper* #_char-ci>=?) - 'string (with-mock-wrapper* #_string) - 'string-fill! (with-mock-wrapper* #_string-fill!) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - 'arity (with-mock-wrapper #_arity) - 'make-string (with-mock-wrapper* #_make-string) - 'char-position (with-mock-wrapper* #_char-position) - 'write-char (with-mock-wrapper* #_write-char) - 'string-set! (with-mock-wrapper* #_string-set!) - 'copy (with-mock-wrapper* #_copy) - 'char? (with-mock-wrapper #_char?) - 'class-name '*mock-char* - 'length (lambda (obj) #f)))) - - (define (mock-char c) - (if (and (char? c) - (not (let? c))) - (immutable! - (openlet - (sublet (*mock-char* 'mock-char-class) - 'value c - 'mock-type 'mock-char?))) - (error 'wrong-type-arg "mock-char arg ~S is not a char" c))) - - (set! mock-char? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-char?)))) - - (curlet)))) + (let* ((mock-char? #f) + (mock-char-class + (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) + 'char-upcase (with-mock-wrapper #_char-upcase) + 'char-downcase (with-mock-wrapper #_char-downcase) + 'char->integer (with-mock-wrapper #_char->integer) + 'char-upper-case? (with-mock-wrapper #_char-upper-case?) + 'char-lower-case? (with-mock-wrapper #_char-lower-case?) + 'char-alphabetic? (with-mock-wrapper #_char-alphabetic?) + 'char-numeric? (with-mock-wrapper #_char-numeric?) + 'char-whitespace? (with-mock-wrapper #_char-whitespace?) + 'char=? (with-mock-wrapper* #_char=?) + 'char<? (with-mock-wrapper* #_char<?) + 'char>? (with-mock-wrapper* #_char>?) + 'char<=? (with-mock-wrapper* #_char<=?) + 'char>=? (with-mock-wrapper* #_char>=?) + 'char-ci=? (with-mock-wrapper* #_char-ci=?) + 'char-ci<? (with-mock-wrapper* #_char-ci<?) + 'char-ci>? (with-mock-wrapper* #_char-ci>?) + 'char-ci<=? (with-mock-wrapper* #_char-ci<=?) + 'char-ci>=? (with-mock-wrapper* #_char-ci>=?) + 'string (with-mock-wrapper* #_string) + 'string-fill! (with-mock-wrapper* #_string-fill!) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + 'arity (with-mock-wrapper #_arity) + 'make-string (with-mock-wrapper* #_make-string) + 'char-position (with-mock-wrapper* #_char-position) + 'write-char (with-mock-wrapper* #_write-char) + 'string-set! (with-mock-wrapper* #_string-set!) + 'copy (with-mock-wrapper* #_copy) + 'char? (with-mock-wrapper #_char?) + 'class-name '*mock-char* + 'length (lambda (obj) #f)))) + + (define (mock-char c) + (if (and (char? c) + (not (let? c))) + (immutable! + (openlet + (sublet (*mock-char* 'mock-char-class) + 'value c + 'mock-type 'mock-char?))) + (error 'wrong-type-arg "mock-char arg ~S is not a char" c))) + + (set! mock-char? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-char?)))) + + (curlet))) ;; eventually I'll conjure up unichars like (define lambda (byte-vector #xce #xbb)) via mock-char, ;; then combine those into unistring via mock-string @@ -453,150 +436,149 @@ ;; -------------------------------------------------------------------------------- (set! *mock-number* - (let ((mock-number? #f)) + (let* ((mock-number? #f) + (mock-number-class + (inlet + 'equivalent? (with-mock-wrapper* #_equivalent?) + 'arity (with-mock-wrapper #_arity) + 'real-part (with-mock-wrapper #_real-part) + 'imag-part (with-mock-wrapper #_imag-part) + 'numerator (with-mock-wrapper #_numerator) + 'denominator (with-mock-wrapper #_denominator) + 'even? (with-mock-wrapper #_even?) + 'odd? (with-mock-wrapper #_odd?) + 'zero? (with-mock-wrapper #_zero?) + 'positive? (with-mock-wrapper #_positive?) + 'negative? (with-mock-wrapper #_negative?) + 'infinite? (with-mock-wrapper #_infinite?) + 'nan? (with-mock-wrapper #_nan?) + 'append (with-mock-wrapper* #_append) + 'magnitude (with-mock-wrapper #_magnitude) + 'angle (with-mock-wrapper #_angle) + 'rationalize (with-mock-wrapper* #_rationalize) + 'abs (with-mock-wrapper #_abs) + 'exp (with-mock-wrapper #_exp) + 'log (with-mock-wrapper* #_log) + 'sin (with-mock-wrapper #_sin) + 'cos (with-mock-wrapper #_cos) + 'tan (with-mock-wrapper #_tan) + 'asin (with-mock-wrapper #_asin) + 'acos (with-mock-wrapper #_acos) + 'atan (with-mock-wrapper* #_atan) + 'sinh (with-mock-wrapper #_sinh) + 'cosh (with-mock-wrapper #_cosh) + 'tanh (with-mock-wrapper #_tanh) + 'asinh (with-mock-wrapper #_asinh) + 'acosh (with-mock-wrapper #_acosh) + 'atanh (with-mock-wrapper #_atanh) + 'sqrt (with-mock-wrapper #_sqrt) + 'expt (with-mock-wrapper* #_expt) + 'floor (with-mock-wrapper #_floor) + 'ceiling (with-mock-wrapper #_ceiling) + 'truncate (with-mock-wrapper #_truncate) + 'round (with-mock-wrapper #_round) + 'integer->char (with-mock-wrapper #_integer->char) + 'inexact->exact (with-mock-wrapper #_inexact->exact) + 'exact->inexact (with-mock-wrapper #_exact->inexact) + 'integer-length (with-mock-wrapper #_integer-length) + 'integer-decode-float (with-mock-wrapper #_integer-decode-float) + 'number? (with-mock-wrapper #_number?) + 'integer? (with-mock-wrapper #_integer?) + 'real? (with-mock-wrapper #_real?) + 'complex? (with-mock-wrapper #_complex?) + 'rational? (with-mock-wrapper #_rational?) + 'exact? (with-mock-wrapper #_exact?) + 'inexact? (with-mock-wrapper #_inexact?) + 'lognot (with-mock-wrapper #_lognot) + 'logior (with-mock-wrapper* #_logior) + 'logxor (with-mock-wrapper* #_logxor) + 'logand (with-mock-wrapper* #_logand) + 'number->string (with-mock-wrapper* #_number->string) + 'lcm (with-mock-wrapper* #_lcm) + 'gcd (with-mock-wrapper* #_gcd) + '+ (with-mock-wrapper* #_+) + '- (with-mock-wrapper* #_-) + '* (with-mock-wrapper* #_*) + '/ (with-mock-wrapper* #_/) + 'max (with-mock-wrapper* #_max) + 'min (with-mock-wrapper* #_min) + '= (with-mock-wrapper* #_=) + '< (with-mock-wrapper* #_<) + '> (with-mock-wrapper* #_>) + '<= (with-mock-wrapper* #_<=) + '>= (with-mock-wrapper* #_>=) + + 'make-polar (if (provided? 'pure-s7) + (lambda (mag ang) (#_complex (* mag (cos ang)) (* mag (sin ang)))) + (lambda args (apply #_make-polar (map ->value args)))) + 'make-rectangular (with-mock-wrapper* #_complex) + 'complex (with-mock-wrapper* #_complex) + 'random-state (with-mock-wrapper* #_random-state) + 'ash (with-mock-wrapper* #_ash) + 'logbit? (with-mock-wrapper* #_logbit?) + 'quotient (with-mock-wrapper* #_quotient) + 'remainder (with-mock-wrapper* #_remainder) + 'modulo (with-mock-wrapper* #_modulo) + 'random (with-mock-wrapper* #_random) + 'write-byte (with-mock-wrapper* #_write-byte) + 'make-list (with-mock-wrapper* #_make-list) + 'make-vector (with-mock-wrapper* #_make-vector) + 'make-float-vector (with-mock-wrapper* #_make-float-vector) + 'make-int-vector (with-mock-wrapper* #_make-int-vector) + 'make-byte-vector (with-mock-wrapper* #_make-byte-vector) + 'make-hash-table (with-mock-wrapper* #_make-hash-table) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + 'string-fill! (with-mock-wrapper* #_string-fill!) + 'copy (with-mock-wrapper* #_copy) + 'vector->list (with-mock-wrapper* #_vector->list) + 'string->list (with-mock-wrapper* #_string->list) + 'substring (with-mock-wrapper* #_substring) + 'vector-fill! (with-mock-wrapper* #_vector-fill!) + 'make-string (with-mock-wrapper* #_make-string) + 'string-ref (with-mock-wrapper* #_string-ref) + 'string-set! (with-mock-wrapper* #_string-set!) + 'string->number (with-mock-wrapper* #_string->number) + 'list-ref (with-mock-wrapper* #_list-ref) + 'list-set! (with-mock-wrapper* #_list-set!) + 'list-tail (with-mock-wrapper* #_list-tail) + 'vector-ref (with-mock-wrapper* #_vector-ref) + 'float-vector-ref (with-mock-wrapper* #_float-vector-ref) + 'int-vector-ref (with-mock-wrapper* #_int-vector-ref) + 'byte-vector-ref (with-mock-wrapper* #_byte-vector-ref) + 'vector-set! (with-mock-wrapper* #_vector-set!) + 'float-vector-set! (with-mock-wrapper* #_float-vector-set!) + 'int-vector-set! (with-mock-wrapper* #_int-vector-set!) + 'byte-vector-set! (with-mock-wrapper* #_byte-vector-set!) + 'float-vector (with-mock-wrapper* #_float-vector) + 'int-vector (with-mock-wrapper* #_int-vector) + 'byte-vector (with-mock-wrapper* #_byte-vector) + 'subvector (with-mock-wrapper* #_subvector) + 'read-string (with-mock-wrapper* #_read-string) + 'length (with-mock-wrapper #_length) + 'number? (with-mock-wrapper #_number?) + 'class-name '*mock-number*))) - (let ((mock-number-class - (inlet - 'equivalent? (with-mock-wrapper* #_equivalent?) - 'arity (with-mock-wrapper #_arity) - 'real-part (with-mock-wrapper #_real-part) - 'imag-part (with-mock-wrapper #_imag-part) - 'numerator (with-mock-wrapper #_numerator) - 'denominator (with-mock-wrapper #_denominator) - 'even? (with-mock-wrapper #_even?) - 'odd? (with-mock-wrapper #_odd?) - 'zero? (with-mock-wrapper #_zero?) - 'positive? (with-mock-wrapper #_positive?) - 'negative? (with-mock-wrapper #_negative?) - 'infinite? (with-mock-wrapper #_infinite?) - 'nan? (with-mock-wrapper #_nan?) - 'append (with-mock-wrapper* #_append) - 'magnitude (with-mock-wrapper #_magnitude) - 'angle (with-mock-wrapper #_angle) - 'rationalize (with-mock-wrapper* #_rationalize) - 'abs (with-mock-wrapper #_abs) - 'exp (with-mock-wrapper #_exp) - 'log (with-mock-wrapper* #_log) - 'sin (with-mock-wrapper #_sin) - 'cos (with-mock-wrapper #_cos) - 'tan (with-mock-wrapper #_tan) - 'asin (with-mock-wrapper #_asin) - 'acos (with-mock-wrapper #_acos) - 'atan (with-mock-wrapper* #_atan) - 'sinh (with-mock-wrapper #_sinh) - 'cosh (with-mock-wrapper #_cosh) - 'tanh (with-mock-wrapper #_tanh) - 'asinh (with-mock-wrapper #_asinh) - 'acosh (with-mock-wrapper #_acosh) - 'atanh (with-mock-wrapper #_atanh) - 'sqrt (with-mock-wrapper #_sqrt) - 'expt (with-mock-wrapper* #_expt) - 'floor (with-mock-wrapper #_floor) - 'ceiling (with-mock-wrapper #_ceiling) - 'truncate (with-mock-wrapper #_truncate) - 'round (with-mock-wrapper #_round) - 'integer->char (with-mock-wrapper #_integer->char) - 'inexact->exact (with-mock-wrapper #_inexact->exact) - 'exact->inexact (with-mock-wrapper #_exact->inexact) - 'integer-length (with-mock-wrapper #_integer-length) - 'integer-decode-float (with-mock-wrapper #_integer-decode-float) - 'number? (with-mock-wrapper #_number?) - 'integer? (with-mock-wrapper #_integer?) - 'real? (with-mock-wrapper #_real?) - 'complex? (with-mock-wrapper #_complex?) - 'rational? (with-mock-wrapper #_rational?) - 'exact? (with-mock-wrapper #_exact?) - 'inexact? (with-mock-wrapper #_inexact?) - 'lognot (with-mock-wrapper #_lognot) - 'logior (with-mock-wrapper* #_logior) - 'logxor (with-mock-wrapper* #_logxor) - 'logand (with-mock-wrapper* #_logand) - 'number->string (with-mock-wrapper* #_number->string) - 'lcm (with-mock-wrapper* #_lcm) - 'gcd (with-mock-wrapper* #_gcd) - '+ (with-mock-wrapper* #_+) - '- (with-mock-wrapper* #_-) - '* (with-mock-wrapper* #_*) - '/ (with-mock-wrapper* #_/) - 'max (with-mock-wrapper* #_max) - 'min (with-mock-wrapper* #_min) - '= (with-mock-wrapper* #_=) - '< (with-mock-wrapper* #_<) - '> (with-mock-wrapper* #_>) - '<= (with-mock-wrapper* #_<=) - '>= (with-mock-wrapper* #_>=) - - 'make-polar (if (provided? 'pure-s7) - (lambda (mag ang) (#_complex (* mag (cos ang)) (* mag (sin ang)))) - (lambda args (apply #_make-polar (map ->value args)))) - 'make-rectangular (with-mock-wrapper* #_complex) - 'complex (with-mock-wrapper* #_complex) - 'random-state (with-mock-wrapper* #_random-state) - 'ash (with-mock-wrapper* #_ash) - 'logbit? (with-mock-wrapper* #_logbit?) - 'quotient (with-mock-wrapper* #_quotient) - 'remainder (with-mock-wrapper* #_remainder) - 'modulo (with-mock-wrapper* #_modulo) - 'random (with-mock-wrapper* #_random) - 'write-byte (with-mock-wrapper* #_write-byte) - 'make-list (with-mock-wrapper* #_make-list) - 'make-vector (with-mock-wrapper* #_make-vector) - 'make-float-vector (with-mock-wrapper* #_make-float-vector) - 'make-int-vector (with-mock-wrapper* #_make-int-vector) - 'make-byte-vector (with-mock-wrapper* #_make-byte-vector) - 'make-hash-table (with-mock-wrapper* #_make-hash-table) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - 'string-fill! (with-mock-wrapper* #_string-fill!) - 'copy (with-mock-wrapper* #_copy) - 'vector->list (with-mock-wrapper* #_vector->list) - 'string->list (with-mock-wrapper* #_string->list) - 'substring (with-mock-wrapper* #_substring) - 'vector-fill! (with-mock-wrapper* #_vector-fill!) - 'make-string (with-mock-wrapper* #_make-string) - 'string-ref (with-mock-wrapper* #_string-ref) - 'string-set! (with-mock-wrapper* #_string-set!) - 'string->number (with-mock-wrapper* #_string->number) - 'list-ref (with-mock-wrapper* #_list-ref) - 'list-set! (with-mock-wrapper* #_list-set!) - 'list-tail (with-mock-wrapper* #_list-tail) - 'vector-ref (with-mock-wrapper* #_vector-ref) - 'float-vector-ref (with-mock-wrapper* #_float-vector-ref) - 'int-vector-ref (with-mock-wrapper* #_int-vector-ref) - 'byte-vector-ref (with-mock-wrapper* #_byte-vector-ref) - 'vector-set! (with-mock-wrapper* #_vector-set!) - 'float-vector-set! (with-mock-wrapper* #_float-vector-set!) - 'int-vector-set! (with-mock-wrapper* #_int-vector-set!) - 'byte-vector-set! (with-mock-wrapper* #_byte-vector-set!) - 'float-vector (with-mock-wrapper* #_float-vector) - 'int-vector (with-mock-wrapper* #_int-vector) - 'byte-vector (with-mock-wrapper* #_byte-vector) - 'subvector (with-mock-wrapper* #_subvector) - 'read-string (with-mock-wrapper* #_read-string) - 'length (with-mock-wrapper #_length) - 'number? (with-mock-wrapper #_number?) - 'class-name '*mock-number*))) - - (define (mock-number x) - (if (and (number? x) - (not (let? x))) - (immutable! - (openlet - (sublet (*mock-number* 'mock-number-class) - 'value x - 'mock-type 'mock-number?))) - (error 'wrong-type-arg "mock-number ~S is not a number" x))) - - (set! mock-number? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-number?)))) - (curlet)))) + (define (mock-number x) + (if (and (number? x) + (not (let? x))) + (immutable! + (openlet + (sublet (*mock-number* 'mock-number-class) + 'value x + 'mock-type 'mock-number?))) + (error 'wrong-type-arg "mock-number ~S is not a number" x))) + + (set! mock-number? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-number?)))) + (curlet))) #| - ;; fuzzy number +;; fuzzy number (define fuzzy-number (let ((fuzz (lambda (fx) @@ -717,107 +699,107 @@ ;; -------------------------------------------------------------------------------- (set! *mock-pair* - (let ((mock-pair? #f)) - (let ((mock-pair-class - (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) - 'pair-line-number (with-mock-wrapper #_pair-line-number) - 'list->string (with-mock-wrapper #_list->string) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - 'list? (with-mock-wrapper #_list?) - 'car (with-mock-wrapper #_car) - 'cdr (with-mock-wrapper #_cdr) - 'set-car! (with-mock-wrapper* #_set-car!) - 'set-cdr! (with-mock-wrapper* #_set-cdr!) - 'caar (with-mock-wrapper #_caar) - 'cadr (with-mock-wrapper #_cadr) - 'cdar (with-mock-wrapper #_cdar) - 'cddr (with-mock-wrapper #_cddr) - 'caaar (with-mock-wrapper #_caaar) - 'caadr (with-mock-wrapper #_caadr) - 'cadar (with-mock-wrapper #_cadar) - 'cdaar (with-mock-wrapper #_cdaar) - 'caddr (with-mock-wrapper #_caddr) - 'cdddr (with-mock-wrapper #_cdddr) - 'cdadr (with-mock-wrapper #_cdadr) - 'cddar (with-mock-wrapper #_cddar) - 'caaaar (with-mock-wrapper #_caaaar) - 'caaadr (with-mock-wrapper #_caaadr) - 'caadar (with-mock-wrapper #_caadar) - 'cadaar (with-mock-wrapper #_cadaar) - 'caaddr (with-mock-wrapper #_caaddr) - 'cadddr (with-mock-wrapper #_cadddr) - 'cadadr (with-mock-wrapper #_cadadr) - 'caddar (with-mock-wrapper #_caddar) - 'cdaaar (with-mock-wrapper #_cdaaar) - 'cdaadr (with-mock-wrapper #_cdaadr) - 'cdadar (with-mock-wrapper #_cdadar) - 'cddaar (with-mock-wrapper #_cddaar) - 'cdaddr (with-mock-wrapper #_cdaddr) - 'cddddr (with-mock-wrapper #_cddddr) - 'cddadr (with-mock-wrapper #_cddadr) - 'cdddar (with-mock-wrapper #_cdddar) - 'assoc (with-mock-wrapper* #_assoc) - 'assq (with-mock-wrapper* #_assq) - 'assv (with-mock-wrapper* #_assv) - 'member (with-mock-wrapper* #_member) - 'memq (with-mock-wrapper* #_memq) - 'memv (with-mock-wrapper* #_memv) - - 'let-ref-fallback (lambda (obj ind) - (if (eq? ind 'value) - #<undefined> - (let ((val (begin - (coverlet obj) - (#_list-ref (obj 'value) ind)))) - (openlet obj) - val))) - 'let-set-fallback (lambda (obj ind val) - (if (eq? ind 'value) - #<undefined> - (let ((val (begin - (coverlet obj) - (#_list-set! (obj 'value) ind val)))) - (openlet obj) - val))) - - 'reverse! (lambda (obj) - (if (mock-pair? obj) - (set! (obj 'value) (#_reverse (obj 'value))) - (#_reverse! obj))) - - 'list-tail (with-mock-wrapper* #_list-tail) - 'sort! (with-mock-wrapper* #_sort!) - 'reverse (with-mock-wrapper #_reverse) - 'arity (with-mock-wrapper #_arity) - 'make-iterator (with-mock-wrapper #_make-iterator) - 'eval (with-mock-wrapper #_eval) - 'list->vector (with-mock-wrapper #_list->vector) - 'fill! (with-mock-wrapper* #_fill!) - 'copy (with-mock-wrapper* #_copy) - 'subvector (with-mock-wrapper* #_subvector) - 'make-vector (with-mock-wrapper* #_make-vector) - 'list-ref (with-mock-wrapper* #_list-ref) - 'list-set! (with-mock-wrapper* #_list-set!) - 'pair? (with-mock-wrapper #_pair?) - 'length (with-mock-wrapper #_length) - 'append (with-mock-wrapper* #_append) - 'class-name '*mock-pair*))) - - (define (mock-pair . args) - (openlet - (sublet (*mock-pair* 'mock-pair-class) - 'value (copy args) - 'mock-type 'mock-pair?))) - - (set! mock-pair? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-pair?)))) - - (curlet)))) + (let* ((mock-pair? #f) + (mock-pair-class + (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) + 'pair-line-number (with-mock-wrapper #_pair-line-number) + 'list->string (with-mock-wrapper #_list->string) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + 'list? (with-mock-wrapper #_list?) + 'car (with-mock-wrapper #_car) + 'cdr (with-mock-wrapper #_cdr) + 'set-car! (with-mock-wrapper* #_set-car!) + 'set-cdr! (with-mock-wrapper* #_set-cdr!) + 'caar (with-mock-wrapper #_caar) + 'cadr (with-mock-wrapper #_cadr) + 'cdar (with-mock-wrapper #_cdar) + 'cddr (with-mock-wrapper #_cddr) + 'caaar (with-mock-wrapper #_caaar) + 'caadr (with-mock-wrapper #_caadr) + 'cadar (with-mock-wrapper #_cadar) + 'cdaar (with-mock-wrapper #_cdaar) + 'caddr (with-mock-wrapper #_caddr) + 'cdddr (with-mock-wrapper #_cdddr) + 'cdadr (with-mock-wrapper #_cdadr) + 'cddar (with-mock-wrapper #_cddar) + 'caaaar (with-mock-wrapper #_caaaar) + 'caaadr (with-mock-wrapper #_caaadr) + 'caadar (with-mock-wrapper #_caadar) + 'cadaar (with-mock-wrapper #_cadaar) + 'caaddr (with-mock-wrapper #_caaddr) + 'cadddr (with-mock-wrapper #_cadddr) + 'cadadr (with-mock-wrapper #_cadadr) + 'caddar (with-mock-wrapper #_caddar) + 'cdaaar (with-mock-wrapper #_cdaaar) + 'cdaadr (with-mock-wrapper #_cdaadr) + 'cdadar (with-mock-wrapper #_cdadar) + 'cddaar (with-mock-wrapper #_cddaar) + 'cdaddr (with-mock-wrapper #_cdaddr) + 'cddddr (with-mock-wrapper #_cddddr) + 'cddadr (with-mock-wrapper #_cddadr) + 'cdddar (with-mock-wrapper #_cdddar) + 'assoc (with-mock-wrapper* #_assoc) + 'assq (with-mock-wrapper* #_assq) + 'assv (with-mock-wrapper* #_assv) + 'member (with-mock-wrapper* #_member) + 'memq (with-mock-wrapper* #_memq) + 'memv (with-mock-wrapper* #_memv) + + 'let-ref-fallback (lambda (obj ind) + (if (eq? ind 'value) + #<undefined> + (let ((val (begin + (coverlet obj) + (#_list-ref (obj 'value) ind)))) + (openlet obj) + val))) + 'let-set-fallback (lambda (obj ind val) + (if (eq? ind 'value) + #<undefined> + (let ((val (begin + (coverlet obj) + (#_list-set! (obj 'value) ind val)))) + (openlet obj) + val))) + + 'reverse! (lambda (obj) + (if (mock-pair? obj) + (set! (obj 'value) (#_reverse (obj 'value))) + (#_reverse! obj))) + + 'list-tail (with-mock-wrapper* #_list-tail) + 'sort! (with-mock-wrapper* #_sort!) + 'reverse (with-mock-wrapper #_reverse) + 'arity (with-mock-wrapper #_arity) + 'make-iterator (with-mock-wrapper #_make-iterator) + 'eval (with-mock-wrapper #_eval) + 'list->vector (with-mock-wrapper #_list->vector) + 'fill! (with-mock-wrapper* #_fill!) + 'copy (with-mock-wrapper* #_copy) + 'subvector (with-mock-wrapper* #_subvector) + 'make-vector (with-mock-wrapper* #_make-vector) + 'list-ref (with-mock-wrapper* #_list-ref) + 'list-set! (with-mock-wrapper* #_list-set!) + 'pair? (with-mock-wrapper #_pair?) + 'length (with-mock-wrapper #_length) + 'append (with-mock-wrapper* #_append) + 'class-name '*mock-pair*))) + + (define (mock-pair . args) + (openlet + (sublet (*mock-pair* 'mock-pair-class) + 'value (copy args) + 'mock-type 'mock-pair?))) + + (set! mock-pair? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-pair?)))) + + (curlet))) #| (let ((immutable-list-class @@ -854,194 +836,194 @@ ;; -------------------------------------------------------------------------------- (set! *mock-symbol* - (let ((mock-symbol? #f)) - (let ((mock-symbol-class - (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) - 'gensym? (with-mock-wrapper #_gensym?) - 'append (with-mock-wrapper* #_append) - 'symbol->string (with-mock-wrapper #_symbol->string) - 'symbol->value (with-mock-wrapper* #_symbol->value) - 'symbol->dynamic-value (with-mock-wrapper #_symbol->dynamic-value) - 'setter (with-mock-wrapper #_setter) - 'provided? (with-mock-wrapper #_provided?) - 'provide (with-mock-wrapper #_provide) - 'defined? (with-mock-wrapper #_defined?) - 'symbol->keyword (with-mock-wrapper #_symbol->keyword) - 'keyword? (with-mock-wrapper #_keyword?) - 'keyword->symbol (with-mock-wrapper #_keyword->symbol) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - 'symbol? (with-mock-wrapper #_symbol?) - 'class-name '*mock-symbol* - ))) - - (define (mock-symbol s) - (if (and (symbol? s) - (not (let? s))) - (immutable! - (openlet - (sublet (*mock-symbol* 'mock-symbol-class) - 'value s - 'mock-type 'mock-symbol?))) - (error 'wrong-type-arg "mock-symbol ~S is not a symbol" s))) - - (set! mock-symbol? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-symbol?)))) - - (curlet)))) + (let* ((mock-symbol? #f) + (mock-symbol-class + (inlet 'equivalent? (with-mock-wrapper* #_equivalent?) + 'gensym? (with-mock-wrapper #_gensym?) + 'append (with-mock-wrapper* #_append) + 'symbol->string (with-mock-wrapper #_symbol->string) + 'symbol->value (with-mock-wrapper* #_symbol->value) + 'symbol->dynamic-value (with-mock-wrapper #_symbol->dynamic-value) + 'setter (with-mock-wrapper #_setter) + 'provided? (with-mock-wrapper #_provided?) + 'provide (with-mock-wrapper #_provide) + 'defined? (with-mock-wrapper #_defined?) + 'symbol->keyword (with-mock-wrapper #_symbol->keyword) + 'keyword? (with-mock-wrapper #_keyword?) + 'keyword->symbol (with-mock-wrapper #_keyword->symbol) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + 'symbol? (with-mock-wrapper #_symbol?) + 'class-name '*mock-symbol* + ))) + + (define (mock-symbol s) + (if (and (symbol? s) + (not (let? s))) + (immutable! + (openlet + (sublet (*mock-symbol* 'mock-symbol-class) + 'value s + 'mock-type 'mock-symbol?))) + (error 'wrong-type-arg "mock-symbol ~S is not a symbol" s))) + + (set! mock-symbol? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-symbol?)))) + + (curlet))) ;; -------------------------------------------------------------------------------- (set! *mock-c-pointer* - (let ((mock-c-pointer? #f)) - (let ((mock-c-pointer-class - (inlet 'c-pointer? (with-mock-wrapper #_c-pointer?) - 'c-pointer-type (with-mock-wrapper #_c-pointer-type) - 'c-pointer-info (with-mock-wrapper #_c-pointer-info) - 'c-pointer-weak1 (with-mock-wrapper #_c-pointer-weak1) - 'c-pointer-weak2 (with-mock-wrapper #_c-pointer-weak2) - 'c-pointer->list (with-mock-wrapper #_c-pointer->list) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - ))) - - (define* (mock-c-pointer (int 0) type info weak1 weak2) - (immutable! - (openlet - (sublet (*mock-c-pointer* 'mock-c-pointer-class) - 'value (#_c-pointer (->value int) (->value type) (->value info) (->value weak1) (->value weak2)) - 'mock-type 'mock-c-pointer?)))) - - (set! mock-c-pointer? - (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-c-pointer?)))) - - (curlet)))) + (let* ((mock-c-pointer? #f) + (mock-c-pointer-class + (inlet 'c-pointer? (with-mock-wrapper #_c-pointer?) + 'c-pointer-type (with-mock-wrapper #_c-pointer-type) + 'c-pointer-info (with-mock-wrapper #_c-pointer-info) + 'c-pointer-weak1 (with-mock-wrapper #_c-pointer-weak1) + 'c-pointer-weak2 (with-mock-wrapper #_c-pointer-weak2) + 'c-pointer->list (with-mock-wrapper #_c-pointer->list) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + ))) + + (define* (mock-c-pointer (int 0) type info weak1 weak2) + (immutable! + (openlet + (sublet (*mock-c-pointer* 'mock-c-pointer-class) + 'value (#_c-pointer (->value int) (->value type) (->value info) (->value weak1) (->value weak2)) + 'mock-type 'mock-c-pointer?)))) + + (set! mock-c-pointer? + (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-c-pointer?)))) + + (curlet))) ;; -------------------------------------------------------------------------------- (set! *mock-random-state* - (let ((mock-random-state? #f)) - (let ((mock-random-state-class - (inlet 'random-state? (with-mock-wrapper #_random-state?) - 'random-state->list (with-mock-wrapper #_random-state->list) - 'random (with-mock-wrapper* #_random) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - ))) - - (define* (mock-random-state seed (carry 1675393560)) - (immutable! - (openlet - (sublet (*mock-random-state* 'mock-random-state-class) - 'value (#_random-state seed carry) - 'mock-type 'mock-random-state?)))) - - (set! mock-random-state? - (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-random-state?)))) - - (curlet)))) + (let* ((mock-random-state? #f) + (mock-random-state-class + (inlet 'random-state? (with-mock-wrapper #_random-state?) + 'random-state->list (with-mock-wrapper #_random-state->list) + 'random (with-mock-wrapper* #_random) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + ))) + + (define* (mock-random-state seed (carry 1675393560)) + (immutable! + (openlet + (sublet (*mock-random-state* 'mock-random-state-class) + 'value (#_random-state seed carry) + 'mock-type 'mock-random-state?)))) + + (set! mock-random-state? + (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-random-state?)))) + + (curlet))) ;; -------------------------------------------------------------------------------- (set! *mock-iterator* - (let ((mock-iterator? #f)) - (let ((mock-iterator-class - (inlet 'iterator? (with-mock-wrapper #_iterator?) - 'iterate (with-mock-wrapper #_iterate) - 'iterator-at-end? (with-mock-wrapper #_iterator-at-end?) - 'iterator-sequence (with-mock-wrapper #_iterator-sequence) - 'object->string (with-mock-wrapper* #_object->string) - 'format (with-mock-wrapper* #_format) - 'write (with-mock-wrapper* #_write) - 'display (with-mock-wrapper* #_display) - ))) - - (define (make-mock-iterator . args) - (immutable! - (openlet - (sublet (*mock-iterator* 'mock-iterator-class) - 'value (apply #_make-iterator args) - 'mock-type 'mock-iterator?)))) - - (set! mock-iterator? - (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-iterator?)))) - - (curlet)))) + (let* ((mock-iterator? #f) + (mock-iterator-class + (inlet 'iterator? (with-mock-wrapper #_iterator?) + 'iterate (with-mock-wrapper #_iterate) + 'iterator-at-end? (with-mock-wrapper #_iterator-at-end?) + 'iterator-sequence (with-mock-wrapper #_iterator-sequence) + 'object->string (with-mock-wrapper* #_object->string) + 'format (with-mock-wrapper* #_format) + 'write (with-mock-wrapper* #_write) + 'display (with-mock-wrapper* #_display) + ))) + + (define (make-mock-iterator . args) + (immutable! + (openlet + (sublet (*mock-iterator* 'mock-iterator-class) + 'value (apply #_make-iterator args) + 'mock-type 'mock-iterator?)))) + + (set! mock-iterator? + (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-iterator?)))) + + (curlet))) ;; -------------------------------------------------------------------------------- (set! *mock-port* - (let ((mock-port? #f)) - (let ((mock-port-class - (inlet 'input-port? (with-mock-wrapper #_input-port?) - 'output-port? (with-mock-wrapper #_output-port?) - 'port-closed? (with-mock-wrapper #_port-closed?) - 'equivalent? (with-mock-wrapper* #_equivalent?) - 'append (with-mock-wrapper* #_append) - 'set-current-output-port (with-mock-wrapper #_set-current-output-port) - 'set-current-input-port (with-mock-wrapper #_set-current-input-port) - 'set-current-error-port (with-mock-wrapper #_set-current-error-port) - 'close-input-port (with-mock-wrapper #_close-input-port) - 'close-output-port (with-mock-wrapper #_close-output-port) - 'flush-output-port (with-mock-wrapper* #_flush-output-port) - 'get-output-string (with-mock-wrapper* #_get-output-string) - 'newline (with-mock-wrapper* #_newline) - 'read-char (with-mock-wrapper* #_read-char) - 'peek-char (with-mock-wrapper* #_peek-char) - 'read-byte (with-mock-wrapper* #_read-byte) - 'read-line (with-mock-wrapper* #_read-line) - 'read (with-mock-wrapper* #_read) - 'char-ready? (with-mock-wrapper* #_char-ready?) - 'port-line-number (with-mock-wrapper* #_port-line-number) - 'port-filename (with-mock-wrapper* #_port-filename) - 'object->string (with-mock-wrapper* #_object->string) - 'display (with-mock-wrapper* #_display) - 'write (with-mock-wrapper* #_write) - 'format (with-mock-wrapper* #_format) - 'write-char (with-mock-wrapper* #_write-char) - 'write-string (with-mock-wrapper* #_write-string) - 'write-byte (with-mock-wrapper* #_write-byte) - 'read-string (with-mock-wrapper* #_read-string) - 'class-name '*mock-port* - ))) + (let* ((mock-port? #f) + (mock-port-class + (inlet 'input-port? (with-mock-wrapper #_input-port?) + 'output-port? (with-mock-wrapper #_output-port?) + 'port-closed? (with-mock-wrapper #_port-closed?) + 'equivalent? (with-mock-wrapper* #_equivalent?) + 'append (with-mock-wrapper* #_append) + 'set-current-output-port (with-mock-wrapper #_set-current-output-port) + 'set-current-input-port (with-mock-wrapper #_set-current-input-port) + 'set-current-error-port (with-mock-wrapper #_set-current-error-port) + 'close-input-port (with-mock-wrapper #_close-input-port) + 'close-output-port (with-mock-wrapper #_close-output-port) + 'flush-output-port (with-mock-wrapper* #_flush-output-port) + 'get-output-string (with-mock-wrapper* #_get-output-string) + 'newline (with-mock-wrapper* #_newline) + 'read-char (with-mock-wrapper* #_read-char) + 'peek-char (with-mock-wrapper* #_peek-char) + 'read-byte (with-mock-wrapper* #_read-byte) + 'read-line (with-mock-wrapper* #_read-line) + 'read (with-mock-wrapper* #_read) + 'char-ready? (with-mock-wrapper* #_char-ready?) + 'port-line-number (with-mock-wrapper* #_port-line-number) + 'port-filename (with-mock-wrapper* #_port-filename) + 'object->string (with-mock-wrapper* #_object->string) + 'display (with-mock-wrapper* #_display) + 'write (with-mock-wrapper* #_write) + 'format (with-mock-wrapper* #_format) + 'write-char (with-mock-wrapper* #_write-char) + 'write-string (with-mock-wrapper* #_write-string) + 'write-byte (with-mock-wrapper* #_write-byte) + 'read-string (with-mock-wrapper* #_read-string) + 'class-name '*mock-port* + ))) - (define (mock-port port) - (if (and (or (input-port? port) - (output-port? port)) - (not (let? port))) - (openlet - (sublet (*mock-port* 'mock-port-class) - 'value port - 'mock-type 'mock-port?)) - (error 'wrong-type-arg "mock-port ~S is not a port" port))) - - (set! mock-port? (lambda (obj) - (and (let? obj) - (defined? 'mock-type obj #t) - (eq? (obj 'mock-type) 'mock-port?)))) - - (curlet)))) + (define (mock-port port) + (if (and (or (input-port? port) + (output-port? port)) + (not (let? port))) + (openlet + (sublet (*mock-port* 'mock-port-class) + 'value port + 'mock-type 'mock-port?)) + (error 'wrong-type-arg "mock-port ~S is not a port" port))) + + (set! mock-port? (lambda (obj) + (and (let? obj) + (defined? 'mock-type obj #t) + (eq? (obj 'mock-type) 'mock-port?)))) + + (curlet))) ;; sublet of any of these needs to include the value field or a let-ref-fallback diff --git a/peak-phases.scm b/peak-phases.scm index fe2731c..a7d258f 100644 --- a/peak-phases.scm +++ b/peak-phases.scm @@ -257,8 +257,8 @@ ;;; 18 all -------------------------------------------------------------------------------- ; 4.24264 (vector 18 4.795 #r(0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0) - 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) + 4.139663 #r(0.000000 0.843712 1.471294 0.063927 0.889407 0.621853 1.732502 0.775514 1.815486 1.135008 1.453343 0.151108 0.100015 0.088501 0.654328 0.118764 -0.026400 1.691683) ) ;;; 19 all -------------------------------------------------------------------------------- ; 4.35889 @@ -935,14 +935,14 @@ (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.193557 #r(0.000000 0.399524 1.646843 1.351441 1.823025 1.171664 0.729762 1.252339 0.515366 0.097810 0.678860 1.897564 1.521972 0.077160 1.268239 0.901387 1.473972 0.667619 0.325795 0.891195 0.034697 1.747321 0.304383 1.443541 1.218449 1.726491 0.863719 0.680079 1.128978 0.311069 0.196787 0.556014 1.793127 1.682138 0.091227 1.306646 1.129016 1.728414 0.837183 0.599682 1.287968 0.345234 0.102947 0.801742 1.877781 1.640902 0.226585 1.396671 1.220080 1.697547 0.969679 0.798912 1.198292 0.544854 0.387407 0.843207 0.103104 0.019694 0.521433 1.661229 1.605311 0.102635 1.157349 1.118566 1.621512 0.723027 0.643827 1.145388 0.314572 0.219869 0.805329 0.006517 1.887267 0.542204 1.747666 1.567711 0.215067 1.350972 1.245790 1.775378 0.951723 0.849293 1.321284 0.601644 0.485751 0.980152 0.390476 0.169629 0.740840 0.138612 1.874833 0.431461 1.718986 1.629368 0.185469 1.331734 1.411703 1.891639 1.004555 1.106306 1.573401 0.791502 0.797704 1.330552 0.584117 0.488052 1.067741 0.317339 0.306746 0.813570 0.066066 0.099246 0.601862 1.795337 1.820144 0.357783 1.595461 1.579848 0.166240 1.466895 1.372961 1.975436 1.317740 1.164009 1.808486 1.102608 1.000643 1.677368 0.956636 0.852478 1.469074 0.760365 0.712295 1.292807 0.555832 0.598457 1.095907 0.430216 0.458751 0.920706 0.270682 0.325363 0.899970 0.173408 0.209294 0.791701 0.094244 0.099310 0.651989 0.010325 0.059977 0.633756 1.963936 1.969054 0.569597 1.790777 1.878600 0.394074 1.703161 1.833624 0.356313 1.832144 1.719691 0.364860 1.791309 1.591331 0.325750 1.506205 1.612715 0.346965 1.508845 1.699526 0.386824 1.730166 1.703816 0.326924 1.872117 1.631584 0.317289 1.789232 1.607605 0.374082 1.631752 1.631313 0.329336 1.648447 1.650306 0.278736 1.778750 1.729896 0.463903 1.802895 1.856258 0.641877 1.756090 1.948418 0.623347 1.897074 0.008893 0.584650 0.086280 0.140431 0.786527 0.276359 0.275548 0.890444 0.265676 0.359419 0.986176 0.297235 0.384001 1.124805 0.481466 0.539550 1.333854 0.750170 0.752600 1.511725 0.897055 1.008348 1.699392 1.038121 1.079651 1.845917 1.287855 1.140400 -0.023963 1.424874 1.286171 0.046406 1.501434 1.602452 0.321371 1.613120 1.908418 0.550743 0.056408 0.227804 0.949635 0.326223 0.264086 1.026683 0.610891 0.620381 1.372120 0.688350 0.735802 1.527568 0.943792 1.417684 1.984600 1.245909 1.375474 0.090665 1.720888 1.763305 0.482303 1.883338 -0.178312 0.672709 0.264609 0.438174 1.152965 0.399187 0.537181 1.442530 0.925288 1.039187 1.777755 1.171305 1.241651 0.077408 1.688521 1.746073 0.572899 -0.031503 -0.054512 0.780914 0.307130 0.377248 1.309947 0.620593 0.647805 1.391170 1.029083 1.242972 0.116208 1.541926 1.636274 0.424680 1.866792 0.180934 0.849061 0.502513 0.547097 1.479781 0.744568 0.922805 1.664208 1.208223 1.492285 0.310325 1.796293 1.840468 0.650666 -0.003684 0.367553 1.063204 0.897182 0.882506 1.810738 1.199687 1.212082 0.105635 1.548127 1.862122 0.788103 0.377315 0.334679 1.391247 0.571526 0.899589 1.716512 1.284574 1.499212 0.368896 1.983312 -0.072073 0.796638 0.291665 0.571920 1.379773 1.116573 1.278689 0.104734 1.567264 1.692617 0.700433 0.303656 0.546992 1.300072 0.627106 1.095583 1.891866 1.555661 1.482424 0.421620 -0.134218 0.292813 0.972962 0.668941 0.743333 1.620423 1.399574 1.499004 0.392218 1.901237 0.163106 1.106102 0.699633 0.986320 1.808714 1.394696 1.548913 0.474054 -0.027677 0.241989 1.194987 0.769790 0.950308 1.843451 1.415095 1.579444 0.593829 0.178033 0.440985 1.381496 0.829738 1.153720 0.108138 1.828197 0.001844 0.921711 0.414644 0.675207 1.622384 1.277034 1.537018 0.449889 -0.054593 0.361449 1.247168 0.802724 1.022726 -0.128510 1.566174 1.841023 0.681270 0.418525 0.594178 1.582797 1.100574 1.498480 0.655383 0.155173 0.411660 1.181526 0.925382 1.328843 0.200473 0.006382 -0.032565 0.991390 0.602529 0.861632 0.041638 1.598274 1.969261 0.977268 0.407970 0.890370 1.757901 1.546776 1.739700 0.530734 0.183300 0.478294 1.491451 1.214965 1.389695 0.474622 0.044001 0.456977 1.479471 1.191919 1.480834 0.363164 0.026157 0.326380 1.336734 0.979602 1.357294 0.319255 -0.203247 0.232685 1.294416 0.948903 1.261622 0.286100 0.092358 0.283080 1.307747 0.989432 1.460487 0.426459 0.073741 0.571242 1.354082 1.101710 1.376656 0.361569 0.296231 0.370466 1.428620 1.084242 1.395303 0.541609 0.189775 0.582146 1.678645 1.102096 1.654581 0.664775 0.425971 0.691471 1.780798 1.653163 1.949891 0.862761 0.598617 0.939898 -0.013960 1.746087 0.153754 1.148094 0.828305 1.259992 0.328347 0.016434 0.376838 1.474740 1.157589 1.534525 0.553645 0.312251 0.866668 1.864799 1.615591 0.009649 1.062077 0.859238 1.148430 0.325782 0.130284 0.468434 1.557339 1.318502 1.816657 0.825796 0.532150 1.028089 0.092303) + 23.189977 #r(0.000000 0.400352 1.646881 1.352186 1.820224 1.171903 0.728255 1.254465 0.513930 0.096435 0.678623 1.896068 1.524404 0.077988 1.266111 0.901656 1.474695 0.666750 0.325140 0.889746 0.031461 1.747664 0.303290 1.442380 1.216839 1.723604 0.863224 0.680958 1.129826 0.311736 0.193407 0.555492 1.792947 1.679721 0.091008 1.307830 1.126811 1.731589 0.839052 0.599635 1.288118 0.346704 0.103683 0.799885 1.881324 1.639831 0.226281 1.396817 1.216183 1.693142 0.967883 0.798890 1.196889 0.545432 0.385266 0.841816 0.102474 0.016917 0.520077 1.660266 1.604546 0.103698 1.155177 1.119005 1.624239 0.720929 0.645369 1.145461 0.313857 0.220582 0.803756 0.005538 1.884424 0.543330 1.749018 1.567115 0.212368 1.351814 1.243356 1.774620 0.949983 0.847788 1.321749 0.601544 0.485568 0.979653 0.389619 0.170830 0.739552 0.138980 1.873820 0.429358 1.719747 1.627475 0.184132 1.333930 1.412582 1.892114 1.004822 1.104992 1.573901 0.791666 0.796319 1.329697 0.584451 0.489684 1.067620 0.319034 0.308954 0.814556 0.064524 0.097555 0.602841 1.796672 1.819509 0.357311 1.595792 1.577166 0.168239 1.467336 1.372675 1.976200 1.316975 1.164980 1.808221 1.103146 1.000071 1.680356 0.955071 0.853384 1.471465 0.758000 0.711840 1.292063 0.556515 0.598835 1.096988 0.432299 0.457329 0.922975 0.270776 0.326833 0.899988 0.173435 0.210469 0.791993 0.096131 0.099798 0.652148 0.011154 0.057498 0.632715 1.963592 1.969306 0.571446 1.788300 1.877826 0.397115 1.703193 1.835777 0.354597 1.832646 1.722115 0.367332 1.790010 1.591869 0.325888 1.505285 1.613369 0.344337 1.509568 1.699657 0.385875 1.732934 1.702796 0.328799 1.873371 1.628395 0.319601 1.789235 1.606650 0.373878 1.634819 1.631971 0.329272 1.648137 1.652983 0.277243 1.779926 1.731646 0.462778 1.802049 1.856738 0.643556 1.755237 1.953948 0.623887 1.895649 0.008180 0.585292 0.085329 0.141670 0.786571 0.276875 0.274159 0.892368 0.266677 0.356930 0.990211 0.295308 0.382754 1.125680 0.482871 0.541134 1.332496 0.748978 0.751245 1.512333 0.900567 1.008919 1.698997 1.037217 1.078478 1.845510 1.288083 1.140338 -0.024055 1.423721 1.286401 0.043424 1.502268 1.602623 0.320818 1.614025 1.907483 0.546839 0.057012 0.227450 0.948947 0.328025 0.263136 1.027035 0.610548 0.618089 1.374903 0.690188 0.736049 1.527127 0.945207 1.420607 1.982363 1.245889 1.377039 0.093875 1.721575 1.764294 0.483397 1.884106 -0.179785 0.671224 0.265139 0.438107 1.153897 0.398895 0.535728 1.442242 0.926749 1.040019 1.779771 1.170515 1.241494 0.076467 1.688139 1.746475 0.572739 -0.029431 -0.055089 0.779847 0.306485 0.377043 1.310308 0.619637 0.647514 1.389888 1.029884 1.245820 0.116360 1.541548 1.636228 0.425375 1.867903 0.178686 0.845985 0.502335 0.550717 1.478630 0.746147 0.921637 1.664176 1.208336 1.491564 0.311150 1.795511 1.840905 0.651661 -0.002247 0.367671 1.062457 0.897875 0.879786 1.809541 1.199453 1.213170 0.106645 1.547957 1.863482 0.787131 0.375345 0.335825 1.390579 0.570732 0.899469 1.714005 1.283109 1.498107 0.367353 1.983111 -0.071391 0.796589 0.289495 0.571127 1.380175 1.116842 1.278494 0.105341 1.566200 1.693664 0.701618 0.302878 0.547404 1.298484 0.629335 1.094248 1.890010 1.553218 1.483661 0.423303 -0.131538 0.292332 0.971091 0.669305 0.742213 1.619653 1.399065 1.498559 0.392971 1.901463 0.163133 1.105913 0.701183 0.984001 1.809506 1.394342 1.548131 0.475595 -0.027570 0.241912 1.194913 0.767151 0.949453 1.839642 1.416626 1.580606 0.593900 0.179496 0.442049 1.382700 0.831032 1.153276 0.111040 1.827359 0.002662 0.919835 0.413504 0.673098 1.623798 1.277197 1.538837 0.446946 -0.055882 0.359099 1.249334 0.804644 1.022680 -0.129161 1.565232 1.837270 0.679347 0.419151 0.596525 1.582037 1.100195 1.497789 0.653803 0.152446 0.411852 1.181340 0.926546 1.327298 0.200287 0.007024 -0.032787 0.989974 0.601147 0.861227 0.041469 1.596668 1.968072 0.976330 0.410383 0.889204 1.756894 1.551268 1.741952 0.529816 0.184054 0.479217 1.492550 1.214306 1.388728 0.476110 0.043478 0.455596 1.480248 1.192473 1.479537 0.361922 0.023585 0.326125 1.336431 0.979467 1.357912 0.317617 -0.203490 0.230525 1.292657 0.950056 1.260511 0.288494 0.091443 0.285153 1.308557 0.989824 1.461195 0.427484 0.074661 0.571384 1.356006 1.100865 1.376996 0.360567 0.294443 0.369162 1.433456 1.083241 1.396734 0.541539 0.190049 0.582731 1.678547 1.102239 1.655238 0.664049 0.424506 0.691131 1.777910 1.655084 1.948811 0.861845 0.601112 0.937689 -0.013567 1.745767 0.153961 1.148324 0.829747 1.260999 0.328687 0.015723 0.375737 1.473206 1.156097 1.534391 0.554594 0.314366 0.866495 1.865078 1.616164 0.010791 1.061746 0.859540 1.149512 0.327388 0.127562 0.466362 1.557328 1.317358 1.818227 0.824304 0.532379 1.027109 0.090332) ) ;;; 1024 all -------------------------------------------------------------------------------- (32) (vector 1024 54.490282136658 #r(0 0 0 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 0 1 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0) ;; from (try-all :all 1024 1025 0.0030465754082342 1.0966230312279) = 39.6408 -- starting point for next - 33.039411 #r(0.000000 0.217793 0.607931 0.967301 1.354927 1.688792 0.066020 0.465453 0.813538 1.195967 1.586820 1.919936 0.299575 0.725651 1.032687 1.433171 1.819098 0.244740 0.528317 0.952329 1.310902 1.725001 0.085841 0.510316 0.883137 1.295552 1.666836 0.117054 0.474142 0.872700 1.255713 1.736490 0.230501 0.606393 1.028728 1.384711 1.863816 0.246036 0.645348 1.117262 1.521884 1.949367 0.365316 0.819118 1.259784 1.743406 0.114681 0.574578 1.046246 1.450509 1.894899 0.336945 0.760564 1.253808 1.716849 0.137592 0.574609 1.042959 1.454824 1.936275 0.419190 0.895894 1.333121 1.844487 0.342502 0.853474 1.292439 1.765609 0.256321 0.692309 1.243113 1.739348 0.172472 0.653116 1.166058 1.631859 0.132258 0.625602 1.076819 1.598670 0.096980 0.577179 1.131695 1.647014 0.164193 0.685727 1.180440 1.702228 0.253302 0.776491 1.309535 1.816332 0.293105 0.852900 1.367077 1.898589 0.432535 0.975988 1.514584 0.043794 0.598139 1.166870 1.714281 0.266095 0.804942 1.357597 1.876090 0.428324 1.001268 1.559200 0.115044 0.618374 1.228782 1.804413 0.389816 0.962363 1.537898 0.140277 0.731613 1.282939 1.840202 0.414673 1.053184 1.588446 0.180107 0.790891 1.387213 -0.009395 0.568597 1.191263 1.801067 0.427802 0.974450 1.619591 0.210665 0.773393 1.392904 -0.016901 0.587123 1.244552 1.854155 0.531939 1.150600 1.768916 0.425159 1.016110 1.610621 0.256880 0.882893 1.538835 0.168686 0.850037 1.472174 0.113856 0.750967 1.406035 0.025255 0.666491 1.359993 -0.031664 0.678754 1.326832 0.026196 0.743883 1.382070 0.030677 0.675957 1.328756 -0.030041 0.654962 1.338458 0.006642 0.677619 1.397568 0.072976 0.783665 1.485790 0.155299 0.853843 1.533492 0.215188 0.953020 1.662973 0.324497 1.041673 1.733423 0.464213 1.243765 1.976367 0.647067 1.345559 0.012662 0.749316 1.489879 0.227914 0.990029 1.690002 0.448728 1.143221 1.859234 0.555390 1.286313 0.069809 0.857122 1.602468 0.322019 1.025459 1.824398 0.578707 1.342375 0.081518 0.784165 1.566385 0.361863 1.106400 1.887522 0.638616 1.404257 0.152091 0.938889 1.721031 0.472675 1.317728 0.043634 0.856009 1.629652 0.437257 1.252987 0.025923 0.794582 1.591058 0.358955 1.166057 -0.002682 0.789366 1.590794 0.386834 1.197846 -0.015623 0.838634 1.655025 0.464895 1.274773 0.058585 0.894215 1.742143 0.557596 1.374194 0.194745 1.055319 1.890167 0.712487 1.581920 0.405773 1.241666 0.042804 0.908599 1.766456 0.617833 1.493265 0.307493 1.185078 0.036343 0.890918 1.784268 0.650479 1.475522 0.339344 1.199572 0.068327 0.952306 1.802580 0.674951 1.547061 0.454334 1.314247 0.208419 1.097577 -0.012428 0.845084 1.764257 0.654064 1.576753 0.430900 1.360385 0.263013 1.142109 0.042247 0.938246 1.849738 0.741581 1.702585 0.626406 1.511517 0.417933 1.342045 0.316150 1.213121 0.129925 1.075504 -0.003643 0.933032 1.855128 0.813392 1.710572 0.687979 1.624093 0.550720 1.484789 0.449410 1.417809 0.352332 1.315385 0.258678 1.242081 0.191596 1.148327 0.128590 1.076998 0.033930 1.000429 0.021446 0.946529 1.911603 0.939668 1.905600 0.832070 1.835891 0.886734 1.814841 0.754215 1.792786 0.817776 1.802122 0.767172 1.771516 0.795570 1.799934 0.749664 1.758097 0.790279 1.789090 0.815718 1.817512 0.821594 1.856689 0.844107 1.876263 0.932131 -0.033027 0.954137 0.041708 1.057579 0.049376 1.112654 0.124479 1.141145 0.189700 1.275163 0.277220 1.352019 0.398622 1.416087 0.471721 1.586811 0.571617 1.636154 0.762022 1.797974 0.792648 1.906186 0.988600 0.048590 1.117019 0.191210 1.280035 0.315709 1.415404 0.523510 1.606178 0.659612 1.735274 0.864437 1.945756 1.038500 0.170782 1.263877 0.328664 1.441094 0.489608 1.619075 0.742578 1.862330 0.978201 0.057087 1.210985 0.315699 1.369242 0.526287 1.686926 0.800561 1.894467 1.020909 0.151248 1.280756 0.415349 1.596186 0.691380 1.812268 1.014468 0.168469 1.246068 0.390545 1.566257 0.763068 1.867617 1.029661 0.210896 1.365853 0.504713 1.668265 0.840178 0.022534 1.175174 0.314446 1.504725 0.644912 1.845437 1.051148 0.239535 1.418245 0.575431 1.755543 0.953544 0.111610 1.291718 0.538603 1.737364 0.920094 0.118883 1.329289 0.551068 1.736946 0.926920 0.119899 1.396472 0.622946 1.774495 1.009428 0.218937 1.460574 0.709308 1.920305 1.134568 0.362724 1.629463 0.871987 0.063242 1.265435 0.549715 1.760983 1.012786 0.268911 1.522067 0.763077 0.022908 1.247788 0.504920 1.737386 1.031185 0.261825 1.506968 0.798277 0.037126 1.317026 0.616309 1.881979 1.132622 0.426461 1.688910 1.015193 0.274225 1.537279 0.814374 0.149856 1.426047 0.681353 -0.011757 1.281532 0.621978 1.877128 1.198275 0.515804 1.781604 1.083809 0.389698 1.722708 1.042047 0.317721 1.608635 0.970703 0.267024 1.600821 0.938556 0.289874 1.584459 0.919633 0.284753 1.600381 0.933102 0.261783 1.593563 0.959453 0.292896 1.637129 0.988883 0.310816 1.649207 1.029681 0.428735 1.766336 1.074255 0.425825 1.799718 1.186541 0.578329 1.932767 1.284594 0.645241 0.041167 1.417411 0.762799 0.172464 1.567570 0.948839 0.309276 1.682672 1.082892 0.477564 1.843514 1.286204 0.670132 0.088133 1.474563 0.903587 0.268966 1.703975 1.091807 0.536262 1.919539 1.329738 0.736390 0.166515 1.568791 1.004973 0.446544 1.857922 1.311269 0.705281 0.113389 1.613060 1.013345 0.476671 1.865416 1.350997 0.757344 0.262328 1.668639 1.135990 0.558918 0.027836 1.482954 0.914355 0.405589 1.877877 1.360731 0.810998 0.261169 1.717993 1.198951 0.681506 0.179681 1.611818 1.116720 0.625715 0.079133 1.554344 1.057016 0.585836 0.021762 1.535703 0.980063 0.485380 0.023651 1.496565 1.028428 0.487728 0.020140 1.532761 1.069147 0.588821 0.060395 1.588111 1.115999 0.646374 0.167975 1.648612 1.193869 0.741882 0.253118 1.790842 1.314892 0.853281 0.414998 1.902434 1.497942 0.990639 0.539224 0.088219 1.622741 1.249411 0.768538 0.343660 1.876211 1.447300 0.997098 0.572570 0.125439 1.644200 1.256400 0.781270 0.404111 1.972536 1.519066 1.186994 0.692860 0.307855 1.854938 1.403699 1.042965 0.597213 0.196180 1.805940 1.398784 1.006898 0.632978 0.181333 1.843721 1.376232 1.022246 0.627057 0.282029 1.859980 1.453595 1.114534 0.674237 0.375415 1.952743 1.558682 1.184653 0.810882 0.444428 0.106739 1.741825 1.353026 1.026092 0.582251 0.277743 1.909713 1.508437 1.193737 0.825066 0.511191 0.176031 1.828730 1.506285 1.153197 0.831714 0.439990 0.170522 1.814214 1.446970 1.128077 0.779419 0.473478 0.119366 1.886969 1.516342 1.219164 0.893550 0.538641 0.258090 1.907636 1.650718 1.360545 1.059180 0.717874 0.414278 0.126132 1.813306 1.573338 1.212731 0.957830 0.622823 0.405985 0.047971 1.825807 1.472501 1.214098 0.947606 0.683963 0.437446 0.175854 1.851289 1.610406 1.357047 1.067661 0.887867 0.554044 0.356299 0.048031 1.779486 1.512616 1.305755 1.022671 0.791907 0.573078 0.247923 0.119906 1.758763 1.585160 1.362276 1.088615 0.895722 0.676468 0.417579 0.164979 0.011350 1.734305 1.546690 1.358415 1.118376 0.926783 0.705220 0.499448 0.315880 0.060118 1.859929 1.723958 1.477160 1.277193 1.104744 0.894346 0.689756 0.496369 0.300553 0.144892 -0.011520 1.749426 1.580379 1.412973 1.276473 1.000323 0.931770 0.729465 0.533414 0.419059 0.232436 0.058428 1.969516 1.749659 1.610372 1.410459 1.309106 1.065622 0.979337 0.814584 0.691674 0.530372 0.424815 0.245987 0.170699 -0.012271 1.879045 1.724963 1.634668 1.453532 1.447115 1.205718 1.100546 1.013892 0.909214 0.720956 0.667663 0.509508 0.398085 0.299597 0.141309 0.034226 1.956289 1.852003 1.769280 1.663148 1.617078 1.511929 1.436643 1.410262 1.252755 1.184206 1.076318 1.039369 0.873633 0.816231 0.737137 0.775666 0.640014 0.552292 0.523393 0.428824 0.414378 0.217133 0.262402 0.171984 0.134805 0.021929 -0.016668 -0.002532 1.951963 1.878249 1.806236 1.774365 1.771348 1.716161 1.642886 1.609487 1.620321 1.591158 1.518580 1.544276 1.464162 1.456414 1.419358 1.466609 1.458320 1.401454 1.399278 1.426924 1.401560 1.354162 1.404450 1.362904 1.311124 1.352591 1.363770 1.369722 1.388055 1.409894 1.360470 1.454066 1.459673 1.429927 1.441529 1.468345 1.425679 1.473974 1.493508 1.543234 1.585340 1.561861 1.660910 1.693672 1.740824 1.797921 1.806792 1.947948 1.869546 1.958885 -1.809691 0.050061 0.129496 0.155639 0.222149 0.330732 0.332881 0.439984 0.450928 0.497058 0.602728 0.660842 0.709316 0.790306 0.877580 0.936659 1.013168 1.033489 1.176399 1.283407 1.410743 1.421371 1.612205 1.634881 1.767582 1.841030 1.986537 0.040900 0.175181 0.251008 0.355412 0.463047 0.575760 0.756405 0.796567 0.934654 1.053898 1.201705 1.308357 1.442561 1.601781 1.682620 1.834403 1.974673 0.095088 0.213066 0.321956 0.432642 0.606311 0.752450 0.885724 1.060880 1.156449 1.343737 1.489563 1.604293 1.789993 -0.034383 0.172034 0.387110 0.514056 0.654408 0.867467 1.034492 1.235624 1.438767 1.575002 1.788990 1.943738 0.058572 0.291200 0.483921 0.638776 0.832612 1.050861 1.244085 1.359691 1.596226 1.736323 -0.038252 0.190511 0.356074 0.569407 0.813994 1.022213 1.253582 1.468846 1.662905 1.861495 0.114564 0.373869 0.577453 0.821773 1.098180 1.315326 1.545147 1.813394 -1.760253 0.188066 0.496257 0.708472 0.960343 1.163646 1.367710 1.703944 1.909640 0.175717 0.454540 0.705636 0.980211 1.195148 1.488818 1.733289 0.044144 0.287687 0.548395 0.800132 1.070146 1.361090 1.590773 1.900706 0.207641 0.451405 0.799749 1.114584 1.405580 1.699154 -0.017363 0.294048 0.624527 0.934607 1.198245 1.538180 1.866634 0.125428 0.487573 0.742561 1.066865 1.413340 1.684269 0.002780 0.341594 0.693237 1.047393 1.377687 1.696633 0.122200) + 33.029821 #r(0.000000 0.217944 0.609929 0.966538 1.354466 1.690402 0.069295 0.463126 0.814401 1.196400 1.587877 1.919637 0.299030 0.724808 1.031299 1.433724 1.817103 0.241494 0.529467 0.953913 1.312038 1.724394 0.083640 0.510832 0.881442 1.294790 1.666828 0.116069 0.473037 0.873150 1.255459 1.735264 0.231025 0.607108 1.026645 1.387601 1.867390 0.246399 0.647371 1.117895 1.523135 1.949578 0.367422 0.819265 1.260489 1.747241 0.114639 0.576953 1.044546 1.450005 1.895359 0.337673 0.760942 1.252665 1.715355 0.138176 0.573778 1.044736 1.454339 1.933805 0.419681 0.897725 1.332490 1.846973 0.341692 0.853530 1.294337 1.764850 0.257004 0.692932 1.243397 1.739885 0.171868 0.652576 1.167240 1.631641 0.130202 0.627593 1.075726 1.600388 0.096166 0.576857 1.134368 1.648800 0.163148 0.685032 1.181053 1.700720 0.253013 0.777113 1.309397 1.817078 0.293402 0.853519 1.368244 1.898017 0.433163 0.974760 1.514173 0.042173 0.597676 1.165987 1.715383 0.264332 0.804952 1.359143 1.877666 0.430708 1.001895 1.560881 0.114994 0.620250 1.229491 1.804490 0.389237 0.962946 1.536544 0.139150 0.730565 1.284249 1.841276 0.417017 1.053568 1.586605 0.179291 0.790530 1.386440 -0.009879 0.569235 1.193034 1.803551 0.428573 0.976995 1.620108 0.211446 0.773716 1.394295 -0.017677 0.588834 1.242761 1.852375 0.532122 1.149688 1.771121 0.422936 1.015951 1.611750 0.256269 0.880464 1.539720 0.170996 0.850370 1.471973 0.111868 0.751131 1.403839 0.025163 0.665501 1.359157 -0.032755 0.678974 1.327344 0.024721 0.741238 1.379682 0.030650 0.676686 1.334190 -0.028684 0.656962 1.337956 0.006882 0.676207 1.399794 0.075000 0.781895 1.482704 0.154625 0.852153 1.534645 0.217402 0.954926 1.663425 0.323355 1.041197 1.734732 0.466361 1.244601 1.978399 0.647632 1.345902 0.011463 0.747333 1.489039 0.226282 0.990350 1.691379 0.448200 1.141928 1.861476 0.554357 1.286100 0.069614 0.855805 1.601651 0.320013 1.023987 1.822894 0.578209 1.344501 0.080052 0.785333 1.566582 0.361677 1.104898 1.885030 0.639545 1.407357 0.153434 0.938179 1.720652 0.474847 1.318256 0.044914 0.855683 1.629465 0.437944 1.252831 0.024990 0.795373 1.590340 0.357127 1.165443 -0.000747 0.788315 1.590652 0.386431 1.197624 -0.013584 0.835954 1.651685 0.463586 1.276162 0.057864 0.897668 1.742027 0.559116 1.374859 0.193273 1.056175 1.889157 0.710586 1.580348 0.407362 1.242569 0.042766 0.907657 1.764531 0.620635 1.493091 0.310002 1.184483 0.034271 0.889272 1.782427 0.653101 1.478420 0.338338 1.201923 0.065161 0.951196 1.800033 0.675255 1.545870 0.451165 1.315646 0.209836 1.097200 -0.012463 0.845013 1.764065 0.652174 1.577225 0.431672 1.358363 0.265803 1.142508 0.041729 0.938441 1.849007 0.741618 1.700757 0.625276 1.512291 0.416998 1.342445 0.314840 1.211910 0.132298 1.072581 -0.004048 0.932218 1.855905 0.812140 1.708124 0.683628 1.624946 0.551196 1.484020 0.446857 1.419168 0.352124 1.315231 0.255127 1.241233 0.191011 1.149002 0.126798 1.077614 0.031447 0.999403 0.019804 0.945636 1.909373 0.940686 1.908817 0.830112 1.834192 0.887932 1.814672 0.756834 1.792523 0.822544 1.804408 0.766593 1.770853 0.794464 1.800727 0.751526 1.758821 0.788987 1.786880 0.814558 1.818971 0.822418 1.859652 0.846380 1.876657 0.931090 -0.031368 0.954000 0.041345 1.055496 0.046192 1.112290 0.125703 1.142215 0.189586 1.275822 0.279344 1.352864 0.399390 1.417195 0.474770 1.586423 0.571385 1.637371 0.762404 1.797359 0.793754 1.905084 0.990127 0.050764 1.120181 0.189950 1.278536 0.314289 1.416606 0.522323 1.605728 0.657609 1.736064 0.864528 1.945709 1.038919 0.172460 1.264344 0.327940 1.441495 0.489339 1.620990 0.742758 1.864010 0.978890 0.054901 1.213647 0.315622 1.367925 0.527446 1.686445 0.801940 1.894535 1.021703 0.150671 1.280517 0.415930 1.597966 0.690690 1.814216 1.015101 0.169339 1.244108 0.393753 1.565800 0.764048 1.867638 1.028999 0.210614 1.366819 0.507337 1.671181 0.838237 0.022188 1.174302 0.313854 1.504329 0.645781 1.845795 1.051255 0.239848 1.417986 0.574481 1.756897 0.951386 0.110073 1.293098 0.540906 1.736282 0.920748 0.119036 1.329341 0.550833 1.736478 0.927385 0.119774 1.392258 0.621372 1.775469 1.007774 0.217206 1.460136 0.708826 1.918555 1.133993 0.362808 1.631767 0.871741 0.066315 1.264788 0.549186 1.761046 1.012312 0.268274 1.523528 0.761486 0.024402 1.246090 0.502848 1.736382 1.030358 0.263498 1.504814 0.797584 0.038284 1.315985 0.615561 1.881866 1.132509 0.426240 1.688331 1.012746 0.276268 1.537983 0.817470 0.149300 1.425804 0.681759 -0.012530 1.283946 0.622295 1.877985 1.199987 0.515375 1.781866 1.081579 0.391646 1.721452 1.040703 0.317360 1.612416 0.970865 0.266856 1.601655 0.937590 0.290327 1.585370 0.921429 0.283284 1.598243 0.931518 0.260021 1.590875 0.958649 0.292061 1.637844 0.988134 0.312289 1.650253 1.031600 0.427015 1.767001 1.074681 0.426252 1.799364 1.185929 0.579219 1.932358 1.282992 0.645875 0.040156 1.418257 0.764669 0.173371 1.562041 0.945336 0.309563 1.680886 1.084452 0.477887 1.844079 1.284871 0.669433 0.089860 1.477088 0.903242 0.268087 1.703640 1.090186 0.536661 1.918966 1.327942 0.735035 0.166520 1.569816 1.004591 0.446853 1.854072 1.312899 0.702518 0.113425 1.613090 1.014710 0.475798 1.865885 1.351105 0.758249 0.262321 1.668284 1.136785 0.559653 0.028507 1.481806 0.915644 0.406371 1.878232 1.360671 0.811030 0.262274 1.718434 1.199699 0.680517 0.179919 1.610435 1.118901 0.627334 0.077819 1.553370 1.057095 0.585546 0.022795 1.538180 0.980766 0.484377 0.023856 1.494108 1.030226 0.491007 0.017274 1.535238 1.068544 0.590261 0.061618 1.587742 1.116980 0.644547 0.170823 1.648240 1.194503 0.741219 0.251235 1.791697 1.315747 0.851811 0.415621 1.900929 1.500285 0.993383 0.541195 0.093249 1.622554 1.249256 0.767888 0.344856 1.876331 1.448744 0.996767 0.573661 0.124676 1.643703 1.257500 0.780607 0.401957 1.972876 1.520976 1.187097 0.694507 0.306886 1.854893 1.401885 1.044022 0.597029 0.195790 1.807551 1.396496 1.006835 0.634520 0.181981 1.843667 1.378220 1.020785 0.627456 0.279505 1.861075 1.453605 1.114444 0.672015 0.375475 1.954714 1.557659 1.185029 0.809641 0.447297 0.106477 1.740616 1.348460 1.027725 0.582687 0.277990 1.910092 1.509602 1.193462 0.824779 0.510119 0.177000 1.827763 1.505398 1.153832 0.832423 0.437455 0.171220 1.814712 1.447020 1.128584 0.777519 0.473598 0.119850 1.886048 1.515369 1.218555 0.893278 0.537987 0.255812 1.909383 1.650827 1.359901 1.061282 0.716316 0.414321 0.125468 1.813275 1.571022 1.212518 0.956851 0.623980 0.408756 0.045675 1.826176 1.471750 1.215304 0.948001 0.683262 0.437623 0.176361 1.854173 1.610937 1.358115 1.068061 0.884621 0.553738 0.356388 0.049199 1.777936 1.512665 1.302866 1.024701 0.792763 0.572863 0.249058 0.119282 1.756813 1.582996 1.361044 1.086282 0.895852 0.676476 0.419545 0.165813 0.012477 1.735267 1.547257 1.359180 1.117816 0.926904 0.704130 0.498447 0.318523 0.057994 1.860723 1.723027 1.477003 1.277427 1.104572 0.893719 0.692617 0.494508 0.303114 0.144052 -0.011112 1.748550 1.579708 1.413473 1.279652 1.001473 0.934202 0.731463 0.532457 0.417666 0.233427 0.059069 1.967681 1.749714 1.609407 1.407439 1.310368 1.067641 0.979830 0.813878 0.690538 0.533904 0.425045 0.244967 0.169973 -0.011723 1.876781 1.727039 1.634464 1.452145 1.448180 1.205364 1.101400 1.013989 0.909619 0.719822 0.668385 0.510761 0.398037 0.300021 0.139310 0.033986 1.956609 1.852122 1.767483 1.663402 1.617220 1.510602 1.438139 1.412647 1.252997 1.181729 1.077732 1.039370 0.871450 0.817399 0.738218 0.775239 0.639974 0.550221 0.521202 0.428119 0.413547 0.217176 0.261744 0.171301 0.134991 0.023232 -0.017163 0.000436 1.951388 1.878190 1.804637 1.774184 1.775406 1.714919 1.645915 1.606995 1.620251 1.590934 1.519629 1.545077 1.464398 1.458268 1.421491 1.464767 1.458836 1.399241 1.400676 1.427477 1.403319 1.354776 1.404944 1.362031 1.313869 1.351539 1.366777 1.370372 1.389353 1.409150 1.360528 1.453599 1.459887 1.429592 1.439773 1.469815 1.424027 1.471130 1.498228 1.543683 1.583469 1.561051 1.660230 1.693126 1.741718 1.801903 1.808387 1.947118 1.871120 1.958034 -1.809188 0.048359 0.132079 0.154730 0.221928 0.329331 0.333421 0.439877 0.452440 0.496765 0.600557 0.660796 0.708086 0.791333 0.878621 0.937596 1.011597 1.035359 1.177245 1.285175 1.409637 1.420773 1.613717 1.634027 1.767500 1.843514 1.983888 0.042196 0.174460 0.251794 0.355433 0.462324 0.575296 0.755077 0.798506 0.934460 1.050726 1.201317 1.304605 1.443907 1.604050 1.683710 1.835109 1.976954 0.094378 0.210911 0.323699 0.433581 0.607326 0.750660 0.884279 1.061010 1.153927 1.341967 1.491178 1.604466 1.790604 -0.034786 0.169692 0.385328 0.513812 0.654879 0.869159 1.035588 1.237414 1.441537 1.574175 1.787644 1.941947 0.058771 0.290678 0.483033 0.637107 0.831997 1.050475 1.246917 1.361026 1.597033 1.738388 -0.038016 0.188808 0.359916 0.569117 0.814455 1.022910 1.248641 1.467152 1.662229 1.861796 0.115242 0.372486 0.579884 0.821252 1.100099 1.314837 1.543761 1.810564 -1.761012 0.186243 0.495461 0.706908 0.960351 1.160813 1.369258 1.704917 1.908953 0.173525 0.454292 0.707228 0.978617 1.195660 1.489816 1.733484 0.041779 0.289482 0.547436 0.800560 1.069460 1.362007 1.589743 1.899198 0.210724 0.451204 0.798331 1.116037 1.402551 1.699288 -0.015822 0.291274 0.622911 0.932610 1.199757 1.538548 1.866245 0.126351 0.485775 0.740845 1.070466 1.417858 1.686157 0.001282 0.344073 0.693525 1.049489 1.374121 1.693405 0.122694) ) ;;; 2048 all -------------------------------------------------------------------------------- (45.254) @@ -1781,14 +1781,14 @@ ;;; 256 odd -------------------------------------------------------------------------------- (vector 256 22.546259712247 #r(0 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1) - 16.242714 #r(0.000000 0.456765 1.687442 -0.133608 1.552599 -0.613047 1.706678 -0.197704 1.654787 0.529802 0.170660 0.135433 1.658670 1.698648 0.767088 1.301406 0.072253 0.476358 0.596769 -0.161294 0.942271 0.141352 1.436652 1.643811 0.711837 1.661608 0.292891 0.496011 0.570892 -0.057105 0.008577 0.821922 1.955586 1.410339 1.633963 1.332570 1.268156 1.838835 -0.014565 0.036112 1.408847 1.075934 0.772389 0.927611 0.964694 0.879860 1.198268 -0.017267 1.071348 0.983689 0.081986 1.232821 1.836590 0.078982 0.150405 0.057144 -0.028459 1.640374 0.117296 0.509253 0.034274 1.251076 1.666299 0.636454 0.070866 0.250422 0.251555 1.243143 1.717552 0.229561 1.056311 0.626892 0.597129 -0.064840 0.471253 0.539823 0.749620 -0.039923 -0.017559 0.905904 1.781183 -0.268850 0.444667 1.472167 -0.120773 1.508667 0.576704 0.190821 0.031775 0.977332 0.331054 0.133008 1.714274 0.283852 1.733589 0.115558 0.190647 0.489017 1.626356 -0.022764 1.166070 1.294472 1.460567 1.611249 0.195899 0.253585 1.347105 -0.078993 0.130173 0.912817 0.964692 0.885152 1.258931 1.388653 1.650194 0.235883 1.663345 1.842430 1.319909 1.713528 0.620667 1.392726 1.013169 1.477128 0.621189 1.077956 0.543032 0.888456 0.042982 1.359273 1.559111 1.621257 0.591536 0.749566 0.237130 0.812394 1.915485 1.675409 0.729778 1.807112 0.444639 0.263269 0.234148 1.382586 1.333218 1.787206 1.277283 1.183815 0.149095 0.419090 1.473544 1.406915 1.202522 1.868149 1.020969 -0.045252 1.105307 1.674286 0.206629 0.156758 1.600082 0.575703 1.357007 1.083986 0.555958 1.714543 1.238085 0.073643 0.928632 0.308256 1.159789 0.654285 0.303936 0.270252 1.370202 0.573369 1.870207 -0.136125 -0.422795 1.529175 0.874024 0.635637 0.622640 1.897396 0.953754 -0.038905 -0.106898 0.731592 0.357232 -0.379996 0.759113 -0.047250 1.159218 0.023363 0.669566 0.142465 0.537408 0.716957 1.180514 -0.500928 0.201921 0.443439 1.263347 1.460836 1.185016 0.463869 0.066634 0.429278 1.842397 1.200918 1.176436 1.836250 0.343392 1.007719 0.145775 0.944929 1.470897 0.823433 1.575221 1.393215 0.741031 0.954913 0.749002 -0.503842 0.746699 1.594650 0.624635 0.030293 -0.141514 -0.043721 1.501023 0.452048 0.783944 1.767362 1.023058 1.013821 0.069368 0.704589 1.140414 1.200862 0.439104 1.571509 1.588482 -0.148788 0.464366 1.259220 1.171049 1.708986 1.838157 1.901193 1.603280 0.692670 0.209609 -0.174803 0.734982 0.637445) + 16.241887 #r(0.000000 0.457219 1.688101 -0.135724 1.554266 -0.611806 1.706899 -0.197397 1.655126 0.532021 0.168553 0.134322 1.658709 1.698544 0.767995 1.300386 0.073269 0.475934 0.595275 -0.159913 0.941546 0.141273 1.436037 1.643970 0.711350 1.661907 0.291119 0.495601 0.570023 -0.057863 0.007497 0.822527 1.955243 1.409512 1.633743 1.331312 1.269211 1.838078 -0.015311 0.034998 1.407787 1.077588 0.770725 0.926391 0.963487 0.879252 1.198148 -0.016124 1.070856 0.984500 0.082453 1.234638 1.834160 0.078431 0.150972 0.057949 -0.028809 1.642879 0.117122 0.510541 0.034690 1.251227 1.664897 0.635870 0.070261 0.252065 0.252447 1.243132 1.718301 0.230524 1.055591 0.623808 0.595028 -0.061739 0.470933 0.539801 0.748257 -0.039695 -0.016919 0.905862 1.782941 -0.270379 0.445737 1.471729 -0.121549 1.506821 0.579023 0.191001 0.032149 0.975023 0.330489 0.131953 1.717060 0.284091 1.732860 0.118520 0.190527 0.489012 1.627624 -0.023309 1.166056 1.293683 1.460156 1.612969 0.194937 0.253102 1.346608 -0.079335 0.129752 0.912709 0.964827 0.883993 1.258487 1.387671 1.647606 0.234856 1.661996 1.842178 1.318183 1.712866 0.621203 1.394390 1.013386 1.476668 0.620387 1.078600 0.543320 0.889221 0.042114 1.358612 1.559872 1.622178 0.592549 0.750458 0.236653 0.814104 1.916106 1.676974 0.730010 1.806593 0.444422 0.264083 0.233265 1.381973 1.334263 1.785958 1.277285 1.184921 0.148608 0.418518 1.473180 1.408973 1.201304 1.868991 1.020965 -0.044821 1.106526 1.674918 0.209372 0.159106 1.598521 0.573512 1.356702 1.081909 0.555382 1.714122 1.238061 0.073588 0.929367 0.307124 1.159278 0.654772 0.302911 0.270314 1.371298 0.573786 1.872452 -0.136149 -0.424576 1.529496 0.873949 0.638125 0.623156 1.895723 0.953475 -0.038340 -0.106234 0.731443 0.356868 -0.380663 0.758234 -0.047360 1.158482 0.023731 0.669253 0.142832 0.538104 0.716402 1.182689 -0.502058 0.201669 0.444026 1.264715 1.460630 1.185463 0.464574 0.067429 0.428940 1.842620 1.203090 1.175884 1.834725 0.345260 1.007660 0.147199 0.944308 1.468959 0.825334 1.577504 1.393002 0.742406 0.956214 0.748483 -0.502843 0.745588 1.595379 0.625211 0.030533 -0.140368 -0.043613 1.501549 0.452579 0.784497 1.767678 1.022420 1.014426 0.068396 0.706827 1.141140 1.199908 0.437007 1.570287 1.588931 -0.149100 0.464974 1.258616 1.170102 1.709945 1.838256 1.903011 1.603603 0.690235 0.208979 -0.173392 0.732931 0.636225) ) ;;; 512 odd -------------------------------------------------------------------------------- (vector 512 35.541 #r(0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0) ;; from (try-all :odd 512 513 0.0057812032540294 1.0142361702487) = 28.7291 start for next - 23.517222 #r(0.000000 1.402699 0.710345 -0.021085 1.303265 0.609795 -0.055093 1.273980 0.672866 0.041691 1.435237 0.833333 0.177771 1.557793 0.888029 0.266694 1.601636 0.994383 0.362007 1.768513 1.197208 0.583281 0.011702 1.381174 0.763027 0.183382 1.606551 1.040600 0.477119 1.923178 1.369819 0.792169 0.178553 1.629573 1.034315 0.478164 -0.081089 1.418536 0.887290 0.381127 1.895987 1.355960 0.854141 0.315774 1.806788 1.269839 0.710345 0.227969 1.714895 1.219933 0.726588 0.231920 1.744568 1.236271 0.737525 0.277218 1.814731 1.361079 0.932165 0.497427 0.034546 1.602648 1.145984 0.711934 0.241767 1.746697 1.282443 0.813937 0.405377 -0.003145 1.638937 1.232256 0.776859 0.375329 1.954103 1.570681 1.177312 0.771946 0.323958 1.915835 1.547043 1.221818 0.852761 0.480068 0.080191 1.705724 1.374295 1.022717 0.641880 0.266807 -0.019746 1.657995 1.299812 0.936909 0.560316 0.229354 1.913978 1.628717 1.360548 1.043780 0.694284 0.371393 0.091836 1.781024 1.475139 1.143091 0.887315 0.654255 0.413241 0.096729 1.827160 1.546134 1.259736 0.984485 0.720505 0.479935 0.222855 1.957332 1.713443 1.465983 1.221933 0.974101 0.749838 0.570861 0.355512 0.110081 1.879010 1.698138 1.524456 1.303746 1.053758 0.872614 0.718600 0.489729 0.294072 0.169464 -0.008641 1.716597 1.555215 1.482842 1.313357 1.111118 0.984889 0.843561 0.630709 0.517262 0.429517 0.280257 0.116909 -0.064022 1.760658 1.627087 1.529461 1.467770 1.396158 1.304189 1.117557 1.012430 0.976655 0.904092 0.752674 0.668762 0.594300 0.513063 0.429396 0.350144 0.313792 0.237384 0.161762 0.078927 0.030013 -0.028713 1.908143 1.946999 1.965070 1.850959 1.822037 1.819046 1.768467 1.744088 1.747536 1.739553 1.690772 1.677619 1.699147 1.681872 1.696594 1.708371 1.713610 1.700981 1.734874 1.774538 1.788305 1.870747 1.913146 1.910801 -0.053276 0.030275 0.095182 0.114923 0.179027 0.206687 0.261459 0.359354 0.439539 0.512740 0.597853 0.719374 0.776363 0.812727 0.905050 1.042484 1.186129 1.269711 1.333701 1.424911 1.553872 1.687013 1.801276 1.950940 0.086688 0.232883 0.419857 0.514985 0.609768 0.813745 0.975824 1.151646 1.269800 1.410488 1.593948 1.788204 1.941630 0.108898 0.263435 0.475794 0.665644 0.867939 1.051137 1.262422 1.451178 1.717053 1.916711 0.139994 0.314093 0.578658 0.772182 1.044568 1.198730 1.543408 1.714573 0.013984 0.198055 0.520182 0.671418 0.986593 1.194118 1.506815 1.764656 0.095617 0.341591 0.625517 0.946734 1.201184 1.474512 1.720383 0.073895 0.317397 0.725186 0.992559 1.377583 1.626110 0.003566 0.250956 0.632946 0.949417 1.301286 1.632717 1.932081 0.363954 0.637141 1.073768 1.334285 1.711744 0.080174 0.434897 0.848893 1.206593 1.600075 0.085497 0.381469 0.875100 1.088754 1.613253 1.960304 0.421052 0.808109 1.175350 1.622670 -0.036371 0.508443 0.863928 1.390892 1.718539 0.229695 0.617597 1.093996 1.518104 0.013362 0.447575 0.956936 1.392740 1.810661 0.309626 0.728227 1.352118 1.754330 0.317267 0.680872 1.238974 1.718025 0.277956 0.771535 1.318514 1.714467 0.282761 0.804627 1.302132 1.938769 0.395052 0.940173 1.468943 -0.014609 0.541180 1.164931 1.594420 0.340967 0.702104 1.381646 1.956724 0.497344 1.081234 1.763306 0.169300 0.815546 1.474038 -0.014390 0.585876 1.248625 1.762636 0.350603 1.010949 1.661136 0.230843 0.942664 1.597953 0.139804 0.831684 1.415720 0.088760 0.710682 1.379888 0.021593 0.668775 1.335611 -0.046174 0.663997 1.412792 -0.004588 0.665452 1.416035 -0.001854 0.771289 1.446169 0.148939 0.918062 1.589163 0.225892 0.991443 1.642378 0.370987 1.113986 1.831948 0.675919 1.327289 0.125468 0.818337 1.616012 0.320288 1.044035 1.790147 0.553501 1.421273 0.048576 0.901459 1.688401 0.374639 1.235535 1.953418 0.752982 1.585223 0.371192 1.194520 0.000910 0.866066 1.545698 0.475364 1.238947 0.121924 0.812102 1.781933 0.540653 1.437672 0.190971 1.127229 1.876709 0.785495 1.565095 0.460687 1.346422 0.194134 1.044974 -0.000786 0.851783 1.729420 0.621621 1.519370 0.444818 1.235551 0.155576 1.068174 0.047946 0.843245 1.776499 0.729201 1.725183 0.565033 1.539334 0.468775 1.422298 0.275576 1.294730 0.256389 1.096067 0.100795 1.052508 0.044185 0.982109 1.901358 0.979933 1.947925 0.997989 1.873802 0.865698 1.886318 0.917516 1.900182 0.947143 1.869354 0.923820 1.868569 0.889420 1.915703 0.927504 -0.032180 1.004125 0.038894 1.035409 0.138211 1.212806 0.268373 1.315550 0.416377 1.412739 0.443529 1.530553 0.592477 1.711606 0.789422 1.898523 0.946240 0.008297 1.128249 0.246651 1.322741 0.381772 1.520393 0.587169 1.757969 0.892136 0.040723 1.141435 0.279184 1.405474 0.518808 1.665159 0.803241 0.008814 1.138954 0.331217 1.446175 0.661772 1.770763 1.037963 0.209348 1.326639 0.543787 1.778195 0.997105 0.276219 1.473564 0.746719) + 23.515902 #r(0.000000 1.400623 0.707698 -0.021146 1.302024 0.608149 -0.057471 1.272153 0.672536 0.041805 1.435569 0.832639 0.177350 1.557740 0.888978 0.266497 1.602407 0.995258 0.361513 1.769278 1.196560 0.583616 0.012645 1.382538 0.761557 0.181770 1.606836 1.039411 0.478759 1.924023 1.369389 0.792884 0.177820 1.630239 1.034678 0.477725 -0.081057 1.417516 0.885954 0.383344 1.898602 1.356891 0.854090 0.315084 1.804468 1.269353 0.710724 0.227408 1.715852 1.221461 0.726563 0.232455 1.743921 1.234011 0.736198 0.276156 1.814011 1.361455 0.933226 0.499533 0.035227 1.601270 1.146366 0.713235 0.242327 1.746883 1.282446 0.811249 0.404760 -0.002718 1.637731 1.231010 0.776517 0.376340 1.954245 1.571918 1.178235 0.773150 0.324821 1.916864 1.548382 1.221923 0.852241 0.479624 0.082593 1.706562 1.374596 1.023279 0.640453 0.266696 -0.019762 1.657409 1.298084 0.935749 0.560508 0.228111 1.913453 1.628711 1.359161 1.043838 0.693794 0.369375 0.092274 1.780684 1.475052 1.145333 0.888094 0.655368 0.411675 0.097128 1.827235 1.545512 1.257577 0.982331 0.720585 0.482829 0.225408 1.959502 1.715865 1.465889 1.222797 0.974775 0.750542 0.570029 0.355748 0.111540 1.879052 1.697744 1.523608 1.305162 1.053531 0.874130 0.721068 0.490522 0.291180 0.169764 -0.007756 1.715295 1.554259 1.481444 1.311705 1.111089 0.985497 0.842324 0.630078 0.516856 0.428781 0.279772 0.117097 -0.064259 1.761418 1.624959 1.529391 1.468189 1.396110 1.303962 1.118879 1.013736 0.975519 0.904314 0.751193 0.669547 0.594851 0.513293 0.429501 0.352413 0.315301 0.237006 0.161937 0.079370 0.028488 -0.026402 1.908077 1.946827 1.965296 1.852570 1.823823 1.817486 1.767239 1.741997 1.747290 1.740397 1.689745 1.676800 1.698396 1.684007 1.694857 1.708195 1.715055 1.701013 1.734063 1.774632 1.788203 1.871615 1.912445 1.909843 -0.052119 0.030795 0.096067 0.117399 0.179387 0.206048 0.260433 0.359250 0.438147 0.511399 0.598449 0.719193 0.777281 0.813651 0.905364 1.044066 1.184791 1.270196 1.335591 1.425261 1.553039 1.687589 1.802744 1.951710 0.085725 0.233622 0.419731 0.516530 0.609152 0.814932 0.975070 1.151827 1.267821 1.411973 1.594155 1.787518 1.941932 0.107944 0.265291 0.475642 0.665690 0.867495 1.050632 1.261964 1.452546 1.718477 1.916955 0.139709 0.313681 0.580142 0.773418 1.044975 1.198158 1.544237 1.715890 0.013619 0.195393 0.521626 0.674111 0.987265 1.190299 1.508602 1.763719 0.096223 0.340338 0.625154 0.947993 1.201063 1.476077 1.717036 0.074486 0.318596 0.724314 0.993467 1.376868 1.627805 0.002199 0.251179 0.634062 0.947739 1.298407 1.633451 1.931299 0.364882 0.637074 1.074404 1.334698 1.711393 0.080678 0.432903 0.848119 1.207340 1.599186 0.086614 0.382265 0.874288 1.089655 1.614150 1.958345 0.422657 0.807576 1.175403 1.623831 -0.036342 0.508327 0.864305 1.388756 1.719892 0.229676 0.618537 1.093681 1.517028 0.016132 0.445756 0.956961 1.395188 1.808915 0.309902 0.729179 1.350999 1.755305 0.317618 0.680173 1.239998 1.717339 0.276743 0.772522 1.317416 1.716264 0.281530 0.804351 1.302294 1.940180 0.395824 0.939511 1.470068 -0.017572 0.542294 1.165684 1.595652 0.341471 0.701666 1.381363 1.955847 0.496325 1.083553 1.760771 0.170952 0.815156 1.474090 -0.013089 0.586503 1.246915 1.765144 0.350293 1.010255 1.662523 0.229166 0.942183 1.596173 0.140756 0.833416 1.416234 0.088121 0.711419 1.380950 0.020045 0.671267 1.333461 -0.044485 0.663882 1.411199 -0.003441 0.665306 1.416535 -0.002821 0.771454 1.444827 0.150263 0.919221 1.590599 0.225087 0.991474 1.644544 0.370727 1.110610 1.832866 0.675392 1.325751 0.126754 0.818563 1.616669 0.319684 1.046989 1.789082 0.551634 1.421227 0.050204 0.902961 1.688738 0.376489 1.237501 1.953673 0.752120 1.584805 0.368717 1.195566 0.000646 0.867087 1.547644 0.474969 1.239119 0.121706 0.813115 1.784454 0.540626 1.436268 0.191584 1.126010 1.878883 0.785009 1.563303 0.460511 1.345419 0.195054 1.042185 -0.001701 0.851435 1.728041 0.620144 1.518945 0.444967 1.234276 0.154684 1.069844 0.047560 0.842754 1.776825 0.729397 1.724377 0.564394 1.538615 0.465807 1.422925 0.275988 1.294515 0.255706 1.096656 0.101089 1.051261 0.042441 0.979389 1.899934 0.978766 1.946682 0.997829 1.873810 0.865544 1.885628 0.918026 1.901413 0.946877 1.869761 0.922699 1.871083 0.889115 1.914947 0.925807 -0.030945 1.003700 0.040869 1.034406 0.137621 1.211490 0.265573 1.315492 0.417647 1.411183 0.445158 1.532648 0.593102 1.712825 0.789474 1.900397 0.946468 0.009195 1.130494 0.248166 1.323336 0.382063 1.519789 0.588138 1.759211 0.891685 0.041566 1.143030 0.278602 1.405902 0.519170 1.664071 0.803596 0.009782 1.138808 0.330096 1.446674 0.659714 1.772235 1.036113 0.209242 1.325978 0.545375 1.776344 0.996276 0.277701 1.474973 0.746274) ) ;;; 1024 odd -------------------------------------------------------------------------------- @@ -2411,7 +2411,7 @@ ;;; 99 prime -------------------------------------------------------------------------------- (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) - 12.604279 #r(0.000000 1.613994 0.693956 0.815100 1.476490 1.821090 0.103788 -0.186459 1.054289 0.575497 0.976162 0.289950 0.573215 0.748133 0.895407 1.357347 0.576353 1.145885 1.627542 1.538668 1.094712 0.669755 1.244013 0.806820 0.624419 0.133906 -0.098944 1.122055 1.214055 0.922372 1.534259 1.567055 0.301290 -0.171688 0.916397 1.057106 0.871820 0.827570 0.796736 1.461966 -0.163480 1.594906 0.547272 0.911653 1.204965 1.303074 1.103514 0.608615 0.564898 0.203947 1.730567 0.438483 0.361658 1.178927 0.940829 0.105178 1.118438 0.410308 0.784810 -0.222999 0.507859 0.271851 0.901340 0.582059 1.661508 0.188368 0.434888 -0.048265 -0.496212 0.558979 1.092417 0.007337 1.071518 0.917906 1.162163 0.001472 1.640217 1.011998 1.446198 0.818152 -0.054291 0.475918 1.418127 0.717589 0.337777 0.978721 -0.106258 0.909136 0.651668 0.076581 1.104661 1.744825 0.166752 1.607515 0.976612 1.561856 1.101062 0.491704 1.141881) + 12.577378 #r(0.000000 1.606500 0.710782 0.831912 1.498992 1.824787 0.116159 -0.180831 1.066295 0.568843 0.967824 0.292392 0.550458 0.753848 0.865239 1.345891 0.576408 1.151601 1.610648 1.534872 1.104991 0.658526 1.253973 0.813550 0.616837 0.146480 -0.064854 1.125560 1.220929 0.935280 1.542029 1.558660 0.290895 -0.156901 0.924185 1.056282 0.875270 0.815532 0.773934 1.481163 -0.163032 1.601935 0.546118 0.908338 1.204483 1.290662 1.107486 0.615436 0.570723 0.198908 1.741425 0.441641 0.378889 1.168082 0.927631 0.114318 1.131285 0.409352 0.780459 -0.239072 0.531242 0.258847 0.921012 0.561150 1.649370 0.198953 0.427352 -0.039450 -0.500229 0.583037 1.113187 -0.008166 1.096497 0.882963 1.164475 0.014000 1.645840 1.004121 1.466757 0.770628 -0.075531 0.498646 1.426871 0.737006 0.309470 0.982564 -0.105052 0.900789 0.647694 0.071810 1.118676 1.735777 0.169421 1.616850 0.964754 1.556953 1.104961 0.493127 1.159598) ) ;;; 100 prime -------------------------------------------------------------------------------- @@ -2447,7 +2447,7 @@ ;;; 105 prime -------------------------------------------------------------------------------- (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) - 12.926115 #r(0.000000 0.038993 0.139572 0.174273 0.018055 1.557860 0.530659 0.667234 0.430142 0.778286 0.347512 1.644577 0.444505 0.644617 1.762947 1.845661 1.030396 0.142534 1.451932 -0.154552 1.369383 -0.120831 1.677206 0.986266 1.278445 0.053794 1.550747 1.348872 1.244971 1.707021 1.869813 1.579245 0.117707 0.068364 0.783355 1.384254 1.604838 1.337568 0.540041 1.101193 0.692224 0.144237 0.337693 0.307875 1.577480 1.908988 1.872255 0.554325 -0.112474 0.392199 1.257947 1.290081 0.014802 0.835447 1.239036 -0.122215 1.440216 1.839313 0.505810 0.800816 0.042267 0.312720 0.229646 1.368607 1.196271 0.867381 -0.107789 0.045631 0.865745 0.152943 1.100072 1.606373 1.553105 -0.173702 1.327564 -0.142572 1.814702 0.873252 1.481489 0.396699 0.721495 0.887932 0.587042 0.440583 1.486368 1.809931 1.093619 1.445449 1.792840 1.714382 1.338744 0.079099 -0.008600 1.274801 1.637416 0.124680 0.871289 1.952091 0.386316 1.020729 0.295167 0.158351 0.678169 1.363599 1.838212) + 12.916522 #r(0.000000 0.035733 0.146816 0.176222 0.019027 1.555239 0.531049 0.662233 0.425721 0.770266 0.351556 1.638905 0.444693 0.646790 1.765319 1.849739 1.029701 0.135044 1.450802 -0.159806 1.362913 -0.124665 1.674443 0.989611 1.272076 0.057071 1.556742 1.346751 1.251145 1.706415 1.872694 1.575371 0.113097 0.068573 0.779217 1.381228 1.603069 1.338719 0.535291 1.105635 0.700633 0.141791 0.344883 0.301141 1.577419 1.904318 1.874848 0.560766 -0.112149 0.389847 1.249710 1.291208 0.017403 0.838973 1.241784 -0.121543 1.444367 1.838412 0.505481 0.802591 0.039878 0.310437 0.226521 1.375029 1.201609 0.875569 -0.109062 0.042976 0.869010 0.155137 1.106003 1.606208 1.553493 -0.177942 1.328488 -0.138564 1.819211 0.873740 1.485950 0.404397 0.720036 0.894644 0.589908 0.439555 1.491305 1.816089 1.096165 1.438818 1.789014 1.713238 1.331991 0.084996 -0.007846 1.275222 1.636598 0.131740 0.866434 1.943413 0.382086 1.017873 0.303950 0.157486 0.677006 1.358584 1.833528) ) ;;; 106 prime -------------------------------------------------------------------------------- @@ -2489,13 +2489,13 @@ ;;; 112 prime -------------------------------------------------------------------------------- (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.449517 #r(0.000000 1.009934 1.687919 0.948416 -0.094916 0.973360 -0.062414 1.888884 0.612802 0.745607 0.394342 0.540176 1.594718 1.482666 0.695941 1.551011 1.476074 0.337673 1.103008 1.244971 0.498488 0.034451 1.087971 -0.832554 1.286322 1.300054 1.009727 0.654128 -0.038826 1.190208 1.390119 0.209629 0.385049 0.078720 0.785885 1.086926 1.298890 1.324113 0.372925 1.292635 1.546725 0.596254 1.617362 1.222022 1.275713 0.256160 0.632238 -0.232815 1.126339 0.505734 1.076905 1.272734 0.060356 0.861157 1.130865 1.173066 1.553849 0.505678 0.201121 -0.065868 0.329893 1.002192 0.397680 1.909056 1.155176 0.713596 0.977995 1.245692 1.000170 0.256004 1.300736 0.896417 0.400681 0.355126 1.416895 0.740465 0.107290 1.703897 0.711961 0.254217 -0.035488 -0.083639 1.679322 0.473559 1.108511 1.392981 0.992231 1.615183 1.225776 1.149840 -0.426023 0.104763 1.201676 1.807583 1.540105 1.797421 0.828771 1.281696 0.097024 0.281632 -0.615401 0.350049 1.589719 0.792056 0.561241 0.979520 0.215323 0.148068 -0.052242 -0.072294 -0.117370 -0.129960) + 13.432041 #r(0.000000 1.022306 1.659808 0.924759 -0.087688 0.965196 -0.066230 1.901637 0.617989 0.728481 0.407054 0.552654 1.585849 1.494557 0.681265 1.537034 1.505763 0.290786 1.072103 1.213397 0.458755 0.057808 1.050683 -0.857452 1.287056 1.288375 0.990442 0.635807 -0.042294 1.189168 1.369581 0.202567 0.368100 0.074637 0.781785 1.113195 1.268694 1.303587 0.363181 1.300784 1.517983 0.612029 1.628780 1.232036 1.268299 0.227626 0.625657 -0.233974 1.101505 0.496818 1.114398 1.293373 0.065936 0.838962 1.121782 1.161294 1.558114 0.490386 0.225463 -0.072671 0.360939 1.026958 0.409468 1.926579 1.152881 0.663659 0.988071 1.240422 1.010565 0.261830 1.300112 0.907465 0.377816 0.345039 1.423383 0.714651 0.094098 1.746831 0.703527 0.262312 -0.033334 -0.082719 1.690275 0.457934 1.104373 1.375564 0.950940 1.651746 1.225689 1.153617 -0.446884 0.128976 1.225947 1.801296 1.536475 1.803596 0.819072 1.299336 0.121015 0.279274 -0.590283 0.345169 1.617128 0.808805 0.573705 0.998005 0.241981 0.169695 -0.046880 -0.083617 -0.077998 -0.124083) ) ;;; 113 prime -------------------------------------------------------------------------------- (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.461006 #r(0.000000 0.552239 -0.201311 1.143801 1.835947 0.959825 1.988613 0.929244 1.523008 1.140964 0.827372 -0.103434 0.629858 0.251553 1.054921 0.691351 1.523080 1.189460 0.256797 0.131366 1.214316 1.908196 1.225839 0.334319 0.594191 0.737655 1.718476 0.096600 1.042834 1.113316 0.187685 0.713826 -0.251837 0.905666 0.107899 1.656124 0.141375 1.456247 1.831858 0.149313 0.600153 1.021196 0.389067 1.341571 1.327127 1.687438 1.371053 0.069654 1.555008 0.380869 0.662728 1.095751 0.067738 1.342924 1.284976 -0.224935 1.161662 -0.136490 1.265725 1.761896 -0.156824 -0.210081 -0.090068 1.829950 1.001393 0.046280 -0.127430 0.875716 -0.190800 0.922452 0.191364 0.538363 1.724916 0.761970 -0.066391 0.671727 0.066585 0.133857 0.368464 0.052157 1.268068 0.900166 1.596943 1.299580 0.458443 1.939109 1.062183 1.232663 0.324295 0.020592 0.198083 0.573314 0.065114 1.223486 0.201165 0.863486 1.113597 0.227513 1.406043 1.673862 1.507883 1.355069 1.278109 0.793277 0.347269 1.957000 1.662167 0.091887 0.726045 1.369646 0.993902 1.008553 0.351579) + 13.378925 #r(0.000000 0.530023 -0.133056 1.165604 1.776990 0.959258 0.083179 0.899966 1.590724 1.146469 0.787123 -0.105292 0.669297 0.284550 1.052397 0.733083 1.553681 1.227712 0.236178 0.058437 1.225511 1.962455 1.230068 0.337163 0.578887 0.725673 1.696799 0.039316 1.042745 1.183984 0.193748 0.658474 -0.242507 0.927268 0.056041 1.690521 0.177710 1.426147 1.814596 0.143288 0.623294 1.067425 0.334220 1.355288 1.290763 1.769115 1.354291 0.013356 1.516252 0.404663 0.678049 1.136111 0.074519 1.364761 1.323246 -0.186482 1.145856 -0.143323 1.199671 1.763817 -0.236628 -0.253283 -0.110928 1.824430 0.982075 0.045710 -0.055784 0.857573 -0.196869 0.965372 0.099866 0.530251 1.758876 0.729743 -0.025201 0.706939 0.080635 0.055884 0.364201 0.043553 1.260827 0.849111 1.573303 1.265174 0.510130 1.962308 1.015411 1.243401 0.238637 0.005950 0.191571 0.557357 0.016971 1.220529 0.120786 0.860456 1.127059 0.178415 1.403551 1.642586 1.449755 1.322698 1.249327 0.747530 0.355627 1.896226 1.693768 0.136043 0.757254 1.324842 0.966556 1.033760 0.349980) ) ;;; 114 prime -------------------------------------------------------------------------------- @@ -2507,19 +2507,19 @@ ;;; 115 prime -------------------------------------------------------------------------------- (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) - 13.527949 #r(0.000000 0.492983 -0.050699 1.015471 1.915660 1.120834 0.045988 0.971405 1.494725 1.071798 0.842989 -0.217635 0.523770 -0.024504 1.202592 0.666052 1.399439 1.161776 0.363176 0.220707 1.229196 1.657537 1.221258 0.382424 0.662100 0.854267 1.707946 0.142129 1.012360 1.207260 0.282908 0.843325 -0.143472 0.991199 -0.069521 1.493748 0.126689 1.319466 1.728584 0.187200 0.516484 1.041945 0.290438 1.281161 1.334163 1.742731 1.114615 0.110688 1.426551 0.367694 0.625975 1.227580 0.038180 1.422144 1.103944 -0.266246 1.356135 -0.196883 1.255132 1.634051 -0.046110 -0.313793 0.093383 -0.003580 0.985068 -0.018270 -0.085157 0.828110 -0.216327 0.869738 0.061165 0.862459 1.796141 0.735161 0.038957 0.606171 0.158921 0.076034 0.486676 0.156005 1.267810 0.882588 1.569324 1.484421 0.480432 1.881689 0.864561 1.074943 0.340836 0.058828 0.062407 0.610276 0.076541 1.290579 0.163510 0.911700 1.084548 0.172492 1.396745 1.671695 1.462706 1.291043 1.127495 0.833067 0.404019 0.073383 1.840879 0.113211 0.486614 1.103146 1.076778 0.983493 0.323004 0.009904 0.110511) + 13.481409 #r(0.000000 0.490468 -0.036628 0.999423 1.938186 1.098039 0.061684 0.941804 1.510411 1.071761 0.847808 -0.195638 0.554398 -0.067035 1.216076 0.645296 1.411766 1.180867 0.379564 0.216040 1.260637 1.635645 1.171227 0.415672 0.665180 0.817423 1.755254 0.172770 1.024590 1.244658 0.225280 0.876694 -0.122050 1.037302 -0.073036 1.499146 0.134868 1.321349 1.759728 0.187835 0.524167 1.014011 0.224420 1.264464 1.407503 1.848526 1.070475 0.080135 1.356366 0.384472 0.592458 1.283499 0.055375 1.414682 1.126802 -0.254309 1.373915 -0.156745 1.223946 1.619996 -0.020115 -0.304510 0.108907 0.006777 0.983682 -0.002895 -0.083993 0.853061 -0.228455 0.810346 -0.005536 0.907120 1.796142 0.768458 0.069640 0.666735 0.167472 0.045277 0.501044 0.151378 1.220180 0.897360 1.609106 1.411203 0.457272 1.888506 0.866716 1.055261 0.297445 0.064088 0.050517 0.604964 0.080094 1.324616 0.155317 0.939071 1.065221 0.167693 1.363021 1.700034 1.430537 1.250487 1.136416 0.899634 0.433311 0.074805 1.823657 0.119687 0.542349 1.110092 1.113300 0.970293 0.318574 0.033727 0.090913) ) ;;; 116 prime -------------------------------------------------------------------------------- (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) - 13.632304 #r(0.000000 1.653744 0.263048 1.463741 0.011900 0.932091 0.493498 1.638798 0.327248 0.711490 0.532281 1.201000 1.701993 0.495888 0.178198 0.117707 -0.576471 0.972724 0.672230 1.239395 0.471062 0.884337 0.683180 0.129467 0.431553 0.596429 0.951594 1.652843 -0.184993 1.685826 0.628242 0.709010 1.877213 -0.130813 0.326453 1.522725 0.287770 1.628365 -0.211136 0.580071 1.514696 -0.185802 1.703547 0.391310 1.065364 0.225515 1.410850 0.954836 -0.070307 1.584156 1.210151 0.479309 0.063148 0.641084 1.147103 1.547710 0.246899 1.920730 -0.074636 0.090701 1.556244 1.121960 1.005395 1.668065 0.782253 0.645320 1.596164 1.568392 -0.189220 0.026342 0.092107 1.555276 1.018230 0.432842 0.334814 1.233518 1.495858 0.941435 1.698492 0.979088 0.172420 1.283775 1.324741 0.060706 0.476506 1.483057 0.709502 1.609572 1.120400 0.340661 1.823379 0.515544 0.875499 0.104129 0.779035 0.737670 1.385595 1.187783 0.950976 0.098718 1.634430 0.187796 -0.193088 1.282403 -0.406473 0.667587 1.751044 1.433358 1.472717 1.622641 1.403666 0.788038 0.045714 0.197589 0.329691 0.072616) + 13.608593 #r(0.000000 1.653095 0.276323 1.455579 0.026403 0.936953 0.496081 1.653901 0.344080 0.759173 0.563063 1.235950 1.706855 0.455503 0.190666 0.126906 -0.572811 0.999205 0.675549 1.223375 0.447059 0.875310 0.646961 0.169878 0.433498 0.649900 0.951144 1.646724 -0.216640 1.674801 0.646809 0.723034 1.905719 -0.173078 0.286966 1.501763 0.261326 1.628260 -0.249038 0.604666 1.544403 -0.156184 1.707154 0.389585 1.062587 0.237581 1.422735 0.978545 -0.051171 1.564189 1.229937 0.452497 0.077991 0.679029 1.167372 1.533593 0.208276 1.922878 -0.148140 0.105080 1.589205 1.124818 1.003160 1.662080 0.752646 0.588955 1.586595 1.578950 -0.204721 0.018922 0.072845 1.560651 0.999946 0.415118 0.312497 1.210531 1.529407 0.909692 1.734534 0.979235 0.172045 1.235153 1.338787 0.043938 0.480071 1.449645 0.645923 1.593635 1.121873 0.346120 1.830749 0.495312 0.919827 0.121056 0.781792 0.735528 1.399506 1.203922 0.960125 0.107924 1.620289 0.193295 -0.157093 1.272690 -0.397301 0.626692 1.754281 1.464042 1.421652 1.669369 1.410750 0.745626 -0.004840 0.199378 0.360546 0.095468) ) ;;; 117 prime -------------------------------------------------------------------------------- (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) - 13.720055 #r(0.000000 1.689553 0.260873 1.402498 -0.005675 0.801849 0.367680 1.547144 0.320259 0.614820 0.410822 1.132755 1.658185 0.478349 0.181018 0.131953 -0.601563 0.901813 0.781523 1.244086 0.405740 1.044868 0.604740 0.185764 0.357627 0.462785 0.976338 1.755743 -0.060886 1.745898 0.622552 0.735234 1.872465 -0.097841 0.145504 1.457404 0.310323 1.525840 -0.173377 0.504073 1.440865 -0.052644 1.755159 0.334654 0.960772 0.389267 1.484438 1.077785 0.052174 1.547328 1.267576 0.616927 -0.011832 0.690701 1.273125 1.399734 0.357148 -0.065713 0.024279 0.032629 1.368725 1.028835 1.026665 1.767217 0.718263 0.695533 1.489810 1.613736 -0.136307 0.148777 0.077313 1.519850 0.978022 0.428765 0.280622 1.338704 1.620294 0.897994 1.724221 0.938714 0.166966 1.309422 1.160745 -0.065170 0.584697 1.425155 0.839861 1.478342 1.119277 0.256678 1.902758 0.352935 0.837522 0.139213 0.849908 0.678512 1.285717 1.064036 1.071577 -0.020479 1.632524 0.143864 -0.084627 1.258093 -0.438620 0.716605 1.687836 1.514542 1.374092 1.560177 1.458122 0.879943 0.238417 0.085940 0.374997 -0.194715 0.265561) + 13.680216 #r(0.000000 1.688026 0.267955 1.374351 -0.002997 0.811104 0.353452 1.551229 0.284696 0.542058 0.377909 1.175383 1.710894 0.412982 0.185867 0.118562 -0.623961 0.889589 0.782241 1.208703 0.402349 0.920095 0.656367 0.168376 0.361453 0.466066 1.040272 1.684105 0.004005 1.798269 0.600767 0.738643 1.841999 -0.121910 0.063062 1.500091 0.349331 1.566370 -0.081025 0.485117 1.433414 -0.175314 1.794407 0.340610 0.925543 0.308779 1.338194 1.062048 0.034329 1.590829 1.249125 0.629072 0.046100 0.678105 1.282374 1.471958 0.343990 -0.012184 0.025088 0.026864 1.371481 1.007248 1.058699 1.796290 0.706534 0.711138 1.427867 1.594466 -0.055777 0.127617 0.153626 1.537163 0.930123 0.370161 0.296951 1.350618 1.645532 0.852235 1.717604 0.955495 0.105226 1.278685 1.181367 -0.105642 0.466691 1.356995 0.807474 1.413130 1.085801 0.249630 1.956545 0.281625 0.802255 0.121542 0.884619 0.602864 1.207667 1.011035 1.098265 -0.002067 1.630354 0.155013 -0.142381 1.206795 -0.517321 0.734081 1.768506 1.435615 1.357134 1.611634 1.476408 0.827132 0.193848 0.004639 0.352651 -0.171724 0.246886) ) ;;; 118 prime -------------------------------------------------------------------------------- @@ -2531,61 +2531,61 @@ ;;; 119 prime -------------------------------------------------------------------------------- (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) - 13.776326 #r(0.000000 1.771586 0.255539 1.477595 0.060083 0.881081 0.308946 1.511598 0.350002 0.565698 0.442621 1.221812 1.605749 0.533003 0.193109 0.089513 -0.605206 1.045895 0.597338 1.162304 0.526264 1.162267 0.786894 0.346956 0.489627 0.455645 1.110924 1.677486 -0.172110 1.445293 0.682126 0.585847 0.006561 0.177952 0.254257 1.610790 0.324458 1.474815 -0.067876 0.434731 1.430474 -0.047646 1.936305 0.367897 1.076645 0.314407 1.495585 1.144442 0.099466 1.646673 1.278627 0.638745 0.122647 0.579598 1.235926 1.358765 0.220101 0.019190 0.040741 0.001879 1.476152 0.915042 1.216670 1.574202 0.814305 0.740775 1.408209 1.649543 -0.286878 0.059229 0.331786 1.595224 0.877739 0.501436 0.241726 1.070388 1.652049 0.874794 1.602726 1.053975 0.195891 1.196353 1.066225 -0.346667 0.559684 1.358701 0.719579 1.573458 1.276969 0.077756 1.930145 0.211732 0.884097 0.097928 0.915102 0.705779 1.335648 1.179843 1.184409 0.215988 1.382213 0.156507 0.006363 1.355134 -0.550491 0.786332 1.730927 1.561621 1.390669 1.500055 1.280498 0.907784 0.224776 -0.134049 0.493078 -0.064869 0.234447 -0.006674 -0.129512) + 13.745598 #r(0.000000 1.763789 0.241864 1.479014 0.040903 0.851640 0.292306 1.494078 0.368530 0.576785 0.413162 1.251253 1.560498 0.533496 0.207377 0.086290 -0.603884 1.088882 0.583146 1.168157 0.551605 1.152674 0.790902 0.337296 0.454014 0.458353 1.138887 1.678384 -0.142605 1.425377 0.694184 0.590015 -0.002181 0.226685 0.273798 1.626617 0.341625 1.482203 -0.084169 0.460416 1.413878 -0.042767 1.919319 0.395600 1.076766 0.315182 1.523747 1.171798 0.108074 1.657882 1.265634 0.626367 0.117327 0.564449 1.248723 1.315461 0.187008 0.035422 0.037190 0.027581 1.480117 0.923211 1.226129 1.609860 0.821969 0.738125 1.393740 1.651376 -0.319430 0.042573 0.325560 1.606961 0.881289 0.481256 0.249164 1.016023 1.672919 0.890288 1.612304 1.085631 0.198732 1.204572 1.063957 -0.352780 0.553193 1.366431 0.709894 1.607219 1.283563 0.057939 1.942264 0.204818 0.870673 0.109301 0.916771 0.737223 1.327629 1.166252 1.195633 0.220792 1.365567 0.156850 0.028721 1.361864 -0.568831 0.826440 1.781827 1.562851 1.394229 1.494946 1.300471 0.919851 0.240616 -0.113556 0.474415 -0.065238 0.268426 0.054389 -0.115644) ) ;;; 120 prime -------------------------------------------------------------------------------- (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) - 13.773494 #r(0.000000 1.666693 0.204459 1.356693 -0.045606 1.045042 0.474802 1.501931 0.301604 0.684680 0.587824 1.181603 1.784112 0.577837 0.113515 0.100747 -0.480543 0.970475 0.399625 1.134652 0.521293 1.034083 0.929219 0.314110 0.397142 0.547687 1.190575 1.745236 0.002602 1.732671 0.664430 0.685415 1.852707 0.106026 0.292629 1.550240 0.120038 1.343568 -0.192473 0.428040 1.306072 -0.104284 1.616243 0.417593 0.997699 0.189368 1.502316 0.997126 0.276906 1.828538 1.124549 0.719115 -0.070816 0.585969 1.339871 1.237020 0.370558 0.048730 0.048845 0.053125 1.325210 0.951251 0.879393 1.569533 0.724585 0.634157 1.384597 1.754317 -0.221359 -0.051514 0.193459 1.441657 0.713974 0.674551 0.040987 0.918459 1.647168 0.829996 1.544574 0.995128 0.232789 1.362044 1.150314 -0.141689 0.639295 1.403515 0.891518 1.619670 1.101605 0.153292 -0.061292 0.402456 0.941442 0.064772 1.077848 0.643777 1.489278 1.288589 1.178892 0.171769 1.313764 0.094331 0.077405 1.339075 -0.549564 0.801577 1.821144 1.485416 1.507392 1.341311 1.474046 0.800090 0.085379 -0.064663 0.333734 -0.178280 0.209697 -0.162751 -0.161102 0.031559) + 13.757227 #r(0.000000 1.621540 0.169951 1.311905 -0.022058 0.998864 0.435432 1.550321 0.295124 0.728672 0.620699 1.161464 1.758940 0.594515 0.135602 0.053085 -0.509385 0.933224 0.330739 1.117745 0.532039 1.015433 0.953700 0.320235 0.350743 0.648910 1.234428 1.754674 -0.036654 1.713667 0.639452 0.748348 1.829889 0.130066 0.263748 1.521305 0.129773 1.337559 -0.166286 0.487377 1.289387 -0.166841 1.582581 0.361588 0.982709 0.157041 1.458196 1.105227 0.232063 1.848893 1.126789 0.716503 -0.030126 0.628288 1.280006 1.160671 0.281229 0.056225 0.062906 0.017528 1.281132 0.941542 0.850217 1.552935 0.761635 0.634315 1.362864 1.737787 -0.240844 -0.068866 0.215999 1.419428 0.692809 0.650219 0.054312 0.906639 1.651447 0.832047 1.586100 1.008012 0.251393 1.398242 1.126445 -0.142663 0.660048 1.394616 0.907185 1.633758 1.146247 0.156134 -0.083636 0.372011 0.901174 0.109270 1.123234 0.659782 1.469391 1.261199 1.245060 0.220555 1.276121 0.107819 0.089933 1.318716 -0.582798 0.870240 1.890975 1.501251 1.464881 1.310475 1.520920 0.773800 0.058424 -0.029155 0.346313 -0.170790 0.199756 -0.257074 -0.263751 0.013773) ) ;;; 121 prime -------------------------------------------------------------------------------- (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) - 13.882652 #r(0.000000 0.023068 1.690874 0.152338 0.573044 1.634102 1.886995 -0.616363 0.451107 0.403847 1.173562 0.179846 1.443032 0.050307 0.031411 0.153706 0.269864 0.157164 1.280239 -0.019116 0.728642 1.450459 0.983559 0.731155 0.410216 0.528722 1.911320 -0.362404 -0.391870 -0.202429 1.336435 1.465615 0.228244 0.906962 1.146817 0.596716 1.148778 0.450900 0.586640 0.327705 0.562941 1.498380 0.575016 0.992823 0.013690 0.089352 1.685031 1.249365 -0.181075 1.362808 0.449568 1.389012 1.037631 1.464731 0.047559 0.514349 1.351332 -0.031705 0.986935 1.001727 1.416479 0.804919 0.697531 1.368208 1.606648 1.701679 0.655500 0.630963 -0.580845 0.710015 1.043483 1.121186 -0.139705 1.298023 1.129987 -0.276638 1.927741 1.548665 0.521288 0.063950 1.311150 0.223242 0.031943 1.009952 0.877310 1.916029 0.264742 0.298459 1.679429 1.675452 0.535831 1.293764 0.155996 0.342315 0.057349 1.299523 0.184750 1.189229 1.383168 0.769436 0.945471 0.942720 0.670285 0.600585 1.578682 0.933142 -0.301322 0.130060 0.385058 0.443529 1.731987 1.135387 0.338277 0.862757 1.571382 -0.135044 0.887098 0.493330 0.138746 1.038447 0.510694) + 13.880637 #r(0.000000 0.011053 1.674094 0.164216 0.586471 1.635002 1.894051 -0.609992 0.457894 0.410791 1.177443 0.187092 1.448735 0.055813 0.015669 0.142698 0.283388 0.150998 1.297568 -0.019025 0.735500 1.454683 0.979934 0.718961 0.404762 0.512634 1.905916 -0.341179 -0.399281 -0.189491 1.320074 1.472687 0.235929 0.878282 1.164743 0.597799 1.142436 0.459071 0.583908 0.334291 0.552901 1.486535 0.567364 0.977839 0.018179 0.089250 1.673515 1.234408 -0.182505 1.334394 0.432891 1.398254 1.019632 1.455323 0.030906 0.505413 1.329025 -0.040316 0.992059 1.000951 1.404993 0.822453 0.688834 1.375137 1.619399 1.713787 0.638450 0.635239 -0.583107 0.718780 1.044893 1.122091 -0.133066 1.294046 1.131795 -0.278577 1.938902 1.541306 0.535432 0.051808 1.301045 0.220007 0.021787 1.012251 0.872353 1.928175 0.279283 0.281752 1.676040 1.689027 0.529259 1.284516 0.155766 0.342767 0.036672 1.290402 0.172578 1.193893 1.363243 0.770479 0.953576 0.956630 0.659910 0.622722 1.540028 0.960250 -0.294554 0.131920 0.392515 0.458717 1.721386 1.147510 0.322474 0.870369 1.571825 -0.127896 0.879113 0.490193 0.144391 1.041373 0.502902) ) ;;; 122 prime -------------------------------------------------------------------------------- (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) - 13.908366 #r(0.000000 -0.107797 1.711410 0.058787 0.522475 1.766808 1.914172 -0.671958 0.493158 0.355585 1.014874 -0.001515 1.556861 0.139678 0.103176 0.363587 0.242965 0.245330 1.270087 0.036112 0.757585 1.296749 0.998128 0.854044 0.307486 0.562453 1.952810 -0.144544 -0.305979 -0.142432 1.162813 1.394231 0.301793 0.901079 1.042049 0.554928 1.101724 0.467490 0.546987 0.311031 0.468178 1.371767 0.600106 0.848028 0.178645 0.221538 1.532781 1.301407 -0.135560 1.406073 0.336900 1.415073 0.987309 1.553130 0.076337 0.601358 1.326760 -0.212644 0.812614 0.926086 1.417262 0.908971 0.745658 1.373586 1.444210 1.663559 0.704966 0.634267 -0.560060 0.729805 1.089383 1.156061 0.066294 1.266422 0.980108 -0.336958 1.798687 1.577685 0.499970 0.044324 1.161616 0.311330 0.018152 1.059658 0.829930 1.915946 0.315802 0.231023 1.674277 1.544713 0.634340 1.230033 0.187028 0.283196 0.077309 1.291317 0.294591 1.180829 1.294832 0.627275 0.942717 0.945719 0.736583 0.525074 1.610007 1.013828 -0.291446 0.241494 0.309589 0.584474 1.710834 1.063091 0.341043 0.905964 1.533803 -0.255578 1.005410 0.482480 0.181354 1.019377 0.509457 0.254219) + 13.906527 #r(0.000000 -0.099547 1.709527 0.048884 0.533827 1.762396 1.904791 -0.668089 0.500366 0.369425 1.007521 0.001958 1.545585 0.140117 0.106602 0.358405 0.232790 0.244646 1.269065 0.030985 0.775241 1.293614 0.988745 0.851475 0.306236 0.561359 1.950591 -0.163655 -0.299640 -0.155721 1.172535 1.395839 0.321719 0.913626 1.031829 0.564370 1.095327 0.455433 0.548185 0.309621 0.476860 1.376713 0.601334 0.850252 0.164826 0.219540 1.533471 1.310826 -0.141881 1.415261 0.341539 1.413199 0.983667 1.541370 0.060919 0.583251 1.340697 -0.207196 0.829939 0.927837 1.411884 0.905082 0.737578 1.372183 1.440649 1.662936 0.698717 0.633216 -0.572907 0.728282 1.091381 1.148246 0.055682 1.252495 0.983975 -0.337992 1.802386 1.568806 0.491796 0.042570 1.172810 0.310740 0.004408 1.065734 0.831355 1.907920 0.308747 0.235042 1.672119 1.561166 0.620423 1.233249 0.183466 0.292383 0.074387 1.281357 0.293915 1.177022 1.285722 0.617262 0.943993 0.922526 0.740040 0.527782 1.599150 1.001771 -0.302278 0.241555 0.315935 0.559426 1.696152 1.068954 0.340744 0.880683 1.524256 -0.245606 1.010616 0.495898 0.176480 1.027028 0.501501 0.247391) ) ;;; 123 prime -------------------------------------------------------------------------------- (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) - 13.986621 #r(0.000000 -0.080629 1.806263 -0.011006 0.434964 1.749448 1.831115 -0.845406 0.414637 0.460091 1.147700 0.050059 1.544042 0.285820 0.135479 0.344966 0.287106 0.092650 1.235727 -0.159135 0.656501 1.369849 1.130006 0.986730 0.286715 0.590022 -0.000602 -0.275757 -0.395617 -0.106908 1.102919 1.449382 0.388908 0.943157 1.013266 0.787729 1.156121 0.421374 0.432260 0.261615 0.518711 1.410728 0.527272 0.728620 0.166434 0.137219 1.549669 1.303772 -0.047599 1.392822 0.557401 1.341486 0.964362 1.455647 0.174984 0.705523 1.343608 0.010713 0.968374 0.860702 1.286946 0.891780 0.697767 1.491119 1.438157 1.695729 0.659848 0.684014 -0.509763 0.660334 1.016083 1.047407 0.076743 1.255767 0.909179 -0.523743 1.752492 1.634543 0.512918 0.192154 1.129653 0.330634 -0.022435 0.863570 0.791716 -0.001837 0.188421 0.412725 1.700387 1.715924 0.614146 1.244490 0.289800 0.276209 0.071719 1.129799 0.339233 1.098741 1.502011 0.530614 0.956511 0.945091 0.722046 0.521779 1.756947 1.018277 -0.193482 0.268403 0.344592 0.533490 1.723397 1.002591 0.404012 0.846672 1.432792 -0.371514 1.074399 0.389548 0.223891 0.959750 0.461746 0.183075 0.042946) + 13.986152 #r(0.000000 -0.089031 1.810628 0.003794 0.428628 1.748574 1.836497 -0.846229 0.414743 0.461103 1.144101 0.065730 1.542626 0.287365 0.139494 0.348534 0.277456 0.092934 1.244603 -0.162559 0.660331 1.378149 1.127024 0.974502 0.286604 0.581351 0.001669 -0.273523 -0.406715 -0.109444 1.105353 1.446824 0.384563 0.933512 1.013085 0.783798 1.145256 0.425557 0.423639 0.274391 0.516734 1.414372 0.519990 0.725593 0.158891 0.132561 1.541683 1.314356 -0.049121 1.395372 0.558758 1.346639 0.961640 1.460054 0.182799 0.703302 1.348988 0.010105 0.972514 0.858076 1.279386 0.891284 0.698762 1.474647 1.441931 1.702456 0.659925 0.674747 -0.513963 0.664878 1.027230 1.047802 0.087502 1.252500 0.892907 -0.522290 1.755677 1.625283 0.505694 0.190308 1.116793 0.332435 -0.021839 0.867635 0.802522 -0.006594 0.179649 0.411803 1.706447 1.718443 0.614606 1.242050 0.282847 0.271446 0.060126 1.132112 0.346208 1.101339 1.506422 0.535516 0.955191 0.944874 0.729330 0.514866 1.751832 1.025674 -0.196520 0.267256 0.349096 0.519442 1.715951 1.000751 0.406605 0.838027 1.435478 -0.369519 1.067076 0.400864 0.222844 0.963085 0.468203 0.183874 0.039937) ) ;;; 124 prime -------------------------------------------------------------------------------- (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.117192 #r(0.000000 -0.099684 1.692811 -0.058213 0.413340 1.705631 1.810482 -0.708512 0.467453 0.338926 1.107184 -0.067838 1.611034 0.319672 0.278801 0.405175 0.095608 0.113756 1.309776 -0.184903 0.729213 1.328972 0.746631 0.920389 0.439992 0.759792 1.862621 -0.303711 -0.114187 -0.104728 1.030876 1.463423 0.446213 0.837687 0.923457 0.780238 1.349425 0.501284 0.363732 0.350957 0.512198 1.415337 0.653574 0.857089 0.255567 0.180843 1.543648 1.315098 -0.124775 1.444709 0.315480 1.378731 0.927545 1.458863 0.307762 0.477211 1.122588 -0.199794 1.029468 1.032312 1.292862 0.732185 0.872711 1.486353 1.624672 1.820585 0.635069 0.683258 -0.607534 0.643220 1.089630 1.118103 0.121995 1.125441 0.859461 -0.549779 1.881808 1.714927 0.597979 0.177216 1.154337 0.427120 -0.002194 0.885761 1.010061 0.040630 0.184915 0.343149 1.683514 1.593777 0.424405 1.462558 0.367749 0.333553 0.081338 1.127049 0.379061 1.216695 1.550938 0.516434 0.823525 1.003383 0.794975 0.623590 1.904338 0.921491 -0.214383 0.492018 0.304826 0.340169 1.717880 1.107823 0.054428 0.988735 1.529719 -0.235784 1.191908 0.344711 0.182550 1.090282 0.307054 0.246028 -0.077494 0.132379) + 14.115497 #r(0.000000 -0.099868 1.691949 -0.057986 0.412632 1.704642 1.810077 -0.707445 0.466437 0.340955 1.107674 -0.066643 1.610327 0.321535 0.279720 0.406051 0.095210 0.114718 1.310572 -0.184696 0.728259 1.328297 0.747098 0.920780 0.439371 0.758487 1.861736 -0.302497 -0.112284 -0.105402 1.031709 1.464177 0.446376 0.839784 0.922524 0.779643 1.349243 0.501806 0.363694 0.350860 0.514462 1.415382 0.654989 0.858408 0.254950 0.181546 1.543575 1.316710 -0.125737 1.443346 0.315216 1.378559 0.927684 1.456696 0.308380 0.476964 1.123342 -0.201049 1.029792 1.033087 1.294009 0.730779 0.873857 1.486810 1.624789 1.820377 0.634989 0.682428 -0.609242 0.643523 1.091673 1.118858 0.123285 1.125796 0.858334 -0.549366 1.882234 1.716220 0.597941 0.178634 1.155193 0.427409 -0.004572 0.886326 1.009592 0.039313 0.184374 0.342820 1.682882 1.594361 0.423206 1.463643 0.368684 0.335146 0.081335 1.128024 0.380373 1.219058 1.553390 0.517718 0.823660 1.002998 0.796501 0.623220 1.905595 0.921222 -0.214740 0.494105 0.307176 0.339791 1.718574 1.107208 0.053454 0.989351 1.531354 -0.234580 1.192471 0.345974 0.182807 1.089994 0.308575 0.246745 -0.077315 0.132691) ) ;;; 125 prime -------------------------------------------------------------------------------- (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.110138 #r(0.000000 -0.059295 1.755021 -0.046068 0.511077 1.740235 1.779534 -0.793196 0.534529 0.274305 1.080449 0.025402 1.518595 0.072289 0.102443 0.264666 0.098613 -0.001613 1.351740 -0.235584 0.657556 1.413557 0.936364 0.950196 0.251231 0.569392 0.027001 -0.354291 -0.291062 -0.441930 1.074335 1.460027 0.470345 0.808196 1.042186 0.912031 1.214172 0.482792 0.428881 0.263783 0.377707 1.560798 0.569682 0.670124 0.016070 0.210768 1.500410 1.358634 -0.026524 1.483061 0.381728 1.414664 1.000604 1.463529 0.161827 0.619821 1.260329 -0.162040 0.965245 0.992678 1.285083 0.896549 0.700635 1.584775 1.450488 1.851996 0.648563 0.631510 -0.596604 0.681533 1.125151 1.136647 0.067139 1.202541 0.822388 -0.404044 1.827522 1.641116 0.588679 0.123893 1.160615 0.441441 0.073944 0.951173 0.995386 1.911150 0.288600 0.384868 1.669710 1.690198 0.527249 1.292146 0.477337 0.249268 -0.026903 0.969837 0.369131 1.092477 1.451970 0.606465 0.895077 0.987325 0.746832 0.659177 1.798061 1.039665 -0.216612 0.431388 0.206710 0.433842 1.720821 1.106813 0.161462 0.854285 1.472612 -0.226894 1.107267 0.425735 0.275209 1.033528 0.195098 0.295622 -0.083823 0.091831 0.276624) + 14.109595 #r(0.000000 -0.058026 1.753753 -0.046932 0.509945 1.738187 1.779267 -0.794569 0.535409 0.274583 1.081133 0.024599 1.517111 0.070958 0.099350 0.264944 0.097415 -0.001189 1.350565 -0.236408 0.657613 1.413391 0.937343 0.949598 0.250371 0.568506 0.028004 -0.356142 -0.290605 -0.443734 1.075249 1.459597 0.470745 0.808252 1.042168 0.912350 1.214820 0.484810 0.430543 0.263063 0.377471 1.560103 0.568656 0.671466 0.014962 0.211292 1.500509 1.358469 -0.026585 1.483732 0.383548 1.414820 1.002190 1.463298 0.162540 0.620406 1.260724 -0.162476 0.965205 0.992088 1.285201 0.897470 0.701380 1.584674 1.449888 1.851813 0.649056 0.632769 -0.598549 0.682218 1.124893 1.136136 0.065249 1.204261 0.822010 -0.401854 1.825721 1.640549 0.588152 0.121224 1.160317 0.441356 0.074632 0.953143 0.994753 1.910550 0.289137 0.385655 1.668894 1.690175 0.528856 1.292631 0.477486 0.249502 -0.024049 0.968766 0.369611 1.092123 1.451294 0.607623 0.892754 0.987904 0.747092 0.658042 1.797382 1.037563 -0.216279 0.432107 0.207168 0.434094 1.719175 1.108204 0.162478 0.855712 1.472548 -0.225359 1.107860 0.426093 0.276161 1.034954 0.193527 0.296896 -0.083856 0.091147 0.277234) ) ;;; 126 prime -------------------------------------------------------------------------------- (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.119429 #r(0.000000 0.947125 1.465821 1.126069 0.116842 0.171688 1.891119 0.987198 -0.282006 0.167019 1.343472 0.671242 1.555615 -0.214194 0.891648 1.068856 0.930436 1.708935 1.182516 0.983171 -0.060504 0.709275 0.817477 1.693397 0.797786 1.089538 0.889032 1.881941 1.500602 1.629732 -0.096552 0.003471 -0.063093 -0.148042 0.178302 0.613217 0.044594 1.412635 0.544273 0.260453 0.605873 -0.047596 0.222359 1.785079 0.467270 1.701946 1.716416 0.300987 0.344761 -0.396184 0.217855 -0.050823 0.649691 1.107723 -0.233379 1.213799 0.280088 1.754316 0.038826 0.697691 1.290815 1.420640 0.922521 1.419534 1.765910 0.216314 0.571189 0.929461 0.591417 -0.142927 0.757924 -0.005222 0.066482 1.126789 1.624701 1.174023 0.878792 1.220042 1.436543 -0.460792 0.740999 1.295176 1.758388 1.925455 1.385165 1.221387 0.659655 1.022563 0.091954 -0.472341 0.831437 0.966447 0.342864 1.873288 1.844982 1.343560 0.858492 0.236376 -0.132179 0.948824 1.086062 0.342863 0.225014 1.619924 1.760470 0.945825 -0.002793 1.531209 0.442056 1.226079 0.975509 0.783986 0.558401 0.772924 0.923129 1.409521 1.523738 0.363594 1.491773 0.973643 0.285777 0.618392 0.035212 0.979951 -0.073007 0.250327) + 14.116066 #r(0.000000 0.949657 1.465052 1.123647 0.116905 0.172795 1.890313 0.987146 -0.281682 0.169256 1.342857 0.671520 1.554641 -0.214819 0.895300 1.067002 0.928752 1.709401 1.181056 0.982089 -0.062562 0.708222 0.816650 1.692571 0.798430 1.091636 0.888614 1.882928 1.498862 1.630085 -0.096688 0.005033 -0.063204 -0.147091 0.178432 0.613880 0.045764 1.413770 0.545890 0.261100 0.603723 -0.048355 0.221736 1.785539 0.468554 1.700955 1.717016 0.300689 0.344169 -0.396342 0.217658 -0.053198 0.649658 1.105691 -0.232405 1.212463 0.278807 1.753605 0.037061 0.698429 1.290046 1.420334 0.923850 1.420226 1.766531 0.214004 0.571191 0.928880 0.591907 -0.143411 0.756426 -0.006643 0.066278 1.125715 1.624851 1.173674 0.879228 1.221064 1.436462 -0.461174 0.740947 1.294057 1.759011 1.925975 1.383009 1.219864 0.659582 1.024160 0.093040 -0.472873 0.831029 0.966134 0.341915 1.874899 1.844309 1.343129 0.857950 0.235438 -0.134227 0.946660 1.090823 0.342113 0.224283 1.619495 1.761983 0.945550 -0.001422 1.530247 0.438541 1.225461 0.975684 0.783218 0.558055 0.771857 0.922380 1.411079 1.525477 0.360097 1.490443 0.973669 0.285638 0.619372 0.035470 0.978346 -0.073125 0.253558) ) ;;; 127 prime -------------------------------------------------------------------------------- (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.055556 #r(0.000000 0.911063 1.391324 1.129606 0.037911 0.166028 1.887421 0.921587 -0.342188 0.166908 1.452963 0.735503 1.589421 0.059212 0.948369 1.118316 1.014687 1.649103 1.019801 0.986088 1.928800 0.628268 0.718520 1.607449 0.944688 1.161838 1.019119 1.665841 1.597066 1.657338 0.004726 -0.184464 -0.133950 -0.081854 0.306566 0.527450 0.085314 1.418883 0.495548 0.218158 0.633128 1.907969 0.203499 1.766860 0.405364 1.878681 1.524269 0.489544 0.310860 -0.375291 0.291330 1.894347 0.614184 1.161756 -0.280893 1.232326 0.202723 1.781341 0.050451 0.827760 1.225916 1.332683 0.774157 1.549220 1.725871 0.204834 0.453394 0.865872 0.553102 -0.174551 0.785423 0.018504 1.881545 1.232466 1.616042 1.167934 0.700894 1.288555 1.556845 -0.408325 0.697173 1.410809 1.820845 1.848311 1.505741 1.365079 0.674238 0.963985 0.074867 -0.424080 0.924722 0.957756 0.245411 1.791267 1.711480 1.347685 0.801538 0.258479 -0.000631 1.017707 1.078628 0.291343 0.359178 1.705364 1.573143 0.847949 0.004028 1.387269 0.407832 1.151720 0.870360 0.706352 0.436556 0.841791 1.074623 1.456706 1.323582 0.378741 1.584303 0.740223 0.419936 0.564770 0.047338 1.055117 0.038312 0.136252 1.214778) + 14.037827 #r(0.000000 0.899427 1.385060 1.126272 0.029049 0.159452 1.878338 0.912810 -0.340839 0.172339 1.451889 0.737075 1.584816 0.056905 0.957871 1.112426 1.031137 1.644734 1.004678 0.981201 1.931585 0.611280 0.742009 1.610869 0.936057 1.160251 1.019153 1.668439 1.608546 1.654460 0.004733 -0.198763 -0.128505 -0.089421 0.313864 0.536451 0.096480 1.435008 0.501610 0.221781 0.637396 1.900661 0.189060 1.766404 0.404640 1.886543 1.511441 0.502961 0.306607 -0.385577 0.284331 1.900108 0.630221 1.168392 -0.279115 1.249779 0.187016 1.795759 0.044064 0.842432 1.193004 1.342190 0.769565 1.553491 1.735403 0.197672 0.450432 0.842469 0.573921 -0.182694 0.802147 0.036762 1.880797 1.250105 1.604963 1.189770 0.697681 1.288227 1.565205 -0.410981 0.697382 1.394844 1.815343 1.850092 1.501696 1.365786 0.661106 0.945392 0.076671 -0.419315 0.918242 0.962035 0.234594 1.785944 1.718970 1.336529 0.805401 0.256612 -0.000599 1.016839 1.058149 0.299499 0.347779 1.705210 1.570619 0.858829 0.003976 1.371577 0.429299 1.159693 0.864482 0.712172 0.413089 0.863171 1.078758 1.457536 1.341515 0.388113 1.573979 0.733519 0.430082 0.550885 0.056485 1.045628 0.039019 0.124603 1.215409) ) ;;; 128 prime -------------------------------------------------------------------------------- (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.252518 #r(0.000000 0.916067 1.521548 1.115742 0.057120 0.249815 1.904358 0.940632 -0.348353 0.204881 1.354216 0.931294 1.615410 0.100767 0.745039 1.205162 0.982696 1.501013 1.144197 0.903099 1.863305 0.378151 0.817939 1.610648 0.942420 1.059520 1.060893 1.821684 1.591692 1.615847 0.093253 -0.144677 -0.298230 0.001831 0.166865 0.481887 0.027763 1.430189 0.620984 0.125967 0.725865 1.876595 0.264554 1.777621 0.333603 1.836465 1.639739 0.583617 0.235639 -0.277699 0.278451 1.881817 0.661568 1.180897 -0.283438 1.133315 0.336565 1.691529 1.883775 0.782357 1.199904 1.343445 0.866805 1.434539 1.713290 0.241072 0.531894 1.028874 0.563695 0.024282 0.671576 1.966174 1.991181 1.255505 1.693510 1.416915 0.804391 1.092866 1.675985 -0.581034 0.786315 1.355924 -0.025986 1.812612 1.466963 1.311792 0.622341 0.972079 0.006227 -0.230778 0.960451 0.814170 0.367704 1.812102 1.959390 1.502571 0.791027 0.274710 0.064591 1.096857 0.976161 0.451238 0.425988 1.689392 1.699051 0.791332 1.766399 1.418394 0.476407 1.122177 0.720474 0.700797 0.596483 0.913637 1.061701 1.474749 1.341150 0.400294 1.577994 0.664978 0.531413 0.585771 0.021360 1.166252 0.046186 0.280323 1.169021 0.812782) + 14.240224 #r(0.000000 0.912071 1.515402 1.122211 0.051948 0.258202 1.898883 0.935088 -0.353133 0.202410 1.363970 0.936289 1.620427 0.131460 0.752690 1.192092 0.968335 1.502191 1.142305 0.899623 1.874743 0.390855 0.800995 1.624509 0.947264 1.053742 1.052522 1.819839 1.621113 1.602677 0.106811 -0.139692 -0.321040 0.008548 0.187451 0.486947 0.015908 1.437997 0.622302 0.140390 0.730405 1.877903 0.269484 1.774083 0.336855 1.852455 1.642017 0.584745 0.234263 -0.269672 0.277120 1.893933 0.654846 1.178832 -0.298671 1.133789 0.328832 1.689308 1.875270 0.780507 1.205780 1.332752 0.869598 1.432245 1.720197 0.242467 0.513974 1.022362 0.570726 0.025789 0.669291 1.973679 0.005375 1.246929 1.691412 1.402445 0.808191 1.106402 1.683778 -0.576127 0.792994 1.368158 -0.051762 1.824938 1.478412 1.310984 0.609265 0.959117 -0.002919 -0.241638 0.972751 0.817046 0.378864 1.831175 1.944682 1.498154 0.780093 0.266896 0.072455 1.094797 0.987490 0.448687 0.430777 1.677826 1.683416 0.786987 1.772036 1.415869 0.490468 1.131276 0.738277 0.703500 0.584572 0.916394 1.072753 1.461873 1.355422 0.411227 1.572356 0.654889 0.547027 0.599793 0.039769 1.164141 0.066127 0.288825 1.175333 0.810278) ) ;;; 256 prime -------------------------------------------------------------------------------- @@ -3855,16 +3855,6 @@ ;; 1 Dec 4183.180, sqrts: 122 120 0 0 (0.0361) ;; (14) ;; 1 Jan 4183.004, sqrts: 122 120 0 0 (0.0346) -;; 1 Mar 4182.956, sqrts: 122 120 0 0 (0.0346) -;; 1 Apr 4182.919, sqrts: 122 120 0 0 (0.0346) -;; 1 May 4182.759, sqrts: 122 120 0 0 (0.0346) -;; 1 Jun 4177.414, sqrts: 122 120 0 0 (0.0346) -;; 1 Jul 4174.620, sqrts: 122 120 0 0 (0.0346) -;; 1 Aug 4171.810, sqrts: 122 120 0 0 (0.0346) -;; 1 Sep 4169.400, sqrts: 122 120 0 0 (0.0346) -;; 1 Oct 4166.886, sqrts: 122 121 0 0 (0.0242) -;; 1 Nov 4163.522, sqrts: 122 122 0 0 (0.0000) -;; 1 Dec 4161.032, sqrts: 122 122 0 0 (0.0000) ;; (15) ;; 1 Jan 4158.938 ;; (16) @@ -3882,16 +3872,16 @@ ; prime 0.5444 (24) to 0.5539 (67), dist: 224.6387, 0.0000 #| -16-Jan-19: -;all peaks... Wed 16-Jan-2019 03:58 +10-Mar-19: +;all peaks... Sun 10-Mar-2019 08:17 (0.00148279395297779 4) -;odd peaks... Wed 16-Jan-2019 03:59 -(0.001687315629052222 125) -;even peaks... Wed 16-Jan-2019 04:00 -(0.001467169674692848 4) -;prime peaks... Wed 16-Jan-2019 04:01 -(0.001975582609148319 2048) -;all done! Wed 16-Jan-2019 04:02 +;odd peaks... Sun 10-Mar-2019 08:18 +(0.0016873156290522218 125) +;even peaks... Sun 10-Mar-2019 08:19 +(0.0014671696746928475 4) +;prime peaks... Sun 10-Mar-2019 08:20 +(0.0019755826091483186 2048) +;all done! Sun 10-Mar-2019 08:21 ;(test-all-phases #f) in test-phases.scm ;repl test-phases.scm diff --git a/profile.scm b/profile.scm index c298834..4890f5d 100644 --- a/profile.scm +++ b/profile.scm @@ -1,3 +1,5 @@ +(provide 'profile.scm) + (define* (show-profile (n 100)) (let ((info (*s7* 'profile-info))) (if (null? info) @@ -47,9 +47,8 @@ (define bytevector byte-vector) (define bytevector? byte-vector?) (define make-bytevector make-byte-vector) -(define bytevector-ref string-ref) -(define bytevector-set! string-set!) - +(define bytevector-ref byte-vector-ref) +(define bytevector-set! byte-vector-set!) (define bytevector-copy! vector-copy!) (define string-copy! vector-copy!) (define (bytevector->list bv) (map values bv)) @@ -102,9 +101,9 @@ (define (bytevector-u8-set! b k c) (set! (b k) c)) (define bytevector-u8 (dilambda (lambda (b k) (b k)) (lambda (b k c) (set! (b k) c)))) (define bytevector-length length) -(define (bytevector-copy . args) (string->byte-vector (apply r7rs-string-copy args))) -(define (bytevector-append . args) (string->byte-vector (apply string-append args))) -(define write-bytevector write-string) +(define bytevector-copy vector-copy!) +(define bytevector-append append) +(define write-bytevector write) (define* (read-bytevector! bv port (start 0) end) (let ((lim (or end (length bv))) (pt (or port (current-input-port)))) @@ -115,7 +114,7 @@ bv) (set! (bv i) c)))) (define* (read-bytevector k port) - (read-bytevector! (string->byte-vector (make-string k)) port)) + (read-bytevector! (make-byte-vector k) port)) (define (get-output-bytevector port) (string->byte-vector (get-output-string port))) (define open-input-bytevector open-input-string) (define open-output-bytevector open-output-string) diff --git a/reactive.scm b/reactive.scm index 1438f1b..9696682 100644 --- a/reactive.scm +++ b/reactive.scm @@ -51,7 +51,6 @@ (define slot-expr-env c-pointer-weak2) (define (slot symbol expr env expr-env) (c-pointer 0 symbol expr env expr-env)) - (define (symbol->let symbol env) ;; return let in which symbol lives (not necessarily curlet) (if (not (let? env)) @@ -60,17 +59,13 @@ env (symbol->let symbol (outlet env))))) - (define (setter-update cp) ; cp: (slot var expr env expr-env) ;; when var set, all other vars dependent on it need to be set also, watching out for GC'd followers - (let ((var (slot-symbol cp)) - (env (slot-env cp)) - (expr (slot-expr cp))) - (when (and (let? (slot-env cp)) ; when slot-env is GC'd, the c-pointer field is set to #f (by the GC) - (let? (slot-expr-env cp))) - (let ((new-val (eval expr (slot-expr-env cp)))) - (when (let? (slot-env cp)) - (let-set! env var new-val)))))) + (when (and (let? (slot-env cp)) ; when slot-env is GC'd, the c-pointer field is set to #f (by the GC) + (let? (slot-expr-env cp))) + (let-set! (slot-env cp) + (slot-symbol cp) + (eval (slot-expr cp) (slot-expr-env cp))))) (define (slot-equal? cp1 cp2) @@ -79,12 +74,11 @@ (define (setter-remove cp lst) ;; if reactive-set! called again on a variable, its old setters need to remove the now obsolete set of that variable - (if (null? lst) - () - (if (slot-equal? cp (car lst)) - (cdr lst) - (cons (car lst) - (setter-remove cp (cdr lst)))))) + (map (lambda (c) + (if (slot-equal? cp c) + (values) + c)) + lst)) (define* (make-setter var env (followers ()) (setters ()) (expr ()) expr-env) @@ -258,9 +252,8 @@ (cons cp setter-followers))))) setters)))))) vars inits))) - `(let ,vars/inits - ,@reacts - ,@body))))) + (cons 'let (cons vars/inits (append reacts body))))))) + ;;; -------------------------------------------------------------------------------- #| @@ -1055,8 +1055,8 @@ ;; -------- emacs -------- (define (emacs-repl) - ;; TODO: use the emacs language server protocol? (not our own rpc stuff or epc), for json, see json.scm - ;; probably will need an argument/function? for repl to open the channel or whatever + ;; someday maybe use the language server protocol? (not our own rpc stuff or epc), for json, see json.scm + ;; probably will need an argument/function for repl to open the channel or whatever ;; also this does not resend the entire expression after editing ;; and does not notice in-place edits ;; can <cr> get entire expr? @@ -48,7 +48,6 @@ * timing tests are in the snd tools directory * * s7.c is organized as follows: - * * structs and type flags * constants * GC @@ -442,66 +441,19 @@ typedef long double long_double; #define MAX_FLOAT_FORMAT_PRECISION 128 /* types */ -#define T_FREE 0 -#define T_PAIR 1 -#define T_NIL 2 -#define T_UNDEFINED 3 -#define T_UNSPECIFIED 4 -#define T_EOF_OBJECT 5 -#define T_BOOLEAN 6 -#define T_CHARACTER 7 -#define T_SYNTAX 8 -#define T_SYMBOL 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_BYTE_VECTOR 23 - -#define T_CATCH 24 -#define T_DYNAMIC_WIND 25 -#define T_HASH_TABLE 26 -#define T_LET 27 -#define T_ITERATOR 28 -#define T_STACK 29 -#define T_COUNTER 30 -#define T_SLOT 31 -#define T_C_POINTER 32 -#define T_OUTPUT_PORT 33 -#define T_INPUT_PORT 34 -#define T_BAFFLE 35 -#define T_RANDOM_STATE 36 - -#define T_CONTINUATION 37 -#define T_GOTO 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, and T_COUNTER are internal */ +enum {T_FREE = 0, + T_PAIR, T_NIL, T_UNUSED, T_UNDEFINED, T_UNSPECIFIED, T_EOF_OBJECT, + T_BOOLEAN, T_CHARACTER, T_SYNTAX, T_SYMBOL, + T_INTEGER, T_RATIO, T_REAL, T_COMPLEX, + T_BIG_INTEGER, T_BIG_RATIO, T_BIG_REAL, T_BIG_COMPLEX, /* these four used only if WITH_GMP -- order matters */ + T_STRING, T_C_OBJECT, T_VECTOR, T_INT_VECTOR, T_FLOAT_VECTOR, T_BYTE_VECTOR, + T_CATCH, T_DYNAMIC_WIND, T_HASH_TABLE, T_LET, T_ITERATOR, + T_STACK, T_COUNTER, T_SLOT, T_C_POINTER, T_OUTPUT_PORT, T_INPUT_PORT, T_RANDOM_STATE, + T_CONTINUATION, T_GOTO, T_BAFFLE, + T_CLOSURE, T_CLOSURE_STAR, T_C_MACRO, T_MACRO, T_MACRO_STAR, T_BACRO, T_BACRO_STAR, + T_C_FUNCTION_STAR, T_C_FUNCTION, T_C_ANY_ARGS_FUNCTION, T_C_OPT_ARGS_FUNCTION, T_C_RST_ARGS_FUNCTION, + NUM_TYPES}; +/* T_UNUSED, T_STACK, T_SLOT, T_BAFFLE, T_DYNAMIC_WIND, T_CATCH, T_GOTO, and T_COUNTER are internal */ typedef struct block_t { union { @@ -571,6 +523,7 @@ typedef block_t vdims_t; 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_INT_VECTOR, TOKEN_FLOAT_VECTOR} token_t; +/* IO ports */ typedef enum {FILE_PORT, STRING_PORT, FUNCTION_PORT} port_type_t; typedef struct { @@ -599,7 +552,6 @@ typedef struct { void (*display)(s7_scheme *sc, const char *s, s7_pointer pt); } port_t; - typedef struct opt_funcs { int32_t typ; void *func; @@ -689,7 +641,7 @@ typedef s7_double (*s7_d_7pii_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int typedef s7_double (*s7_d_7piid_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_double x1); #ifndef OPT_INFO_DEBUGGING - #define OPT_INFO_DEBUGGING 0 + #define OPT_INFO_DEBUGGING 0 /* not useful unless S7_DEBUGGING */ #endif #if OPT_INFO_DEBUGGING @@ -782,7 +734,7 @@ typedef struct s7_cell { uint8_t type_field; uint16_t sflag; struct { - uint32_t low_flag; + uint32_t unused_low_flag; uint16_t opt_choice; uint16_t high_flag; } opts; @@ -794,7 +746,7 @@ typedef struct s7_cell { s7_double real_value; struct { - uint8_t padding[PRINT_NAME_PADDING]; + uint8_t unused_padding[PRINT_NAME_PADDING]; uint8_t name[PRINT_NAME_SIZE + 2]; } pval; @@ -1107,7 +1059,7 @@ struct s7_scheme { s7_pointer undefined; /* #<undefined> */ s7_pointer unspecified; /* #<unspecified> */ s7_pointer no_value; /* the (values) value */ - s7_pointer gc_nil; /* a marker for an unoccupied slot in sc->protected_objects (and other similar stuff) */ + s7_pointer unused; /* a marker for an unoccupied slot in sc->protected_objects (and other similar stuff) */ s7_pointer symbol_table; /* symbol table */ s7_pointer rootlet, shadow_rootlet; /* rootlet */ @@ -1157,7 +1109,7 @@ struct s7_scheme { s7_int read_line_buf_size; s7_pointer u, v, w, x, y, z; /* evaluator local vars */ - s7_pointer temp1, temp2, temp3, temp4, temp6, temp7, temp8, temp9, temp10, temp11; + s7_pointer temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8, temp9, temp10; s7_pointer temp_cell, temp_cell_1, temp_cell_2, u1_1; 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; @@ -1180,7 +1132,7 @@ struct s7_scheme { int32_t num_fdats, last_error_line; s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, plist_1, plist_2, plist_2_2, plist_3, qlist_2, qlist_3, clist_1; gc_list *strings, *vectors, *input_ports, *output_ports, *continuations, *c_objects, *hash_tables; - gc_list *gensyms, *unknowns, *lambdas, *multivectors, *weak_refs; + gc_list *gensyms, *unknowns, *lambdas, *multivectors, *weak_refs, *weak_hash_iterators; s7_pointer *setters; s7_int setters_size, setters_loc; s7_pointer *tree_pointers; @@ -1217,8 +1169,7 @@ struct s7_scheme { char int_to_str1[INT_TO_STR_SIZE], int_to_str2[INT_TO_STR_SIZE], int_to_str3[INT_TO_STR_SIZE], int_to_str4[INT_TO_STR_SIZE], int_to_str5[INT_TO_STR_SIZE]; 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, + 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, byte_vector_to_string_symbol, c_pointer_symbol, c_pointer_info_symbol, c_pointer_to_list_symbol, c_pointer_type_symbol, c_pointer_weak1_symbol, c_pointer_weak2_symbol, caaaar_symbol, caaadr_symbol, caaar_symbol, caadar_symbol, caaddr_symbol, caadr_symbol, @@ -1253,7 +1204,7 @@ struct s7_scheme { 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, let_temporarily_symbol, list_ref_symbol, list_set_symbol, list_symbol, list_tail_symbol, list_values_symbol, + let_set_symbol, let_temporarily_symbol, libraries_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_weak_hash_table_symbol, make_int_vector_symbol, make_iterator_symbol, string_to_keyword_symbol, make_list_symbol, make_string_symbol, @@ -1262,7 +1213,7 @@ struct s7_scheme { object_to_string_symbol, object_to_let_symbol, open_input_file_symbol, open_input_string_symbol, open_output_file_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_source_symbol, provide_symbol, + port_file_symbol, port_position_symbol, procedure_source_symbol, provide_symbol, quotient_symbol, random_state_symbol, random_state_to_list_symbol, random_symbol, rationalize_symbol, read_byte_symbol, read_char_symbol, read_line_symbol, read_string_symbol, read_symbol, real_part_symbol, remainder_symbol, @@ -1299,7 +1250,7 @@ struct s7_scheme { catches_symbol, stack_symbol, default_rationalize_error_symbol, max_string_length_symbol, default_random_state_symbol, history_enabled_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, equivalent_float_epsilon_symbol, initial_string_port_length_symbol, memory_usage_symbol, max_format_length_symbol, - undefined_identifier_warnings_symbol, undefined_constant_warnings_symbol, print_length_symbol, bignum_precision_symbol, + undefined_identifier_warnings_symbol, undefined_constant_warnings_symbol, print_length_symbol, bignum_precision_symbol, stacktrace_defaults_symbol, history_symbol, history_size_symbol; /* syntax symbols et al */ @@ -1307,7 +1258,7 @@ struct s7_scheme { define_expansion_symbol, baffle_symbol, with_let_symbol, if_symbol, autoload_error_symbol, when_symbol, unless_symbol, begin_symbol, cond_symbol, case_symbol, and_symbol, or_symbol, do_symbol, define_symbol, define_star_symbol, define_constant_symbol, with_baffle_symbol, define_macro_symbol, - define_macro_star_symbol, define_bacro_symbol, define_bacro_star_symbol, letrec_symbol, letrec_star_symbol, let_star_symbol, + define_macro_star_symbol, define_bacro_symbol, define_bacro_star_symbol, letrec_symbol, letrec_star_symbol, let_star_symbol, key_rest_symbol, key_allow_other_keys_symbol, key_readable_symbol, key_display_symbol, key_write_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, @@ -1315,8 +1266,10 @@ struct s7_scheme { missing_method_symbol, unbound_variable_symbol, key_if_symbol; s7_pointer dox_slot_symbol; + /* signatures of sequences used as applicable objects: ("hi" 1) */ s7_pointer string_signature, vector_signature, float_vector_signature, int_vector_signature, byte_vector_signature, c_object_signature, let_signature, hash_table_signature, pair_signature; + /* common signatures */ s7_pointer pcl_bc, pcl_bs, pcl_bt, pcl_c, pcl_e, pcl_f, pcl_i, pcl_n, pcl_r, pcl_s, pcl_v, pl_bc, pl_bn, pl_bt, pl_p, pl_sf, pl_tl; /* optimizer s7_functions */ @@ -1325,7 +1278,7 @@ struct s7_scheme { char_equal_2, char_greater_2, char_less_2, char_position_csi, string_equal_2, substring_to_temp, display_2, string_greater_2, string_less_2, symbol_to_string_uncopied, vector_ref_ic, vector_ref_ic_0, vector_ref_ic_1, vector_ref_ic_2, vector_ref_ic_3, vector_ref_2, vector_ref_2_direct, vector_ref_3, vector_set_3, vector_set_4, - fv_ref_2, fv_ref_3, fv_set_3, fv_set_unchecked, iv_ref_2, iv_ref_2i, iv_ref_3, iv_set_3, bv_ref_2, bv_ref_3, bv_set_3, + fv_ref_2, fv_ref_3, fv_set_3, fv_set_unchecked, iv_ref_2, iv_ref_2i, iv_ref_3, iv_set_3, bv_ref_2, bv_ref_3, bv_set_3, list_set_ic, hash_table_ref_2, hash_table_ref_ss, hash_table_2, hash_table_ref_car, format_allg, format_allg_no_column, format_just_control_string, format_as_objstr, not_is_pair_s, not_is_null_s, not_is_symbol_s, not_is_number_s, not_is_eq_ss, not_is_eq_sq, not_is_pair_car_s, @@ -1338,7 +1291,7 @@ struct s7_scheme { #if (!WITH_GMP) s7_pointer multiply_2, multiply_is, multiply_si, multiply_fs, multiply_sf, sqr_ss, invert_1, divide_1r, mod_si, equal_s_ic, equal_length_ic, equal_2, equal_2i, less_s_ic, less_s0, less_2, less_length_ic, greater_s_ic, greater_s_fc, greater_2, - leq_s_ic, leq_2, geq_s_ic, geq_s_fc, random_ic, random_rc, random_1, + leq_s_ic, leq_2, geq_s_ic, geq_s_fc, random_ic, random_rc, random_1, mul_2_ff, mul_2_ii, mul_2_if, mul_2_fi, mul_2_xi, mul_2_ix, mul_2_fx, mul_2_xf, add_2_ff, add_2_ii, add_2_if, add_2_fi, add_2_xi, add_2_ix, add_2_fx, add_2_xf; #endif @@ -1370,21 +1323,18 @@ struct s7_scheme { s7_pointer safe_lists[NUM_SAFE_LISTS]; int32_t current_safe_list; - s7_pointer autoload_table, libraries, profile_info, s7_let; + s7_pointer autoload_table, profile_info, s7_let; const char ***autoload_names; s7_int *autoload_names_sizes; bool **autoloaded_already; s7_int autoload_names_loc, autoload_names_top; int32_t format_depth; - bool undefined_identifier_warnings, undefined_constant_warnings; optfix_t *optimizer_fixups; - jmp_buf opt_exit; int32_t pc; #define OPTS_SIZE 256 /* 128 overflows twice in s7test, 64 overflows 4 times in s7test, once in tall, pqw-vox needs 173 */ opt_info *opts[OPTS_SIZE + 1]; /* this form is a lot faster than opt_info**! */ - heap_block_t *heap_blocks; }; @@ -1477,12 +1427,12 @@ static inline void liberate(s7_scheme *sc, block_t *p) } else { - if (block_data(p)) + if (block_data(p)) { #if S7_DEBUGGING permanent_string_len -= block_size(p); #endif - free(block_data(p)); + free(block_data(p)); block_data(p) = NULL; } block_set_index(p, BLOCK_LIST); @@ -1619,15 +1569,10 @@ static block_t *reallocate(s7_scheme *sc, block_t *op, size_t bytes) /* -------------------------------------------------------------------------------- */ -/* (*s7* 'safety) settings */ -#define NO_SAFETY 0 -#define IMMUTABLE_VECTOR_SAFETY 1 -#define MORE_SAFETY_WARNINGS 2 +enum {NO_SAFETY = 0, IMMUTABLE_VECTOR_SAFETY, MORE_SAFETY_WARNINGS}; /* (*s7* 'safety) settings */ typedef enum {P_DISPLAY, P_WRITE, P_READABLE, P_KEY} use_write_t; -#define INITIAL_AUTOLOAD_NAMES_SIZE 4 - static s7_pointer prepackaged_type_names[NUM_TYPES]; static s7_pointer too_many_arguments_string, not_enough_arguments_string, missing_method_string, @@ -1849,7 +1794,6 @@ static void init_types(void) static s7_pointer check_ref10(s7_pointer p, const char *func, int32_t line); static s7_pointer check_ref11(s7_pointer p, const char *func, int32_t line); static s7_pointer check_ref12(s7_pointer p, const char *func, int32_t line); - static s7_pointer check_ref14(s7_pointer p, const char *func, int32_t line); static s7_pointer check_nref(s7_pointer p, const char *func, int32_t line); static s7_pointer check_let_ref(s7_pointer p, uint64_t role, const char *func, int32_t line); static s7_pointer check_let_set(s7_pointer p, uint64_t role, const char *func, int32_t line); @@ -1910,7 +1854,6 @@ static void init_types(void) #define T_Bgr(P) check_ref(P, T_BIG_REAL, __func__, __LINE__, "sweep", NULL) #define T_Bgf(P) check_ref(P, T_BIG_RATIO, __func__, __LINE__, "sweep", NULL) #define T_Bgz(P) check_ref(P, T_BIG_COMPLEX, __func__, __LINE__, "sweep", NULL) - #define T_Chr(P) check_ref(P, T_CHARACTER, __func__, __LINE__, NULL, NULL) #define T_Ctr(P) check_ref(P, T_COUNTER, __func__, __LINE__, NULL, NULL) #define T_Ptr(P) check_ref(P, T_C_POINTER, __func__, __LINE__, NULL, NULL) @@ -1921,9 +1864,6 @@ static void init_types(void) #define T_Cat(P) check_ref(P, T_CATCH, __func__, __LINE__, NULL, NULL) #define T_Dyn(P) check_ref(P, T_DYNAMIC_WIND, __func__, __LINE__, NULL, NULL) #define T_Slt(P) check_ref(P, T_SLOT, __func__, __LINE__, NULL, NULL) - #define T_Slp(P) check_ref2(P, T_SLOT, T_PAIR, __func__, __LINE__, NULL, NULL) - /* #define T_Sln(P) check_ref2(P, T_SLOT, T_NIL, __func__, __LINE__, NULL, NULL) */ - #define T_Sln(P) check_ref14(P, __func__, __LINE__) #define T_Sld(P) check_ref2(P, T_SLOT, T_UNDEFINED,__func__, __LINE__, NULL, NULL) #define T_Syn(P) check_ref(P, T_SYNTAX, __func__, __LINE__, NULL, NULL) #define T_Mac(P) check_ref(P, T_C_MACRO, __func__, __LINE__, NULL, NULL) @@ -1933,10 +1873,9 @@ static void init_types(void) #define T_Lst(P) check_ref2(P, T_PAIR, T_NIL, __func__, __LINE__, "gc", NULL) #define T_Str(P) check_ref(P, T_STRING, __func__, __LINE__, "sweep", NULL) #define T_BVc(P) check_ref(P, T_BYTE_VECTOR, __func__, __LINE__, "sweep", NULL) - #define T_BSt(P) check_ref2(P, T_BYTE_VECTOR, T_STRING, __func__, __LINE__, "sweep", NULL) #define T_Obj(P) check_ref(P, T_C_OBJECT, __func__, __LINE__, "sweep", NULL) #define T_Hsh(P) check_ref(P, T_HASH_TABLE, __func__, __LINE__, "sweep", "free_hash_table") - #define T_Itr(P) check_ref(P, T_ITERATOR, __func__, __LINE__, "sweep", NULL) + #define T_Itr(P) check_ref(P, T_ITERATOR, __func__, __LINE__, "sweep", "process_iterator") #define T_Con(P) check_ref(P, T_CONTINUATION, __func__, __LINE__, "sweep", "process_continuation") #define T_Fvc(P) check_ref(P, T_FLOAT_VECTOR, __func__, __LINE__, "sweep", NULL) #define T_Ivc(P) check_ref(P, T_INT_VECTOR, __func__, __LINE__, "sweep", NULL) @@ -1944,16 +1883,16 @@ static void init_types(void) #define T_Sym(P) check_ref(P, T_SYMBOL, __func__, __LINE__, "sweep", "remove_gensym_from_symbol_table") #define T_Fst(P) check_ref(P, T_C_FUNCTION_STAR, __func__, __LINE__, "sweep", NULL) #define T_Exp(P) check_ref2(P, T_MACRO, T_SYMBOL, __func__, __LINE__, NULL, NULL) - #define T_Prt(P) check_ref3(P, __func__, __LINE__) /* input|output_port, or free */ - #define T_Vec(P) check_ref4(P, __func__, __LINE__) /* any vector or free */ + #define T_Prt(P) check_ref3(P, __func__, __LINE__) /* input|output_port */ + #define T_Vec(P) check_ref4(P, __func__, __LINE__) /* any vector */ #define T_Clo(P) check_ref5(P, __func__, __LINE__) /* has closure let */ - #define T_Clp(P) check_ref12(P, __func__, __LINE__) /* any closure or pair */ #define T_Fnc(P) check_ref6(P, __func__, __LINE__) /* any c_function|c_macro */ #define T_Num(P) check_ref7(P, __func__, __LINE__) /* any number (not bignums I think) */ #define T_Seq(P) check_ref8(P, __func__, __LINE__) /* any sequence or structure */ #define T_Met(P) check_ref9(P, __func__, __LINE__) /* anything that might contain a method */ #define T_Arg(P) check_ref10(P, __func__, __LINE__) /* closure arg (list, symbol) */ #define T_App(P) check_ref11(P, __func__, __LINE__) /* applicable or #f */ + #define T_Sln(P) check_ref12(P, __func__, __LINE__) /* slot or nil */ #define T_Pos(P) check_nref(P, __func__, __LINE__) /* not free */ #define T_Any(P) check_cell(P, __func__, __LINE__) /* any cell */ @@ -1971,7 +1910,6 @@ static void init_types(void) #define T_Bgz(P) P #define T_Str(P) P #define T_BVc(P) P - #define T_BSt(P) P #define T_Syn(P) P #define T_Chr(P) P #define T_Obj(P) P @@ -1993,13 +1931,11 @@ static void init_types(void) #define T_Dyn(P) P #define T_Cat(P) P #define T_Clo(P) P - #define T_Clp(P) P #define T_Fnc(P) P #define T_Fst(P) P #define T_Slt(P) P #define T_Sln(P) P #define T_Sld(P) P - #define T_Slp(P) P #define T_Sym(P) P #define T_Let(P) P #define T_Lid(P) P @@ -2071,7 +2007,6 @@ static void init_types(void) #define is_syntactic_pair(p) (typesflag(T_Pos(p)) == (uint16_t)(T_PAIR | T_SYNTACTIC)) /* this marks symbols that represent syntax objects, it should be in the second byte */ - #define T_SIMPLE_ARG_DEFAULTS (1 << (TYPE_BITS + 2)) #define lambda_has_simple_defaults(p) has_type_bit(T_Pair(p), T_SIMPLE_ARG_DEFAULTS) #define lambda_set_simple_defaults(p) set_type_bit(T_Pair(p), T_SIMPLE_ARG_DEFAULTS) @@ -2102,16 +2037,16 @@ static void init_types(void) #define is_scope_safe(p) has_type_bit(T_Fnc(p), T_SCOPE_SAFE) #define set_scope_safe(p) set_type_bit(T_Fnc(p), T_SCOPE_SAFE) - #define T_SAFE_CLOSURE (1 << (TYPE_BITS + 4)) -#define is_safe_closure(p) has_type0_bit(T_Clp(p), T_SAFE_CLOSURE) /* T_Pos 1-Nov-18 */ -#define set_safe_closure(p) set_type0_bit(T_Clp(p), T_SAFE_CLOSURE) /* T_Clp: has_closure_let, pair #f */ -#define clear_safe_closure(p) clear_type0_bit(T_Clp(p), T_SAFE_CLOSURE) +#define is_safe_closure(p) has_type0_bit(T_Clo(p), T_SAFE_CLOSURE) +#define set_safe_closure(p) set_type0_bit(T_Clo(p), T_SAFE_CLOSURE) +#define is_safe_closure_body(p) has_type0_bit(T_Pair(p), T_SAFE_CLOSURE) +#define set_safe_closure_body(p) set_type0_bit(T_Pair(p), T_SAFE_CLOSURE) +#define clear_safe_closure_body(p) clear_type0_bit(T_Pair(p), T_SAFE_CLOSURE) /* optimizer flag for a closure body that is completely simple (every expression is safe) * set_safe_closure happens only in optimize_lambda (and define_funchcecked?), clear only in procedure_source, bits only here * this has to be separate from T_SAFE_PROCEDURE, and should be in the second byte (closure_is_ok_1 checks typesflag). - * 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* @@ -2122,7 +2057,7 @@ static void init_types(void) /* this marks things that don't evaluate their arguments */ #define T_EXPANSION (1 << (TYPE_BITS + 6)) -#define is_expansion(p) has_type0_bit(T_Exp(p), T_EXPANSION) +#define is_expansion(p) has_type0_bit(T_Exp(p), T_EXPANSION) /* T_Exp: macro or symbol */ #define clear_expansion(p) clear_type0_bit(T_Sym(p), T_EXPANSION) /* this marks the symbol and its run-time macro value, distinguishing it from an ordinary macro */ @@ -2131,9 +2066,8 @@ static void init_types(void) #define set_multiple_value(p) set_type0_bit(T_Pair(p), T_MULTIPLE_VALUE) #define clear_multiple_value(p) clear_type0_bit(T_Pair(p), T_MULTIPLE_VALUE) #define multiple_value(p) p -/* this bit marks a list (from "values") that is waiting for a - * chance to be spliced into its caller's argument list. It is normally - * on only for a very short time. +/* this bit marks a list (from "values") that is waiting for a chance to be spliced into its caller's argument list. + * It is normally on only for a very short time. */ #define T_MATCHED T_MULTIPLE_VALUE @@ -2329,9 +2263,11 @@ static void init_types(void) #define has_direct_x_opt(p) has_type_bit(T_Pair(p), T_DIRECT_X_OPT) #define T_SAFE_STEPPER (1 << (TYPE_BITS + 19)) -#define is_safe_stepper(p) has_type_bit(T_Slp(p), T_SAFE_STEPPER) -#define set_safe_stepper(p) set_type_bit(T_Slp(p), T_SAFE_STEPPER) -#define clear_safe_stepper(p) clear_type_bit(T_Slp(p), T_SAFE_STEPPER) /* T_Pos 1-Nov-18 */ +#define is_safe_stepper(p) has_type_bit(T_Slt(p), T_SAFE_STEPPER) +#define set_safe_stepper(p) set_type_bit(T_Slt(p), T_SAFE_STEPPER) +#define clear_safe_stepper(p) clear_type_bit(T_Slt(p), T_SAFE_STEPPER) +#define is_safe_stepper_expr(p) has_type_bit(T_Pair(p), T_SAFE_STEPPER) +#define set_safe_stepper_expr(p) set_type_bit(T_Pair(p), T_SAFE_STEPPER) #define T_PRINT_NAME T_SAFE_STEPPER #define has_print_name(p) has_type_bit(T_Num(p), T_PRINT_NAME) @@ -2348,6 +2284,7 @@ static void init_types(void) #define has_let_set_fallback(p) ((typeflag(T_Lid(p)) & (T_HAS_LET_SET_FALLBACK | T_HAS_METHODS)) == (T_HAS_LET_SET_FALLBACK | T_HAS_METHODS)) #define set_has_let_ref_fallback(p) set_type_bit(T_Let(p), T_HAS_LET_REF_FALLBACK) #define set_has_let_set_fallback(p) set_type_bit(T_Let(p), T_HAS_LET_SET_FALLBACK) +#define has_let_fallback(p) has_type_bit(T_Lid(p), (T_HAS_LET_REF_FALLBACK | T_HAS_LET_SET_FALLBACK)) #define set_all_methods(p, e) typeflag(T_Let(p)) |= (typeflag(e) & (T_HAS_METHODS | T_HAS_LET_REF_FALLBACK | T_HAS_LET_SET_FALLBACK)) #define T_WEAK_HASH T_SAFE_STEPPER @@ -2406,9 +2343,10 @@ static void init_types(void) #define T_SYMCONS (1 << 0) #define is_possibly_constant(p) has_type1_bit(T_Sym(p), T_SYMCONS) #define set_possibly_constant(p) set_type1_bit(T_Sym(p), T_SYMCONS) +#define is_probably_constant(p) has_type_bit(T_Sym(p), (T_FULL_SYMCONS | T_IMMUTABLE)) #define T_HAS_LET_ARG T_SYMCONS -#define has_let_arg(p) has_type1_bit(T_App(p), T_HAS_LET_ARG) /* was T_Pos 1-Nov-18 */ +#define has_let_arg(p) has_type1_bit(T_App(p), T_HAS_LET_ARG) #define set_has_let_arg(p) set_type1_bit(T_App(p), T_HAS_LET_ARG) /* p is a setter procedure, "let arg" refers to the setter's optional third (let) argument */ @@ -2453,6 +2391,11 @@ static void init_types(void) #define slot_defaults(p) has_type1_bit(T_Slt(p), T_SLOT_DEFAULTS) #define set_slot_defaults(p) set_type1_bit(T_Slt(p), T_SLOT_DEFAULTS) +#define T_WEAK_HASH_ITERATOR T_DEFINER +#define is_weak_hash_iterator(p) has_type1_bit(T_Itr(p), T_WEAK_HASH_ITERATOR) +#define set_weak_hash_iterator(p) set_type1_bit(T_Itr(p), T_WEAK_HASH_ITERATOR) +#define clear_weak_hash_iterator(p) clear_type1_bit(T_Itr(p), T_WEAK_HASH_ITERATOR) + #define T_FULL_BINDER (1LL << (TYPE_BITS + BIT_ROOM + 27)) #define T_BINDER (1 << 3) #define is_definer_or_binder(p) has_type1_bit(T_Sym(p), T_DEFINER | T_BINDER) @@ -2471,19 +2414,21 @@ static void init_types(void) #define T_VERY_SAFE_CLOSURE (1LL << (TYPE_BITS + BIT_ROOM + 28)) #define T_SHORT_VERY_SAFE_CLOSURE (1 << 4) -#define is_very_safe_closure(p) has_type1_bit(T_Clp(p), T_SHORT_VERY_SAFE_CLOSURE) -#define set_very_safe_closure(p) set_type1_bit(T_Clp(p), T_SHORT_VERY_SAFE_CLOSURE) /* T_Pos 1-Nov-18 (can be a pair) */ -#define closure_bits(p) (typeflag(T_Clp(p)) & (T_SAFE_CLOSURE | T_VERY_SAFE_CLOSURE)) +#define is_very_safe_closure(p) has_type1_bit(T_Clo(p), T_SHORT_VERY_SAFE_CLOSURE) +#define set_very_safe_closure(p) set_type1_bit(T_Clo(p), T_SHORT_VERY_SAFE_CLOSURE) +#define closure_bits(p) (typeflag(T_Pair(p)) & (T_SAFE_CLOSURE | T_VERY_SAFE_CLOSURE)) +#define is_very_safe_closure_body(p) has_type1_bit(T_Pair(p), T_SHORT_VERY_SAFE_CLOSURE) +#define set_very_safe_closure_body(p) set_type1_bit(T_Pair(p), T_SHORT_VERY_SAFE_CLOSURE) #define T_CYCLIC (1LL << (TYPE_BITS + BIT_ROOM + 29)) #define T_SHORT_CYCLIC (1 << 5) -#define is_cyclic(p) has_type1_bit(T_Seq(p), T_SHORT_CYCLIC) /* T_Pos 1-Nov-18 */ +#define is_cyclic(p) has_type1_bit(T_Seq(p), T_SHORT_CYCLIC) #define set_cyclic(p) set_type1_bit(T_Seq(p), T_SHORT_CYCLIC) #define T_CYCLIC_SET (1LL << (TYPE_BITS + BIT_ROOM + 30)) #define T_SHORT_CYCLIC_SET (1 << 6) #define is_cyclic_set(p) has_type1_bit(T_Pos(p), T_SHORT_CYCLIC_SET) -#define set_cyclic_set(p) set_type1_bit(T_Seq(p), T_SHORT_CYCLIC_SET) /* T_Pos 1-Nov-18 */ +#define set_cyclic_set(p) set_type1_bit(T_Seq(p), T_SHORT_CYCLIC_SET) #define clear_cyclic_bits(p) clear_type_bit(p, T_COLLECTED | T_SHARED | T_CYCLIC | T_CYCLIC_SET) #define T_KEYWORD (1LL << (TYPE_BITS + BIT_ROOM + 31)) @@ -2547,7 +2492,6 @@ static void init_types(void) #define raw_opt1(p) ((p)->object.cons.opt1) #if (!S7_DEBUGGING) - #define opt1(p, r) ((p)->object.cons.opt1) #define set_opt1(p, x, r) (p)->object.cons.opt1 = x #define opt2(p, r) ((p)->object.cons.opt2) @@ -2621,8 +2565,8 @@ static void init_types(void) #define G_SYM (1 << 4) /* expression symbol access */ #define G_AND (1 << 5) /* and second clause */ #define G_DIRECT (1 << 6) /* direct call info */ -#define G_ANY (1 << 29) -#define G_CTR (1 << 30) +#define G_ANY (1 << 29) +#define G_CTR (1 << 30) #define G_CON 0x80000000 /* not (1LL < 31) ! */ #define G_MASK (G_ARGLEN | G_SYM | G_AND | G_ANY | G_CTR | G_CON | S_LINE | S_LEN | G_DIRECT) @@ -2635,7 +2579,7 @@ static void init_types(void) #define pair_line(p) s_line_1(T_Pair(p), __func__, __LINE__) #define pair_set_line(p, X) set_s_line_1(T_Pair(p), X, __func__, __LINE__) -#define pair_file(p) (p)->object.sym_cons.file +#define pair_file(p) (T_Pair(p))->object.sym_cons.file #define pair_set_file(p, X) set_s_file_1(sc, T_Pair(p), X, __func__, __LINE__) #define pair_raw_hash(p) s_hash_1(T_Pair(p), __func__, __LINE__) #define pair_set_raw_hash(p, X) set_s_hash_1(T_Pair(p), X, __func__, __LINE__) @@ -2709,7 +2653,7 @@ static void init_types(void) #define opt3_con(P) T_Pair(P)->object.cons_ext.ce.opt_type /* op_if_is_type */ #define set_opt3_con(P, X) do {T_Pair(P)->object.cons_ext.ce.opt_type = X; clear_type_bit(P, T_LINE_NUMBER);} while (0) #define opt3_ctr(P) T_Pair(P)->object.cons_ext.ce.ctr -#define set_opt3_ctr(P, X) do {T_Pair(P)->object.cons_ext.ce.ctr = X; set_ctr3_is_set(P);} while(0) +#define set_opt3_ctr(P, X) do {T_Pair(P)->object.cons_ext.ce.ctr = X; clear_type_bit(P, T_LINE_NUMBER); set_ctr3_is_set(P);} while(0) #define increment_opt3_ctr(P) do {if (ctr3_is_set(P)) P->object.cons_ext.ce.ctr++; else set_opt3_ctr(P, 0);} while (0) #endif @@ -2960,7 +2904,6 @@ static s7_pointer slot_expression(s7_pointer p) {if (slot_has_expression(p)) #define float_vector_floats(p) (T_Fvc(p))->object.vector.elements.floats #define is_byte_vector(p) (type(p) == T_BYTE_VECTOR) -/* #define is_mutable_byte_vector(p) ((typeflag(T_Pos(p)) & (TYPE_MASK | T_IMMUTABLE)) == T_BYTE_VECTOR) */ #define byte_vector_length(p) (T_BVc(p))->object.vector.length #define byte_vector_bytes(p) (T_BVc(p))->object.vector.elements.bytes #define byte_vector(p, i) ((T_BVc(p))->object.vector.elements.bytes[i]) @@ -2992,19 +2935,20 @@ static s7_pointer slot_expression(s7_pointer p) {if (slot_has_expression(p)) #define hash_table_block(p) (T_Hsh(p))->object.hasher.block #define hash_table_set_block(p, b) (T_Hsh(p))->object.hasher.block = b #define hash_table_element(p, i) (T_Hsh(p))->object.hasher.elements[i] -#define hash_table_elements(p) (T_Hsh(p))->object.hasher.elements +#define hash_table_elements(p) (T_Hsh(p))->object.hasher.elements /* block data (dx) */ #define hash_table_entries(p) hash_table_block(p)->nx.nx_int #define hash_table_checker(p) (T_Hsh(p))->object.hasher.hash_func #define hash_table_mapper(p) (T_Hsh(p))->object.hasher.loc #define hash_table_checker_locked(p) (hash_table_mapper(p) != default_hash_map) #define hash_table_procedures(p) T_Lst(hash_table_block(p)->ex.ex_ptr) -#define hash_table_set_procedures(p, Lst) hash_table_block(p)->ex.ex_ptr = T_Lst(Lst) -#define hash_table_procedures_checker(p) car(hash_table_procedures(p)) -#define hash_table_procedures_mapper(p) cdr(hash_table_procedures(p)) -#define hash_table_key_typer(p) opt1_any(hash_table_procedures(p)) -#define hash_table_set_key_typer(p, Fnc) set_opt1_any(p, Fnc) -#define hash_table_value_typer(p) opt2_any(hash_table_procedures(p)) +#define hash_table_set_procedures(p, Lst) hash_table_block(p)->ex.ex_ptr = T_Lst(Lst) +#define hash_table_procedures_checker(p) car(hash_table_procedures(p)) +#define hash_table_procedures_mapper(p) cdr(hash_table_procedures(p)) +#define hash_table_key_typer(p) opt1_any(hash_table_procedures(p)) +#define hash_table_set_key_typer(p, Fnc) set_opt1_any(p, Fnc) +#define hash_table_value_typer(p) opt2_any(hash_table_procedures(p)) #define hash_table_set_value_typer(p, Fnc) set_opt2_any(p, Fnc) +#define weak_hash_iters(p) hash_table_block(p)->ln.tag #if S7_DEBUGGING #define T_Itr_Pos(p) titr_pos(sc, T_Itr(p), __func__, __LINE__) @@ -3159,6 +3103,8 @@ static s7_pointer slot_expression(s7_pointer p) {if (slot_has_expression(p)) #define closure_let(p) T_Lid((T_Clo(p))->object.func.env) #define closure_set_let(p, L) (T_Clo(p))->object.func.env = T_Lid(L) #define closure_arity(p) (T_Clo(p))->object.func.arity +#define closure_set_arity(p, A) (T_Clo(p))->object.func.arity = A + #define closure_setter(p) (T_Clo(p))->object.func.setter #define closure_set_setter(p, Val) (T_Clo(p))->object.func.setter = T_Pos(Val) @@ -3415,7 +3361,6 @@ static void slot_set_setter(s7_pointer p, s7_pointer val) #define show_stack_stats(Sc) ((Sc->gc_stats & STACK_STATS) != 0) #define show_heap_stats(Sc) ((Sc->gc_stats & HEAP_STATS) != 0) - #if (!S7_DEBUGGING) #define new_cell(Sc, Obj, Type) \ do { \ @@ -3477,30 +3422,18 @@ static inline s7_pointer wrap_real2(s7_scheme *sc, s7_double x) {real(sc->real_w #endif /* 9007199254740991LL is where a truncated double starts to skip integers (expt 2 53) = ca 1e16 - * :(ceiling (+ 1e16 1)) - * 10000000000000000 - * :(> 9007199254740993.0 9007199254740992.0) - * #f ; in non-gmp 64-bit doubles - * + * (ceiling (+ 1e16 1)) -> 10000000000000000 + * (> 9007199254740993.0 9007199254740992.0) -> #f ; in non-gmp 64-bit doubles * but we can't fix this except in the gmp case because: - * :(integer-decode-float (+ (expt 2.0 62) 100)) - * (4503599627370496 10 1) - * :(integer-decode-float (+ (expt 2.0 62) 500)) - * (4503599627370496 10 1) - * :(> (+ (expt 2.0 62) 500) (+ (expt 2.0 62) 100)) - * #f ; non-gmp again - * + * (integer-decode-float (+ (expt 2.0 62) 100)) -> (4503599627370496 10 1) + * (integer-decode-float (+ (expt 2.0 62) 500)) -> (4503599627370496 10 1) + * (> (+ (expt 2.0 62) 500) (+ (expt 2.0 62) 100)) -> #f ; non-gmp again * i.e. the bits are identical. We can't even detect when it has happened, so should * we just give an error for any floor (or whatever) of an arg>1e16? (sin has a similar problem)? - * I think in the non-gmp case I'll throw an error in these cases because the results are - * bogus: - * :(floor (+ (expt 2.0 62) 512)) - * 4611686018427387904 - * :(floor (+ (expt 2.0 62) 513)) - * 4611686018427388928 - * + * I think in the non-gmp case I'll throw an error in these cases because the results are bogus: + * (floor (+ (expt 2.0 62) 512)) -> 4611686018427387904 + * (floor (+ (expt 2.0 62) 513)) -> 4611686018427388928 * another case at the edge: (round 9007199254740992.51) -> 9007199254740992 - * * This spells trouble for normal arithmetic in this range. If no gmp, * (- (+ (expt 2.0 62) 512) (+ (expt 2.0 62) 513)) = -1024.0 (should be -1.0) * but we don't currently give an error in this case -- not sure what the right thing is. @@ -3525,8 +3458,8 @@ static void local_memset(void *s, uint8_t val, size_t n) int64_t ival; int64_t *s1 = (int64_t *)s; size_t n8 = n >> 3; - ival = val | (val << 8) | (val << 16) | (val << 24); /* make gcc happy */ - ival = (ival << 32) | ival; + ival = val | (val << 8) | (val << 16) | (((uint64_t)val) << 24); /* uint64_t casts make gcc/clang/fsanitize happy */ + ival = (((uint64_t)ival) << 32) | ival; do {*s1++ = ival;} while (--n8 > 0); n &= 7; s2 = (uint8_t *)s1; @@ -3552,7 +3485,6 @@ static inline s7_int safe_strlen(const char *str) return(tmp - str - 1); } - static char *copy_string_with_length(const char *str, s7_int len) { char *newstr; @@ -3572,7 +3504,6 @@ static char *copy_string(const char *str) return(copy_string_with_length(str, safe_strlen(str))); } - static bool local_strcmp(const char *s1, const char *s2) { while (true) @@ -3708,7 +3639,6 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic static void free_hash_table(s7_scheme *sc, s7_pointer table); static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args); static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst); -static bool tree_is_cyclic(s7_scheme *sc, s7_pointer tree); static inline s7_pointer symbol_to_slot(s7_scheme *sc, s7_pointer symbol); static inline s7_pointer make_simple_vector(s7_scheme *sc, s7_int len); static inline s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, s7_int len); @@ -3758,30 +3688,25 @@ static s7_pointer wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer cal 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 s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr); -/* putting off the type description until s7_error via the sc->gc_nil marker below makes it possible +/* putting off the type description until s7_error via the sc->unused marker below makes it possible * 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->unused, 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->unused, 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->unused, 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->unused, Type) #define simple_out_of_range(Sc, Caller, Arg, Description) simple_out_of_range_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, Description) #define out_of_range(Sc, Caller, Arg_Num, Arg, Description) out_of_range_error_prepackaged(Sc, symbol_name_cell(Caller), Arg_Num, Arg, Description) -#if (!HAVE_COMPLEX_NUMBERS) - static s7_pointer no_complex_numbers_string; -#endif - - /* ---------------- evaluator ops ---------------- */ /* C=constant, S=symbol, A=fx-callable, Q=quote, D=list of constants, FX=list of A's */ @@ -3790,13 +3715,13 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_SAFE_C_D, HOP_SAFE_C_D, 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_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_CQ, HOP_SAFE_C_CQ, + 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_CQ, HOP_SAFE_C_CQ, 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_CCS, HOP_SAFE_C_CCS, OP_SAFE_C_ALL_S, HOP_SAFE_C_ALL_S, OP_SAFE_C_opDq, HOP_SAFE_C_opDq, OP_SAFE_C_opSq, HOP_SAFE_C_opSq, OP_SAFE_C_opDq_opSq, HOP_SAFE_C_opDq_opSq, OP_SAFE_C_opSq_opDq, HOP_SAFE_C_opSq_opDq, - OP_SAFE_C_opSSq, HOP_SAFE_C_opSSq, OP_SAFE_C_opSCq, HOP_SAFE_C_opSCq, + OP_SAFE_C_opSSq, HOP_SAFE_C_opSSq, OP_SAFE_C_opSCq, HOP_SAFE_C_opSCq, 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, @@ -3829,7 +3754,7 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_SAFE_C_S_opAAq, HOP_SAFE_C_S_opAAq, OP_SAFE_C_S_opAAAq, HOP_SAFE_C_S_opAAAq, OP_SAFE_IFA_SS_A, HOP_SAFE_IFA_SS_A, OP_SAFE_C_STAR, HOP_SAFE_C_STAR, OP_SAFE_C_STAR_A, HOP_SAFE_C_STAR_A, OP_SAFE_C_STAR_AA, HOP_SAFE_C_STAR_AA, OP_SAFE_C_STAR_FX, HOP_SAFE_C_STAR_FX, - OP_SAFE_C_P, HOP_SAFE_C_P, + OP_SAFE_C_P, HOP_SAFE_C_P, OP_THUNK, HOP_THUNK, OP_THUNK_P, HOP_THUNK_P, OP_SAFE_THUNK, HOP_SAFE_THUNK, OP_SAFE_THUNK_P, HOP_SAFE_THUNK_P, OP_SAFE_THUNK_A, HOP_SAFE_THUNK_A, @@ -3863,7 +3788,7 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_CLOSURE_STAR_A, HOP_CLOSURE_STAR_A, OP_CLOSURE_STAR_FX, HOP_CLOSURE_STAR_FX, OP_SAFE_CLOSURE_STAR_A, HOP_SAFE_CLOSURE_STAR_A, OP_SAFE_CLOSURE_STAR_AA, HOP_SAFE_CLOSURE_STAR_AA, - OP_SAFE_CLOSURE_STAR_FX, HOP_SAFE_CLOSURE_STAR_FX, OP_SAFE_CLOSURE_STAR_FX_0, HOP_SAFE_CLOSURE_STAR_FX_0, + OP_SAFE_CLOSURE_STAR_FX, HOP_SAFE_CLOSURE_STAR_FX, OP_SAFE_CLOSURE_STAR_FX_0, HOP_SAFE_CLOSURE_STAR_FX_0, OP_SAFE_CLOSURE_STAR_FX_1, HOP_SAFE_CLOSURE_STAR_FX_1, OP_SAFE_CLOSURE_STAR_FX_2, HOP_SAFE_CLOSURE_STAR_FX_2, /* these can't be embedded, and have to be the last thing called */ @@ -3877,9 +3802,9 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_SAFE_C_PP, HOP_SAFE_C_PP, OP_SAFE_C_opSq_P, HOP_SAFE_C_opSq_P, - OP_SAFE_C_SP, HOP_SAFE_C_SP, OP_SAFE_C_CP, HOP_SAFE_C_CP, + OP_SAFE_C_SP, HOP_SAFE_C_SP, OP_SAFE_C_CP, HOP_SAFE_C_CP, OP_SAFE_C_AP, HOP_SAFE_C_AP, OP_SAFE_C_PA, HOP_SAFE_C_PA, - OP_SAFE_C_PS, HOP_SAFE_C_PS, OP_SAFE_C_PC, HOP_SAFE_C_PC, + OP_SAFE_C_PS, HOP_SAFE_C_PS, OP_SAFE_C_PC, HOP_SAFE_C_PC, OP_SAFE_C_SSP, HOP_SAFE_C_SSP, OP_SAFE_C_FP, HOP_SAFE_C_FP, OP_S, OP_S_S, OP_S_C, OP_S_A, OP_C_FA_1, OP_S_AA, @@ -3931,15 +3856,16 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_DEFINE_WITH_SETTER, OP_DEFINE_MACRO_WITH_SETTER, OP_LET_NO_VARS, OP_NAMED_LET, OP_NAMED_LET_NO_VARS, OP_NAMED_LET_STAR, OP_LET_FX, OP_LET_STAR_FX, - OP_LET_opSSq, OP_LET_opSSq_E, OP_LET_opaSSq, OP_LET_opaSSq_E, - OP_LET_ONE, OP_LET_ONE_1, OP_LET_ONE_P, OP_LET_ONE_P_1, OP_LET_A, OP_LET_A_P, OP_LET_A_A, + OP_LET_opSSq, OP_LET_opSSq_E, OP_LET_opaSSq, OP_LET_opaSSq_E, + OP_LET_ONE, OP_LET_ONE_1, OP_LET_ONE_P, OP_LET_ONE_P_1, OP_LET_A, OP_LET_A_P, OP_LET_A_A, 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_A_S_S, OP_CASE_A_S_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_S_S_S, OP_CASE_S_S_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_P_S_S, OP_CASE_P_S_G, OP_CASE_E_S, OP_CASE_I_S, OP_CASE_G_S, OP_CASE_E_G, OP_CASE_G_G, OP_CASE_S_S, OP_CASE_S_G, - OP_IF_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_AP, OP_AND_SAFE_P, OP_AND_SAFE_AA, OP_AND_PAIR_P, + OP_IF_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_AP, OP_AND_SAFE_AA, OP_AND_PAIR_P, + OP_AND_SAFE_P, OP_AND_SAFE_P1, OP_AND_SAFE_P2, OP_AND_SAFE_P3, OP_AND_SAFE_P_REST, OP_OR_P, OP_OR_P1, OP_OR_AP, 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_UNLESS_P, @@ -3980,7 +3906,7 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_SAFE_C_PA_1, OP_SAFE_C_PA_MV, OP_SET_WITH_LET_1, OP_SET_WITH_LET_2, OP_S7_LET, - OP_D1, OP_D2, OP_D3, OP_D4, + OP_D1, OP_D2, OP_D3, OP_D4, OP_MAX_DEFINED_1}; #define OP_MAX_DEFINED (OP_MAX_DEFINED_1 + 1) @@ -3995,13 +3921,13 @@ static const char* op_names[OP_MAX_DEFINED_1] = "safe_c_d", "h_safe_c_d", "safe_c_and2", "h_safe_c_and2", "safe_c_or2", "h_safe_c_or2", "safe_c_s", "h_safe_c_s", "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_cq", "h_safe_c_cq", + "safe_c_ss", "h_safe_c_ss", "safe_c_sc", "h_safe_c_sc", "safe_c_cs", "h_safe_c_cs", "safe_c_cq", "h_safe_c_cq", "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_ccs", "h_safe_c_ccs", "safe_c_all_s", "h_safe_c_all_s", "safe_c_opdq", "h_safe_c_opdq", "safe_c_opsq", "h_safe_c_opsq", "safe_c_opdq_opsq", "h_safe_c_opdq_opsq", "safe_c_opsq_opdq", "h_safe_c_opsq_opdq", - "safe_c_opssq", "h_safe_c_opssq", "safe_c_opscq", "h_safe_c_opscq", + "safe_c_opssq", "h_safe_c_opssq", "safe_c_opscq", "h_safe_c_opscq", "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", @@ -4034,7 +3960,7 @@ static const char* op_names[OP_MAX_DEFINED_1] = "safe_c_s_opaaq", "h_safe_c_s_opaaq", "safe_c_s_opaaaq", "h_safe_c_s_opaaaq", "safe_ifa_ss_a", "h_safe_ifa_ss_a", "safe_c*", "h_safe_c*", "safe_c*_a", "h_safe_c*_a", "safe_c*_aa", "h_safe_c*_aa", "safe_c*_fx", "h_safe_c*_fx", - "safe_c_p", "h_safe_c_p", + "safe_c_p", "h_safe_c_p", "thunk", "h_thunk", "thunk_p", "h_thunk_p", "safe_thunk", "h_safe_thunk", "safe_thunk_p", "h_safe_thunk_p", "safe_thunk_a", "h_safe_thunk_a", @@ -4080,9 +4006,9 @@ static const char* op_names[OP_MAX_DEFINED_1] = "safe_c_pp", "h_safe_c_pp", "safe_c_opsq_p", "h_safe_c_opsq_p", - "safe_c_sp", "h_safe_c_sp", "safe_c_cp", "h_safe_c_cp", + "safe_c_sp", "h_safe_c_sp", "safe_c_cp", "h_safe_c_cp", "safe_c_ap", "h_safe_c_ap", "safe_c_pa", "h_safe_c_pa", - "safe_c_ps", "h_safe_c_ps", "safe_c_pc", "h_safe_c_pc", + "safe_c_ps", "h_safe_c_ps", "safe_c_pc", "h_safe_c_pc", "safe_c_ssp", "h_safe_c_ssp", "safe_c_fp", "h_safe_c_fp", "s", "s_s", "s_c", "s_a", "c_fa_1", "s_aa", "goto", "goto_a", @@ -4133,15 +4059,16 @@ static const char* op_names[OP_MAX_DEFINED_1] = "define_with_setter", "define_macro_with_setter", "let_no_vars", "named_let", "named_let_no_vars", "named_let*", "let_fx", "let*_fx", - "let_opssq", "let_opssq_e", "let_opassq", "let_opassq_e", - "let_one", "let_one_1", "let_one_p", "let_one_p_1", "let_a", "let_a_p", "let_a_a", + "let_opssq", "let_opssq_e", "let_opassq", "let_opassq_e", + "let_one", "let_one_1", "let_one_p", "let_one_p_1", "let_a", "let_a_p", "let_a_a", "case_a_e_s", "case_a_i_s", "case_a_g_s", "case_a_e_g", "case_a_g_g", "case_a_s_s", "case_a_s_g", "case_s_e_s", "case_s_i_s", "case_s_g_s", "case_s_e_g", "case_s_g_g", "case_s_s_s", "case_s_s_g", "case_p_e_s", "case_p_i_s", "case_p_g_s", "case_p_e_g", "case_p_g_g", "case_p_s_s", "case_p_s_g", "case_e_s", "case_i_s", "case_g_s", "case_e_g", "case_g_g", "case_s_s", "case_s_g", - "if_unchecked", "and_p", "and_p1", "and_ap", "and_safe_p", "and_safe_aa", "and_pair_p", + "if_unchecked", "and_p", "and_p1", "and_ap", "and_safe_aa", "and_pair_p", + "and_safe_p", "and_safe_p1", "op_and_safe_p2", "and_safe_p3", "and_safe_p_rest", "or_p", "or_p1", "or_ap", "or_safe_p", "or_safe_aa", "cond_feed", "cond_feed_1", "when_s", "when_a", "when_p", "unless_s", "unless_a", "unless_p", @@ -4317,7 +4244,6 @@ static s7_pointer set_plist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_po return(set_wlist_3(sc->plist_3, x1, x2, x3)); } - static int32_t position_of(s7_pointer p, s7_pointer args) { int32_t i; @@ -4332,7 +4258,6 @@ s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method) return(sc->undefined); } - /* if a method is shadowing a built-in like abs, it should expect the same args as abs and * behave the same -- no multiple values etc. */ @@ -4494,6 +4419,7 @@ static s7_pointer g_is_eof_object(s7_scheme *sc, s7_pointer args) static bool s7_is_eof_object(s7_pointer p) {return(p == eof_object);} + /* -------------------------------- not -------------------------------- */ static s7_pointer g_not(s7_scheme *sc, s7_pointer args) { @@ -4546,6 +4472,7 @@ static s7_pointer g_is_constant(s7_scheme *sc, s7_pointer args) static s7_pointer is_constant_p_p(s7_scheme *sc, s7_pointer p) {return(make_boolean(sc, is_constant(sc, p)));} + /* -------------------------------- immutable? -------------------------------- */ bool s7_is_immutable(s7_pointer p) { @@ -4627,7 +4554,7 @@ static void resize_gc_protect(s7_scheme *sc) sc->gpofl = (s7_int *)realloc(sc->gpofl, new_size * sizeof(s7_int)); for (i = size; i < new_size; i++) { - vector_element(sc->protected_objects, i) = sc->gc_nil; + vector_element(sc->protected_objects, i) = sc->unused; sc->gpofl[++sc->gpofl_loc] = i; } } @@ -4649,7 +4576,7 @@ void s7_gc_unprotect(s7_scheme *sc, s7_pointer x) for (i = 0; i < sc->protected_objects_size; i++) if (vector_element(sc->protected_objects, i) == x) { - vector_element(sc->protected_objects, i) = sc->gc_nil; + vector_element(sc->protected_objects, i) = sc->unused; sc->gpofl[++sc->gpofl_loc] = i; return; } @@ -4660,9 +4587,9 @@ void s7_gc_unprotect_at(s7_scheme *sc, s7_int loc) { if (loc < sc->protected_objects_size) { - if (vector_element(sc->protected_objects, loc) != sc->gc_nil) + if (vector_element(sc->protected_objects, loc) != sc->unused) sc->gpofl[++sc->gpofl_loc] = loc; - vector_element(sc->protected_objects, loc) = sc->gc_nil; + vector_element(sc->protected_objects, loc) = sc->unused; } } @@ -4673,7 +4600,7 @@ s7_pointer s7_gc_protected_at(s7_scheme *sc, s7_int loc) obj = sc->unspecified; if (loc < sc->protected_objects_size) obj = vector_element(sc->protected_objects, loc); - if (obj == sc->gc_nil) + if (obj == sc->unused) return(sc->unspecified); return(obj); @@ -4707,8 +4634,26 @@ static inline void mark_slot(s7_pointer p) static void mark_noop(s7_pointer p) {} static void close_output_port(s7_scheme *sc, s7_pointer p); -static void clear_weak_hash_table(s7_scheme *sc, s7_pointer table); static void remove_gensym_from_symbol_table(s7_scheme *sc, s7_pointer sym); +static void cull_weak_hash_table(s7_scheme *sc, s7_pointer table); + +static void process_iterator(s7_scheme *sc, s7_pointer s1) +{ + if (is_weak_hash_iterator(s1)) + { + s7_pointer h; + clear_weak_hash_iterator(s1); + h = iterator_sequence(s1); + if (unchecked_type(h) == T_HASH_TABLE) + { +#if S7_DEBUGGING + if (weak_hash_iters(h) == 0) + fprintf(stderr, "in gc weak has iters wrapping under!\n"); +#endif + weak_hash_iters(h)--; + } + } +} static void process_multivector(s7_scheme *sc, s7_pointer s1) { @@ -4847,14 +4792,18 @@ static void sweep(s7_scheme *sc) free_hash_table(sc, s1); else { - if (is_weak_hash_table(s1)) - clear_weak_hash_table(sc, s1); + if ((is_weak_hash_table(s1)) && + (weak_hash_iters(s1) == 0)) + cull_weak_hash_table(sc, s1); gp->list[j++] = s1; } } gp->loc = j; } + gp = sc->weak_hash_iterators; + process_gc_list(process_iterator(sc, s1)); + gp = sc->input_ports; process_gc_list(process_input_port(sc, s1)); @@ -4945,6 +4894,7 @@ static void add_gensym(s7_scheme *sc, s7_pointer p) #define add_multivector(sc, p) add_to_gc_list(sc->multivectors, p) #define add_lambda(sc, p) add_to_gc_list(sc->lambdas, p) #define add_weak_ref(sc, p) add_to_gc_list(sc->weak_refs, p) +#define add_weak_hash_iterator(sc, p) add_to_gc_list(sc->weak_hash_iterators, p) #if WITH_GMP #define add_big_integer(sc, p) add_to_gc_list(sc->big_integers, p) @@ -4968,6 +4918,7 @@ static void init_gc_caches(s7_scheme *sc) sc->c_objects = make_gc_list(); sc->lambdas = make_gc_list(); sc->weak_refs = make_gc_list(); + sc->weak_hash_iterators = make_gc_list(); #if WITH_GMP sc->big_integers = make_gc_list(); sc->big_ratios = make_gc_list(); @@ -5170,7 +5121,8 @@ static void mark_continuation(s7_pointer p) { uint32_t i; set_mark(p); - mark_stack_1(continuation_stack(p), continuation_stack_top(p)); + if (!is_marked(continuation_stack(p))) /* can these be cyclic? */ + mark_stack_1(continuation_stack(p), continuation_stack_top(p)); for (i = 0; i < continuation_op_loc(p); i++) gc_mark(continuation_op_stack(p)[i]); } @@ -5269,7 +5221,8 @@ static void mark_hash_table(s7_pointer p) len = hash_table_mask(p) + 1; last = (hash_entry_t **)(entries + len); - if (is_weak_hash_table(p)) + if ((is_weak_hash_table(p)) && + (weak_hash_iters(p) == 0)) { while (entries < last) { @@ -5320,6 +5273,7 @@ static void init_mark_functions(void) mark_function[T_EOF_OBJECT] = mark_noop; mark_function[T_UNSPECIFIED] = mark_noop; mark_function[T_NIL] = mark_noop; + mark_function[T_UNUSED] = mark_noop; mark_function[T_BOOLEAN] = mark_noop; mark_function[T_SYNTAX] = mark_noop; mark_function[T_CHARACTER] = mark_noop; @@ -5481,12 +5435,12 @@ static int64_t gc(s7_scheme *sc) gc_mark(sc->temp2); gc_mark(sc->temp3); gc_mark(sc->temp4); + gc_mark(sc->temp5); gc_mark(sc->temp6); gc_mark(sc->temp7); gc_mark(sc->temp8); gc_mark(sc->temp9); gc_mark(sc->temp10); - gc_mark(sc->temp11); { int32_t i; for (i = 0; i < T_TEMPS_SIZE; i++) {gc_mark(sc->t_temps[i]);} @@ -5531,7 +5485,6 @@ static int64_t gc(s7_scheme *sc) { s7_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 ((is_pair(sc->safe_lists[i])) && (list_is_in_use(sc->safe_lists[i]))) @@ -5636,7 +5589,6 @@ static int64_t gc(s7_scheme *sc) void s7_gc_stats(s7_scheme *sc, bool on) {sc->gc_stats = (on) ? GC_STATS : 0;} - static void resize_heap_to(s7_scheme *sc, int64_t size) { /* alloc more heap */ @@ -5805,7 +5757,6 @@ static s7_big_cell *alloc_big_pointer(s7_scheme *sc, int64_t loc) return(p); } - static void add_permanent_object(s7_scheme *sc, s7_pointer obj) { gc_obj *g; @@ -5829,13 +5780,10 @@ static void free_cell(s7_scheme *sc, s7_pointer p) uint8_t typ; typ = unchecked_type(p); if ((t_freeze_p[typ]) || ((typ == T_SYMBOL) && (is_gensym(p)))) - { - fprintf(stderr, "free_cell of %s?\n", type_name_from_type(typ, 0)); - /* abort(); */ - } + fprintf(stderr, "free_cell of %s?\n", type_name_from_type(typ, 0)); p->debugger_bits = 0; - p->opt1_func = NULL; - p->opt2_func = NULL; + p->opt1_func = NULL; + p->opt2_func = NULL; p->opt3_func = NULL; p->explicit_free_line = line; #endif @@ -6123,13 +6071,13 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c sc->stack_end += 4; } -#define push_stack_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, Sc->gc_nil) -#define push_stack_no_let_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, Sc->gc_nil) -#define push_stack_no_args(Sc, Op, Code) push_stack(Sc, Op, Sc->gc_nil, Code) +#define push_stack_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, sc->unused) +#define push_stack_no_let_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, sc->unused) +#define push_stack_no_args(Sc, Op, Code) push_stack(Sc, Op, sc->unused, Code) #define push_stack_no_let(Sc, Op, Args, Code) push_stack(Sc, Op, Args, Code) -#define push_stack_op(Sc, Op) push_stack(Sc, Op, Sc->gc_nil, Sc->gc_nil) -#define push_stack_op_let(Sc, Op) push_stack(Sc, Op, Sc->gc_nil, Sc->gc_nil) -/* in the non-debugging case, the sc->gc_nil's here are not set, so we can (later) pop free cells */ +#define push_stack_op(Sc, Op) push_stack(Sc, Op, sc->unused, sc->unused) +#define push_stack_op_let(Sc, Op) push_stack(Sc, Op, sc->unused, sc->unused) +/* in the non-debugging case, the sc->unused's here are not set, so we can (later) pop free cells */ #else @@ -6238,10 +6186,6 @@ static void resize_stack(s7_scheme *sc) #endif s7_error(sc, make_symbol(sc, "stack-too-big"), set_elist_1(sc, wrap_string(sc, "no room to expand stack?", 24))); } -#if 0 - for (i = sc->stack_size; i < new_size; i++) - stack_element(sc->stack, i) = sc->nil; -#else { s7_pointer *orig; s7_int i, left; @@ -6253,7 +6197,6 @@ static void resize_stack(s7_scheme *sc) for (; i < new_size; i++) orig[i] = sc->nil; } -#endif vector_length(sc->stack) = new_size; sc->stack_size = new_size; @@ -6442,6 +6385,8 @@ s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name) #define FILLED true #define NOT_FILLED false + +/* -------------------------------- symbol-table -------------------------------- */ static s7_pointer g_symbol_table(s7_scheme *sc, s7_pointer args) { #define H_symbol_table "(symbol-table) returns a vector containing the current symbol-table symbols" @@ -6668,6 +6613,7 @@ static s7_pointer g_is_syntax(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, is_syntax, sc->is_syntax_symbol, args); } + /* -------------------------------- symbol? -------------------------------- */ bool s7_is_symbol(s7_pointer p) {return(is_symbol(p));} @@ -6686,6 +6632,7 @@ s7_pointer s7_name_to_value(s7_scheme *sc, const char *name) return(s7_symbol_value(sc, make_symbol(sc, name))); } + /* -------------------------------- symbol->string -------------------------------- */ static inline s7_pointer make_string_with_length(s7_scheme *sc, const char *str, s7_int len) { @@ -7044,6 +6991,19 @@ static s7_pointer find_let(s7_scheme *sc, s7_pointer obj) static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer old_value); +static inline s7_pointer checked_slot_set_value(s7_scheme *sc, s7_pointer y, s7_pointer value) +{ + if (slot_has_setter(y)) + slot_set_value(y, call_setter(sc, y, value)); + else + { + if (is_immutable_slot(y)) + return(immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->let_set_symbol, slot_symbol(y)))); + slot_set_value(y, value); + } + return(slot_value(y)); +} + static s7_pointer let_fill(s7_scheme *sc, s7_pointer args) { s7_pointer e, val; @@ -7068,11 +7028,7 @@ static s7_pointer let_fill(s7_scheme *sc, s7_pointer args) { s7_pointer p; for (p = let_slots(e); tis_slot(p); p = next_slot(p)) - { - if (slot_has_setter(p)) - slot_set_value(p, call_setter(sc, p, val)); - else slot_set_value(p, val); - } + checked_slot_set_value(sc, p, val); } return(val); } @@ -7233,8 +7189,8 @@ s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_poi (env == sc->rootlet)) { s7_pointer ge, slot; - if (is_immutable(sc->rootlet)) /* PERHAPS: since this is undoable and disables much of s7, it should be an error? */ - return(immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->define_symbol, sc->rootlet))); + if (is_immutable(sc->rootlet)) + return(immutable_object_error(sc, set_elist_2(sc, wrap_string(sc, "can't define '~S; rootlet is immutable", 38), symbol))); if ((sc->safety == NO_SAFETY) && (has_closure_let(value))) remove_function_from_heap(sc, value); @@ -7243,6 +7199,7 @@ s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_poi if (is_slot(global_slot(symbol))) { slot = global_slot(symbol); + symbol_increment_ctr(symbol); slot_set_value_with_hook(slot, value); return(slot); } @@ -7270,16 +7227,13 @@ s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_poi { if (!is_gensym(symbol)) { -#if S7_DEBUGGING - if (!symbol_info(symbol)) fprintf(stderr, "%s info is null?\n", symbol_name(symbol)); -#endif if (initial_slot(symbol) == sc->undefined) set_initial_slot(symbol, permanent_slot(sc, symbol, value)); } set_local_slot(symbol, slot); - symbol_increment_ctr(symbol); set_global(symbol); } + symbol_increment_ctr(symbol); if (is_gensym(symbol)) s7_remove_from_heap(sc, symbol); return(slot); @@ -7366,15 +7320,10 @@ static s7_pointer g_unlet(s7_scheme *sc, s7_pointer args) #define Q_unlet s7_make_signature(sc, 1, sc->is_let_symbol) /* slightly confusing: - * :((unlet) 'abs) - * #<undefined> - * :(defined? 'abs (unlet)) - * #t - * this is because unlet sets up a local environment of unshadowed symbols, - * and s7_let_ref below only looks at the local env chain (that is, if env is not - * the global env, then the global env is not searched). - * - * Also (define hi 3) #_hi => 3, (set! hi 4), #_hi -> 3 but (with-let (unlet) hi) -> 4! + * ((unlet) 'abs) -> #<undefined> + * (defined? 'abs (unlet)) -> #t + * this is because unlet sets up a local environment of unshadowed symbols, and s7_let_ref only looks at the local env chain + * (that is, if env is not the global env, then the global env is not searched). */ int32_t i; s7_pointer *inits; @@ -7409,7 +7358,6 @@ static s7_pointer g_unlet(s7_scheme *sc, s7_pointer args) * so we have to check the actual values in the non-local case. * (define (f x) (with-let (unlet) (+ x 1))) */ - x = sc->w; sc->w = sc->nil; return(x); @@ -7459,21 +7407,23 @@ static s7_pointer g_openlet(s7_scheme *sc, s7_pointer args) return(e); } -static s7_pointer g_openlets(s7_scheme *sc, s7_pointer args) + +/* -------------------------------- openlets/coverlets -------------------------------- */ +static s7_pointer g_openlets(s7_scheme *sc, s7_pointer args) { #define H_openlets "(openlets) (re)activates any open lets" #define Q_openlets s7_make_signature(sc, 1, sc->is_boolean_symbol) - sc->has_openlets = true; + sc->has_openlets = true; return(sc->T); } -static s7_pointer g_coverlets(s7_scheme *sc, s7_pointer args) +static s7_pointer g_coverlets(s7_scheme *sc, s7_pointer args) { #define H_coverlets "(coverlets) deactivates any open lets" #define Q_coverlets s7_make_signature(sc, 1, sc->is_boolean_symbol) - sc->has_openlets = false; + sc->has_openlets = false; return(sc->F); } @@ -7541,7 +7491,6 @@ static s7_pointer check_c_obj_env(s7_scheme *sc, s7_pointer old_e, s7_pointer ca return(old_e); } - s7_pointer s7_varlet(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value) { if (!is_let(env)) @@ -7564,11 +7513,10 @@ s7_pointer s7_varlet(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointe return(value); } - static s7_pointer g_varlet(s7_scheme *sc, s7_pointer args) { - #define H_varlet "(varlet env ...) adds its arguments (a let, a cons: symbol . value, or a pair of arguments, the symbol and its value) \ -to the let env, and returns env." + #define H_varlet "(varlet env ...) adds its arguments (a let, a cons: symbol . value, or two arguments, the symbol and its value) \ +to the let env, and returns env. (varlet (curlet) 'a 1) adds 'a to the current environment with the value 1." #define Q_varlet s7_make_circular_signature(sc, 2, 4, sc->is_let_symbol, \ s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_null_symbol), \ s7_make_signature(sc, 3, sc->is_pair_symbol, sc->is_symbol_symbol, sc->is_let_symbol), \ @@ -7619,6 +7567,9 @@ to the let env, and returns env." if (is_constant_symbol(sc, sym)) return(wrong_type_argument_with_type(sc, sc->varlet_symbol, position_of(x, args), sym, a_non_constant_symbol_string)); + if ((has_let_fallback(e)) && + ((sym == sc->let_ref_fallback_symbol) || (sym == sc->let_set_fallback_symbol))) + return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "varlet can't shadow ~S", 22), sym))); if (e == sc->rootlet) { @@ -7627,11 +7578,8 @@ to the let env, and returns env." if (is_syntax(slot_value(global_slot(sym)))) return(wrong_type_argument_with_type(sc, sc->varlet_symbol, position_of(x, args), p, wrap_string(sc, "a non-syntactic keyword", 23))); /* without this check we can end up turning our code into gibberish: - * :(set! quote 1) - * ;can't set! quote - * :(varlet (rootlet) '(quote . 1)) - * :quote - * 1 + * (set! quote 1) -> ;can't set! quote + * (varlet (rootlet) '(quote . 1)), :quote -> 1 * or worse set quote to a function of one arg that tries to quote something -- infinite loop */ slot_set_value_with_hook(global_slot(sym), val); @@ -7694,6 +7642,10 @@ static s7_pointer g_cutlet(s7_scheme *sc, s7_pointer args) } else { + if ((has_let_fallback(e)) && + ((sym == sc->let_ref_fallback_symbol) || (sym == sc->let_set_fallback_symbol))) + return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "cutlet can't remove ~S", 22), sym))); + slot = let_slots(e); if (tis_slot(slot)) { @@ -7712,8 +7664,7 @@ static s7_pointer g_cutlet(s7_scheme *sc, s7_pointer args) symbol_set_id(sym, THE_UN_ID); set_next_slot(last_slot, next_slot(slot)); break; - }}}} - } + }}}}} return(e); } @@ -7815,8 +7766,7 @@ static s7_pointer g_sublet(s7_scheme *sc, s7_pointer args) /* -------------------------------- inlet -------------------------------- */ s7_pointer s7_inlet(s7_scheme *sc, s7_pointer args) { - #define H_inlet "(inlet ...) adds its \ -arguments, each a let, a cons: '(symbol . value), or a keyword/value pair, to a new environment, and returns the \ + #define H_inlet "(inlet ...) adds its arguments, each a let, a cons: '(symbol . value), or a keyword/value pair, to a new environment, and returns the \ new environment. (inlet :a 1 :b 2) or (inlet '(a . 1) '(b . 2))" #define Q_inlet s7_make_circular_signature(sc, 1, 2, sc->is_let_symbol, sc->T) @@ -7841,7 +7791,7 @@ static s7_pointer g_simple_inlet(s7_scheme *sc, s7_pointer args) symbol = keyword_symbol(symbol); if (is_constant_symbol(sc, symbol)) /* (inlet 'pi 1) */ return(wrong_type_argument_with_type(sc, sc->inlet_symbol, 1, symbol, a_non_constant_symbol_string)); - new_cell(sc, slot, T_SLOT); + new_cell_no_check(sc, slot, T_SLOT); slot_set_symbol(slot, symbol); slot_set_value(slot, cadr(x)); set_next_slot(slot, let_slots(new_e)); @@ -7868,7 +7818,7 @@ static s7_pointer inlet_p_pp(s7_scheme *sc, s7_pointer symbol, s7_pointer value) sc->temp3 = x; let_id(x) = ++sc->let_number; set_outlet(x, sc->nil); - new_cell(sc, slot, T_SLOT); + new_cell_no_check(sc, slot, T_SLOT); slot_set_symbol(slot, symbol); slot_set_value(slot, value); set_next_slot(slot, slot_end(sc)); @@ -7898,7 +7848,7 @@ static s7_pointer g_local_inlet(s7_scheme *sc, s7_int num_args, ...) value = va_arg(ap, s7_pointer); if (is_keyword(symbol)) /* (inlet ':allow-other-keys 3) */ symbol = keyword_symbol(symbol); - new_cell(sc, slot, T_SLOT); + new_cell_no_check(sc, slot, T_SLOT); slot_set_symbol(slot, symbol); slot_set_value(slot, value); set_next_slot(slot, let_slots(new_e)); @@ -7977,7 +7927,7 @@ s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer env) s7_pointer iter, func; /* need to check make-iterator method before dropping into let->list */ - if ((has_active_methods(sc, env)) && + if ((has_active_methods(sc, env)) && ((func = find_method(sc, env, sc->make_iterator_symbol)) != sc->undefined)) iter = s7_apply_function(sc, func, list_1(sc, env)); else iter = sc->nil; @@ -8039,7 +7989,7 @@ static s7_pointer call_let_ref_fallback(s7_scheme *sc, s7_pointer env, s7_pointe /* args could be protected via let = stack_end[1] */ push_stack_no_let(sc, OP_GC_PROTECT, sc->value, sc->code); p = s7_apply_function(sc, find_method(sc, env, sc->let_ref_fallback_symbol), set_qlist_2(sc, env, symbol)); - sc->stack_end -= 4; + sc->stack_end -= 4; sc->code = T_Pos(sc->stack_end[0]); sc->value = T_Pos(sc->stack_end[2]); return(p); @@ -8050,7 +8000,7 @@ static s7_pointer call_let_set_fallback(s7_scheme *sc, s7_pointer env, s7_pointe s7_pointer p; push_stack_no_let(sc, OP_GC_PROTECT, sc->value, sc->code); p = s7_apply_function(sc, find_method(sc, env, sc->let_set_fallback_symbol), set_qlist_3(sc, env, symbol, value)); - sc->stack_end -= 4; + sc->stack_end -= 4; sc->code = T_Pos(sc->stack_end[0]); sc->value = T_Pos(sc->stack_end[2]); return(p); @@ -8075,8 +8025,7 @@ inline s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer symbol) check_method_uncopied(sc, env, sc->let_ref_symbol, list_2(sc, env, symbol)); /* a let-ref method is almost impossible to write without creating an infinite loop: * any reference to the let will probably call let-ref somewhere, calling us again, and looping. - * This is not a problem in c-objects and funclets because c-object-ref and funclet-ref don't - * exist -- perhaps let-ref should not also. + * This is not a problem in c-objects and funclets because c-object-ref and funclet-ref don't exist. */ if (is_keyword(symbol)) @@ -8098,10 +8047,8 @@ inline s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer symbol) if (slot_symbol(y) == symbol) return(slot_value(y)); - if (has_methods(env)) + if (has_methods(env)) /* this is not a redundant check -- if has_methods, don't check global slot */ { - /* this is not a redundant check -- if has_methods, don't check global slot */ - /* If a let is a mock-hash-table (for example), implicit * indexing of the hash-table collides with the same thing for the let (field names * versus keys), and we can't just try again here because that makes it too easy to @@ -8161,23 +8108,18 @@ static s7_pointer let_ref_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {ret static inline s7_pointer g_lint_let_ref(s7_scheme *sc, s7_pointer args) { - s7_pointer lt; + s7_pointer lt, y, sym; lt = lookup(sc, opt2_sym(args)); /* cadar */ - if (is_pair(lt)) - { - lt = cdr(lt); - if (is_let(lt)) - { - s7_pointer y, sym; - sym = opt3_sym(args); /* cadadr */ - for (y = let_slots(lt); tis_slot(y); y = next_slot(y)) - if (slot_symbol(y) == sym) - return(slot_value(y)); - return(lint_let_ref_1(sc, outlet(lt), sym)); - } - return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, lt, a_let_string)); - } - return(simple_wrong_type_argument(sc, sc->cdr_symbol, lt, T_PAIR)); + if (!is_pair(lt)) + return(simple_wrong_type_argument(sc, sc->cdr_symbol, lt, T_PAIR)); + lt = cdr(lt); + if (!is_let(lt)) + return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, lt, a_let_string)); + sym = opt3_sym(args); /* cadadr */ + for (y = let_slots(lt); tis_slot(y); y = next_slot(y)) + if (slot_symbol(y) == sym) + return(slot_value(y)); + return(lint_let_ref_1(sc, outlet(lt), sym)); } static s7_pointer let_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) @@ -8256,23 +8198,13 @@ static s7_pointer let_set_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7 { y = local_slot(symbol); if (is_slot(y)) - { - if (slot_has_setter(y)) - slot_set_value(y, call_setter(sc, y, value)); - else slot_set_value(y, value); - return(slot_value(y)); - } + return(checked_slot_set_value(sc, y, value)); } for (x = env; is_let(x); x = outlet(x)) for (y = let_slots(x); tis_slot(y); y = next_slot(y)) if (slot_symbol(y) == symbol) - { - if (slot_has_setter(y)) - slot_set_value(y, call_setter(sc, y, value)); - else slot_set_value(y, value); - return(slot_value(y)); - } + return(checked_slot_set_value(sc, y, value)); if (has_methods(env)) { @@ -8428,7 +8360,6 @@ static s7_pointer reverse_slots(s7_scheme *sc, s7_pointer list) return(result); } - static s7_pointer let_copy(s7_scheme *sc, s7_pointer env) { if (is_let(env)) @@ -8438,8 +8369,7 @@ static s7_pointer let_copy(s7_scheme *sc, s7_pointer env) if (env == sc->rootlet) /* (copy (rootlet)) or (copy (funclet abs)) etc */ return(sc->rootlet); - /* we can't make copy handle environments-as-objects specially because the - * make-object function in define-class uses copy to make a new object! + /* we can't make copy handle environments-as-objects specially because the make-object function in define-class uses copy to make a new object! * So if it is present, we get it here, and then there's almost surely trouble. */ new_e = new_frame_in_env(sc, outlet(env)); @@ -8576,7 +8506,6 @@ 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))) */ @@ -8800,7 +8729,7 @@ static s7_pointer find_dynamic_value(s7_scheme *sc, s7_pointer x, s7_pointer sym return(slot_value(y)); } } - return(sc->gc_nil); + return(sc->unused); } static s7_pointer g_symbol_to_dynamic_value(s7_scheme *sc, s7_pointer args) @@ -8830,13 +8759,13 @@ static s7_pointer g_symbol_to_dynamic_value(s7_scheme *sc, s7_pointer args) { s7_pointer cur_val; cur_val = find_dynamic_value(sc, stack_let(sc->stack, i), sym, &top_id); - if (cur_val != sc->gc_nil) + if (cur_val != sc->unused) val = cur_val; if (top_id == symbol_id(sym)) return(val); } - if (val == sc->gc_nil) + if (val == sc->unused) return(s7_symbol_value(sc, sym)); return(val); } @@ -8898,7 +8827,6 @@ static bool pair_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e) (direct_memq(sym, e))); } - static inline s7_pointer collect_variables(s7_scheme *sc, s7_pointer lst, s7_pointer e) { /* collect local variable names from let/do (pre-error-check) */ @@ -8931,7 +8859,6 @@ static s7_pointer collect_parameters(s7_scheme *sc, s7_pointer lst, s7_pointer e return(sc->w); } - typedef enum {OPT_F, OPT_T, OPT_OOPS} opt_t; static opt_t optimize(s7_scheme *sc, s7_pointer code, int32_t hop, s7_pointer e); @@ -8953,7 +8880,6 @@ static void clear_all_optimizations(s7_scheme *sc, s7_pointer p) } } - static s7_pointer make_macro(s7_scheme *sc, opcode_t op) { s7_pointer cx, mac; @@ -8990,7 +8916,7 @@ static s7_pointer make_macro(s7_scheme *sc, opcode_t op) closure_set_body(mac, cdr(sc->code)); closure_set_setter(mac, sc->F); closure_set_let(mac, sc->envir); - closure_arity(mac) = CLOSURE_ARITY_NOT_SET; + closure_set_arity(mac, CLOSURE_ARITY_NOT_SET); sc->capture_let_counter++; sc->code = caar(sc->code); @@ -9021,7 +8947,7 @@ static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code, if (is_pair(cdr(code))) set_closure_has_multiform(x); else set_closure_has_one_form(x); closure_set_let(x, sc->envir); closure_set_setter(x, sc->F); - closure_arity(x) = arity; + closure_set_arity(x, arity); sc->capture_let_counter++; return(x); } @@ -9034,7 +8960,7 @@ static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code, if (is_pair(cdr(Code))) set_closure_has_multiform(X); else set_closure_has_one_form(X);\ closure_set_let(X, Env); \ closure_set_setter(X, sc->F); \ - closure_arity(X) = Arity; \ + closure_set_arity(X, Arity); \ sc->capture_let_counter++; \ } while (0) @@ -9052,17 +8978,6 @@ static int32_t closure_length(s7_scheme *sc, s7_pointer e) return(-1); } -#define check_closure_for(Sc, Fnc, Sym) \ - if ((has_closure_let(Fnc)) && (is_let(closure_let(Fnc)))) \ - { \ - s7_pointer val; \ - val = symbol_to_local_slot(Sc, Sym, closure_let(Fnc)); \ - if ((!is_slot(val)) && (is_let(outlet(closure_let(Fnc))))) \ - val = symbol_to_local_slot(Sc, Sym, outlet(closure_let(Fnc))); \ - if (is_slot(val)) \ - return(slot_value(val)); \ - } - static s7_pointer copy_tree_with_type(s7_scheme *sc, s7_pointer tree) { /* if sc->safety > NO_SAFETY, '(1 2) is set immutable by the reader, but eval (in that safety case) calls @@ -9097,6 +9012,8 @@ static s7_pointer copy_tree(s7_scheme *sc, s7_pointer tree) (is_pair(cdr(tree))) ? COPY_TREE(cdr(tree)) : cdr(tree))); } + +/* -------------------------------- tree-cyclic? -------------------------------- */ #define TREE_NOT_CYCLIC 0 #define TREE_CYCLIC 1 #define TREE_HAS_PAIRS 2 @@ -9112,7 +9029,7 @@ static int tree_is_cyclic_or_has_pairs(s7_scheme *sc, s7_pointer tree) while (true) { if (tree_is_collected(fast)) return(TREE_CYCLIC); - if ((!has_pairs) && + if ((!has_pairs) && (is_unquoted_pair(car(fast)))) has_pairs = true; fast = cdr(fast); @@ -9122,8 +9039,8 @@ static int tree_is_cyclic_or_has_pairs(s7_scheme *sc, s7_pointer tree) break; } if (tree_is_collected(fast)) return(TREE_CYCLIC); - if ((!has_pairs) && - (is_unquoted_pair(car(fast)))) + if ((!has_pairs) && + (is_unquoted_pair(car(fast)))) has_pairs = true; fast = cdr(fast); if (!is_pair(fast)) @@ -9185,7 +9102,7 @@ static bool tree_is_cyclic(s7_scheme *sc, s7_pointer tree) result = tree_is_cyclic_or_has_pairs(sc, tree); if (result == TREE_NOT_CYCLIC) return(false); if (result == TREE_CYCLIC) return(true); - + #if S7_DEBUGGING if (sc->tree_pointers_top != 0) fprintf(stderr, "top: %d\n", sc->tree_pointers_top); @@ -9232,7 +9149,7 @@ static s7_pointer copy_closure(s7_scheme *sc, s7_pointer fnc) closure_set_args(x, closure_args(fnc)); closure_set_body(x, body); closure_set_setter(x, closure_setter(fnc)); - closure_arity(x) = closure_arity(fnc); + closure_set_arity(x, closure_arity(fnc)); closure_set_let(x, closure_let(fnc)); return(x); } @@ -9422,6 +9339,7 @@ static s7_pointer g_string_to_keyword(s7_scheme *sc, s7_pointer args) return(s7_make_keyword(sc, string_value(str))); } + /* -------------------------------- keyword->symbol -------------------------------- */ static s7_pointer g_keyword_to_symbol(s7_scheme *sc, s7_pointer args) { @@ -9480,6 +9398,7 @@ static s7_pointer g_is_c_pointer(s7_scheme *sc, s7_pointer args) return(sc->T); } + /* -------------------------------- c-pointer -------------------------------- */ void *s7_c_pointer(s7_pointer p) { @@ -9549,6 +9468,7 @@ static s7_pointer g_c_pointer(s7_scheme *sc, s7_pointer args) return(cp); } + /* -------------------------------- c-pointer-info -------------------------------- */ static s7_pointer c_pointer_info_p_p(s7_scheme *sc, s7_pointer p) { @@ -9564,6 +9484,7 @@ static s7_pointer g_c_pointer_info(s7_scheme *sc, s7_pointer args) return(c_pointer_info_p_p(sc, car(args))); } + /* -------------------------------- c-pointer-type -------------------------------- */ s7_pointer s7_c_pointer_type(s7_pointer p) { @@ -9586,6 +9507,7 @@ static s7_pointer g_c_pointer_type(s7_scheme *sc, s7_pointer args) return(c_pointer_type_p_p(sc, car(args))); } + /* -------------------------------- c-pointer-weak1/2 -------------------------------- */ static s7_pointer c_pointer_weak1_p_p(s7_scheme *sc, s7_pointer p) { @@ -9615,6 +9537,7 @@ static s7_pointer g_c_pointer_weak2(s7_scheme *sc, s7_pointer args) return(c_pointer_weak2_p_p(sc, car(args))); } + /* -------------------------------- c-pointer->list -------------------------------- */ static s7_pointer g_c_pointer_to_list(s7_scheme *sc, s7_pointer args) { @@ -9634,6 +9557,8 @@ static s7_pointer g_c_pointer_to_list(s7_scheme *sc, s7_pointer args) 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}; + +/* ----------------------- continuation? -------------------------------- */ 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" @@ -9709,7 +9634,6 @@ static s7_pointer protected_list_copy(s7_scheme *sc, s7_pointer a) return(sc->w); } - static s7_pointer copy_counter(s7_scheme *sc, s7_pointer obj) { s7_pointer nobj; @@ -9783,7 +9707,6 @@ static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int64_t top) return(new_v); } - static inline s7_pointer make_goto(s7_scheme *sc) { s7_pointer x; @@ -9794,7 +9717,6 @@ static inline s7_pointer make_goto(s7_scheme *sc) return(x); } - static s7_pointer *copy_op_stack(s7_scheme *sc) { int32_t len; @@ -9806,7 +9728,6 @@ static s7_pointer *copy_op_stack(s7_scheme *sc) return(ops); } - /* (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. @@ -9861,7 +9782,7 @@ static s7_int find_any_baffle(s7_scheme *sc) return(-1); } - +/* -------------------------------- call/cc -------------------------------- */ s7_pointer s7_make_continuation(s7_scheme *sc) { s7_pointer x, stack; @@ -9891,6 +9812,7 @@ s7_pointer s7_make_continuation(s7_scheme *sc) static void let_temp_done(s7_scheme *sc, s7_pointer args, s7_pointer code, s7_pointer let) { + /* called in call/cc, call-with-exit and, catch (unwind to catch) */ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code); sc->args = T_Pos(args); sc->code = code; @@ -9988,6 +9910,14 @@ static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c) if (op == OP_DEACTIVATE_GOTO) call_exit_active(stack_args(continuation_stack(c), i)) = true; /* not let_temp_done here! */ + /* if op == OP_LET_TEMP_DONE, we're jumping back into a let-temporarily. MIT and Chez scheme say they remember the + * let-temp vars (fluid-let or parameters in their terminology) at the point of the call/cc, and restore them + * on re-entry; that strikes me as incoherently complex -- they've wrapped a hidden dynamic-wind around the + * call/cc to restore all let-temp vars! I think let-temp here should be the same as let -- if you jump back + * in, nothing hidden happens. So, + * (let ((x #f) (cc #f)) (let-temporarily ((x 1)) (set! x 2) (call/cc (lambda (r) (set! cc r))) (display x) (unless (= x 2) (newline) (exit)) (set! x 3) (cc))) + * behaves the same (in this regard) if let-temp is replaced with let. + */ } } return(true); @@ -10081,6 +10011,7 @@ static bool op_continuation_a(s7_scheme *sc) return(true); } + /* -------------------------------- with-baffle -------------------------------- */ static s7_pointer check_with_baffle(s7_scheme *sc) { @@ -10165,8 +10096,8 @@ static void call_with_exit(s7_scheme *sc) 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 #<gc-nil> */ - if (x != sc->gc_nil) + x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #<unused> */ + if (x != sc->unused) sc->output_port = x; } break; @@ -10247,8 +10178,7 @@ static s7_pointer g_call_with_exit(s7_scheme *sc, s7_pointer args) (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. + * 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. @@ -10374,7 +10304,6 @@ static bool op_goto_a(s7_scheme *sc) static bool is_NaN(s7_double x) {return(x != x);} /* callgrind says this is faster than isnan, I think (very confusing data...) */ - #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 @@ -10465,7 +10394,6 @@ static s7_complex cpow(s7_complex x, s7_complex y) 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 */ @@ -10603,7 +10531,6 @@ static s7_int c_gcd(s7_int u, s7_int v) return(a); } - static bool c_rationalize(s7_double ux, s7_double error, s7_int *numer, s7_int *denom) { /* @@ -10640,7 +10567,7 @@ static bool c_rationalize(s7_double ux, s7_double error, s7_int *numer, s7_int * /* #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)) + if ((ux >= s7_int_max) || (ux <= s7_int_min)) /* (rationalize most-positive-fixnum) should not return most-negative-fixnum */ { /* 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; @@ -10834,7 +10761,7 @@ s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b) return(division_by_zero_error(sc, wrap_string(sc, "make-ratio", 10), set_elist_2(sc, wrap_integer1(sc, a), small_int(0)))); if (a == 0) return(small_int(0)); - if (a == b) + if (a == b) return(small_int(1)); if (b == 1) return(make_integer(sc, a)); @@ -10857,7 +10784,7 @@ s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b) a = -a; b = -b; } - + if (a == s7_int_min) { while (((a & 1) == 0) && ((b & 1) == 0)) @@ -10870,7 +10797,7 @@ s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b) { s7_int b1, divisor; divisor = s7_int_abs(a); - b1 = b; + b1 = b; do { s7_int temp; temp = divisor % b1; @@ -11224,7 +11151,8 @@ static double ipow(int32_t x, int32_t y) return(pepow[x][y + MAX_POW]); } -/* -------------------------------- */ + +/* -------------------------------- number->string -------------------------------- */ #define WITH_DTOA 1 #if WITH_DTOA /* fpconv, revised to fit the local coding style @@ -11293,16 +11221,16 @@ static dtoa_Fp dtoa_find_cachedpow10(int exp, int* k) approx = -(exp + dtoa_npowers) * one_log_ten; idx = (approx - dtoa_firstpower) / dtoa_steppowers; - while (true) + while (true) { int current; current = exp + dtoa_powers_ten[idx].exp + 64; - if (current < dtoa_expmin) + if (current < dtoa_expmin) { idx++; continue; } - if (current > dtoa_expmax) + if (current > dtoa_expmax) { idx--; continue; @@ -11320,7 +11248,7 @@ static dtoa_Fp dtoa_find_cachedpow10(int exp, int* k) #define dtoa_absv(n) ((n) < 0 ? -(n) : (n)) #define dtoa_minv(a, b) ((a) < (b) ? (a) : (b)) -static uint64_t dtoa_tens[] = +static uint64_t dtoa_tens[] = { 10000000000000000000U, 1000000000000000000U, 100000000000000000U, 10000000000000000U, 1000000000000000U, 100000000000000U, 10000000000000U, 1000000000000U, 100000000000U, @@ -11343,11 +11271,11 @@ static dtoa_Fp dtoa_build_fp(double d) bits = dtoa_get_dbits(d); fp.frac = bits & dtoa_fracmask; fp.exp = (bits & dtoa_expmask) >> 52; - if (fp.exp) + if (fp.exp) { fp.frac += dtoa_hiddenbit; fp.exp -= dtoa_expbias; - } + } else fp.exp = -dtoa_expbias + 1; return(fp); } @@ -11370,7 +11298,7 @@ static void dtoa_get_normalized_boundaries(dtoa_Fp* fp, dtoa_Fp* lower, dtoa_Fp* int u_shift, l_shift; upper->frac = (fp->frac << 1) + 1; upper->exp = fp->exp - 1; - while ((upper->frac & (dtoa_hiddenbit << 1)) == 0) + while ((upper->frac & (dtoa_hiddenbit << 1)) == 0) { upper->frac <<= 1; upper->exp--; @@ -11395,7 +11323,7 @@ static dtoa_Fp dtoa_multiply(dtoa_Fp* a, dtoa_Fp* b) al_bh = (a->frac & lomask) * (b->frac >> 32); al_bl = (a->frac & lomask) * (b->frac & lomask); ah_bh = (a->frac >> 32) * (b->frac >> 32); - tmp = (ah_bl & lomask) + (al_bh & lomask) + (al_bl >> 32); + tmp = (ah_bl & lomask) + (al_bh & lomask) + (al_bl >> 32); /* round up */ tmp += 1U << 31; fp.frac = ah_bh + (ah_bl >> 32) + (al_bh >> 32) + (tmp >> 32); @@ -11430,18 +11358,18 @@ static int dtoa_generate_digits(dtoa_Fp* fp, dtoa_Fp* upper, dtoa_Fp* lower, cha kappa = 10; /* 1000000000 */ - for (divp = dtoa_tens + 10; kappa > 0; divp++) + for (divp = dtoa_tens + 10; kappa > 0; divp++) { uint64_t tmp, div; unsigned digit; div = *divp; digit = part1 / div; - if (digit || idx) + if (digit || idx) digits[idx++] = digit + '0'; part1 -= digit * div; kappa--; tmp = (part1 << -one.exp) + part2; - if (tmp <= delta) + if (tmp <= delta) { *K += kappa; dtoa_round_digit(digits, idx, delta, tmp, div << -one.exp, wfrac); @@ -11451,7 +11379,7 @@ static int dtoa_generate_digits(dtoa_Fp* fp, dtoa_Fp* upper, dtoa_Fp* lower, cha /* 10 */ unit = dtoa_tens + 18; - while(true) + while(true) { unsigned digit; part2 *= 10; @@ -11495,7 +11423,7 @@ static int dtoa_emit_digits(char* digits, int ndigits, char* dest, int K, bool n exp = dtoa_absv(K + ndigits - 1); /* write plain integer */ - if ((K >= 0) && (exp < (ndigits + 7))) + if ((K >= 0) && (exp < (ndigits + 7))) { memcpy(dest, digits, ndigits); memset(dest + ndigits, '0', K); @@ -11519,7 +11447,7 @@ static int dtoa_emit_digits(char* digits, int ndigits, char* dest, int K, bool n memcpy(dest + offset + 2, digits, ndigits); return(ndigits + 2 + offset); /* fp > 1.0 */ - } + } else { memcpy(dest, digits, offset); @@ -11528,7 +11456,7 @@ static int dtoa_emit_digits(char* digits, int ndigits, char* dest, int K, bool n return(ndigits + 1); } } - + /* write decimal w/ scientific notation */ ndigits = dtoa_minv(ndigits, 18 - neg); idx = 0; @@ -11577,7 +11505,7 @@ static int dtoa_filter_special(double fp, char* dest, bool neg) bits = dtoa_get_dbits(fp); nan = (bits & dtoa_expmask) == dtoa_expmask; if (!nan) return(0); - + if (!neg) { dest[0] = '+'; @@ -11599,14 +11527,14 @@ static inline int fpconv_dtoa(double d, char dest[24]) char digits[18]; int str_len = 0, spec, K, ndigits; bool neg = false; - + if (dtoa_get_dbits(d) & dtoa_signmask) { dest[0] = '-'; str_len++; neg = true; } - + spec = dtoa_filter_special(d, dest + str_len, neg); if (spec) return(str_len + spec); K = 0; @@ -11616,6 +11544,7 @@ static inline int fpconv_dtoa(double d, char dest[24]) } #endif + /* -------------------------------- number->string -------------------------------- */ static const char dignum[] = "0123456789abcdef"; @@ -12565,7 +12494,6 @@ static s7_double string_to_double_with_radix_1(const char *ur_str, int32_t radix max_len = s7_int_digits_by_radix[radix]; str = (char *)ur_str; - /* fprintf(stderr, "%s[%d]: str: %s\n", __func__, __LINE__, str); */ if (*str == '+') str++; @@ -12926,8 +12854,6 @@ static s7_pointer make_atom(s7_scheme *sc, char *q, int32_t radix, bool want_sym char c, *p; bool has_dec_point1 = false; - /* fprintf(stderr, "%s[%d]: %s\n", __func__, __LINE__, q); */ - p = q; c = *p++; @@ -13041,7 +12967,6 @@ static s7_pointer make_atom(s7_scheme *sc, char *q, int32_t radix, bool want_sym } continue; - /* -------- 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! */ @@ -13088,7 +13013,6 @@ static s7_pointer make_atom(s7_scheme *sc, char *q, int32_t radix, bool want_sym continue; break; - /* -------- internal + or - -------- */ case '+': case '-': @@ -13131,7 +13055,6 @@ static s7_pointer make_atom(s7_scheme *sc, char *q, int32_t radix, bool want_sym continue; - /* -------- i for the imaginary part -------- */ case 'i': if ((has_plus_or_minus != 0) && @@ -13351,8 +13274,7 @@ static s7_pointer string_to_number_p_pp(s7_scheme *sc, s7_pointer str1, s7_point if (!is_t_integer(radix1)) return(wrong_type_argument(sc, sc->string_to_number_symbol, 2, radix1, T_INTEGER)); radix = s7_integer(radix1); - 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) */ + if ((radix < 2) || (radix > 16)) return(out_of_range(sc, sc->string_to_number_symbol, small_int(2), radix1, a_valid_radix_string)); str = (char *)string_value(str1); @@ -13378,8 +13300,7 @@ static s7_pointer g_string_to_number_1(s7_scheme *sc, s7_pointer args, s7_pointe if (!s7_is_integer(rad)) return(method_or_bust(sc, rad, caller, args, T_INTEGER, 2)); 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) */ + if ((radix < 2) || (radix > 16)) return(out_of_range(sc, caller, small_int(2), rad, a_valid_radix_string)); } else radix = 10; @@ -13515,9 +13436,10 @@ static s7_pointer g_magnitude(s7_scheme *sc, s7_pointer args) /* -------------------------------- rationalize -------------------------------- */ static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args) { - #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_real_symbol, sc->is_real_symbol, sc->is_real_symbol) - /* result is real (not rational) if argument is NaN */ + #define H_rationalize "(rationalize x err) returns the ratio with smallest 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) + /* I can't find a case where this returns a non-rational result */ + s7_double err; s7_pointer x; @@ -13585,17 +13507,24 @@ static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args) if (c_rationalize(rat, err, &numer, &denom)) return(s7_make_ratio(sc, numer, denom)); - +#if S7_DEBUGGING + fprintf(stderr, "rationalize %s -> #f\n", DISPLAY(args)); +#endif return(sc->F); } } +#if S7_DEBUGGING + fprintf(stderr, "(at end) rationalize %s -> #f\n", DISPLAY(args)); +#endif return(sc->F); /* make compiler happy */ } -s7_pointer rationalize_p_d(s7_scheme *sc, s7_double x) +s7_pointer rationalize_p_d(s7_scheme *sc, s7_double x) { if ((is_NaN(x)) || (is_inf(x))) return(out_of_range(sc, sc->rationalize_symbol, small_int(1), make_real(sc, x), a_normal_real_string)); + if ((x > 9.2233720368548e+18) || (x < -9.2233720368548e+18)) + return(out_of_range(sc, sc->rationalize_symbol, small_int(1), make_real(sc, x), its_too_large_string)); return(s7_rationalize(sc, x, sc->default_rationalize_error)); } @@ -13843,6 +13772,10 @@ static s7_pointer complex_p_dd(s7_scheme *sc, s7_double x, s7_double y) /* -------------------------------- exp -------------------------------- */ +#if (!HAVE_COMPLEX_NUMBERS) + static s7_pointer no_complex_numbers_string; +#endif + static s7_pointer g_exp(s7_scheme *sc, s7_pointer args) { #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459" @@ -14023,8 +13956,7 @@ static s7_pointer g_sin(s7_scheme *sc, s7_pointer args) /* 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 + * (sin (remainder 1e22 (* 2 pi))) -> -0.57876806033477 * but it should be -8.522008497671888065747423101326159661908E-1 * --- * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 !! @@ -14961,6 +14893,7 @@ static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args) } +/* -------------------------------- quotient -------------------------------- */ 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) || @@ -15129,6 +15062,7 @@ static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args) } +/* -------------------------------- remainder -------------------------------- */ static inline s7_int c_rem_int(s7_scheme *sc, s7_int x, s7_int y) { if (y == 0) @@ -15624,6 +15558,7 @@ static s7_int round_i_7d(s7_scheme *sc, s7_double z) } +/* -------------------------------- modulo -------------------------------- */ static s7_int c_mod(s7_int x, s7_int y) { s7_int z; @@ -15995,10 +15930,8 @@ static s7_pointer g_add(s7_scheme *sc, s7_pointer args) { 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? + * arithmetic to overflow as an integer. Perhaps 'safety==0 would not check anywhere? */ goto ADD_REALS; } @@ -16815,7 +16748,6 @@ static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args) return(NULL); /* make the compiler happy */ } - static s7_pointer g_subtract_1(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -17944,7 +17876,6 @@ static s7_pointer g_divide_1r(s7_scheme *sc, s7_pointer args) } #endif - static s7_double divide_d_7d(s7_scheme *sc, s7_double x) { if (x == 0.0) division_by_zero_error(sc, sc->divide_symbol, set_elist_1(sc, real_zero)); @@ -18027,7 +17958,6 @@ static s7_pointer g_max(s7_scheme *sc, s7_pointer args) return(method_or_bust(sc, y, sc->max_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1)); } - case T_RATIO: MAX_RATIOS: if (is_null(p)) return(x); @@ -18121,7 +18051,6 @@ static s7_pointer g_max(s7_scheme *sc, s7_pointer args) return(method_or_bust(sc, y, sc->max_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1)); } - case T_REAL: if (is_NaN(real(x))) return(nan_with_error_check(sc, x, p, args, sc->max_symbol)); @@ -18529,18 +18458,26 @@ static s7_pointer g_equal_length_ic(s7_scheme *sc, s7_pointer args) case T_HASH_TABLE: return(make_boolean(sc, (hash_table_mask(val) + 1) == ilen)); case T_C_OBJECT: return(make_boolean(sc, c_object_length_to_int(sc, val) == ilen)); case T_LET: return(make_boolean(sc, let_length(sc, val) == ilen)); + case T_BYTE_VECTOR: 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_active_methods(sc, val)) return(make_boolean(sc, closure_length(sc, val) == ilen)); + case T_VECTOR: + return(make_boolean(sc, vector_length(val) == ilen)); + case T_ITERATOR: { s7_pointer len; len = s7_length(sc, iterator_sequence(val)); return(make_boolean(sc, (is_t_integer(len)) && (integer(len) == ilen))); } + + case T_CLOSURE: + case T_CLOSURE_STAR: + if (has_active_methods(sc, val)) + return(make_boolean(sc, closure_length(sc, val) == ilen)); + /* fall through */ + 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 */ @@ -19458,18 +19395,26 @@ static s7_pointer g_less_length_ic(s7_scheme *sc, s7_pointer args) 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_C_OBJECT: return(make_boolean(sc, c_object_length_to_int(sc, val) < ilen)); case T_LET: return(make_boolean(sc, let_length(sc, val) < ilen)); /* this works because let_length handles the length method itself! */ + case T_BYTE_VECTOR: 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_active_methods(sc, val)) return(make_boolean(sc, closure_length(sc, val) < ilen)); + case T_VECTOR: + return(make_boolean(sc, vector_length(val) < ilen)); + case T_ITERATOR: { s7_pointer len; len = s7_length(sc, iterator_sequence(val)); return(make_boolean(sc, (is_t_integer(len)) && (integer(len) < ilen))); } + + case T_CLOSURE: + case T_CLOSURE_STAR: + if (has_active_methods(sc, val)) + return(make_boolean(sc, closure_length(sc, val) < ilen)); + /* fall through */ + default: return(simple_wrong_type_argument_with_type(sc, sc->length_symbol, val, a_sequence_string)); /* no check method here because we checked above */ } @@ -20019,7 +19964,6 @@ s7_double s7_real_part(s7_pointer x) return(0.0); } - s7_double s7_imag_part(s7_pointer x) { switch (type(x)) @@ -20073,7 +20017,6 @@ static s7_pointer g_real_part(s7_scheme *sc, s7_pointer args) } } - static s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args) { #define H_imag_part "(imag-part num) returns the imaginary part of num" @@ -20457,7 +20400,7 @@ static bool is_positive_d(s7_double p) {return(p > 0.0);} /* -------------------------------- negative? -------------------------------- */ -static s7_pointer is_negative_p_p(s7_scheme *sc, s7_pointer x) +static s7_pointer is_negative_p_p(s7_scheme *sc, s7_pointer x) { switch (type(x)) { @@ -20623,7 +20566,6 @@ static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args) if (!s7_is_integer(p)) return(method_or_bust_one_arg(sc, p, sc->integer_length_symbol, args, T_INTEGER)); - x = s7_integer(p); if (x < 0) return(make_integer(sc, integer_length(-(x + 1)))); @@ -20638,7 +20580,6 @@ static s7_int integer_length_i_i(s7_int x) } #endif /* !pure s7 */ - static s7_pointer g_integer_decode_float(s7_scheme *sc, s7_pointer args) { #define H_integer_decode_float "(integer-decode-float x) returns a list containing the significand, exponent, and \ @@ -20793,8 +20734,7 @@ order here follows gmp, and is the opposite of the CL convention. (logbit? int 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) + /* (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. */ @@ -20808,7 +20748,7 @@ static bool logbit_b_ii(s7_int i1, s7_int i2) { /* no b_7ii_t so fallback on cur_sc, etc -- kinda ugly */ out_of_range(cur_sc, cur_sc->logbit_symbol, small_int(2), make_integer(cur_sc, i1), its_negative_string); - return(false); + return(false); } if (i2 >= s7_int_bits) return(i1 < 0); @@ -20888,8 +20828,6 @@ static s7_int rsh_i_i2_direct(s7_int i1, s7_int i2) {return(i1 >> 1);} #endif -/* ---------------------------------------- random ---------------------------------------- */ - /* 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 @@ -20901,6 +20839,7 @@ static s7_int rsh_i_i2_direct(s7_int i1, s7_int i2) {return(i1 >> 1);} */ #if (!WITH_GMP) +/* -------------------------------- random-state -------------------------------- */ 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'. \ @@ -20962,6 +20901,7 @@ static s7_pointer rng_copy(s7_scheme *sc, s7_pointer args) } +/* -------------------------------- random-state? -------------------------------- */ 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)." @@ -20971,6 +20911,8 @@ static s7_pointer g_is_random_state(s7_scheme *sc, s7_pointer args) static bool is_random_state_b(s7_pointer p) {return(type(p) == T_RANDOM_STATE);} + +/* -------------------------------- random-state->list -------------------------------- */ 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.\ @@ -21039,7 +20981,6 @@ static double next_random(s7_pointer r) return(result); } - s7_double s7_random(s7_scheme *sc, s7_pointer state) { if (!state) @@ -21047,7 +20988,6 @@ s7_double s7_random(s7_scheme *sc, s7_pointer state) return(next_random(state)); } - 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)." @@ -21192,6 +21132,7 @@ static s7_pointer random_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p #define NUM_CHARS 256 +/* -------------------------------- char<->integer -------------------------------- */ 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" @@ -21209,7 +21150,6 @@ static s7_int char_to_integer_i_7p(s7_scheme *sc, s7_pointer p) return(character(p)); } - static s7_pointer integer_to_char_p_p(s7_scheme *sc, s7_pointer x) { s7_int ind; @@ -21301,11 +21241,10 @@ static void init_chars(void) else len = snprintf((char *)(&(character_name(cp))), P_SIZE, "#\\%c", c); character_name_length(cp) = len; break; - } - } - } + }}} } + /* -------------------------------- char-upcase, char-downcase ----------------------- */ static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args) { @@ -21325,6 +21264,7 @@ static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args) return(s7_make_character(sc, lowers[character(car(args))])); } + /* -------------------------------- char-alphabetic? char-numeric? char-whitespace? -------------------------------- */ static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args) { @@ -21344,7 +21284,7 @@ static bool is_char_alphabetic_b_7p(s7_scheme *sc, s7_pointer c) return(is_char_alphabetic(c)); } static bool is_char_alphabetic_c(s7_pointer c) {return(is_char_alphabetic(c));} -static s7_pointer is_char_alphabetic_p_p(s7_scheme *sc, s7_pointer c) +static s7_pointer is_char_alphabetic_p_p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) simple_wrong_type_argument(sc, sc->is_char_alphabetic_symbol, c, T_CHARACTER); @@ -21399,13 +21339,14 @@ static bool is_char_whitespace_b_7p(s7_scheme *sc, s7_pointer c) return(false); } static bool is_char_whitespace_c(s7_pointer c) {return(is_char_whitespace(c));} -static s7_pointer is_char_whitespace_p_p(s7_scheme *sc, s7_pointer c) +static s7_pointer is_char_whitespace_p_p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) simple_wrong_type_argument(sc, sc->is_char_whitespace_symbol, c, T_CHARACTER); return(make_boolean(sc, is_char_whitespace(c))); } + /* -------------------------------- char-upper-case? char-lower-case? -------------------------------- */ static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args) { @@ -21449,6 +21390,7 @@ static bool is_char_lower_case_b_7p(s7_scheme *sc, s7_pointer c) static bool is_char_lower_case_c(s7_pointer c) {return(is_char_lowercase(c));} + /* -------------------------------- char? -------------------------------- */ static s7_pointer g_is_char(s7_scheme *sc, s7_pointer args) { @@ -21648,6 +21590,7 @@ static bool char_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) return(character(p1) == character(p2)); } + /* -------------------------------- char-ci<? char-ci<=? char-ci>? char-ci>=? char-ci=? -------------------------------- */ static s7_pointer g_char_equal_s_ic(s7_scheme *sc, s7_pointer args) { @@ -21806,6 +21749,7 @@ static bool char_ci_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) #endif /* not pure s7 */ + /* -------------------------------- char-position -------------------------------- */ static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args) { @@ -21860,9 +21804,8 @@ static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args) 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? + /* 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? */ return(sc->F); } @@ -21927,6 +21870,7 @@ static s7_pointer g_char_position_csi(s7_scheme *sc, s7_pointer args) return(sc->F); } + /* -------------------------------- string-position -------------------------------- */ static s7_pointer g_string_position(s7_scheme *sc, s7_pointer args) { @@ -22230,7 +22174,7 @@ static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args) return(make_empty_string(sc, len, '\0')); /* #\null here means "don't fill/clear" */ } -static s7_pointer make_string_p_i(s7_scheme *sc, s7_int len) +static s7_pointer make_string_p_i(s7_scheme *sc, s7_int len) { if ((len < 0) || (len > sc->max_string_length)) return(out_of_range(sc, sc->make_string_symbol, small_int(1), make_integer(sc, len), (len < 0) ? its_negative_string : its_too_large_string)); @@ -22239,6 +22183,7 @@ static s7_pointer make_string_p_i(s7_scheme *sc, s7_int len) #if (!WITH_PURE_S7) +/* -------------------------------- string-length -------------------------------- */ 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" @@ -22271,7 +22216,6 @@ static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args) p = car(args); if (!is_string(p)) - /* perhaps gc-protect p here and in upcase below */ return(method_or_bust_one_arg(sc, p, sc->string_downcase_symbol, list_1(sc, p), T_STRING)); len = string_length(p); newstr = make_empty_string(sc, len, 0); @@ -22521,6 +22465,7 @@ static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args) } #if (!WITH_PURE_S7) +/* -------------------------------- string-copy -------------------------------- */ 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" @@ -22564,7 +22509,7 @@ static s7_pointer start_and_end(s7_scheme *sc, s7_pointer caller, s7_pointer arg 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); + return(sc->unused); } static s7_pointer g_substring(s7_scheme *sc, s7_pointer args) @@ -22585,7 +22530,7 @@ end: (substring \"01234\" 1 2) -> \"1\"" if (!is_null(cdr(args))) { x = start_and_end(sc, sc->substring_symbol, args, 2, &start, &end); - if (x != sc->gc_nil) return(x); + if (x != sc->unused) return(x); } s = string_value(str); len = end - start; @@ -22608,7 +22553,7 @@ static s7_pointer g_substring_to_temp(s7_scheme *sc, s7_pointer args) { s7_pointer x; x = start_and_end(sc, sc->substring_symbol, args, 2, &start, &end); - if (x != sc->gc_nil) return(x); + if (x != sc->unused) return(x); } return(wrap_string(sc, (char *)(string_value(str) + start), end - start)); } @@ -22873,7 +22818,6 @@ static bool string_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) #if (!WITH_PURE_S7) - static int32_t 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). @@ -23070,7 +23014,7 @@ static s7_pointer g_string_fill_1(s7_scheme *sc, s7_pointer caller, s7_pointer a { s7_pointer p; p = start_and_end(sc, caller, args, 3, &start, &end); - if (p != sc->gc_nil) + if (p != sc->unused) return(p); if (start == end) return(chr); } @@ -23084,6 +23028,7 @@ static s7_pointer g_string_fill_1(s7_scheme *sc, s7_pointer caller, s7_pointer a } #if (!WITH_PURE_S7) +/* -------------------------------- string-fill! -------------------------------- */ 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" @@ -23132,6 +23077,7 @@ static s7_pointer g_string_1(s7_scheme *sc, s7_pointer args, s7_pointer sym) return(newstr); } + /* -------------------------------- string -------------------------------- */ static s7_pointer g_string(s7_scheme *sc, s7_pointer args) { @@ -23144,6 +23090,7 @@ static s7_pointer g_string(s7_scheme *sc, s7_pointer args) } +/* -------------------------------- list->string -------------------------------- */ #if (!WITH_PURE_S7) static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args) { @@ -23160,6 +23107,8 @@ static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args) } #endif + +/* -------------------------------- string->list -------------------------------- */ static s7_pointer s7_string_to_list(s7_scheme *sc, const char *str, s7_int len) { s7_int i; @@ -23192,7 +23141,7 @@ static s7_pointer g_string_to_list(s7_scheme *sc, s7_pointer args) if (!is_null(cdr(args))) { p = start_and_end(sc, sc->string_to_list_symbol, args, 2, &start, &end); - if (p != sc->gc_nil) return(p); + if (p != sc->unused) return(p); if (start == end) return(sc->nil); } else @@ -23241,6 +23190,85 @@ static bool is_port_closed_b_7p(s7_scheme *sc, s7_pointer x) return(false); } + +/* -------------------------------- port-position -------------------------------- */ + +static s7_pointer g_port_position(s7_scheme *sc, s7_pointer args) +{ + #define H_port_position "(port-position input-port) returns the current location (in bytes) in the port's data where the next read will take place." + #define Q_port_position s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_input_port_symbol) + s7_pointer port; + + port = car(args); + if (!(is_input_port(port))) + return(simple_wrong_type_argument(sc, sc->port_position_symbol, port, T_INPUT_PORT)); + if (port_is_closed(port)) + return(s7_wrong_type_arg_error(sc, "port-position", 0, port, "an open input port")); + if (is_string_port(port)) + return(make_integer(sc, port_position(port))); +#if (!MS_WINDOWS) + if (is_file_port(port)) + return(make_integer(sc, ftell(port_file(port)))); +#endif + return(small_int(0)); +} + +static s7_pointer g_set_port_position(s7_scheme *sc, s7_pointer args) +{ + s7_pointer port, pos; + s7_int position; + + port = car(args); + if (!(is_input_port(port))) + return(s7_wrong_type_arg_error(sc, "set! port-position", 1, port, "an input port")); + if (port_is_closed(port)) + return(s7_wrong_type_arg_error(sc, "set! port-position", 1, port, "an open input port")); + + pos = cadr(args); + if (!is_t_integer(pos)) + return(s7_wrong_type_arg_error(sc, "set! port-position", 2, pos, "an integer")); + position = s7_integer(pos); + if (position < 0) + return(out_of_range(sc, sc->port_position_symbol, small_int(2), pos, its_negative_string)); + + if (is_string_port(port)) + port_position(port) = position; +#if (!MS_WINDOWS) + else + { + if (is_file_port(port)) + { + rewind(port_file(port)); + fseek(port_file(port), (long)position, SEEK_SET); + } + } +#endif + return(pos); +} + + +/* -------------------------------- port-file -------------------------------- */ + +static s7_pointer g_port_file(s7_scheme *sc, s7_pointer args) +{ + #define H_port_file "(port-file port) returns the FILE* pointer associated with the port wrapped in a c-pointer object" + #define Q_port_file s7_make_signature(sc, 2, sc->is_c_pointer_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_output_port_symbol)) + s7_pointer port; + + port = car(args); + if ((!is_input_port(port)) && + (!is_output_port(port))) + return(s7_wrong_type_arg_error(sc, "port-file", 0, port, "a port")); + if (port_is_closed(port)) + return(s7_wrong_type_arg_error(sc, "port-file", 0, port, "an open port")); +#if (!MS_WINDOWS) + if (is_file_port(port)) + return(s7_make_c_pointer_with_type(sc, (void *)(port_file(port)), s7_make_symbol(sc, "FILE*"), sc->F)); +#endif + return(s7_make_c_pointer(sc, NULL)); +} + + /* -------------------------------- port-line-number -------------------------------- */ static s7_pointer c_port_line_number(s7_scheme *sc, s7_pointer x) { @@ -23290,6 +23318,7 @@ static s7_pointer g_set_port_line_number(s7_scheme *sc, s7_pointer args) return(line); } + /* -------------------------------- port-filename -------------------------------- */ const char *s7_port_filename(s7_scheme *sc, s7_pointer x) { @@ -23321,6 +23350,52 @@ static s7_pointer g_port_filename(s7_scheme *sc, s7_pointer args) return(c_port_filename(sc, (is_null(args)) ? sc->input_port : car(args))); } + +/* -------------------------------- pair-line-number -------------------------------- */ +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->not_symbol), sc->is_pair_symbol) + + p = car(args); + if (!is_pair(p)) + return(method_or_bust_one_arg(sc, p, sc->pair_line_number_symbol, set_plist_1(sc, p), T_PAIR)); + + if (has_line_number(p)) + return(make_integer(sc, pair_line(p))); + return(sc->F); /* was 0 21-Mar-17 */ +} + +static s7_pointer pair_line_number_p_p(s7_scheme *sc, s7_pointer p) +{ + if (!is_pair(p)) + return(method_or_bust_one_arg(sc, p, sc->pair_line_number_symbol, set_plist_1(sc, p), T_PAIR)); + if (has_line_number(p)) + return(make_integer(sc, pair_line(p))); + return(sc->F); +} + + +/* -------------------------------- pair-filename -------------------------------- */ +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, s7_make_signature(sc, 2, sc->is_string_symbol, sc->not_symbol), sc->is_pair_symbol) + s7_pointer p; + p = car(args); + + if (!is_pair(p)) + { + check_method(sc, p, sc->pair_filename_symbol, args); + return(simple_wrong_type_argument(sc, sc->pair_filename_symbol, p, T_PAIR)); + } + if (has_line_number(p)) + return(sc->file_names[pair_file(p)]); + return(sc->F); +} + + /* -------------------------------- input-port? -------------------------------- */ bool s7_is_input_port(s7_scheme *sc, s7_pointer p) {return(is_input_port(p));} static bool is_input_port_b(s7_pointer p) {return(is_input_port(p));} @@ -23332,6 +23407,7 @@ static s7_pointer g_is_input_port(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, is_input_port, sc->is_input_port_symbol, args); } + /* -------------------------------- output-port? -------------------------------- */ 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));} @@ -23343,6 +23419,7 @@ static s7_pointer g_is_output_port(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, is_output_port, sc->is_output_port_symbol, args); } + /* -------------------------------- current-input-port -------------------------------- */ s7_pointer s7_current_input_port(s7_scheme *sc) {return(sc->input_port);} @@ -23380,6 +23457,7 @@ s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer port) return(old_port); } + /* -------------------------------- current-output-port -------------------------------- */ s7_pointer s7_current_output_port(s7_scheme *sc) {return(sc->output_port);} @@ -23418,6 +23496,7 @@ static s7_pointer g_set_current_output_port(s7_scheme *sc, s7_pointer args) return(old_port); } + /* -------------------------------- current-error-port -------------------------------- */ s7_pointer s7_current_error_port(s7_scheme *sc) {return(sc->error_port);} @@ -23456,6 +23535,7 @@ static s7_pointer g_set_current_error_port(s7_scheme *sc, s7_pointer args) return(old_port); } + /* -------------------------------- char-ready? -------------------------------- */ #if (!WITH_PURE_S7) static s7_pointer g_is_char_ready(s7_scheme *sc, s7_pointer args) @@ -23543,6 +23623,7 @@ void s7_close_input_port(s7_scheme *sc, s7_pointer p) port_position(p) = 0; } + /* -------------------------------- close-input-port -------------------------------- */ static s7_pointer g_close_input_port(s7_scheme *sc, s7_pointer args) { @@ -23559,6 +23640,7 @@ static s7_pointer g_close_input_port(s7_scheme *sc, s7_pointer args) return(sc->unspecified); } + /* -------------------------------- flush-output-port -------------------------------- */ void s7_flush_output_port(s7_scheme *sc, s7_pointer p) { @@ -23567,7 +23649,7 @@ void s7_flush_output_port(s7_scheme *sc, s7_pointer p) (port_is_closed(p)) || (p == sc->F)) return; - + if (port_file(p)) { if (port_position(p) > 0) @@ -23599,6 +23681,7 @@ static s7_pointer g_flush_output_port(s7_scheme *sc, s7_pointer args) return(pt); } + /* -------------------------------- close-output-port -------------------------------- */ static void close_output_port(s7_scheme *sc, s7_pointer p) { @@ -23868,7 +23951,6 @@ static void input_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_output_port_string); } - static void closed_port_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) { simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_open_port_string); @@ -23887,7 +23969,6 @@ static void closed_port_write_string(s7_scheme *sc, const char *str, s7_int len, simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_open_port_string); } - static void input_display(s7_scheme *sc, const char *s, s7_pointer port) { simple_wrong_type_argument_with_type(sc, sc->display_symbol, port, an_output_port_string); @@ -23898,7 +23979,6 @@ static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port) simple_wrong_type_argument_with_type(sc, sc->display_symbol, port, an_open_port_string); } - static void stdout_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer port) { if (str[len] == '\0') @@ -23968,7 +24048,6 @@ static void file_write_string(s7_scheme *sc, const char *str, s7_int len, s7_poi } } - static void string_display(s7_scheme *sc, const char *s, s7_pointer port) { if (s) @@ -24016,6 +24095,7 @@ static void stderr_display(s7_scheme *sc, const char *s, s7_pointer port) if (s) fputs(s, stderr); } + /* -------------------------------- write-string -------------------------------- */ static s7_pointer g_write_string(s7_scheme *sc, s7_pointer args) { @@ -24038,7 +24118,7 @@ static s7_pointer g_write_string(s7_scheme *sc, s7_pointer args) { s7_pointer p; p = start_and_end(sc, sc->write_string_symbol, args, 3, &start, &end); - if (p != sc->gc_nil) return(p); + if (p != sc->unused) return(p); } } else port = sc->output_port; @@ -24142,7 +24222,7 @@ static s7_pointer file_read_name_or_sharp(s7_scheme *sc, s7_pointer pt, bool ato if (c == '\n') port_line_number(pt)++; - sc->strbuf[i++] = c; + sc->strbuf[i++] = (unsigned char)c; if (i >= sc->strbuf_size) resize_strbuf(sc, i); } while ((c != EOF) && (char_ok_in_a_name[c])); @@ -24177,7 +24257,6 @@ static s7_pointer file_read_sharp(s7_scheme *sc, s7_pointer pt) return(file_read_name_or_sharp(sc, pt, false)); } - static s7_pointer string_read_name_no_free(s7_scheme *sc, s7_pointer pt) { /* sc->strbuf[0] has the first char of the string we're reading */ @@ -24232,14 +24311,12 @@ static s7_pointer string_read_name_no_free(s7_scheme *sc, s7_pointer pt) return(result); } - static s7_pointer string_read_sharp(s7_scheme *sc, s7_pointer pt) { /* 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 */ char *str; - str = (char *)(port_data(pt) + port_position(pt)); if (char_ok_in_a_name[(uint8_t)*str]) @@ -24276,7 +24353,6 @@ static s7_pointer string_read_sharp(s7_scheme *sc, s7_pointer pt) return(make_sharp_constant(sc, sc->strbuf, WITH_OVERFLOW_ERROR)); } - static s7_pointer string_read_name(s7_scheme *sc, s7_pointer pt) { /* port_string was allocated (and read from a file) so we can mess with it directly */ @@ -24463,6 +24539,7 @@ static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, s7_int ma return(port); } + /* -------------------------------- open-input-file -------------------------------- */ static int32_t remember_file_name(s7_scheme *sc, const char *file) { @@ -24678,6 +24755,7 @@ static void make_standard_ports(s7_scheme *sc) sc->current_line = -1; } + /* -------------------------------- open-output-file -------------------------------- */ s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode) { @@ -24742,6 +24820,7 @@ static s7_pointer g_open_output_file(s7_scheme *sc, s7_pointer args) return(s7_open_output_file(sc, string_value(name), "w")); } + /* -------------------------------- open-input-string -------------------------------- */ static s7_pointer open_input_string(s7_scheme *sc, const char *input_string, s7_int len) { @@ -24799,6 +24878,7 @@ s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string) return(open_input_string(sc, input_string, safe_strlen(input_string))); } + /* -------------------------------- open-output-string -------------------------------- */ static s7_pointer g_open_input_string(s7_scheme *sc, s7_pointer args) { @@ -24859,6 +24939,7 @@ static s7_pointer g_open_output_string(s7_scheme *sc, s7_pointer args) return(s7_open_output_string(sc)); } + /* -------------------------------- get-output-string -------------------------------- */ const char *s7_get_output_string(s7_scheme *sc, s7_pointer p) { @@ -24936,6 +25017,7 @@ static s7_pointer op_get_output_string(s7_scheme *sc) return(NULL); } + /* -------------------------------- open-input-function -------------------------------- */ s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port)) { @@ -24965,6 +25047,7 @@ s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_schem return(x); } + /* -------------------------------- open-output-function -------------------------------- */ s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, uint8_t c, s7_pointer port)) { @@ -25063,6 +25146,7 @@ static s7_pointer input_port_if_not_loading(s7_scheme *sc) return(port); } + /* -------------------------------- read-char -------------------------------- */ s7_pointer s7_read_char(s7_scheme *sc, s7_pointer port) { @@ -25090,6 +25174,7 @@ static s7_pointer g_read_char(s7_scheme *sc, s7_pointer args) return(chars[port_read_character(port)(sc, port)]); } + /* -------------------------------- write-char -------------------------------- */ s7_pointer s7_write_char(s7_scheme *sc, s7_pointer c, s7_pointer pt) { @@ -25132,6 +25217,7 @@ static s7_pointer write_char_p_p(s7_scheme *sc, s7_pointer c) * is this correct? It's what Guile does. write-char is actually display-char. */ + /* -------------------------------- peek-char -------------------------------- */ s7_pointer s7_peek_char(s7_scheme *sc, s7_pointer port) { @@ -25168,6 +25254,7 @@ static s7_pointer g_peek_char(s7_scheme *sc, s7_pointer args) return(s7_peek_char(sc, port)); } + /* -------------------------------- read-byte -------------------------------- */ static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args) { @@ -25192,6 +25279,7 @@ static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args) return(small_int(c)); } + /* -------------------------------- write-byte -------------------------------- */ static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args) { @@ -25222,6 +25310,7 @@ static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args) return(b); } + /* -------------------------------- read-line -------------------------------- */ static s7_pointer g_read_line(s7_scheme *sc, s7_pointer args) { @@ -25239,7 +25328,7 @@ If 'with-eol' is not #f, read-line includes the trailing end-of-line character." return(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); + with_eol = (cadr(args) != sc->F); /* perhaps this should insist on #t: (read-line port (c-pointer 0)) */ } else { @@ -25293,13 +25382,15 @@ static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args) if (!is_null(cdr(args))) port = cadr(args); - else + else { port = input_port_if_not_loading(sc); if (!port) return(eof_object); } if (!is_input_port(port)) return(method_or_bust_with_type(sc, port, sc->read_string_symbol, list_2(sc, make_integer(sc, nchars), port), an_input_port_string, 2)); + if (port_is_closed(port)) + return(simple_wrong_type_argument_with_type(sc, sc->read_string_symbol, port, an_open_port_string)); if (nchars == 0) return(make_empty_string(sc, 0, 0)); @@ -25320,6 +25411,14 @@ static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args) port_position(port) += len; return(s); } + if (is_file_port(port)) + { + size_t len; + len = fread((void *)str, 1, nchars, port_file(port)); + str[len] = '\0'; + string_length(s) = len; + return(s); + } for (i = 0; i < nchars; i++) { int32_t c; @@ -25363,6 +25462,7 @@ static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args) jump_loc = setjmp(sc->goto_start); \ } while (0) + /* -------------------------------- read -------------------------------- */ s7_pointer s7_read(s7_scheme *sc, s7_pointer port) { @@ -25755,7 +25855,6 @@ s7_pointer s7_load_path(s7_scheme *sc) return(s7_symbol_value(sc, sc->load_path_symbol)); } - s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir) { s7_symbol_set_value(sc, @@ -25766,7 +25865,6 @@ s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir) return(s7_symbol_value(sc, sc->load_path_symbol)); } - static s7_pointer g_load_path_set(s7_scheme *sc, s7_pointer args) { /* new value must be either () or a proper list of strings */ @@ -25797,6 +25895,8 @@ static s7_pointer g_cload_directory_set(s7_scheme *sc, s7_pointer args) /* ---------------- autoload ---------------- */ +#define INITIAL_AUTOLOAD_NAMES_SIZE 4 + void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size) { /* the idea here is that by sticking to string constants we can handle 90% of the work at compile-time, @@ -25813,8 +25913,6 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size) * 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? @@ -25825,9 +25923,7 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size) * 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->autoload_names) { sc->autoload_names = (const char ***)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(const char **)); @@ -25850,10 +25946,7 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size) sc->autoload_names[i] = NULL; sc->autoload_names_sizes[i] = 0; sc->autoloaded_already[i] = NULL; - } - } - } - + }}} 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)); @@ -25862,8 +25955,8 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size) static const char *find_autoload_name(s7_scheme *sc, s7_pointer symbol, bool *already_loaded, bool loading) { - s7_int l = 0, pos = -1, lib, libs; - const char *name, *this_name; + s7_int l = 0, lib, libs; + const char *name; name = symbol_name(symbol); libs = sc->autoload_names_loc; @@ -25877,7 +25970,8 @@ static const char *find_autoload_name(s7_scheme *sc, s7_pointer symbol, bool *al while (true) { - s7_int comp; + s7_int comp, pos; + const char *this_name; if (u < l) break; pos = (l + u) / 2; this_name = names[pos * 2]; @@ -25941,6 +26035,8 @@ in the file, or by the function." return(s7_wrong_type_arg_error(sc, "autoload", 2, value, "a string (file-name) or a thunk")); } + +/* -------------------------------- *autoload* -------------------------------- */ 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." @@ -26014,6 +26110,7 @@ static bool is_memq(s7_pointer sym, s7_pointer lst) return(false); } + /* ---------------- provided? ---------------- */ static s7_pointer g_is_provided(s7_scheme *sc, s7_pointer args) { @@ -26118,10 +26215,42 @@ void s7_provide(s7_scheme *sc, const char *feature) {c_provide(sc, s7_make_symbo static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args) { - /* setter for set/let of *features* which can only be changed via provide */ - if (s7_is_list(sc, cadr(args))) - return(cadr(args)); - return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "can't set *features* to ~S", 26), cadr(args)))); + s7_pointer nf; + nf = cadr(args); + if (is_null(nf)) + return(sc->nil); + if (is_pair(nf)) + { + s7_pointer p; + if (s7_list_length(sc, nf) <= 0) + return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "can't set *features* to ~S", 26), nf))); + for (p = nf; is_pair(p); p = cdr(p)) + if (!is_symbol(car(p))) + return(simple_wrong_type_argument(sc, sc->features_symbol, car(p), T_SYMBOL)); + return(nf); + } + return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "can't set *features* to ~S", 26), nf))); +} + +static s7_pointer g_libraries_set(s7_scheme *sc, s7_pointer args) +{ + s7_pointer nf; + nf = cadr(args); + if (is_null(nf)) + return(sc->nil); + if (is_pair(nf)) + { + s7_pointer p; + if (s7_list_length(sc, nf) <= 0) + return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "can't set *libraries* to ~S", 27), nf))); + for (p = nf; is_pair(p); p = cdr(p)) + if ((!is_pair(car(p))) || + (!is_string(caar(p))) || + (!is_let(cdar(p)))) + return(simple_wrong_type_argument_with_type(sc, sc->libraries_symbol, car(p), wrap_string(sc, "a list of conses of the form (string . let)", 43))); + return(nf); + } + return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "can't set *libraries* to ~S", 27), nf))); } @@ -26170,8 +26299,7 @@ static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args) push_stack(sc, OP_EVAL_STRING, args, sc->code); push_stack_op_let(sc, OP_READ_INTERNAL); - return(sc->F); - /* I think this means that sc->value defaults to #f in op_eval_string below, so (eval-string "") mimics (eval) -> #f */ + return(sc->F); /* I think this means that sc->value defaults to #f in op_eval_string below, so (eval-string "") mimics (eval) -> #f */ } static s7_pointer eval_string_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) @@ -26195,8 +26323,7 @@ static s7_pointer op_eval_string(s7_scheme *sc) trail_data = make_string_with_length(sc, (const char *)(port_data(sc->input_port) + port_position(sc->input_port) - 1), trail_len); s7_close_input_port(sc, sc->input_port); pop_input_port(sc); - s7_error(sc, sc->read_error_symbol, - set_elist_2(sc, wrap_string(sc, "eval-string trailing junk: ~S", 29), trail_data)); + s7_error(sc, sc->read_error_symbol, set_elist_2(sc, wrap_string(sc, "eval-string trailing junk: ~S", 29), trail_data)); } } s7_close_input_port(sc, sc->input_port); @@ -26307,7 +26434,7 @@ static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args) push_stack_op_let(sc, OP_READ_INTERNAL); return(sc->input_port); } - + if (!is_thunk(sc, cadr(args))) return(method_or_bust_with_type(sc, cadr(args), sc->with_input_from_string_symbol, args, a_thunk_string, 2)); @@ -26395,6 +26522,7 @@ static s7_pointer titr_pos(s7_scheme *sc, s7_pointer p, const char *func, int32_ } #endif + /* -------------------------------- iterator? -------------------------------- */ static s7_pointer g_is_iterator(s7_scheme *sc, s7_pointer args) { @@ -26404,7 +26532,7 @@ static s7_pointer g_is_iterator(s7_scheme *sc, s7_pointer args) x = car(args); if (is_iterator(x)) return(sc->T); - /* closure is not an iterator: (let ((c1 (let ((+iterator+ #t) (a 0)) (lambda () (set! a (+ a 1)))))) (iterate c1)): error (a function not an iterator) */ + /* closure itself is not an iterator: (let ((c1 (let ((+iterator+ #t) (a 0)) (lambda () (set! a (+ a 1)))))) (iterate c1)): error (a function not an iterator) */ check_boolean_method(sc, is_iterator, sc->is_iterator_symbol, args); return(sc->F); } @@ -26471,6 +26599,17 @@ static s7_pointer rootlet_iterate(s7_scheme *sc, s7_pointer iterator) return(iterator_quit(iterator)); } +static s7_pointer hash_entry_to_cons(s7_scheme *sc, hash_entry_t *entry, s7_pointer p) +{ + if (p) + { + set_car(p, hash_entry_key(entry)); + set_cdr(p, hash_entry_value(entry)); + return(p); + } + return(cons(sc, hash_entry_key(entry), hash_entry_value(entry))); +} + static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator) { s7_pointer table; @@ -26482,17 +26621,8 @@ static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator) if (lst) { iterator_hash_current(iterator) = hash_entry_next(lst); - if (iterator_current(iterator)) - { - s7_pointer p; - p = iterator_current(iterator); - set_car(p, hash_entry_key(lst)); - set_cdr(p, hash_entry_value(lst)); - return(p); - } - return(cons(sc, hash_entry_key(lst), hash_entry_value(lst))); + return(hash_entry_to_cons(sc, lst, iterator_current(iterator))); } - 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); @@ -26505,17 +26635,18 @@ static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator) { iterator_position(iterator) = loc; iterator_hash_current(iterator) = hash_entry_next(x); - if (iterator_current(iterator)) - { - s7_pointer p; - p = iterator_current(iterator); - set_car(p, hash_entry_key(x)); - set_cdr(p, hash_entry_value(x)); - return(p); - } - return(cons(sc, hash_entry_key(x), hash_entry_value(x))); + return(hash_entry_to_cons(sc, x, iterator_current(iterator))); } } + if (is_weak_hash_table(table)) + { + clear_weak_hash_iterator(iterator); +#if S7_DEBUGGING + if (weak_hash_iters(table) == 0) + fprintf(stderr, "weak has iters wrapping under!\n"); +#endif + weak_hash_iters(table)--; + } return(iterator_quit(iterator)); } @@ -26557,6 +26688,7 @@ static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj) static s7_pointer closure_iterate(s7_scheme *sc, s7_pointer obj) { s7_pointer result; + /* TODO: check type */ result = s7_call(sc, iterator_sequence(obj), sc->nil); /* this can't use s7_apply_function -- we need to catch the error handler's longjmp here */ if (result == ITERATOR_END) @@ -26592,7 +26724,6 @@ static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj) return(iterator_quit(obj)); } - static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj); static s7_pointer pair_iterate(s7_scheme *sc, s7_pointer obj) { @@ -26640,10 +26771,21 @@ static s7_pointer iterator_method(s7_scheme *sc, s7_pointer e) return(NULL); } + /* -------------------------------- make-iterator -------------------------------- */ static bool is_iterable_closure(s7_scheme *sc, s7_pointer x) { - check_closure_for(sc, x, sc->local_iterator_symbol); + if (!is_thunk(sc, x)) + wrong_type_argument_with_type(sc, sc->make_iterator_symbol, 1, x, a_thunk_string); + if ((has_closure_let(x)) && (is_let(closure_let(x)))) + { + s7_pointer val; + val = symbol_to_local_slot(sc, sc->local_iterator_symbol, closure_let(x)); + if ((!is_slot(val)) && (is_let(outlet(closure_let(x))))) + val = symbol_to_local_slot(sc, sc->local_iterator_symbol, outlet(closure_let(x))); + if (is_slot(val)) + return(slot_value(val) != sc->F); + } return(false); } @@ -26683,6 +26825,12 @@ s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e) iterator_current(iter) = NULL; iterator_position(iter) = -1; iterator_next(iter) = hash_table_iterate; + if (is_weak_hash_table(e)) + { + set_weak_hash_iterator(iter); + weak_hash_iters(e)++; + add_weak_hash_iterator(sc, iter); + } break; case T_STRING: @@ -26772,6 +26920,7 @@ in the sequence each time it is called. When it reaches the end, it returns " I s7_pointer iter, seq, carrier; /* we need to call s7_make_iterator before fixing up the optional second arg in case let->method */ + seq = car(args); carrier = (is_pair(cdr(args))) ? cadr(args) : NULL; iter = s7_make_iterator(sc, seq); @@ -26797,7 +26946,7 @@ in the sequence each time it is called. When it reaches the end, it returns " I set_mark_seq(iter); } else /* (let-temporarily (((*s7* 'safety) 1)) (make-iterator "asdf" (cons 1 2))) */ - { + { if (sc->safety > MORE_SAFETY_WARNINGS) s7_warn(sc, 256, "(make-iterator %s %s) does not need the second argument\n", DISPLAY_80(seq), DISPLAY_80(carrier)); } @@ -26806,6 +26955,7 @@ in the sequence each time it is called. When it reaches the end, it returns " I return(iter); } + /* -------------------------------- iterate -------------------------------- */ static s7_pointer g_iterate(s7_scheme *sc, s7_pointer args) { @@ -26874,6 +27024,7 @@ static s7_pointer g_iterator_is_at_end(s7_scheme *sc, s7_pointer args) return(sc->T); } + /* -------------------------------- iterator-sequence -------------------------------- */ static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args) { @@ -26895,12 +27046,10 @@ static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args) static int32_t shared_ref(shared_info *ci, s7_pointer p) { - /* from print after collecting refs, not called by equality check */ + /* from print after collecting refs, not called by equality check, only called in object_to_port_with_circle_check_1 */ int32_t i; s7_pointer *objs; - if (!is_collected(p)) return(0); /* PERHAPS: here and below move these out */ - objs = ci->objs; for (i = 0; i < ci->top; i++) if (objs[i] == p) @@ -26937,7 +27086,7 @@ static int32_t peek_shared_ref(shared_info *ci, s7_pointer p) objs = ci->objs; for (i = 0; i < ci->top; i++) - if (objs[i] == p) + if (objs[i] == p) return(ci->refs[i]); return(0); } @@ -26969,6 +27118,7 @@ static void add_shared_ref(shared_info *ci, s7_pointer x, int32_t 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 hash_entry_t *hash_equivalent(s7_scheme *sc, s7_pointer table, s7_pointer key); static bool check_collected(s7_pointer top, shared_info *ci) { @@ -27111,7 +27261,9 @@ static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, hash_entry_t **entries; bool keys_safe; - keys_safe = ((hash_table_checker(top) != hash_equal) && (!hash_table_checker_locked(top))); + keys_safe = ((hash_table_checker(top) != hash_equal) && + (hash_table_checker(top) != hash_equivalent) && + (!hash_table_checker_locked(top))); entries = hash_table_elements(top); len = hash_table_mask(top) + 1; for (i = 0; i < len; i++) @@ -27409,7 +27561,6 @@ static s7_pointer g_cyclic_sequences(s7_scheme *sc, s7_pointer args) return(cyclic_sequences(sc, car(args))); } - static int32_t circular_list_entries(s7_pointer lst) { int32_t i; @@ -27466,12 +27617,9 @@ static void slashify_string_to_port(s7_scheme *sc, s7_pointer port, const char * * 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" - * + * (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" * also it is problematic to use sc->print_length here because * it is normally (say) 8 which truncates just about every string. In CL, *print-length* * does not affect strings, symbols, or bit-vectors. But if the string is enormous, @@ -27782,7 +27930,6 @@ static int32_t multivector_to_port(s7_scheme *sc, s7_pointer vec, s7_pointer por return(flat_ref); } - static void make_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port) { s7_int vlen; @@ -28330,7 +28477,6 @@ static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, port_write_character(port)(sc, ')', port); } - static void string_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ignored) { if ((use_write == P_READABLE) && @@ -28423,7 +28569,7 @@ static void simple_list_readable_display(s7_scheme *sc, s7_pointer lst, s7_int t static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_write_t use_write, shared_info *ci) { - /* we need list_to_starboard... (making port_write_string|character local was noticeable slower) */ + /* we need list_to_starboard... (making port_write_string|character local was noticeably slower) */ s7_pointer x; s7_int i, len, true_len; @@ -28454,31 +28600,21 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri } } - if ((car(lst) == sc->quote_symbol) && + if ((use_write != P_READABLE) && + (car(lst) == sc->quote_symbol) && (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) + * :readable is tricky because the list might be something like (list 'quote (lambda () #f)) which needs to be evalable back to its original */ - if (use_write == P_READABLE) - { - if (is_immutable_pair(lst)) - port_write_string(port)(sc, "(immutable! ", 12, port); - port_write_string(port)(sc, "''", 2, port); - object_to_port_with_circle_check(sc, cadr(lst), port, P_WRITE, ci); - if (is_immutable_pair(lst)) - port_write_character(port)(sc, ')', port); - } - else - { - port_write_character(port)(sc, '\'', port); - object_to_port_with_circle_check(sc, cadr(lst), port, P_WRITE, ci); - } + port_write_character(port)(sc, '\'', port); + object_to_port_with_circle_check(sc, cadr(lst), port, P_WRITE, ci); return; } - else port_write_character(port)(sc, '(', port); + port_write_character(port)(sc, '(', port); if (is_multiple_value(lst)) port_write_string(port)(sc, "values ", 7, port); @@ -28716,8 +28852,8 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, len = hash_table_entries(hash); if (len == 0) { - if ((is_weak_hash_table(hash)) && (use_write == P_READABLE)) - port_write_string(port)(sc, "(make-weak-hash-table)", 22, port); + if (is_weak_hash_table(hash)) + port_write_string(port)(sc, "(weak-hash-table)", 17, port); else port_write_string(port)(sc, "(hash-table)", 12, port); return; } @@ -28773,7 +28909,7 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, int32_t href; href = peek_shared_ref(ci, hash); if (href < 0) href = -href; - + if (is_weak_hash_table(hash)) port_write_string(port)(sc, "(weak-hash-table", 16, port); else port_write_string(port)(sc, "(hash-table", 11, port); /* top level let */ @@ -28835,6 +28971,14 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, s7_pointer key_val; port_write_character(port)(sc, ' ', port); key_val = hash_table_iterate(sc, iterator); +#if S7_DEBUGGING + if (!is_pair(key_val)) + { + fprintf(stderr, "hash entries clobbered\n"); + hash_table_entries(hash) = i; + break; + } +#endif if (use_write != P_READABLE) { if ((is_symbol(car(key_val))) && @@ -28985,7 +29129,7 @@ static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_writ 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 == P_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); @@ -29078,7 +29222,7 @@ static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_writ len = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, -peek_shared_ref(ci, outlet(obj))), ">", NULL); port_write_string(port)(sc, buf, len, port); } - else + else { s7_pointer name; name = s7_let_ref(sc, obj, make_symbol(sc, "class-name")); @@ -29391,7 +29535,10 @@ static void write_closure_readably(s7_scheme *sc, s7_pointer obj, s7_pointer por if (sc->safety > NO_SAFETY) { if (tree_is_cyclic(sc, body)) - s7_error(sc, sc->wrong_type_arg_symbol, wrap_string(sc, "write_closure: body is cyclic", 29)); + { + port_write_string(port)(sc, "#<write_closure: body is cyclic>", 32, port); /* not s7_error here! */ + return; + } /* perhaps: if any sequence in the closure_body is cyclic, complain, but how to check without clobbering ci? * perhaps pass ci, and use make_shared_info if ci=null else continue_shared_info? * this can happen only if (apply lambda ... cyclic-seq ...) I think @@ -29517,9 +29664,9 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj) /* used outside S full_typ = typeflag(obj); /* if debugging all of these bits are being watched, so we need to access them directly */ - snprintf(buf, 1024, "type: %d (%s), opt_op: %d, flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", - typ, + snprintf(buf, 1024, "type: %s? (%d), opt_op: %d, flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", type_name(sc, obj, NO_ARTICLE), + typ, optimize_op(obj), full_typ, /* bit 0 (the first 8 bits are easy...) */ @@ -29630,7 +29777,8 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj) /* used outside S ((full_typ & T_FULL_DEFINER) != 0) ? ((is_symbol(obj)) ? " definer" : ((is_pair(obj)) ? " has-fx" : ((is_slot(obj)) ? " slot-defaults" : - " ?26?"))) : "", + ((is_iterator(obj)) ? " weak-hash-iterator" : + " ?26?")))) : "", /* bit 27+16 */ ((full_typ & T_FULL_BINDER) != 0) ? ((is_pair(obj)) ? " tree-collected" : ((is_hash_table(obj)) ? " simple-values" : @@ -29651,7 +29799,6 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj) /* used outside S " 32?"))) : "", /* bit 33+16 */ ((full_typ & T_FULL_CASE_KEY) != 0) ? " case-key" : "", - ((full_typ & UNUSED_BITS) != 0) ? " unused bits set?" : "", /* bit 54 */ @@ -29679,7 +29826,7 @@ static bool has_odd_bits(s7_pointer obj) if (((full_typ & T_MULTIPLE_VALUE) != 0) && (!is_symbol(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_GLOBAL) != 0) && (!is_pair(obj)) && (!is_symbol(obj)) && (!is_syntax(obj))) return(true); if (((full_typ & T_ITER_OK) != 0) && (!is_iterator(obj))) return(true); - if (((full_typ & T_FULL_DEFINER) != 0) && (!is_symbol(obj)) && (!is_pair(obj)) && (!is_slot(obj))) return(true); + if (((full_typ & T_FULL_DEFINER) != 0) && (!is_symbol(obj)) && (!is_pair(obj)) && (!is_slot(obj)) && (!is_iterator(obj))) return(true); if (((full_typ & T_FULL_SYMCONS) != 0) && (!is_symbol(obj)) && (!is_procedure(obj))) return(true); if (((full_typ & T_LOCAL) != 0) && (!is_symbol(obj))) return(true); if (((full_typ & T_COPY_ARGS) != 0) && (!is_any_macro(obj)) && (!is_any_closure(obj)) && (!is_c_function(obj))) return(true); @@ -29738,9 +29885,9 @@ void s7_show_history(s7_scheme *sc) int32_t i, size; size = sc->history_size; for (i = 0, p = cdr(sc->cur_code); i < size; i++, p = cdr(p)) /* stepper "i" is not redundant */ - fprintf(stderr, "%s\n", DISPLAY_80(car(p))); + fprintf(stderr, "%s\n", DISPLAY(car(p))); #else - fprintf(stderr, "%s\n", DISPLAY_80(sc->cur_code)); + fprintf(stderr, "%s\n", DISPLAY(sc->cur_code)); #endif } @@ -29794,6 +29941,8 @@ static void complain(const char* complaint, s7_pointer p, const char *func, int if (stop_at_error) abort(); } +static char* show_debugger_bits(int64_t bits); + static s7_pointer check_ref(s7_pointer p, uint8_t expected_type, const char *func, int32_t line, const char *func1, const char *func2) { if (!p) @@ -29821,10 +29970,7 @@ static s7_pointer check_ref(s7_pointer p, uint8_t expected_type, const char *fun { 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); } @@ -29860,19 +30006,28 @@ static s7_pointer check_ref2(s7_pointer p, uint8_t expected_type, int32_t other_ static s7_pointer check_ref3(s7_pointer p, const char *func, int32_t line) { - uint8_t typ; - typ = unchecked_type(p); - if ((typ != T_INPUT_PORT) && (typ != T_OUTPUT_PORT) && (typ != T_FREE)) - complain("%s%s[%d]: not a port, but %s (%s)%s\n", p, func, line, typ); + if ((strcmp(func, "process_input_port") != 0) && + (strcmp(func, "process_output_port") != 0) && + (strcmp(func, "close_output_port") != 0)) + { + uint8_t typ; + typ = unchecked_type(p); + if ((typ != T_INPUT_PORT) && (typ != T_OUTPUT_PORT)) + complain("%s%s[%d]: not a port, but %s (%s)%s\n", p, func, line, typ); + } return(p); } static s7_pointer check_ref4(s7_pointer p, const char *func, int32_t line) { - uint8_t typ; - typ = unchecked_type(p); - if ((!t_vector_p[typ]) && (typ != T_FREE)) - complain("%s%s[%d]: not a vector, but %s (%s)%s\n", p, func, line, typ); + if ((strcmp(func, "sweep") != 0) && + (strcmp(func, "process_multivector") != 0)) + { + uint8_t typ; + typ = unchecked_type(p); + if (!t_vector_p[typ]) + complain("%s%s[%d]: not a vector, but %s (%s)%s\n", p, func, line, typ); + } return(p); } @@ -29910,7 +30065,7 @@ static s7_pointer check_ref8(s7_pointer p, const char *func, int32_t line) { uint8_t typ; typ = unchecked_type(p); - if ((!t_sequence_p[typ]) && (!t_structure_p[typ]) && (!is_any_closure(p))) /* closure calling itself an iterator?? */ + if ((!t_sequence_p[typ]) && (!t_structure_p[typ]) && (!is_any_closure(p))) /* closure as iterator -- see s7test */ complain("%s%s[%d]: not a sequence or structure, but %s (%s)%s\n", p, func, line, typ); return(p); } @@ -29937,7 +30092,7 @@ static s7_pointer check_ref11(s7_pointer p, const char *func, int32_t line) { uint8_t typ; typ = unchecked_type(p); - if ((!t_applicable_p[typ]) && (typ != T_BOOLEAN)) + if ((!t_applicable_p[typ]) && (p != cur_sc->F)) complain("%s%s[%d]: applicable object is %s (%s)%s?\n", p, func, line, typ); return(p); } @@ -29945,15 +30100,6 @@ static s7_pointer check_ref11(s7_pointer p, const char *func, int32_t line) static s7_pointer check_ref12(s7_pointer p, const char *func, int32_t line) { uint8_t typ; - typ = unchecked_type(p); - if ((!t_has_closure_let[typ]) && (typ != T_PAIR) && (typ != T_BOOLEAN)) /* #f actually */ - complain("%s%s[%d]: safe-closure is %s (%s)%s?\n", p, func, line, typ); - return(p); -} - -static s7_pointer check_ref14(s7_pointer p, const char *func, int32_t line) -{ - uint8_t typ; if (is_slot_end(p)) return(p); typ = unchecked_type(p); if ((typ != T_SLOT) && (typ != T_NIL)) /* unset slots are nil */ @@ -30319,6 +30465,7 @@ static int32_t opt3_ctr_1(s7_pointer p, int32_t role, const char *func, int32_t static void set_opt3_ctr_1(s7_pointer p, int32_t x, uint32_t role, const char *func, int32_t line) { + clear_type_bit(p, T_LINE_NUMBER); p->object.cons_ext.ce.ctr = x; set_ctr3_is_set(p); base_opt3(p, role, func, line); @@ -30326,7 +30473,8 @@ static void set_opt3_ctr_1(s7_pointer p, int32_t x, uint32_t role, const char *f static void increment_opt3_ctr_1(s7_pointer p, uint32_t role, const char *func, int32_t line) { - if (ctr3_is_set(p)) + clear_type_bit(p, T_LINE_NUMBER); + if (ctr3_is_set(p)) p->object.cons_ext.ce.ctr++; else p->object.cons_ext.ce.ctr = 0; set_ctr3_is_set(p); @@ -30460,8 +30608,15 @@ static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use case T_INT_VECTOR: port_write_string(port)(sc, "(make-iterator #i())", 20, port); break; case T_FLOAT_VECTOR: port_write_string(port)(sc, "(make-iterator #r())", 20, port); break; case T_LET: port_write_string(port)(sc, "(make-iterator (inlet))", 23, port); break; - case T_HASH_TABLE: port_write_string(port)(sc, "(make-iterator (hash-table))", 28, port); break; - default: port_write_string(port)(sc, "(make-iterator ())", 18, port); break; /* c-object?? function? */ + + case T_HASH_TABLE: + if (is_weak_hash_table(iterator_sequence(obj))) + port_write_string(port)(sc, "(make-iterator (weak-hash-table))", 33, port); + else port_write_string(port)(sc, "(make-iterator (hash-table))", 28, port); + break; + + default: + port_write_string(port)(sc, "(make-iterator ())", 18, port); break; /* c-object?? function? */ } } else @@ -30562,7 +30717,9 @@ static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use else { const char *str; - str = type_name(sc, iterator_sequence(obj), NO_ARTICLE); + if ((is_hash_table(iterator_sequence(obj))) && (is_weak_hash_table(iterator_sequence(obj)))) + str = "weak-hash-table"; + else 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); @@ -30571,9 +30728,9 @@ static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use static void baffle_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci) { - int32_t nlen; + int32_t nlen; /* (with-baffle (display (curlet)) (newline)) */ char buf[64]; - nlen = catstrs_direct(buf, "#<baffle: ", pos_int_to_str_direct(sc, baffle_key(obj)), NULL); + nlen = catstrs_direct(buf, "#<baffle: ", pos_int_to_str_direct(sc, baffle_key(obj)), ">", NULL); port_write_string(port)(sc, buf, nlen, port); } @@ -30847,28 +31004,24 @@ static void c_function_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, u } if (c_function_name_length(obj) > 0) port_write_string(port)(sc, c_function_name(obj), c_function_name_length(obj), port); - else port_write_string(port)(sc, "<unnamed c_function>", 20, port); + else port_write_string(port)(sc, "#<unnamed-c-function>", 21, port); } static void c_macro_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci) { if (c_macro_name_length(obj) > 0) port_write_string(port)(sc, c_macro_name(obj), c_macro_name_length(obj), port); - else port_write_string(port)(sc, "<unnamed c_macro>", 17, port); + else port_write_string(port)(sc, "#<unnamed-c-macro>", 18, port); } 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 == P_READABLE) - port_write_string(port)(sc, "continuation", 12, port); - else port_write_string(port)(sc, "#<continuation>", 15, port); + port_write_string(port)(sc, "#<continuation>", 15, port); /* how can a continuation be printed readably? */ } 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 == P_READABLE) - port_write_string(port)(sc, "goto", 4, port); - else port_write_string(port)(sc, "#<goto>", 7, port); + port_write_string(port)(sc, "#<goto>", 7, port); /* same query as above */ } static void catch_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci) @@ -31020,6 +31173,7 @@ static void init_display_functions(void) display_functions[T_LET] = let_to_port; display_functions[T_BOOLEAN] = unique_to_port; display_functions[T_NIL] = unique_to_port; + display_functions[T_UNUSED] = unique_to_port; display_functions[T_UNSPECIFIED] = unique_to_port; display_functions[T_UNDEFINED] = undefined_to_port; display_functions[T_EOF_OBJECT] = eof_to_port; @@ -31067,7 +31221,8 @@ static void init_display_functions(void) static void object_to_port_with_circle_check_1(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info *ci) { int32_t ref; - ref = shared_ref(ci, vr); + + ref = (is_collected(vr)) ? shared_ref(ci, vr) : 0; if (ref != 0) { char buf[32]; @@ -31174,13 +31329,7 @@ static s7_pointer cyclic_out(s7_scheme *sc, s7_pointer obj, s7_pointer port, sha static void object_out_1(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice) { if (sc->object_out_locked) - { - /* if obj has an object->string (or format) method and choice == P_READABLE, #_object->string will be called, calling us. - * if that happens in an ongoing display, we can't step on the current cycle info, but I'm not sure - * it is always ok to simply carry through the outer one. We might need support in cyclic_sequences. - */ - object_to_port_with_circle_check(sc, obj, strport, choice, sc->circle_info); - } + object_to_port_with_circle_check(sc, obj, strport, choice, sc->circle_info); else { shared_info *ci; @@ -31254,7 +31403,6 @@ static void close_format_port(s7_scheme *sc, s7_pointer port) sc->format_ports = port; } - char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj) { char *str; @@ -31320,10 +31468,11 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) use_write_t choice; s7_pointer obj, strport, res; s7_int out_len; - sc->objstr_max_len = s7_int_max; + bool old_openlets; + sc->objstr_max_len = s7_int_max; + old_openlets = sc->has_openlets; obj = car(args); - check_method(sc, obj, sc->object_to_string_symbol, args); if (is_not_null(cdr(args))) { @@ -31339,7 +31488,7 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) if (is_not_null(cddr(args))) { arg = caddr(args); - if (!s7_is_integer(arg)) + if ((!s7_is_integer(arg)) && (choice != P_READABLE)) return(method_or_bust(sc, arg, sc->object_to_string_symbol, args, T_INTEGER, 3)); if (s7_integer(arg) < 0) return(out_of_range(sc, sc->object_to_string_symbol, small_int(3), arg, a_non_negative_integer_string)); @@ -31349,6 +31498,10 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) else choice = P_WRITE; /* can't use s7_object_to_string here anymore because it assumes use_write arg is a boolean */ + if (choice == P_READABLE) + sc->has_openlets = false; + else check_method(sc, obj, sc->object_to_string_symbol, args); + strport = open_format_port(sc); object_out(sc, obj, strport, choice); out_len = port_position(strport); @@ -31362,6 +31515,7 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) { close_format_port(sc, strport); sc->objstr_max_len = s7_int_max; + sc->has_openlets = old_openlets; return(make_string_with_length(sc, "...", 3)); } for (i = out_len - 3; i < out_len; i++) @@ -31373,6 +31527,7 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) res = block_to_string(sc, reallocate(sc, port_data_block(strport), out_len + 1), out_len); else res = block_to_string(sc, port_data_block(strport), out_len); restore_format_port(sc, strport); + sc->has_openlets = old_openlets; return(res); } @@ -31398,10 +31553,10 @@ static s7_pointer g_newline(s7_scheme *sc, s7_pointer args) if (port == sc->F) return(newline_char); if (!is_output_port(port)) return(method_or_bust_with_type_one_arg(sc, port, sc->newline_symbol, args, an_output_port_string)); - /* shouldn't we check for closed output port? */ + if (port_is_closed(port)) + s7_wrong_type_arg_error(sc, "newline", 1, port, "an open output port"); s7_newline(sc, port); - return(newline_char); - /* return(sc->unspecified) until 28-Sep-17, but for example (display c) returns c */ + return(newline_char); /* return(sc->unspecified) until 28-Sep-17, but for example (display c) returns c */ } static s7_pointer newline_p(s7_scheme *sc) @@ -31448,7 +31603,7 @@ 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, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol)) - + check_method(sc, car(args), sc->write_symbol, args); return(write_p_pp(sc, car(args), (is_pair(cdr(args))) ? cadr(args) : sc->output_port)); } @@ -31519,7 +31674,6 @@ static s7_pointer display_p_p(s7_scheme *sc, s7_pointer x) } - /* -------------------------------- call-with-output-string -------------------------------- */ static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args) { @@ -31535,8 +31689,8 @@ static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args) return(method_or_bust_with_type(sc, proc, sc->call_with_output_string_symbol, args, wrap_string(sc, "a procedure of one argument (the port)", 38), 1)); port = s7_open_output_string(sc); - push_stack(sc, OP_UNWIND_OUTPUT, sc->gc_nil, port); /* gc_nil here is a marker (needed) */ - push_stack(sc, OP_GET_OUTPUT_STRING, sc->gc_nil, port); /* args checked in call_with_exit */ + push_stack(sc, OP_UNWIND_OUTPUT, sc->unused, port); /* #<unused> here is a marker (needed) */ + push_stack(sc, OP_GET_OUTPUT_STRING, sc->unused, port); /* args checked in call_with_exit */ push_stack(sc, OP_APPLY, list_1(sc, port), proc); return(sc->F); } @@ -31559,7 +31713,7 @@ static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args) return(method_or_bust_with_type(sc, proc, sc->call_with_output_file_symbol, args, wrap_string(sc, "a procedure of one argument (the port)", 38), 2)); port = s7_open_output_file(sc, string_value(file), "w"); - push_stack(sc, OP_UNWIND_OUTPUT, sc->gc_nil, port); /* gc_nil here is a marker (needed) */ + push_stack(sc, OP_UNWIND_OUTPUT, sc->unused, port); /* #<unused> here is a marker (needed) */ push_stack(sc, OP_APPLY, list_1(sc, port), proc); return(sc->F); } @@ -31581,7 +31735,7 @@ static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args) old_output_port = sc->output_port; sc->output_port = s7_open_output_string(sc); - push_stack(sc, OP_UNWIND_OUTPUT, old_output_port, sc->output_port); + push_stack(sc, OP_UNWIND_OUTPUT, old_output_port, sc->output_port); push_stack(sc, OP_GET_OUTPUT_STRING, old_output_port, sc->output_port); push_stack(sc, OP_APPLY, sc->nil, p); return(sc->F); @@ -31658,13 +31812,10 @@ static void format_append_char(s7_scheme *sc, char c, s7_pointer port) /* 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" + * (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" + * (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" */ } @@ -32177,6 +32328,8 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s (!has_active_methods(sc, obj)) || (!format_method(sc, (char *)(str + i), fdat, port))) { + bool old_openlets; + old_openlets = sc->has_openlets; /* for the column check, we need to know the length of the object->string output */ if (columnized) { @@ -32184,26 +32337,29 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s fdat->strport = strport; } else strport = port; + if (use_write == P_READABLE) + sc->has_openlets = false; object_out(sc, obj, strport, use_write); + if (use_write == P_READABLE) + sc->has_openlets = old_openlets; if (columnized) { if (port_position(strport) >= port_data_size(strport)) resize_port_data(sc, 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 ',': @@ -32596,6 +32752,7 @@ const char *s7_format(s7_scheme *sc, s7_pointer args) #if WITH_SYSTEM_EXTRAS #include <fcntl.h> +/* -------------------------------- directory? -------------------------------- */ 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" @@ -32615,7 +32772,6 @@ static bool is_directory_b_7p(s7_scheme *sc, s7_pointer p) return(is_directory(string_value(p))); } - static bool file_probe(const char *arg) { #if (!MS_WINDOWS) @@ -32629,7 +32785,7 @@ static bool file_probe(const char *arg) #endif } - +/* -------------------------------- file-exists? -------------------------------- */ 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" @@ -32650,7 +32806,7 @@ static bool file_exists_b_7p(s7_scheme *sc, s7_pointer p) return(file_probe(string_value(p))); } - +/* -------------------------------- delete-file -------------------------------- */ static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args) { #define H_delete_file "(delete-file filename) deletes the file filename." @@ -32664,7 +32820,7 @@ static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args) return(make_integer(sc, unlink(string_value(name)))); } - +/* -------------------------------- getenv -------------------------------- */ static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args) { #define H_getenv "(getenv var) returns the value of an environment variable." @@ -32678,7 +32834,7 @@ static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args) return(s7_make_string(sc, getenv(string_value(name)))); } - +/* -------------------------------- system -------------------------------- */ static s7_pointer g_system(s7_scheme *sc, s7_pointer args) { #define H_system "(system command) executes the command. If the optional second argument is #t, \ @@ -32716,7 +32872,6 @@ system captures the output as a string and returns it." cur_len += buf_len; } pclose(fd); -#if 1 if (str) { block_t *b; @@ -32726,14 +32881,6 @@ system captures the output as a string and returns it." return(block_to_string(sc, b, cur_len)); } return(make_empty_string(sc, 0, 0)); -#else - { - s7_pointer res; - res = make_string_with_length(sc, str, cur_len); - if (str) free(str); - return(res); - } -#endif } return(make_integer(sc, system(string_value(name)))); } @@ -32742,6 +32889,7 @@ system captures the output as a string and returns it." #if (!MS_WINDOWS) #include <dirent.h> +/* -------------------------------- directory->list -------------------------------- */ static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args) { s7_pointer name; @@ -32769,6 +32917,7 @@ static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args) return(result); } +/* -------------------------------- file-mtime -------------------------------- */ 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" @@ -32905,7 +33054,6 @@ s7_pointer s7_make_circular_signature(s7_scheme *sc, s7_int cycle_point, s7_int bool s7_is_pair(s7_pointer p) {return(is_pair(p));} static s7_pointer is_pair_p_p(s7_scheme *sc, s7_pointer p) {return((is_pair(p)) ? sc->T : sc->F);} - s7_pointer s7_car(s7_pointer p) {return(car(p));} s7_pointer s7_cdr(s7_pointer p) {return(cdr(p));} @@ -32941,7 +33089,6 @@ 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); @@ -32954,6 +33101,7 @@ s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q) return(q); /* was p? 5-Aug-17 */ } + /* -------------------------------------------------------------------------------- */ s7_pointer s7_apply_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1)) @@ -33187,7 +33335,6 @@ s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args, /* -------------------------------------------------------------------------------- */ - s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, s7_int num) { s7_int i; @@ -33198,7 +33345,6 @@ s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, s7_int num) return(sc->nil); } - s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, s7_int num, s7_pointer val) { s7_int i; @@ -33210,7 +33356,6 @@ s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, s7_int num, s7_pointer val return(val); } - s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst) { s7_pointer x; @@ -33220,7 +33365,6 @@ s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst) return(sc->F); } - static bool symbol_is_in_arg_list(s7_pointer sym, s7_pointer lst) { s7_pointer x; @@ -33232,6 +33376,7 @@ static bool symbol_is_in_arg_list(s7_pointer sym, s7_pointer lst) return(sym == x); } + /* ---------------- tree-leaves ---------------- */ static inline s7_int tree_len_1(s7_scheme *sc, s7_pointer p) { @@ -33291,20 +33436,20 @@ static s7_int tree_leaves_i_7p(s7_scheme *sc, s7_pointer p) return(tree_len(sc, p)); } -static s7_pointer g_tree_leaves(s7_scheme *sc, s7_pointer args) +static s7_pointer tree_leaves_p_p(s7_scheme *sc, s7_pointer tree) { - #define H_tree_leaves "(tree-leaves tree) returns the number of leaves in the tree" - #define Q_tree_leaves s7_make_signature(sc, 2, sc->is_integer_symbol, sc->T) - - s7_pointer tree; - tree = car(args); - if ((sc->safety > NO_SAFETY) && + if ((sc->safety > NO_SAFETY) && /* repeat code to avoid extra call overhead */ (tree_is_cyclic(sc, tree))) s7_error(sc, sc->wrong_type_arg_symbol, wrap_string(sc, "tree-leaves: tree is cyclic", 27)); return(s7_make_integer(sc, tree_len(sc, tree))); } -static s7_pointer tree_leaves_p_p(s7_scheme *sc, s7_pointer tree) {return(s7_make_integer(sc, tree_len(sc, tree)));} +static s7_pointer g_tree_leaves(s7_scheme *sc, s7_pointer args) +{ + #define H_tree_leaves "(tree-leaves tree) returns the number of leaves in the tree" + #define Q_tree_leaves s7_make_signature(sc, 2, sc->is_integer_symbol, sc->T) + return(tree_leaves_p_p(sc, car(args))); +} /* ---------------- tree-memq ---------------- */ @@ -33352,7 +33497,7 @@ static inline bool tree_memq_1(s7_scheme *sc, s7_pointer sym, s7_pointer tree) return(false); } -bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree) +bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree) { if (sym == tree) return(true); if (!is_pair(tree)) return(false); @@ -33370,6 +33515,7 @@ static s7_pointer g_tree_memq(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, s7_tree_memq(sc, car(args), cadr(args)))); } + /* ---------------- tree-set-memq ---------------- */ static inline bool pair_set_memq(s7_scheme *sc, s7_pointer tree) { @@ -33453,6 +33599,7 @@ static s7_pointer tree_set_memq_chooser(s7_scheme *sc, s7_pointer f, int32_t arg return(f); } + /* ---------------- tree-count ---------------- */ static s7_int tree_count(s7_scheme *sc, s7_pointer x, s7_pointer p, s7_int count) { @@ -33661,9 +33808,7 @@ static s7_pointer copy_list_with_arglist_error(s7_scheme *sc, s7_pointer lst) 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. - */ + /* (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)) @@ -33786,22 +33931,13 @@ static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args) static bool is_proper_list_b_7p(s7_scheme *sc, s7_pointer p) {return(s7_is_proper_list(sc, p));} -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); -} - /* -------------------------------- make-list -------------------------------- */ static s7_pointer make_big_list(s7_scheme *sc, int32_t len, s7_pointer init) { s7_pointer result; int32_t i; - + check_heap_size(sc, len); sc->v = sc->nil; for (i = 0; i < len; i++) @@ -34094,9 +34230,6 @@ static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args) /* -------------------------------- cons -------------------------------- */ static s7_pointer g_cons(s7_scheme *sc, s7_pointer args) { - /* n-ary cons could be the equivalent of CL's list*? */ - /* (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) @@ -34659,6 +34792,7 @@ static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args) } +/* -------------------------------- assoc assv assq -------------------------------- */ s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x) { s7_pointer y; @@ -34733,9 +34867,6 @@ static s7_pointer g_assv(s7_scheme *sc, s7_pointer args) /* g_assv is cal return(sc->F); /* not reached */ } - -static s7_pointer fx_c_ss(s7_scheme *sc, s7_pointer arg); -static s7_pointer fx_c_d(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); @@ -35189,7 +35320,6 @@ static s7_pointer g_memv(s7_scheme *sc, s7_pointer args) return(sc->F); /* not reached */ } - static s7_pointer member(s7_scheme *sc, s7_pointer obj, s7_pointer x) { s7_pointer y; @@ -35476,6 +35606,7 @@ static bool member_if(s7_scheme *sc) return(false); } + /* -------------------------------- list -------------------------------- */ static s7_pointer g_list(s7_scheme *sc, s7_pointer args) { @@ -36082,7 +36213,7 @@ static void normal_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj) __ static void float_vector_fill(s7_scheme *sc, s7_pointer vec, s7_double x) { - s7_int len; + s7_int len; len = vector_length(vec); if (len == 0) return; if (x == 0.0) @@ -36233,7 +36364,7 @@ static s7_pointer g_vector_fill_1(s7_scheme *sc, s7_pointer caller, s7_pointer a { s7_pointer p; p = start_and_end(sc, caller, args, 3, &start, &end); - if (p != sc->gc_nil) return(p); + if (p != sc->unused) return(p); if (start == end) return(fill); } if (end == 0) return(fill); @@ -36247,8 +36378,7 @@ static s7_pointer g_vector_fill_1(s7_scheme *sc, s7_pointer caller, s7_pointer a { if ((is_typed_vector(x)) && (c_function_call(typed_vector_typer(x))(sc, set_plist_1(sc, fill)) == sc->F)) - s7_wrong_type_arg_error(sc, "vector fill!", 2, fill, - make_type_name(sc, c_function_name(typed_vector_typer(x)), INDEFINITE_ARTICLE)); + s7_wrong_type_arg_error(sc, "vector fill!", 2, fill, make_type_name(sc, c_function_name(typed_vector_typer(x)), INDEFINITE_ARTICLE)); for (i = start; i < end; i++) vector_element(x, i) = fill; @@ -36302,6 +36432,7 @@ static s7_pointer g_vector_fill_1(s7_scheme *sc, s7_pointer caller, s7_pointer a } #if (!WITH_PURE_S7) +/* -------------------------------- vector-fill! -------------------------------- */ 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" @@ -36379,6 +36510,7 @@ s7_int s7_vector_offsets(s7_pointer vec, s7_int *offs, s7_int offs_size) #if (!WITH_PURE_S7) +/* -------------------------------- vector-append -------------------------------- */ static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, uint8_t typ, s7_pointer caller); static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args) @@ -36520,6 +36652,7 @@ s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect) } #if (!WITH_PURE_S7) +/* -------------------------------- vector->list -------------------------------- */ static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args) { s7_int i, start = 0, end; @@ -36535,7 +36668,7 @@ static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args) if (!is_null(cdr(args))) { p = start_and_end(sc, sc->vector_to_list_symbol, args, 2, &start, &end); - if (p != sc->gc_nil) return(p); + if (p != sc->unused) return(p); if (start == end) return(sc->nil); } if ((end - start) > sc->max_list_length) @@ -36571,6 +36704,7 @@ s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill) return(vect); } + /* -------------------------------- string->byte-vector -------------------------------- */ static s7_pointer g_string_to_byte_vector(s7_scheme *sc, s7_pointer args) { @@ -36587,6 +36721,7 @@ static s7_pointer g_string_to_byte_vector(s7_scheme *sc, s7_pointer args) return(s7_copy_1(sc, sc->string_to_byte_vector_symbol, set_plist_2(sc, str, make_simple_byte_vector(sc, string_length(str))))); } + /* -------------------------------- byte-vector->string -------------------------------- */ static s7_pointer g_byte_vector_to_string(s7_scheme *sc, s7_pointer args) { @@ -36625,6 +36760,7 @@ static s7_pointer g_vector(s7_scheme *sc, s7_pointer args) return(vec); } + /* -------------------------------- float-vector? -------------------------------- */ static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args) { @@ -36633,6 +36769,7 @@ static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, s7_is_float_vector, sc->is_float_vector_symbol, args); } + /* -------------------------------- float-vector -------------------------------- */ static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args) { @@ -36659,7 +36796,7 @@ static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args) { if (s7_is_real(p)) /* bignum is ok here */ float_vector(vec, i) = s7_real(p); - else + else { sc->w = sc->nil; return(method_or_bust(sc, p, sc->float_vector_symbol, copy_list(sc, args), T_REAL, i + 1)); @@ -36688,6 +36825,7 @@ static s7_pointer g_is_int_vector(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, is_int_vector, sc->is_int_vector_symbol, args); } + /* -------------------------------- int-vector -------------------------------- */ static s7_pointer g_int_vector(s7_scheme *sc, s7_pointer args) { @@ -36741,6 +36879,7 @@ static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, s7_is_byte_vector, sc->is_byte_vector_symbol, args); } + /* -------------------------------- byte-vector -------------------------------- */ static s7_pointer g_byte_vector(s7_scheme *sc, s7_pointer args) { @@ -36778,6 +36917,7 @@ static s7_pointer g_byte_vector(s7_scheme *sc, s7_pointer args) return(vec); } + #if (!WITH_PURE_S7) /* -------------------------------- list->vector -------------------------------- */ static s7_pointer g_list_to_vector(s7_scheme *sc, s7_pointer args) @@ -36799,6 +36939,7 @@ static s7_pointer g_list_to_vector(s7_scheme *sc, s7_pointer args) return(p); } +/* -------------------------------- vector-length -------------------------------- */ static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args) { s7_pointer vec; @@ -36821,7 +36962,7 @@ static s7_int vector_length_i_7p(s7_scheme *sc, s7_pointer p) #endif -/* -------------------------------- subvector -------------------------------- */ +/* -------------------------------- subvector subvector? subvector-vector subvector-position -------------------------------- */ static bool s7_is_subvector(s7_pointer g) {return((is_any_vector(g)) && (is_subvector(g)));} @@ -37046,7 +37187,6 @@ a vector that points to the same elements as the original-vector but with differ static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices) { s7_int index = 0; - /* fprintf(stderr, "%s: %s %s\n", __func__, DISPLAY(vect), DISPLAY(indices)); */ if (vector_length(vect) == 0) return(out_of_range(sc, sc->vector_ref_symbol, small_int(1), vect, its_too_large_string)); @@ -37195,9 +37335,9 @@ static s7_pointer g_vector_ref_ic_3(s7_scheme *sc, s7_pointer args) {return(g_ve static inline s7_pointer vector_ref_p_pp(s7_scheme *sc, s7_pointer vec, s7_pointer ind) { s7_int index; - if ((!is_any_vector(vec)) || + if ((!is_any_vector(vec)) || (vector_rank(vec) != 1) || - (!s7_is_integer(ind))) + (!s7_is_integer(ind))) return(g_vector_ref(sc, set_plist_2(sc, vec, ind))); index = s7_integer(ind); if ((index < 0) || (index >= vector_length(vec))) @@ -37245,7 +37385,7 @@ static s7_pointer g_vector_ref_2_direct(s7_scheme *sc, s7_pointer args) vec = car(args); ind = cadr(args); if (!s7_is_integer(ind)) - return(wrong_type_argument(sc, sc->vector_ref_symbol, 2, ind, T_INTEGER)); + return(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)); @@ -37321,7 +37461,7 @@ static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args) } if (is_typed_vector(vec)) - { + { if ((sc->safety < 0) || /* or == 0?? */ (c_function_call(typed_vector_typer(vec))(sc, set_plist_1(sc, val)) != sc->F)) { @@ -37452,7 +37592,7 @@ static s7_pointer g_vector_set_4(s7_scheme *sc, s7_pointer args) v = car(args); ip1 = cadr(args); ip2 = caddr(args); - if ((!is_any_vector(v)) || + if ((!is_any_vector(v)) || (vector_rank(v) != 2) || (is_immutable(v)) || (!s7_is_integer(ip1)) || @@ -37471,19 +37611,20 @@ static s7_pointer g_vector_set_4(s7_scheme *sc, s7_pointer args) return(val); } + /* -------------------------------- make-vector -------------------------------- */ static s7_int multivector_length(s7_scheme *sc, s7_pointer x, s7_pointer caller) { s7_int len, dims; s7_pointer y; - + dims = s7_list_length(sc, x); if (dims <= 0) /* 0 if circular, negative if dotted */ wrong_type_argument_with_type(sc, caller, 1, x, a_proper_list_string); if (dims > sc->max_vector_dimensions) out_of_range(sc, caller, small_int(1), x, its_too_large_string); - + for (len = 1, y = x; is_pair(y); y = cdr(y)) { if (!s7_is_integer(car(y))) @@ -37574,9 +37715,9 @@ static s7_pointer g_make_vector_1(s7_scheme *sc, s7_pointer args, s7_pointer cal s7_pointer sig; if (!c_function_name(typf)) return(wrong_type_argument_with_type(sc, caller, 3, typf, wrap_string(sc, "type procedure must have a name", 31))); - if (!c_function_marker(typf)) + if (!c_function_marker(typf)) c_function_set_marker(typf, mark_vector_1); - if (!c_function_symbol(typf)) + if (!c_function_symbol(typf)) c_function_symbol(typf) = make_symbol(sc, c_function_name(typf)); sig = c_function_signature(typf); if ((sig != sc->pl_bt) && @@ -37656,7 +37797,7 @@ static s7_pointer g_make_float_vector(s7_scheme *sc, s7_pointer args) else init = real_zero; if (s7_is_integer(p)) len = s7_integer(p); - else + else { if (!is_pair(p)) return(method_or_bust_with_type(sc, p, sc->make_float_vector_symbol, args, wrap_string(sc, "an integer or a list of integers", 32), 1)); @@ -37722,7 +37863,7 @@ static s7_pointer g_make_int_vector(s7_scheme *sc, s7_pointer args) else init = small_int(0); if (s7_is_integer(p)) len = s7_integer(p); - else + else { if (!is_pair(p)) return(method_or_bust_with_type(sc, p, sc->make_int_vector_symbol, args, wrap_string(sc, "an integer or a list of integers", 32), 1)); @@ -37898,7 +38039,6 @@ static int32_t traverse_vector_data(s7_scheme *sc, s7_pointer vec, s7_int flat_r return(flat_ref); } - static s7_pointer s7_multivector_error(s7_scheme *sc, const char *message, s7_pointer data) { return(s7_error(sc, sc->read_error_symbol, @@ -37906,7 +38046,6 @@ static s7_pointer s7_multivector_error(s7_scheme *sc, const char *message, s7_po s7_make_string_wrapper(sc, message), data))); } - 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 @@ -38133,7 +38272,6 @@ static s7_pointer univect_ref(s7_scheme *sc, s7_pointer args, s7_pointer caller, return(small_int(byte_vector(v, ind))); } - static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, s7_pointer caller, int32_t typ) { s7_pointer vec, val, index; @@ -38208,6 +38346,7 @@ static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, s7_pointer caller, return(val); } + /* -------------------------------- float-vector-ref -------------------------------- */ static s7_pointer g_float_vector_ref(s7_scheme *sc, s7_pointer args) { @@ -38269,7 +38408,7 @@ static inline s7_int ref_check_index(s7_scheme *sc, s7_pointer v, s7_int i) static s7_double float_vector_ref_d_7pi(s7_scheme *sc, s7_pointer v, s7_int i) {return(float_vector(v, ref_check_index(sc, v, i)));} static s7_pointer float_vector_ref_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i) {return(make_real(sc, float_vector(v, i)));} -static s7_double float_vector_ref_d_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2) +static s7_double float_vector_ref_d_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2) { if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) { @@ -38290,6 +38429,7 @@ static s7_pointer float_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t return(f); } + /* -------------------------------- float-vector-set! -------------------------------- */ static s7_pointer g_float_vector_set(s7_scheme *sc, s7_pointer args) { @@ -38393,7 +38533,7 @@ static s7_int set_check_index(s7_scheme *sc, s7_pointer v, s7_int i) } static s7_double float_vector_set_d_7pid(s7_scheme *sc, s7_pointer v, s7_int i, s7_double x) {float_vector(v, (set_check_index(sc, v, i))) = x; return(x);} -static s7_double float_vector_set_d_7piid(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_double x) +static s7_double float_vector_set_d_7piid(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_double x) { if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) { @@ -38466,7 +38606,7 @@ static inline s7_pointer int_vector_ref_p_pp(s7_scheme *sc, s7_pointer v, s7_poi { s7_int ind; if (!is_int_vector(v)) - return(method_or_bust(sc, v, sc->int_vector_ref_symbol, list_2(sc, v, index), T_INT_VECTOR, 1)); + return(method_or_bust(sc, v, sc->int_vector_ref_symbol, list_2(sc, v, index), T_INT_VECTOR, 1)); if (vector_rank(v) != 1) return(univect_ref(sc, set_plist_2(sc, v, index), sc->int_vector_ref_symbol, T_INT_VECTOR)); if (!s7_is_integer(index)) @@ -38789,7 +38929,8 @@ static void pc_fallback(s7_scheme *sc, int32_t new_pc) sc->pc = new_pc; } -/* -------- sort! -------- */ + +/* -------------------------------- sort! -------------------------------- */ #if (!WITH_GMP) static int32_t dbl_less(const void *f1, const void *f2) @@ -39381,7 +39522,6 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) } } #endif - /* currently we have to make the ordinary vector here even if not sf1 * 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). @@ -39499,7 +39639,6 @@ static s7_pointer g_sort(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) { @@ -40037,12 +40176,12 @@ static hash_entry_t *hash_int(s7_scheme *sc, s7_pointer table, s7_pointer key) { if (is_t_integer(key)) { - s7_int loc, hash_len, kv; + s7_int loc, hash_mask, kv; hash_entry_t *x; - hash_len = hash_table_mask(table); + hash_mask = hash_table_mask(table); kv = integer(key); - loc = kv & hash_len; + loc = kv & hash_mask; for (x = hash_table_element(table, loc); x; x = hash_entry_next(x)) if (integer(hash_entry_key(x)) == kv) return(x); @@ -40055,7 +40194,7 @@ static hash_entry_t *hash_string(s7_scheme *sc, s7_pointer table, s7_pointer key if (is_string(key)) { hash_entry_t *x; - s7_int key_len, hash_len; + s7_int key_len, hash_mask; uint64_t hash; const char *key_str; @@ -40066,17 +40205,17 @@ static hash_entry_t *hash_string(s7_scheme *sc, s7_pointer table, s7_pointer key string_hash(key) = raw_string_hash((const uint8_t *)string_value(key), string_length(key)); hash = string_hash(key); - hash_len = hash_table_mask(table); + hash_mask = hash_table_mask(table); if (key_len <= 8) { - for (x = hash_table_element(table, hash & hash_len); x; x = hash_entry_next(x)) + for (x = hash_table_element(table, hash & hash_mask); x; x = hash_entry_next(x)) if ((hash == string_hash(hash_entry_key(x))) && (key_len == string_length(hash_entry_key(x)))) return(x); } else { - for (x = hash_table_element(table, hash & hash_len); x; x = hash_entry_next(x)) + for (x = hash_table_element(table, hash & hash_mask); x; x = hash_entry_next(x)) if ((hash == string_hash(hash_entry_key(x))) && (key_len == string_length(hash_entry_key(x))) && /* these are scheme strings, so we can't assume 0=end of string */ (strings_are_equal_with_length(key_str, string_value(hash_entry_key(x)), key_len))) @@ -40092,12 +40231,12 @@ static hash_entry_t *hash_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer if (is_string(key)) { hash_entry_t *x; - s7_int hash, hash_len; + s7_int hash, hash_mask; - hash_len = hash_table_mask(table); + hash_mask = hash_table_mask(table); hash = hash_map_ci_string(sc, table, key); - for (x = hash_table_element(table, hash & hash_len); x; x = hash_entry_next(x)) + for (x = hash_table_element(table, hash & hash_mask); x; x = hash_entry_next(x)) if (scheme_strequal_ci(key, hash_entry_key(x))) return(x); } @@ -40109,10 +40248,10 @@ static hash_entry_t *hash_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer ke if (s7_is_character(key)) { hash_entry_t *x; - s7_int hash_len, loc; + s7_int hash_mask, loc; - hash_len = hash_table_mask(table); - loc = hash_loc(sc, table, key) & hash_len; + hash_mask = hash_table_mask(table); + loc = hash_loc(sc, table, key) & hash_mask; for (x = hash_table_element(table, loc); x; x = hash_entry_next(x)) if (upper_character(key) == upper_character(hash_entry_key(x))) @@ -40150,18 +40289,17 @@ static hash_entry_t *hash_float_1(s7_scheme *sc, s7_pointer table, s7_int loc, s return(sc->unentry); } - 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; - s7_int hash_len, loc; + s7_int hash_mask, loc; - hash_len = hash_table_mask(table); + hash_mask = hash_table_mask(table); keyval = real(key); - loc = hash_float_location(keyval) & hash_len; + loc = hash_float_location(keyval) & hash_mask; return(hash_float_1(sc, table, loc, keyval)); } @@ -40259,13 +40397,13 @@ static hash_entry_t *hash_equivalent(s7_scheme *sc, s7_pointer table, s7_pointer static hash_entry_t *hash_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key) { hash_entry_t *x; - s7_int hash_len, hash, loc; + s7_int hash_mask, hash, loc; s7_function f; f = c_function_call(hash_table_procedures_checker(table)); - hash_len = hash_table_mask(table); + hash_mask = hash_table_mask(table); hash = hash_loc(sc, table, key); - loc = hash & hash_len; + loc = hash & hash_mask; set_car(sc->t2_1, key); for (x = hash_table_element(table, loc); x; x = hash_entry_next(x)) @@ -40282,10 +40420,10 @@ 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; - s7_int hash_len, loc; + s7_int hash_mask, loc; - hash_len = hash_table_mask(table); - loc = symbol_hmap(key) & hash_len; /* hash_map_eq */ + hash_mask = hash_table_mask(table); + loc = symbol_hmap(key) & hash_mask; /* hash_map_eq */ for (x = hash_table_element(table, loc); x; x = hash_entry_next(x)) if (key == hash_entry_key(x)) @@ -40297,10 +40435,10 @@ static hash_entry_t *hash_eq(s7_scheme *sc, s7_pointer table, s7_pointer key) static hash_entry_t *hash_eqv(s7_scheme *sc, s7_pointer table, s7_pointer key) { hash_entry_t *x; - s7_int hash_len, loc; + s7_int hash_mask, loc; - hash_len = hash_table_mask(table); - loc = hash_loc(sc, table, key) & hash_len; + hash_mask = hash_table_mask(table); + loc = hash_loc(sc, table, key) & hash_mask; for (x = hash_table_element(table, loc); x; x = hash_entry_next(x)) if (s7_is_eqv(key, hash_entry_key(x))) @@ -40314,10 +40452,10 @@ static hash_entry_t *hash_number(s7_scheme *sc, s7_pointer table, s7_pointer key if (is_number(key)) { hash_entry_t *x; - s7_int hash_len, loc; + s7_int hash_mask, loc; - hash_len = hash_table_mask(table); - loc = hash_loc(sc, table, key) & hash_len; + hash_mask = hash_table_mask(table); + loc = hash_loc(sc, table, key) & hash_mask; #if (!WITH_GMP) for (x = hash_table_element(table, loc); x; x = hash_entry_next(x)) @@ -40363,13 +40501,13 @@ static hash_entry_t *hash_char(s7_scheme *sc, s7_pointer table, s7_pointer key) static hash_entry_t *hash_closure(s7_scheme *sc, s7_pointer table, s7_pointer key) { hash_entry_t *x; - s7_int hash_len, hash, loc; + s7_int hash_mask, hash, loc; s7_pointer f, args, body, old_e; f = hash_table_procedures_checker(table); - hash_len = hash_table_mask(table); + hash_mask = hash_table_mask(table); hash = hash_loc(sc, table, key); - loc = hash & hash_len; + loc = hash & hash_mask; old_e = sc->envir; args = closure_args(f); /* in lambda* case, car/cadr(args) can be lists */ @@ -40428,14 +40566,6 @@ s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size) } els = (block_t *)callocate(sc, size * sizeof(hash_entry_t *)); - if (!els) - return(s7_error(sc, make_symbol(sc, "out-of-memory"), - set_elist_1(sc, wrap_string(sc, "make-hash-table allocation failed!", 34)))); - /* this isn't hit, at least in Linux, even when the size is too large and the block_data will be null. - * perhaps trap for segfault and touch the new block, or check sysinfo/sysconf vs size? - * can we even depend on getting a segfault? - */ - new_cell(sc, table, T_HASH_TABLE | T_SAFE_PROCEDURE); hash_table_mask(table) = size - 1; hash_table_set_block(table, els); @@ -40455,9 +40585,9 @@ static bool compatible_types(s7_scheme *sc, s7_pointer eq_type, s7_pointer value if (eq_type == value_type) return(true); if (eq_type == sc->is_number_symbol) /* only = among built-ins, so otherr cases aren't needed */ - return((value_type == sc->is_integer_symbol) || - (value_type == sc->is_real_symbol) || - (value_type == sc->is_complex_symbol) || + return((value_type == sc->is_integer_symbol) || + (value_type == sc->is_real_symbol) || + (value_type == sc->is_complex_symbol) || (value_type == sc->is_rational_symbol)); return(false); @@ -40521,7 +40651,7 @@ static s7_pointer g_make_hash_table_1(s7_scheme *sc, s7_pointer args, s7_pointer return(wrong_type_argument_with_type(sc, caller, 3, keyp, wrap_string(sc, "key type procedure must have a name", 31))); if (c_function_has_simple_elements(keyp)) set_has_simple_keys(ht); - if (!c_function_symbol(keyp)) + if (!c_function_symbol(keyp)) c_function_symbol(keyp) = make_symbol(sc, c_function_name(keyp)); /* c_function_marker is not currently used in this context */ } @@ -40531,9 +40661,9 @@ static s7_pointer g_make_hash_table_1(s7_scheme *sc, s7_pointer args, s7_pointer return(wrong_type_argument_with_type(sc, caller, 3, valp, wrap_string(sc, "value type procedure must have a name", 31))); if (c_function_has_simple_elements(valp)) set_has_simple_values(ht); - if (!c_function_symbol(valp)) + if (!c_function_symbol(valp)) c_function_symbol(valp) = make_symbol(sc, c_function_name(valp)); - + /* now a consistency check for eq-func and value type */ proc = cadr(args); if (is_c_function(proc)) @@ -40691,6 +40821,8 @@ static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args) return(g_make_hash_table_1(sc, args, sc->make_hash_table_symbol)); } + +/* -------------------------------- make-weak-hash-table -------------------------------- */ static s7_pointer g_make_weak_hash_table(s7_scheme *sc, s7_pointer args) { #define H_make_weak_hash_table "(make-weak-hash-table (size 8) eq-func typers) returns a new weak hash table" @@ -40700,9 +40832,12 @@ static s7_pointer g_make_weak_hash_table(s7_scheme *sc, s7_pointer args) s7_pointer table; table = g_make_hash_table_1(sc, args, sc->make_weak_hash_table_symbol); set_weak_hash_table(table); + weak_hash_iters(table) = 0; return(table); } + +/* -------------------------------- weak-hash-table? -------------------------------- */ static s7_pointer g_is_weak_hash_table(s7_scheme *sc, s7_pointer args) { #define H_is_weak_hash_table "(weak-hash-table? obj) returns #t if obj is a weak hash-table" @@ -40711,7 +40846,6 @@ static s7_pointer g_is_weak_hash_table(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, is_weak_hash, sc->is_weak_hash_table_symbol, args); } - void init_hash_maps(void) { int32_t i; @@ -40803,7 +40937,7 @@ void init_hash_maps(void) static void resize_hash_table(s7_scheme *sc, s7_pointer table) { - s7_int hash_len, loc, i, old_size, new_size; + s7_int hash_mask, loc, i, old_size, new_size; hash_entry_t **new_els, **old_els; block_t *np; s7_pointer dproc; @@ -40813,7 +40947,7 @@ static void resize_hash_table(s7_scheme *sc, s7_pointer table) entries = hash_table_entries(table); old_size = hash_table_mask(table) + 1; new_size = old_size * 4; - hash_len = new_size - 1; + hash_mask = new_size - 1; np = (block_t *)callocate(sc, new_size * sizeof(hash_entry_t *)); new_els = (hash_entry_t **)(block_data(np)); old_els = hash_table_elements(table); @@ -40824,7 +40958,7 @@ static void resize_hash_table(s7_scheme *sc, s7_pointer table) for (x = old_els[i]; x; x = n) { n = hash_entry_next(x); - loc = hash_entry_raw_hash(x) & hash_len; + loc = hash_entry_raw_hash(x) & hash_mask; hash_entry_next(x) = new_els[loc]; new_els[loc] = x; } @@ -40930,13 +41064,11 @@ static bool op_hash_table_a(s7_scheme *sc) static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key, hash_entry_t *p) { hash_entry_t *x; - s7_int hash_len, loc; + s7_int hash_mask, loc; if (p == sc->unentry) return(sc->F); - - hash_len = hash_table_mask(table); - loc = hash_entry_raw_hash(p) & hash_len; - + hash_mask = hash_table_mask(table); + loc = hash_entry_raw_hash(p) & hash_mask; x = hash_table_element(table, loc); if (x == p) hash_table_element(table, loc) = hash_entry_next(x); @@ -40950,7 +41082,6 @@ static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_poi break; } } - hash_table_entries(table)--; if ((hash_table_entries(table) == 0) && (!hash_table_checker_locked(table))) @@ -40962,7 +41093,7 @@ static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_poi return(sc->F); } -static void clear_weak_hash_table(s7_scheme *sc, s7_pointer table) +static void cull_weak_hash_table(s7_scheme *sc, s7_pointer table) { if (hash_table_entries(table) > 0) { @@ -41033,7 +41164,7 @@ static void check_hash_types(s7_scheme *sc, s7_pointer table, s7_pointer key, s7 inline s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value) { - s7_int hash_len, loc; + s7_int hash_mask, loc; hash_entry_t *p, *x; #if S7_DEBUGGING if (is_immutable(table)) fprintf(stderr, "%s[%d]: table immutable\n", __func__, __LINE__); @@ -41052,7 +41183,7 @@ inline s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer return(value); } /* hash_entry_raw_hash(x) can save the hash_loc from the lookup operations, but at some added complexity in - * all the preceding code. This saves about 5% compute time best case in this function. Keep it simple... + * all the preceding code. This saves about 5% compute time best case in this function. */ if (!hash_chosen(table)) @@ -41062,13 +41193,13 @@ inline s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer hash_entry_key(p) = key; hash_entry_set_value(p, T_Pos(value)); hash_entry_set_raw_hash(p, hash_loc(sc, table, key)); - hash_len = hash_table_mask(table); - loc = hash_entry_raw_hash(p) & hash_len; + hash_mask = hash_table_mask(table); + loc = hash_entry_raw_hash(p) & hash_mask; hash_entry_next(p) = hash_table_element(table, loc); hash_table_element(table, loc) = p; hash_table_entries(table)++; - if (hash_table_entries(table) > hash_len) + if (hash_table_entries(table) > hash_mask) resize_hash_table(sc, table); return(value); @@ -41100,15 +41231,15 @@ static s7_pointer hash_table_set_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer static inline s7_pointer hash_table_add(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value) { - s7_int hash, hash_len, loc; + s7_int hash, hash_mask, loc; hash_entry_t *x, *p; if (!hash_chosen(table)) hash_table_set_checker(table, type(key)); /* raw_hash value (hash_loc(sc, table, key)) does not change via hash_table_set_checker etc */ - hash_len = hash_table_mask(table); + hash_mask = hash_table_mask(table); hash = hash_loc(sc, table, key); - loc = hash & hash_len; + loc = hash & hash_mask; for (x = hash_table_element(table, loc); x; x = hash_entry_next(x)) if ((hash_entry_raw_hash(x) == hash) && @@ -41123,7 +41254,7 @@ static inline s7_pointer hash_table_add(s7_scheme *sc, s7_pointer table, s7_poin hash_table_element(table, loc) = p; hash_table_entries(table)++; - if (hash_table_entries(table) > hash_len) + if (hash_table_entries(table) > hash_mask) resize_hash_table(sc, table); return(value); @@ -41169,13 +41300,14 @@ static s7_pointer g_hash_table_2(s7_scheme *sc, s7_pointer args) return(ht); } + /* -------------------------------- weak-hash-table -------------------------------- */ static s7_pointer g_weak_hash_table(s7_scheme *sc, s7_pointer args) { #define H_weak_hash_table "(weak-hash-table ...) returns a weak-hash-table containing the symbol/value pairs passed as its arguments. \ That is, (weak-hash-table 'a 1 'b 2) returns a new weak-hash-table with the two key/value pairs preinstalled." #define Q_weak_hash_table Q_hash_table - + s7_pointer table; table = g_hash_table(sc, args); set_weak_hash_table(table); @@ -41210,7 +41342,7 @@ static void check_old_hash(s7_scheme *sc, s7_pointer old_hash, s7_pointer new_ha static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer new_hash, s7_int start, s7_int end) { - s7_int i, old_len, new_len, count = 0; + s7_int i, old_len, new_mask, count = 0; hash_entry_t **old_lists, **new_lists; hash_entry_t *x, *p; @@ -41222,7 +41354,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer check_old_hash(sc, old_hash, new_hash, start, end); old_len = hash_table_mask(old_hash) + 1; - new_len = hash_table_mask(new_hash); + new_mask = hash_table_mask(new_hash); old_lists = hash_table_elements(old_hash); new_lists = hash_table_elements(new_hash); @@ -41237,7 +41369,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer for (x = old_lists[i]; x; x = hash_entry_next(x)) { s7_int loc; - loc = hash_entry_raw_hash(x) & new_len; + loc = hash_entry_raw_hash(x) & new_mask; p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); hash_entry_next(p) = new_lists[loc]; new_lists[loc] = p; @@ -41256,7 +41388,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer if (count >= start) { s7_int loc; - loc = hash_entry_raw_hash(x) & new_len; + loc = hash_entry_raw_hash(x) & new_mask; p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); hash_entry_next(p) = new_lists[loc]; new_lists[loc] = p; @@ -41282,7 +41414,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer else { s7_int loc; - loc = hash_entry_raw_hash(x) & new_len; + loc = hash_entry_raw_hash(x) & new_mask; p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); hash_entry_next(p) = new_lists[loc]; new_lists[loc] = p; @@ -41363,7 +41495,6 @@ static s7_pointer hash_table_fill(s7_scheme *sc, s7_pointer args) return(val); } - static s7_pointer hash_table_reverse(s7_scheme *sc, s7_pointer old_hash) { s7_int i, len; @@ -41395,7 +41526,6 @@ bool s7_is_function(s7_pointer p) return(is_c_function(p)); } - static s7_pointer fallback_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { return(f); @@ -41504,7 +41634,6 @@ s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function f, return(p); } - s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc, s7_pointer signature) { @@ -41516,12 +41645,12 @@ s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f } +/* -------------------------------- procedure? -------------------------------- */ bool s7_is_procedure(s7_pointer x) { return(is_procedure(x)); } - static s7_pointer g_is_procedure(s7_scheme *sc, s7_pointer args) { #define H_is_procedure "(procedure? obj) returns #t if obj is a procedure" @@ -41537,7 +41666,6 @@ static void s7_function_set_setter(s7_scheme *sc, const char *getter, const char c_function_set_setter(s7_name_to_value(sc, getter), s7_name_to_value(sc, setter)); } - s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p) { if (has_closure_let(p)) @@ -41545,7 +41673,6 @@ s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p) return(sc->nil); } - s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p) { if (has_closure_let(p)) @@ -41553,7 +41680,6 @@ s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p) return(sc->nil); } - s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p) { if (has_closure_let(p)) @@ -41561,6 +41687,7 @@ s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p) return(sc->nil); } +/* -------------------------------- procedure-source -------------------------------- */ static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args) { /* make it look like a scheme-level lambda */ @@ -41586,12 +41713,12 @@ static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args) s7_pointer body; body = closure_body(p); /* perhaps if this function has been removed from the heap, it would be better to use copy_body (as in s7_copy)? */ - if (is_safe_closure(body)) - clear_safe_closure(body); + if (is_safe_closure_body(body)) + clear_safe_closure_body(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)); + closure_args(p)), body)); } if (!is_procedure(p)) @@ -41600,6 +41727,7 @@ static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args) return(sc->nil); } +/* -------------------------------- funclet -------------------------------- */ s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p) { if (has_closure_let(p)) @@ -41688,7 +41816,6 @@ static s7_pointer define_bool_function(s7_scheme *sc, const char *name, s7_funct return(sym); } - s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc, s7_pointer signature) @@ -41702,7 +41829,6 @@ s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_f return(sym); } - s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc) { @@ -41715,10 +41841,10 @@ s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, } +/* -------------------------------- macro? -------------------------------- */ bool s7_is_macro(s7_scheme *sc, s7_pointer x) {return(is_any_macro(x));} static bool is_macro_b(s7_pointer x) {return(is_any_macro(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" @@ -41726,7 +41852,6 @@ static s7_pointer g_is_macro(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, is_any_macro, sc->is_macro_symbol, args); } - static s7_pointer s7_macroexpand(s7_scheme *sc, s7_pointer mac, s7_pointer args) { push_stack(sc, OP_EVAL_DONE, sc->args, sc->code); @@ -41737,7 +41862,6 @@ static s7_pointer s7_macroexpand(s7_scheme *sc, s7_pointer mac, s7_pointer args) return(sc->value); } - s7_pointer s7_make_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc) { s7_pointer func, local_args, p; @@ -41832,7 +41956,15 @@ void s7_define_typed_function_star(s7_scheme *sc, const char *name, s7_function /* -------------------------------- documentation -------------------------------- */ static s7_pointer funclet_entry(s7_scheme *sc, s7_pointer x, s7_pointer sym) { - check_closure_for(sc, x, sym); + if ((has_closure_let(x)) && (is_let(closure_let(x)))) + { + s7_pointer val; + val = symbol_to_local_slot(sc, sym, closure_let(x)); + if ((!is_slot(val)) && (is_let(outlet(closure_let(x))))) + val = symbol_to_local_slot(sc, sym, outlet(closure_let(x))); + if (is_slot(val)) + return(slot_value(val)); + } return(NULL); } @@ -41926,7 +42058,6 @@ const char *s7_help(s7_scheme *sc, s7_pointer obj) return(NULL); } - static s7_pointer g_help(s7_scheme *sc, s7_pointer args) { #define H_help "(help obj) returns obj's documentation" @@ -41950,8 +42081,8 @@ static void init_signatures(s7_scheme *sc) sc->float_vector_signature = s7_make_circular_signature(sc, 2, 3, sc->is_float_symbol, sc->is_float_vector_symbol, sc->is_integer_symbol); sc->int_vector_signature = s7_make_circular_signature(sc, 2, 3, sc->is_integer_symbol, sc->is_int_vector_symbol, sc->is_integer_symbol); sc->c_object_signature = s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_c_object_symbol, sc->T); - sc->let_signature = s7_make_signature(sc, 3, sc->T, sc->is_let_symbol, sc->T); - sc->hash_table_signature = s7_make_signature(sc, 3, sc->T, sc->is_hash_table_symbol, sc->T); /* should this be circular? */ + sc->let_signature = s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_let_symbol, sc->is_symbol_symbol); + sc->hash_table_signature = s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_hash_table_symbol, sc->T); sc->pair_signature = s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_pair_symbol, sc->is_integer_symbol); } @@ -42003,9 +42134,9 @@ static s7_pointer g_signature(s7_scheme *sc, s7_pointer args) case T_HASH_TABLE: if (is_typed_hash_table(p)) - return(list_3(sc, + return(list_3(sc, (is_c_function(hash_table_value_typer(p))) ? c_function_symbol(hash_table_value_typer(p)) : sc->T, - sc->is_hash_table_symbol, + sc->is_hash_table_symbol, (is_c_function(hash_table_key_typer(p)) ? c_function_symbol(hash_table_key_typer(p)) : sc->T))); return(sc->hash_table_signature); @@ -42074,6 +42205,7 @@ static s7_pointer fallback_length(s7_scheme *sc, s7_pointer obj) return(sc->F); } +/* -------------------------------- c-object? -------------------------------- */ bool s7_is_c_object(s7_pointer p) { return(is_c_object(p)); @@ -42090,6 +42222,8 @@ static s7_pointer g_is_c_object(s7_scheme *sc, s7_pointer args) return(apply_boolean_method(sc, obj, sc->is_c_object_symbol)); } + +/* -------------------------------- c-object-type -------------------------------- */ s7_int s7_c_object_type(s7_pointer obj) { if (is_c_object(obj)) @@ -42422,6 +42556,7 @@ static void op_set_dilambda(s7_scheme *sc) sc->value = lookup_checked(sc, sc->value); } + /* -------------------------------- dilambda? -------------------------------- */ bool s7_is_dilambda(s7_pointer obj) { @@ -42452,6 +42587,7 @@ static s7_pointer g_is_dilambda(s7_scheme *sc, s7_pointer args) check_boolean_method(sc, s7_is_dilambda, sc->is_dilambda_symbol, args); } + /* -------------------------------- dilambda -------------------------------- */ static s7_pointer g_dilambda(s7_scheme *sc, s7_pointer args) { @@ -42483,7 +42619,7 @@ static s7_pointer closure_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer return(s7_cons(sc, small_int(0), max_arity)); if (closure_arity_unknown(x)) - closure_arity(x) = s7_list_length(sc, x_args); + closure_set_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)); @@ -42495,11 +42631,11 @@ static void closure_star_arity_1(s7_scheme *sc, s7_pointer x, s7_pointer args) if (closure_arity_unknown(x)) { if (is_null(args)) - closure_arity(x) = 0; + closure_set_arity(x, 0); else { if ((is_symbol(args)) || (allows_other_keys(args))) - closure_arity(x) = -1; + closure_set_arity(x, -1); else { s7_pointer p; @@ -42513,8 +42649,8 @@ static void closure_star_arity_1(s7_scheme *sc, s7_pointer x, s7_pointer args) i++; } if (is_null(p)) - closure_arity(x) = i; - else closure_arity(x) = -1; /* see below */ + closure_set_arity(x, i); + else closure_set_arity(x, -1); /* see below */ } } } @@ -42529,7 +42665,6 @@ static s7_pointer closure_star_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_poi return(s7_cons(sc, small_int(0), s7_make_integer(sc, closure_arity(x)))); } - static int32_t closure_arity_to_int(s7_scheme *sc, s7_pointer x) { /* not lambda* here */ @@ -42539,18 +42674,17 @@ static int32_t closure_arity_to_int(s7_scheme *sc, s7_pointer x) 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; + closure_set_arity(x, i); else { if (i == 0) return(-1); - closure_arity(x) = -i; + closure_set_arity(x, -i); } } return(closure_arity(x)); } - static int32_t closure_star_arity_to_int(s7_scheme *sc, s7_pointer x) { /* not lambda here */ @@ -42558,7 +42692,6 @@ static int32_t closure_star_arity_to_int(s7_scheme *sc, s7_pointer x) return(closure_arity(x)); } - s7_pointer s7_arity(s7_scheme *sc, s7_pointer x) { switch (type(x)) @@ -42626,7 +42759,6 @@ s7_pointer s7_arity(s7_scheme *sc, s7_pointer x) return(sc->F); } - static s7_pointer g_arity(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." @@ -42652,7 +42784,7 @@ static bool closure_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, if (len == CLOSURE_ARITY_NOT_SET) { len = s7_list_length(sc, x_args); - closure_arity(x) = len; + closure_set_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 */ @@ -42752,7 +42884,7 @@ static s7_pointer g_is_aritable(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, s7_is_aritable(sc, car(args), num))); } -static bool is_aritable_b_7pp(s7_scheme *sc, s7_pointer f, s7_pointer i) +static bool is_aritable_b_7pp(s7_scheme *sc, s7_pointer f, s7_pointer i) { return(g_is_aritable(sc, set_plist_2(sc, f, i)) != sc->F); } @@ -42840,9 +42972,6 @@ static s7_pointer b_is_proper_list_setter(s7_scheme *sc, s7_pointer args) car(args), cadr(args), prepackaged_type_names[type(cadr(args))], wrap_string(sc, "a proper list", 13)))); } - -#define SETTER_PRINT 0 - static s7_pointer g_setter(s7_scheme *sc, s7_pointer args) { #define H_setter "(setter obj env) returns the setter associated with obj" @@ -42946,10 +43075,6 @@ static s7_pointer g_setter(s7_scheme *sc, s7_pointer args) { s7_pointer sym, slot; sym = car(args); - -#if SETTER_PRINT - fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sym)); -#endif if (is_keyword(sym)) return(sc->F); @@ -42963,20 +43088,11 @@ static s7_pointer g_setter(s7_scheme *sc, s7_pointer args) slot = symbol_to_slot(sc, sym); sc->envir = old_e; } - -#if SETTER_PRINT - fprintf(stderr, "%s %s %p\n", DISPLAY(sym), DISPLAY(slot), slot); -#endif if (!is_slot(slot)) return(sc->F); if (slot_has_setter(slot)) - { -#if SETTER_PRINT - fprintf(stderr, "symbol(%s)-setter: %s %p\n", DISPLAY(sym), DISPLAY(slot_setter(slot)), slot); -#endif - return(slot_setter(slot)); - } + return(slot_setter(slot)); return(sc->F); } } @@ -42993,9 +43109,6 @@ s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj) static void protect_setter(s7_scheme *sc, s7_pointer sym, s7_pointer acc) { s7_int loc; -#if SETTER_PRINT - fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sym)); -#endif if (sc->protected_setters_size == sc->protected_setters_loc) { s7_int i, new_size, size; @@ -43019,8 +43132,8 @@ static void protect_setter(s7_scheme *sc, s7_pointer sym, s7_pointer acc) for (i = size; i < new_size; i++) { - vector_element(sc->protected_setters, i) = sc->gc_nil; - vector_element(sc->protected_setter_symbols, i) = sc->gc_nil; + vector_element(sc->protected_setters, i) = sc->unused; + vector_element(sc->protected_setter_symbols, i) = sc->unused; } sc->protected_setters_size = new_size; } @@ -43035,22 +43148,15 @@ static s7_pointer g_set_setter(s7_scheme *sc, s7_pointer args) p = car(args); /* should we check that p != setter? - * :(set! (setter <) <) - * < - * :(set! (< 3 2) 3) - * #f - * :(set! (< 1) 2) - * #t - * can this make sense? + * (set! (setter <) <) -> < + * (set! (< 3 2) 3) -> #f + * (set! (< 1) 2) -> #t */ if (is_symbol(p)) { s7_pointer sym, func, slot; sym = p; -#if SETTER_PRINT - fprintf(stderr, "%s: %s ", __func__, DISPLAY(sym)); -#endif if (is_keyword(sym)) return(s7_wrong_type_arg_error(sc, "set! setter", 1, sym, "a normal symbol (a keyword can't be set)")); @@ -43076,27 +43182,18 @@ static s7_pointer g_set_setter(s7_scheme *sc, s7_pointer args) slot = symbol_to_slot(sc, sym); func = cadr(args); } -#if SETTER_PRINT - fprintf(stderr, "%s\n", DISPLAY_80(func)); -#endif - if ((!is_procedure_or_macro(func)) && (func != sc->F)) return(s7_wrong_type_arg_error(sc, "set! setter", 3, func, "a function or #f")); + if (sym == sc->setter_symbol) + return(immutable_object_error(sc, set_elist_2(sc, wrap_string(sc, "can't set (setter setter) to ~S", 31), func))); + if (!is_slot(slot)) - { -#if SETTER_PRINT - fprintf(stderr, " not a slot: %s\n", DISPLAY(slot)); -#endif - return(sc->F); - } + return(sc->F); if (slot == global_slot(sym)) { -#if SETTER_PRINT - fprintf(stderr, " setting global\n"); -#endif s7_set_setter(sc, sym, func); /* special GC protection for global vars */ return(func); } @@ -43132,6 +43229,8 @@ static s7_pointer g_set_setter(s7_scheme *sc, s7_pointer args) case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION: case T_C_FUNCTION_STAR: + if (p == slot_value(global_slot(sc->setter_symbol))) + return(immutable_object_error(sc, set_elist_2(sc, wrap_string(sc, "can't set (setter setter) to ~S", 31), setter))); c_function_set_setter(p, setter); if ((is_any_closure(setter)) || (is_any_macro(setter))) @@ -43199,10 +43298,6 @@ s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter) static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer old_value) { s7_pointer func, new_value; -#if SETTER_PRINT - fprintf(stderr, "%s: %s\n", __func__, DISPLAY(slot_symbol(slot))); -#endif - /* new_value = sc->error_symbol; */ func = slot_setter(slot); if (!is_procedure_or_macro(func)) @@ -43248,9 +43343,6 @@ static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer old_val static s7_pointer bind_symbol_with_setter(s7_scheme *sc, opcode_t op, s7_pointer symbol, s7_pointer new_value) { s7_pointer func; -#if SETTER_PRINT - fprintf(stderr, "%s: %s\n", __func__, DISPLAY(symbol)); -#endif func = g_setter(sc, set_plist_2(sc, symbol, sc->envir)); if (is_procedure_or_macro(func)) { @@ -43279,7 +43371,6 @@ s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook) return(s7_symbol_local_value(sc, sc->body_symbol, closure_let(hook))); } - s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions) { if (is_list(functions)) @@ -43288,7 +43379,7 @@ s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer func } -/* -------------------------------- eq etc -------------------------------- */ +/* -------------------------------- eq? eqv? equal? equivalent? -------------------------------- */ bool s7_is_eq(s7_pointer obj1, s7_pointer obj2) { @@ -43327,7 +43418,6 @@ bool s7_is_eqv(s7_pointer a, s7_pointer b) return(false); } - static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args) { #define H_is_eqv "(eqv? obj1 obj2) returns #t if obj1 is equivalent to obj2" @@ -43452,7 +43542,8 @@ static bool port_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_in (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)))); case FILE_PORT: - return((port_position(x) == port_position(y)) && + return((is_input_port(x)) && + (port_position(x) == port_position(y)) && (local_strncmp((const char *)port_filename(x), (const char *)port_filename(y), port_filename_length(x)))); case FUNCTION_PORT: if (is_input_port(x)) @@ -43631,7 +43722,6 @@ static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_i return(true); } - static bool slots_match(s7_scheme *sc, s7_pointer px, s7_pointer y, shared_info *nci) { s7_pointer ey, py; @@ -43755,7 +43845,6 @@ static bool closure_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared (s7_is_equivalent_1(sc, closure_body(x), closure_body(y), ci))); } - static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci) { shared_info *nci; @@ -44030,8 +44119,7 @@ static bool iterator_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_i return((is_any_vector(y_seq)) && (iterator_position(x) == iterator_position(y)) && (iterator_length(x) == iterator_length(y)) && - ((equivalent) ? (vector_equivalent(sc, x_seq, y_seq, ci)) : - (vector_equal(sc, x_seq, y_seq, ci)))); + ((equivalent) ? (vector_equivalent(sc, x_seq, y_seq, ci)) : (vector_equal(sc, x_seq, y_seq, ci)))); /* iterator_next is a function (pair_iterate, iterator_finished etc) */ case T_PAIR: @@ -44094,10 +44182,8 @@ static bool iterator_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_i return(hash_table_equal(sc, x_seq, y_seq, ci)); return(hash_table_equivalent(sc, x_seq, y_seq, ci)); - /* no equivalent for lets etc?, can t_lets be let_equivalent - * let case: (make-iterator (inlet 'integer? (lambda (f) #f))) - * hash case: (make-iterator (hash-table 'a 1)) - */ + case T_CLOSURE: case T_CLOSURE_STAR: + return(x_seq == y_seq); /* or closure_equal/equivalent? */ default: break; @@ -44212,7 +44298,6 @@ static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *c static bool real_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci) { - /* fprintf(stderr, "%s: %s %s\n", __func__, DISPLAY(x), DISPLAY(y)); */ #if WITH_GMP if (is_big_number(y)) return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F); @@ -44428,7 +44513,6 @@ static s7_pointer g_is_equivalent(s7_scheme *sc, s7_pointer args) static bool is_equal_b_7pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return(s7_is_equal(sc, a, b));} static bool is_equivalent_b_7pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return(s7_is_equivalent(sc, a, b));} - static s7_pointer is_equal_p_pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return((s7_is_equal(sc, a, b)) ? sc->T : sc->F);} static s7_pointer is_equivalent_p_pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return((s7_is_equivalent(sc, a, b)) ? sc->T : sc->F);} @@ -44480,10 +44564,33 @@ static s7_pointer fnc_length(s7_scheme *sc, s7_pointer lst) return(sc->F); } -static s7_pointer io_length(s7_scheme *sc, s7_pointer lst) +static s7_pointer ip_length(s7_scheme *sc, s7_pointer port) { - if (is_string_port(lst)) - return(make_integer(sc, port_data_size(lst))); + if (port_is_closed(port)) + return(sc->F); /* or 0? */ + if (is_string_port(port)) + return(make_integer(sc, port_data_size(port))); /* length of string we're reading */ +#if (!MS_WINDOWS) + if (is_file_port(port)) + { + long cur_pos, len; + cur_pos = ftell(port_file(port)); + fseek(port_file(port), 0, SEEK_END); + len = ftell(port_file(port)); + rewind(port_file(port)); + fseek(port_file(port), cur_pos, SEEK_SET); + return(make_integer(sc, len)); + } +#endif + return(sc->F); +} + +static s7_pointer op_length(s7_scheme *sc, s7_pointer port) +{ + if (port_is_closed(port)) + return(sc->F); /* or 0? */ + if (is_string_port(port)) + return(make_integer(sc, port_position(port))); /* length of string we've written */ return(sc->F); } @@ -44504,7 +44611,8 @@ static void init_length_functions(void) length_functions[T_LET] = lt_length; length_functions[T_CLOSURE] = fnc_length; length_functions[T_CLOSURE_STAR] = fnc_length; - length_functions[T_INPUT_PORT] = io_length; + length_functions[T_INPUT_PORT] = ip_length; + length_functions[T_OUTPUT_PORT] = op_length; } static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst) @@ -44514,17 +44622,13 @@ static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst) 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. \ + #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, input-port, 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->not_symbol), sc->T) return((*length_functions[unchecked_type(car(args))])(sc, car(args))); } -/* what about (length file)? input port, read_file gets the file length, so perhaps save it - * but we're actually looking at the port, so its length is what remains to be read? (if input port) - */ - static s7_pointer length_p_p(s7_scheme *sc, s7_pointer obj) {return((*length_functions[unchecked_type(obj)])(sc, obj));} @@ -44575,7 +44679,7 @@ static s7_pointer let_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer s7_pointer slot; slot = slot_in_let(sc, e, sym); if (is_slot(slot)) - slot_set_value(slot, cdr(val)); + checked_slot_set_value(sc, slot, cdr(val)); else make_slot_1(sc, e, sym, cdr(val)); return(cdr(val)); } @@ -44700,7 +44804,10 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) #endif case T_C_POINTER: - return(s7_make_c_pointer_with_type(sc, c_pointer(source), c_pointer_type(source), c_pointer_info(source))); + dest = s7_make_c_pointer_with_type(sc, c_pointer(source), c_pointer_type(source), c_pointer_info(source)); + c_pointer_weak1(dest) = c_pointer_weak1(source); + c_pointer_weak2(dest) = c_pointer_weak2(source); + return(dest); } return(source); } @@ -44721,10 +44828,10 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) if (dest == sc->key_readable_symbol) /* a kludge, but I can't think of anything less stupid */ { if (have_indices) /* it seems to me that the start/end args here don't make any sense so... */ - return(s7_error(sc, sc->wrong_number_of_args_symbol, + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, wrap_string(sc, "~S: start/end indices make no sense with :readable: ~S", 54), caller, args))); return(copy_body(sc, source)); - } + } end = s7_list_length(sc, source); if (end == 0) end = circular_list_entries(source); @@ -44777,8 +44884,19 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) } else { - for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot)) - make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot)); + if ((has_let_fallback(source)) && + (has_let_fallback(dest))) + { + for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot)) + if ((slot_symbol(slot) != sc->let_ref_fallback_symbol) && + (slot_symbol(slot) != sc->let_set_fallback_symbol)) + make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot)); + } + else + { + for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot)) + make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot)); + } } return(dest); } @@ -44799,7 +44917,7 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) { s7_pointer p; p = start_and_end(sc, caller, args, 3, &start, &end); - if (p != sc->gc_nil) return(p); + if (p != sc->unused) return(p); } if ((start == 0) && (source == dest)) return(dest); @@ -45030,8 +45148,19 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) { 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)); + if ((has_let_fallback(source)) && + (has_let_fallback(dest))) + { + for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot)) + if ((slot_symbol(slot) != sc->let_ref_fallback_symbol) && + (slot_symbol(slot) != sc->let_set_fallback_symbol)) + make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot)); + } + else + { + for (i = start; i < end; i++, slot = next_slot(slot)) + make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot)); + } } else { @@ -45080,13 +45209,29 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) { if (is_let(dest)) { - for (i = start; i < end; i++) + if (has_let_fallback(dest)) { - while (!x) x = elements[++loc]; - if (!is_symbol(hash_entry_key(x))) - return(simple_wrong_type_argument(sc, caller, hash_entry_key(x), T_SYMBOL)); - make_slot_1(sc, dest, hash_entry_key(x), hash_entry_value(x)); - x = hash_entry_next(x); + for (i = start; i < end; i++) + { + while (!x) x = elements[++loc]; + if (!is_symbol(hash_entry_key(x))) + return(simple_wrong_type_argument(sc, caller, hash_entry_key(x), T_SYMBOL)); + if ((hash_entry_key(x) != sc->let_ref_fallback_symbol) && + (hash_entry_key(x) != sc->let_set_fallback_symbol)) + make_slot_1(sc, dest, hash_entry_key(x), hash_entry_value(x)); + x = hash_entry_next(x); + } + } + else + { + for (i = start; i < end; i++) + { + while (!x) x = elements[++loc]; + if (!is_symbol(hash_entry_key(x))) + return(simple_wrong_type_argument(sc, caller, hash_entry_key(x), T_SYMBOL)); + make_slot_1(sc, dest, hash_entry_key(x), hash_entry_value(x)); + x = hash_entry_next(x); + } } } else @@ -45492,7 +45637,7 @@ static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args) #if __linux__ /* need byteswp.h */ /* this code (from StackOverflow) is much faster: */ - if ((len & 0xf) == 0) + if ((len & 0x1f) == 0) { #include <byteswap.h> uint32_t *dst = (uint32_t *)(bytes + len - 4); @@ -45500,8 +45645,7 @@ static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args) while (src < dst) { uint32_t a, b; - a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a); - a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a); + LOOP_4(a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a)); } } else @@ -45608,6 +45752,10 @@ static s7_pointer pair_fill(s7_scheme *sc, s7_pointer args) obj = car(args); if (is_immutable_pair(obj)) return(immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->fill_symbol, obj))); + if (obj == slot_value(global_slot(sc->features_symbol))) + return(s7_error(sc, sc->error_symbol, set_elist_1(sc, wrap_string(sc, "can't fill! *features*", 22)))); + if (obj == slot_value(global_slot(sc->libraries_symbol))) + return(s7_error(sc, sc->error_symbol, set_elist_1(sc, wrap_string(sc, "can't fill! *libraries*", 23)))); val = cadr(args); len = s7_list_length(sc, obj); @@ -45616,7 +45764,7 @@ static s7_pointer pair_fill(s7_scheme *sc, s7_pointer args) if (!is_null(cddr(args))) { p = start_and_end(sc, sc->fill_symbol, args, 3, &start, &end); - if (p != sc->gc_nil) return(p); + if (p != sc->unused) return(p); if (start == end) return(val); } if (len > 0) @@ -45646,7 +45794,6 @@ static s7_pointer pair_fill(s7_scheme *sc, s7_pointer args) return(val); } - s7_pointer s7_fill(s7_scheme *sc, s7_pointer args) { #define H_fill "(fill! obj val (start 0) end) fills obj with val" @@ -45766,7 +45913,7 @@ static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, uint8_t typ, s7_ uint8_t *byte_elements = NULL; s7_int len; - push_stack_no_let_no_code(sc, OP_GC_PROTECT, args); + push_stack_no_let_no_code(sc, OP_GC_PROTECT, args); len = total_sequence_length(sc, args, caller, (typ == T_VECTOR) ? T_FREE : ((typ == T_FLOAT_VECTOR) ? T_REAL : T_INTEGER)); if (len > sc->max_vector_length) return(s7_error(sc, sc->out_of_range_symbol, @@ -46088,7 +46235,440 @@ static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj) return(obj); } -static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int64_t top); +static s7_pointer symbol_to_let(s7_scheme *sc, s7_pointer obj, s7_pointer args) +{ + s7_pointer let; + let = g_local_inlet(sc, 4, sc->value_symbol, obj, + sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol : ((is_gensym(obj)) ? sc->is_gensym_symbol : sc->is_symbol_symbol)); + if (!is_keyword(obj)) + { + s7_pointer val; + if (!sc->current_value_symbol) + sc->current_value_symbol = make_symbol(sc, "current-value"); + val = s7_symbol_value(sc, obj); + s7_varlet(sc, let, sc->current_value_symbol, val); + s7_varlet(sc, let, sc->setter_symbol, g_setter(sc, args)); + s7_varlet(sc, let, sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable_symbol(obj))); + if (!is_undefined(val)) + { + const char *doc; + doc = s7_documentation(sc, obj); + if (doc) + s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc)); + } + } + return(let); +} + +static s7_pointer random_state_to_let(s7_scheme *sc, s7_pointer obj) +{ +#if WITH_GMP + return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol)); +#else + if (!sc->seed_symbol) + { + sc->seed_symbol = make_symbol(sc, "seed"); + sc->carry_symbol = make_symbol(sc, "carry"); + } + return(g_local_inlet(sc, 8, sc->value_symbol, obj, + sc->type_symbol, sc->is_random_state_symbol, + sc->seed_symbol, s7_make_integer(sc, random_seed(obj)), + sc->carry_symbol, s7_make_integer(sc, random_carry(obj)))); +#endif +} + +static s7_pointer vector_to_let(s7_scheme *sc, s7_pointer obj) +{ + s7_pointer let; + if (!sc->dimensions_symbol) + sc->dimensions_symbol = make_symbol(sc, "dimensions"); + if (!sc->position_symbol) + sc->position_symbol = make_symbol(sc, "position"); + let = g_local_inlet(sc, 10, sc->value_symbol, obj, + sc->type_symbol, (is_subvector(obj)) ? cons(sc, sc->is_subvector_symbol, s7_type_of(sc, subvector_vector(obj))) : s7_type_of(sc, obj), + sc->length_symbol, s7_length(sc, obj), + sc->dimensions_symbol, g_vector_dimensions(sc, set_plist_1(sc, obj)), + sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable_vector(obj))); + if (is_subvector(obj)) + { + s7_varlet(sc, let, sc->position_symbol, make_integer(sc, (s7_int)(vector_elements(obj) - vector_elements(subvector_vector(obj))))); + s7_varlet(sc, let, sc->vector_symbol, subvector_vector(obj)); + } + if (is_typed_vector(obj)) + s7_varlet(sc, let, sc->signature_symbol, g_signature(sc, set_plist_1(sc, obj))); + return(let); +} + +static s7_pointer hash_table_to_let(s7_scheme *sc, s7_pointer obj) +{ + s7_pointer let; + if (!sc->entries_symbol) + { + sc->entries_symbol = make_symbol(sc, "entries"); + sc->locked_symbol = make_symbol(sc, "locked"); + sc->weak_symbol = make_symbol(sc, "weak"); + } + if (!sc->function_symbol) + sc->function_symbol = make_symbol(sc, "function"); + let = g_local_inlet(sc, 12, sc->value_symbol, obj, + sc->type_symbol, sc->is_hash_table_symbol, + sc->length_symbol, s7_length(sc, obj), + sc->entries_symbol, s7_make_integer(sc, hash_table_entries(obj)), + sc->locked_symbol, s7_make_boolean(sc, hash_table_checker_locked(obj)), + sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); + if (is_weak_hash_table(obj)) + s7_varlet(sc, let, sc->weak_symbol, sc->T); + 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, sc->function_symbol, sc->is_eq_symbol); + else + { + if (hash_table_checker(obj) == hash_eqv) + s7_varlet(sc, let, sc->function_symbol, sc->is_eqv_symbol); + else + { + if ((hash_table_checker(obj) == hash_equal) || + (hash_table_checker(obj) == hash_empty)) + s7_varlet(sc, let, sc->function_symbol, sc->is_equal_symbol); + else + { + if (hash_table_checker(obj) == hash_equivalent) + s7_varlet(sc, let, sc->function_symbol, sc->is_equivalent_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, sc->function_symbol, sc->eq_symbol); + else + { + if (hash_table_checker(obj) == hash_string) + s7_varlet(sc, let, sc->function_symbol, sc->string_eq_symbol); + else + { + if (hash_table_checker(obj) == hash_char) + s7_varlet(sc, let, sc->function_symbol, sc->char_eq_symbol); +#if (!WITH_PURE_S7) + else + { + if (hash_table_checker(obj) == hash_ci_char) + s7_varlet(sc, let, sc->function_symbol, sc->char_ci_eq_symbol); + else + { + if (hash_table_checker(obj) == hash_ci_string) + s7_varlet(sc, let, sc->function_symbol, sc->string_ci_eq_symbol); + }} +#endif + }}}}}} + if (is_typed_hash_table(obj)) + s7_varlet(sc, let, sc->signature_symbol, g_signature(sc, set_plist_1(sc, obj))); + return(let); +} + +static s7_pointer iterator_to_let(s7_scheme *sc, s7_pointer obj) +{ + s7_pointer let, seq; + if (!sc->at_end_symbol) + { + sc->at_end_symbol = make_symbol(sc, "at-end"); + sc->sequence_symbol = make_symbol(sc, "sequence"); + } + seq = iterator_sequence(obj); + let = g_local_inlet(sc, 8, sc->value_symbol, obj, + sc->type_symbol, sc->is_iterator_symbol, + sc->at_end_symbol, s7_make_boolean(sc, iterator_is_at_end(obj)), + sc->sequence_symbol, 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_any_vector(seq)) || + (seq == sc->rootlet) || + (is_c_object(seq)) || + (is_hash_table(seq))) + s7_varlet(sc, let, make_symbol(sc, "position"), s7_make_integer(sc, iterator_position(obj))); + else + { + if (is_pair(seq)) + s7_varlet(sc, let, make_symbol(sc, "position"), iterator_current(obj)); + } + return(let); +} + +static s7_pointer let_to_let(s7_scheme *sc, s7_pointer obj) +{ + /* how to handle setters? + * (display (let ((e (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (object->let e))): + * "(inlet 'value (inlet 'i 0) 'type let? 'length 1 'open #f 'outlet () 'immutable? #f)" + */ + s7_pointer let; + if (!sc->open_symbol) + { + sc->open_symbol = make_symbol(sc, "open"); + sc->alias_symbol = make_symbol(sc, "alias"); + } + if (!sc->function_symbol) + sc->function_symbol = make_symbol(sc, "function"); + if (!sc->file_symbol) + { + sc->file_symbol = make_symbol(sc, "file"); + sc->line_symbol = make_symbol(sc, "line"); + } + let = g_local_inlet(sc, 12, sc->value_symbol, obj, + sc->type_symbol, sc->is_let_symbol, + sc->length_symbol, s7_length(sc, obj), + sc->open_symbol, s7_make_boolean(sc, has_methods(obj)), + sc->outlet_symbol, (obj == sc->rootlet) ? sc->nil : outlet(obj), + sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); + if (obj == sc->rootlet) + s7_varlet(sc, let, sc->alias_symbol, sc->rootlet_symbol); + else + { + if (obj == sc->owlet) /* this can't happen, I think -- owlet is always copied first */ + s7_varlet(sc, let, sc->alias_symbol, sc->owlet_symbol); + else + { + if (is_funclet(obj)) + { + s7_varlet(sc, let, sc->function_symbol, funclet_function(obj)); + if ((has_let_file(obj)) && + (let_file(obj) <= (s7_int)sc->file_names_top) && + (let_line(obj) > 0) && + (let_line(obj) < 100000)) + { + s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(obj)]); + s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(obj))); + } + } + } + } + if (has_active_methods(sc, obj)) + { + s7_pointer func; + func = find_method(sc, obj, sc->object_to_let_symbol); + if (func != sc->undefined) + { + s7_int gc_loc; + gc_loc = s7_gc_protect_1(sc, let); + s7_apply_function(sc, func, list_2(sc, obj, let)); + s7_gc_unprotect_at(sc, gc_loc); + } + } + return(let); +} + +static s7_pointer c_object_to_let(s7_scheme *sc, s7_pointer obj) +{ + s7_pointer let, clet; + if (!sc->class_symbol) + { + sc->class_symbol = make_symbol(sc, "class"); + sc->c_object_length_symbol = make_symbol(sc, "c-object-length"); + sc->c_object_ref_symbol = make_symbol(sc, "c-object-ref"); + sc->c_object_let_symbol = make_symbol(sc, "c-object-let"); + sc->c_object_set_symbol = make_symbol(sc, "c-object-set!"); + sc->c_object_copy_symbol = make_symbol(sc, "c-object-copy"); + sc->c_object_fill_symbol = make_symbol(sc, "c-object-fill!"); + sc->c_object_reverse_symbol = make_symbol(sc, "c-object-reverse"); + sc->c_object_to_list_symbol = make_symbol(sc, "c-object->list"); + sc->c_object_to_string_symbol = make_symbol(sc, "c-object->string"); + } + clet = c_object_let(obj); + let = g_local_inlet(sc, 10, sc->value_symbol, obj, + sc->type_symbol, sc->is_c_object_symbol, + sc->c_object_type_symbol, s7_make_integer(sc, c_object_type(obj)), + sc->c_object_let_symbol, clet, + sc->class_symbol, c_object_type_to_let(sc, obj)); + + /* not sure these are useful */ + if (c_object_len(sc, obj)) /* c_object_length is the object length, not the procedure */ + s7_varlet(sc, let, sc->c_object_length_symbol, s7_lambda(sc, c_object_len(sc, obj), 1, 0, false)); + if (c_object_ref(sc, obj)) + s7_varlet(sc, let, sc->c_object_ref_symbol, s7_lambda(sc, c_object_ref(sc, obj), 1, 0, true)); + if (c_object_set(sc, obj)) + s7_varlet(sc, let, sc->c_object_set_symbol, s7_lambda(sc, c_object_set(sc, obj), 2, 0, true)); + if (c_object_copy(sc, obj)) + s7_varlet(sc, let, sc->c_object_copy_symbol, s7_lambda(sc, c_object_copy(sc, obj), 1, 0, true)); + if (c_object_fill(sc, obj)) + s7_varlet(sc, let, sc->c_object_fill_symbol, s7_lambda(sc, c_object_fill(sc, obj), 1, 0, true)); + if (c_object_reverse(sc, obj)) + s7_varlet(sc, let, sc->c_object_reverse_symbol, s7_lambda(sc, c_object_reverse(sc, obj), 1, 0, true)); + if (c_object_to_list(sc, obj)) + s7_varlet(sc, let, sc->c_object_to_list_symbol, s7_lambda(sc, c_object_to_list(sc, obj), 1, 0, true)); + if (c_object_to_string(sc, obj)) + s7_varlet(sc, let, sc->c_object_to_string_symbol, s7_lambda(sc, c_object_to_string(sc, obj), 1, 1, false)); + + if ((is_let(clet)) && + ((has_active_methods(sc, clet)) || (has_active_methods(sc, obj)))) + { + s7_pointer func; + func = find_method(sc, clet, sc->object_to_let_symbol); + if (func != sc->undefined) + { + s7_int gc_loc; + gc_loc = s7_gc_protect_1(sc, let); + s7_apply_function(sc, func, list_2(sc, obj, let)); + s7_gc_unprotect_at(sc, gc_loc); + } + } + return(let); +} + +static s7_pointer port_to_let(s7_scheme *sc, s7_pointer obj) +{ + s7_pointer let; + if (!sc->function_symbol) + sc->function_symbol = make_symbol(sc, "function"); + if (!sc->file_symbol) + { + sc->file_symbol = make_symbol(sc, "file"); + sc->line_symbol = make_symbol(sc, "line"); + } + if (!sc->data_symbol) + { + sc->data_symbol = make_symbol(sc, "data"); + sc->port_type_symbol = make_symbol(sc, "port-type"); + sc->closed_symbol = make_symbol(sc, "closed"); + if (!sc->position_symbol) sc->position_symbol = make_symbol(sc, "position"); + } + let = g_local_inlet(sc, 10, sc->value_symbol, obj, + sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol, + sc->port_type_symbol, (is_string_port(obj)) ? sc->string_symbol : ((is_file_port(obj)) ? sc->file_symbol : sc->function_symbol), + sc->closed_symbol, s7_make_boolean(sc, port_is_closed(obj)), + sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable_port(obj))); + push_stack_no_let_no_code(sc, OP_GC_PROTECT, let); + if (is_file_port(obj)) + { + s7_varlet(sc, let, sc->file_symbol, g_port_filename(sc, set_plist_1(sc, obj))); + if (is_input_port(obj)) + s7_varlet(sc, let, sc->line_symbol, g_port_line_number(sc, set_plist_1(sc, obj))); + } + if ((is_string_port(obj)) && /* file port might not have a data buffer */ + (port_data(obj)) && + (port_data_size(obj) > 0)) + { + s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, port_data_size(obj))); + s7_varlet(sc, let, sc->position_symbol, 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. + */ + if (port_position(obj) < sc->max_string_length) + s7_varlet(sc, let, sc->data_symbol, make_string_with_length(sc, (const char *)port_data(obj), port_position(obj))); + } + unstack(sc); + return(let); +} + +static s7_pointer closure_to_let(s7_scheme *sc, s7_pointer obj) +{ + s7_pointer let, sig; + const char* doc; + s7_int gc_loc; + if (!sc->file_symbol) + { + sc->file_symbol = make_symbol(sc, "file"); + sc->line_symbol = make_symbol(sc, "line"); + } + if (!sc->source_symbol) + sc->source_symbol = make_symbol(sc, "source"); + let = g_local_inlet(sc, 8, sc->value_symbol, obj, + sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol, + sc->arity_symbol, s7_arity(sc, obj), + sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); + gc_loc = s7_gc_protect_1(sc, let); + + sig = s7_signature(sc, obj); + if (is_pair(sig)) + s7_varlet(sc, let, sc->local_signature_symbol, sig); + + doc = s7_documentation(sc, obj); + if (doc) + s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc)); + + if (is_let(closure_let(obj))) + { + s7_pointer flet; + flet = closure_let(obj); + if ((has_let_file(flet)) && + (let_file(flet) <= (s7_int)sc->file_names_top) && + (let_line(flet) > 0)) + { + s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(flet)]); + s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(flet))); + } + } + + if (closure_setter(obj) != sc->F) + s7_varlet(sc, let, sc->local_setter_symbol, closure_setter(obj)); + + s7_varlet(sc, let, sc->source_symbol, + 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 s7_pointer c_pointer_to_let(s7_scheme *sc, s7_pointer obj) +{ + /* c_pointer_info can be a let and might have an object->let method (see c_object below) */ + if (!sc->c_type_symbol) + { + sc->c_type_symbol = make_symbol(sc, "c-type"); + sc->info_symbol = make_symbol(sc, "info"); + } + return(g_local_inlet(sc, 10, sc->value_symbol, obj, + sc->type_symbol, sc->is_c_pointer_symbol, + sc->c_pointer_symbol, s7_make_integer(sc, (s7_int)((intptr_t)c_pointer(obj))), + sc->c_type_symbol, c_pointer_type(obj), + sc->info_symbol, c_pointer_info(obj))); +} + +static s7_pointer c_function_to_let(s7_scheme *sc, s7_pointer obj) +{ + s7_pointer let, sig; + const char* doc; + let = g_local_inlet(sc, 8, sc->value_symbol, obj, + sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol, + sc->arity_symbol, s7_arity(sc, obj), + sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); + + sig = c_function_signature(obj); + if (is_pair(sig)) + s7_varlet(sc, let, sc->local_signature_symbol, sig); + + doc = s7_documentation(sc, obj); + if (doc) + s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc)); + + if (c_function_setter(obj) != sc->F) /* c_macro_setter is the same underlying field */ + s7_varlet(sc, let, sc->local_setter_symbol, c_function_setter(obj)); + + return(let); +} + +static s7_pointer goto_to_let(s7_scheme *sc, s7_pointer obj) +{ + if (!sc->active_symbol) + { + sc->active_symbol = make_symbol(sc, "active"); + sc->goto_symbol = make_symbol(sc, "goto?"); + } + return(g_local_inlet(sc, 6, sc->value_symbol, obj, + sc->type_symbol, sc->goto_symbol, + sc->active_symbol, s7_make_boolean(sc, call_exit_active(obj)))); +} static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) { @@ -46123,46 +46703,20 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) case T_CHARACTER: return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_char_symbol)); - case T_INTEGER: - case T_BIG_INTEGER: + case T_INTEGER: case T_BIG_INTEGER: return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_integer_symbol)); - case T_RATIO: - case T_BIG_RATIO: + case T_RATIO: case T_BIG_RATIO: return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_rational_symbol)); - case T_REAL: - case T_BIG_REAL: + case T_REAL: case T_BIG_REAL: return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_real_symbol)); - case T_COMPLEX: - case T_BIG_COMPLEX: + case T_COMPLEX: case T_BIG_COMPLEX: return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_complex_symbol)); case T_SYMBOL: - { - s7_pointer let; - let = g_local_inlet(sc, 4, sc->value_symbol, obj, - sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol : ((is_gensym(obj)) ? sc->is_gensym_symbol : sc->is_symbol_symbol)); - if (!is_keyword(obj)) - { - s7_pointer val; - if (!sc->current_value_symbol) - sc->current_value_symbol = make_symbol(sc, "current-value"); - val = s7_symbol_value(sc, obj); - s7_varlet(sc, let, sc->current_value_symbol, val); - s7_varlet(sc, let, sc->setter_symbol, g_setter(sc, args)); - s7_varlet(sc, let, sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable_symbol(obj))); - if (!is_undefined(val)) - { - const char *doc; - doc = s7_documentation(sc, obj); - if (doc) - s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc)); - } - } - return(let); - } + return(symbol_to_let(sc, obj, args)); case T_STRING: return(g_local_inlet(sc, 8, sc->value_symbol, obj, @@ -46176,425 +46730,41 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) sc->length_symbol, s7_length(sc, obj))); case T_RANDOM_STATE: -#if WITH_GMP - return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol)); -#else - if (!sc->seed_symbol) - { - sc->seed_symbol = make_symbol(sc, "seed"); - sc->carry_symbol = make_symbol(sc, "carry"); - } - return(g_local_inlet(sc, 8, sc->value_symbol, obj, - sc->type_symbol, sc->is_random_state_symbol, - sc->seed_symbol, s7_make_integer(sc, random_seed(obj)), - sc->carry_symbol, s7_make_integer(sc, random_carry(obj)))); -#endif + return(random_state_to_let(sc, obj)); case T_GOTO: - if (!sc->active_symbol) - { - sc->active_symbol = make_symbol(sc, "active"); - sc->goto_symbol = make_symbol(sc, "goto?"); - } - return(g_local_inlet(sc, 6, sc->value_symbol, obj, - sc->type_symbol, sc->goto_symbol, - sc->active_symbol, s7_make_boolean(sc, call_exit_active(obj)))); + return(goto_to_let(sc, obj)); - case T_INT_VECTOR: - case T_FLOAT_VECTOR: - case T_BYTE_VECTOR: - case T_VECTOR: - { - s7_pointer let; - if (!sc->dimensions_symbol) - sc->dimensions_symbol = make_symbol(sc, "dimensions"); - if (!sc->position_symbol) - sc->position_symbol = make_symbol(sc, "position"); - let = g_local_inlet(sc, 10, sc->value_symbol, obj, - sc->type_symbol, (is_subvector(obj)) ? cons(sc, sc->is_subvector_symbol, s7_type_of(sc, subvector_vector(obj))) : s7_type_of(sc, obj), - sc->length_symbol, s7_length(sc, obj), - sc->dimensions_symbol, g_vector_dimensions(sc, set_plist_1(sc, obj)), - sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable_vector(obj))); - if (is_subvector(obj)) - { - s7_varlet(sc, let, sc->position_symbol, make_integer(sc, (s7_int)(vector_elements(obj) - vector_elements(subvector_vector(obj))))); - s7_varlet(sc, let, sc->vector_symbol, subvector_vector(obj)); - } - if (is_typed_vector(obj)) - s7_varlet(sc, let, sc->signature_symbol, g_signature(sc, set_plist_1(sc, obj))); - return(let); - } + case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_BYTE_VECTOR: case T_VECTOR: + return(vector_to_let(sc, obj)); case T_C_POINTER: - /* c_pointer_info can be a let and might have an object->let method (see c_object below) */ - if (!sc->c_type_symbol) - { - sc->c_type_symbol = make_symbol(sc, "c-type"); - sc->info_symbol = make_symbol(sc, "info"); - } - return(g_local_inlet(sc, 10, sc->value_symbol, obj, - sc->type_symbol, sc->is_c_pointer_symbol, - sc->c_pointer_symbol, s7_make_integer(sc, (s7_int)((intptr_t)c_pointer(obj))), - sc->c_type_symbol, c_pointer_type(obj), - sc->info_symbol, c_pointer_info(obj))); + return(c_pointer_to_let(sc, obj)); case T_CONTINUATION: return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_continuation_symbol)); case T_ITERATOR: - { - s7_pointer let, seq; - if (!sc->at_end_symbol) - { - sc->at_end_symbol = make_symbol(sc, "at-end"); - sc->sequence_symbol = make_symbol(sc, "sequence"); - } - seq = iterator_sequence(obj); - let = g_local_inlet(sc, 8, sc->value_symbol, obj, - sc->type_symbol, sc->is_iterator_symbol, - sc->at_end_symbol, s7_make_boolean(sc, iterator_is_at_end(obj)), - sc->sequence_symbol, 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_any_vector(seq)) || - (seq == sc->rootlet) || - (is_c_object(seq)) || - (is_hash_table(seq))) - s7_varlet(sc, let, make_symbol(sc, "position"), s7_make_integer(sc, iterator_position(obj))); - else - { - if (is_pair(seq)) - s7_varlet(sc, let, make_symbol(sc, "position"), iterator_current(obj)); - } - return(let); - } + return(iterator_to_let(sc, obj)); case T_HASH_TABLE: - { - s7_pointer let; - if (!sc->entries_symbol) - { - sc->entries_symbol = make_symbol(sc, "entries"); - sc->locked_symbol = make_symbol(sc, "locked"); - sc->weak_symbol = make_symbol(sc, "weak"); - } - if (!sc->function_symbol) - sc->function_symbol = make_symbol(sc, "function"); - let = g_local_inlet(sc, 12, sc->value_symbol, obj, - sc->type_symbol, sc->is_hash_table_symbol, - sc->length_symbol, s7_length(sc, obj), - sc->entries_symbol, s7_make_integer(sc, hash_table_entries(obj)), - sc->locked_symbol, s7_make_boolean(sc, hash_table_checker_locked(obj)), - sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); - if (is_weak_hash_table(obj)) - s7_varlet(sc, let, sc->weak_symbol, sc->T); - 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, sc->function_symbol, sc->is_eq_symbol); - else - { - if (hash_table_checker(obj) == hash_eqv) - s7_varlet(sc, let, sc->function_symbol, sc->is_eqv_symbol); - else - { - if ((hash_table_checker(obj) == hash_equal) || - (hash_table_checker(obj) == hash_empty)) - s7_varlet(sc, let, sc->function_symbol, sc->is_equal_symbol); - else - { - if (hash_table_checker(obj) == hash_equivalent) - s7_varlet(sc, let, sc->function_symbol, sc->is_equivalent_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, sc->function_symbol, sc->eq_symbol); - else - { - if (hash_table_checker(obj) == hash_string) - s7_varlet(sc, let, sc->function_symbol, sc->string_eq_symbol); - else - { - if (hash_table_checker(obj) == hash_char) - s7_varlet(sc, let, sc->function_symbol, sc->char_eq_symbol); -#if (!WITH_PURE_S7) - else - { - if (hash_table_checker(obj) == hash_ci_char) - s7_varlet(sc, let, sc->function_symbol, sc->char_ci_eq_symbol); - else - { - if (hash_table_checker(obj) == hash_ci_string) - s7_varlet(sc, let, sc->function_symbol, sc->string_ci_eq_symbol); - }} -#endif - }}}}}} - if (is_typed_hash_table(obj)) - s7_varlet(sc, let, sc->signature_symbol, g_signature(sc, set_plist_1(sc, obj))); - return(let); - } + return(hash_table_to_let(sc, obj)); case T_LET: - { - /* how to handle setters? - * (display (let ((e (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (object->let e))): - * "(inlet 'value (inlet 'i 0) 'type let? 'length 1 'open #f 'outlet () 'immutable? #f)" - */ - s7_pointer let; - if (!sc->open_symbol) - { - sc->open_symbol = make_symbol(sc, "open"); - sc->alias_symbol = make_symbol(sc, "alias"); - } - if (!sc->function_symbol) - sc->function_symbol = make_symbol(sc, "function"); - if (!sc->file_symbol) - { - sc->file_symbol = make_symbol(sc, "file"); - sc->line_symbol = make_symbol(sc, "line"); - } - let = g_local_inlet(sc, 12, sc->value_symbol, obj, - sc->type_symbol, sc->is_let_symbol, - sc->length_symbol, s7_length(sc, obj), - sc->open_symbol, s7_make_boolean(sc, has_methods(obj)), - sc->outlet_symbol, (obj == sc->rootlet) ? sc->nil : outlet(obj), - sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); - if (obj == sc->rootlet) - s7_varlet(sc, let, sc->alias_symbol, sc->rootlet_symbol); - else - { - if (obj == sc->owlet) /* this can't happen, I think -- owlet is always copied first */ - s7_varlet(sc, let, sc->alias_symbol, sc->owlet_symbol); - else - { - if (is_funclet(obj)) - { - s7_varlet(sc, let, sc->function_symbol, funclet_function(obj)); - if ((has_let_file(obj)) && - (let_file(obj) <= (s7_int)sc->file_names_top) && - (let_line(obj) > 0) && - (let_line(obj) < 100000)) - { - s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(obj)]); - s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(obj))); - } - } - } - } - if (has_active_methods(sc, obj)) - { - s7_pointer func; - func = find_method(sc, obj, sc->object_to_let_symbol); - if (func != sc->undefined) - { - s7_int gc_loc; - gc_loc = s7_gc_protect_1(sc, let); - s7_apply_function(sc, func, list_2(sc, obj, let)); - s7_gc_unprotect_at(sc, gc_loc); - } - } - return(let); - } + return(let_to_let(sc, obj)); case T_C_OBJECT: - { - s7_pointer let, clet; - if (!sc->class_symbol) - { - sc->class_symbol = make_symbol(sc, "class"); - sc->c_object_length_symbol = make_symbol(sc, "c-object-length"); - sc->c_object_ref_symbol = make_symbol(sc, "c-object-ref"); - sc->c_object_let_symbol = make_symbol(sc, "c-object-let"); - sc->c_object_set_symbol = make_symbol(sc, "c-object-set!"); - sc->c_object_copy_symbol = make_symbol(sc, "c-object-copy"); - sc->c_object_fill_symbol = make_symbol(sc, "c-object-fill!"); - sc->c_object_reverse_symbol = make_symbol(sc, "c-object-reverse"); - sc->c_object_to_list_symbol = make_symbol(sc, "c-object->list"); - sc->c_object_to_string_symbol = make_symbol(sc, "c-object->string"); - } - clet = c_object_let(obj); - let = g_local_inlet(sc, 10, sc->value_symbol, obj, - sc->type_symbol, sc->is_c_object_symbol, - sc->c_object_type_symbol, s7_make_integer(sc, c_object_type(obj)), - sc->c_object_let_symbol, clet, - sc->class_symbol, c_object_type_to_let(sc, obj)); - - /* not sure these are useful */ - if (c_object_len(sc, obj)) /* c_object_length is the object length, not the procedure */ - s7_varlet(sc, let, sc->c_object_length_symbol, s7_lambda(sc, c_object_len(sc, obj), 1, 0, false)); - if (c_object_ref(sc, obj)) - s7_varlet(sc, let, sc->c_object_ref_symbol, s7_lambda(sc, c_object_ref(sc, obj), 1, 0, true)); - if (c_object_set(sc, obj)) - s7_varlet(sc, let, sc->c_object_set_symbol, s7_lambda(sc, c_object_set(sc, obj), 2, 0, true)); - if (c_object_copy(sc, obj)) - s7_varlet(sc, let, sc->c_object_copy_symbol, s7_lambda(sc, c_object_copy(sc, obj), 1, 0, true)); - if (c_object_fill(sc, obj)) - s7_varlet(sc, let, sc->c_object_fill_symbol, s7_lambda(sc, c_object_fill(sc, obj), 1, 0, true)); - if (c_object_reverse(sc, obj)) - s7_varlet(sc, let, sc->c_object_reverse_symbol, s7_lambda(sc, c_object_reverse(sc, obj), 1, 0, true)); - if (c_object_to_list(sc, obj)) - s7_varlet(sc, let, sc->c_object_to_list_symbol, s7_lambda(sc, c_object_to_list(sc, obj), 1, 0, true)); - if (c_object_to_string(sc, obj)) - s7_varlet(sc, let, sc->c_object_to_string_symbol, s7_lambda(sc, c_object_to_string(sc, obj), 1, 1, false)); - - if ((is_let(clet)) && - ((has_active_methods(sc, clet)) || (has_active_methods(sc, obj)))) - { - s7_pointer func; - func = find_method(sc, clet, sc->object_to_let_symbol); - if (func != sc->undefined) - { - s7_int gc_loc; - gc_loc = s7_gc_protect_1(sc, let); - s7_apply_function(sc, func, list_2(sc, obj, let)); - s7_gc_unprotect_at(sc, gc_loc); - } - } - return(let); - } + return(c_object_to_let(sc, obj)); case T_INPUT_PORT: case T_OUTPUT_PORT: - { - s7_pointer let; - if (!sc->function_symbol) - sc->function_symbol = make_symbol(sc, "function"); - if (!sc->file_symbol) - { - sc->file_symbol = make_symbol(sc, "file"); - sc->line_symbol = make_symbol(sc, "line"); - } - if (!sc->data_symbol) - { - sc->data_symbol = make_symbol(sc, "data"); - sc->port_type_symbol = make_symbol(sc, "port-type"); - sc->closed_symbol = make_symbol(sc, "closed"); - if (!sc->position_symbol) sc->position_symbol = make_symbol(sc, "position"); - } - let = g_local_inlet(sc, 10, sc->value_symbol, obj, - sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol, - sc->port_type_symbol, (is_string_port(obj)) ? sc->string_symbol : ((is_file_port(obj)) ? sc->file_symbol : sc->function_symbol), - sc->closed_symbol, s7_make_boolean(sc, port_is_closed(obj)), - sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable_port(obj))); - push_stack_no_let_no_code(sc, OP_GC_PROTECT, let); - if (is_file_port(obj)) - { - s7_varlet(sc, let, sc->file_symbol, g_port_filename(sc, set_plist_1(sc, obj))); - if (is_input_port(obj)) - s7_varlet(sc, let, sc->line_symbol, g_port_line_number(sc, set_plist_1(sc, obj))); - } - if ((is_string_port(obj)) && /* file port might not have a data buffer */ - (port_data(obj)) && - (port_data_size(obj) > 0)) - { - s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, port_data_size(obj))); - s7_varlet(sc, let, sc->position_symbol, 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. - */ - if (port_position(obj) < sc->max_string_length) - s7_varlet(sc, let, sc->data_symbol, make_string_with_length(sc, (const char *)port_data(obj), port_position(obj))); - } - unstack(sc); - return(let); - } + return(port_to_let(sc, 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; - s7_int gc_loc; - if (!sc->file_symbol) - { - sc->file_symbol = make_symbol(sc, "file"); - sc->line_symbol = make_symbol(sc, "line"); - } - if (!sc->source_symbol) - sc->source_symbol = make_symbol(sc, "source"); - let = g_local_inlet(sc, 8, sc->value_symbol, obj, - sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol, - sc->arity_symbol, s7_arity(sc, obj), - sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); - gc_loc = s7_gc_protect_1(sc, let); - - sig = s7_signature(sc, obj); - if (is_pair(sig)) - s7_varlet(sc, let, sc->local_signature_symbol, sig); - - doc = s7_documentation(sc, obj); - if (doc) - s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc)); - - if (is_let(closure_let(obj))) - { - s7_pointer flet; - flet = closure_let(obj); - if ((has_let_file(flet)) && - (let_file(flet) <= (s7_int)sc->file_names_top) && - (let_line(flet) > 0)) - { - s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(flet)]); - s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(flet))); - } - } - - if (closure_setter(obj) != sc->F) - s7_varlet(sc, let, sc->local_setter_symbol, closure_setter(obj)); - - s7_varlet(sc, let, sc->source_symbol, - 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); - } - - 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 = g_local_inlet(sc, 8, sc->value_symbol, obj, - sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol, - sc->arity_symbol, s7_arity(sc, obj), - sc->is_immutable_symbol, s7_make_boolean(sc, is_immutable(obj))); + case T_CLOSURE: case T_CLOSURE_STAR: case T_MACRO: case T_MACRO_STAR: case T_BACRO: case T_BACRO_STAR: + return(closure_to_let(sc, obj)); - sig = c_function_signature(obj); - if (is_pair(sig)) - s7_varlet(sc, let, sc->local_signature_symbol, sig); - - doc = s7_documentation(sc, obj); - if (doc) - s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc)); - - if (c_function_setter(obj) != sc->F) /* c_macro_setter is the same underlying field */ - s7_varlet(sc, let, sc->local_setter_symbol, c_function_setter(obj)); - - return(let); - } + 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: + return(c_function_to_let(sc, obj)); default: return(sc->F); @@ -46678,7 +46848,7 @@ static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e, cha char *objstr, *str; s7_pointer objp; const char *spaces; - s7_int new_note_len, notes_max, cur_line_len = 0, spaces_len; + s7_int new_note_len, notes_max, spaces_len; bool new_notes_line = false, old_short_print; s7_int old_len, objlen; @@ -46717,6 +46887,7 @@ static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e, cha if (notes) { char *last_newline; + s7_int cur_line_len; 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); @@ -47068,6 +47239,7 @@ static const char *type_name_from_type(int32_t typ, int32_t article) { static const char *frees[2] = {"free-cell", "a free cell"}; static const char *nils[2] = {"nil", "nil"}; + static const char *unuseds[2] = {"#<unused>", "the unused object"}; static const char *eofs[2] = {"#<eof>", "the end-of-file object"}; static const char *unspecs[2] = {"#<unspecified>", "the unspecified object"}; static const char *undefs[2] = {"undefined", "an undefined object"}; @@ -47117,6 +47289,7 @@ static const char *type_name_from_type(int32_t typ, int32_t article) { case T_FREE: return(frees[article]); case T_NIL: return(nils[article]); + case T_UNUSED: return(unuseds[article]); case T_EOF_OBJECT: return(eofs[article]); case T_UNSPECIFIED: return(unspecs[article]); case T_UNDEFINED: return(undefs[article]); @@ -47170,7 +47343,6 @@ static const char *type_name_from_type(int32_t typ, int32_t article) return(NULL); } - static const char *type_name(s7_scheme *sc, s7_pointer arg, int32_t article) { switch (unchecked_type(arg)) @@ -47203,7 +47375,6 @@ static const char *type_name(s7_scheme *sc, s7_pointer arg, int32_t article) return("messed up object"); } - static s7_pointer prepackaged_type_name(s7_scheme *sc, s7_pointer x) { s7_pointer p; @@ -47239,7 +47410,6 @@ static s7_pointer type_name_string(s7_scheme *sc, s7_pointer arg) return(s7_make_string_wrapper(sc, type_name(sc, arg, INDEFINITE_ARTICLE))); } - 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) { /* info list is '(format_string caller arg_n arg type_name descr) */ @@ -47248,24 +47418,20 @@ static s7_pointer wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer cal 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); + set_car(p, (typnam == sc->unused) ? 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)); } - static s7_pointer simple_wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer typnam, s7_pointer descr) { - set_wlist_4(cdr(sc->simple_wrong_type_arg_info), caller, arg, (typnam == sc->gc_nil) ? prepackaged_type_name(sc, arg) : typnam, descr); + set_wlist_4(cdr(sc->simple_wrong_type_arg_info), caller, arg, (typnam == sc->unused) ? prepackaged_type_name(sc, arg) : typnam, descr); return(s7_error(sc, sc->wrong_type_arg_symbol, sc->simple_wrong_type_arg_info)); } - s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr) { - /* 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, wrap_string(sc, caller, safe_strlen(caller)), wrap_integer1(sc, arg_n), arg, type_name_string(sc, arg), wrap_string(sc, descr, safe_strlen(descr)))); @@ -47273,27 +47439,20 @@ s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, s7_int arg type_name_string(sc, arg), wrap_string(sc, descr, safe_strlen(descr)))); } - static s7_pointer out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer descr) { - /* info list is '(format_string caller arg_n arg descr) */ set_wlist_4(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 s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr) { set_wlist_3(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)); } - s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr) { - /* info list is '(format_string caller arg_n arg descr) */ - if (arg_n < 0) arg_n = 0; - if (arg_n > 0) return(out_of_range_error_prepackaged(sc, wrap_string(sc, caller, safe_strlen(caller)), wrap_integer1(sc, arg_n), arg, wrap_string(sc, descr, safe_strlen(descr)))); @@ -47301,19 +47460,16 @@ s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, s7_int arg_n arg, wrap_string(sc, descr, safe_strlen(descr)))); } - 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, s7_make_string_wrapper(sc, caller), args))); /* "caller" includes the format directives */ } - 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, wrap_string(sc, "~A: division by zero, ~S", 24), caller, arg))); } - static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *descr, const char *name) { return(s7_error(sc, sc->io_error_symbol, @@ -47324,6 +47480,7 @@ static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *desc } +/* -------------------------------- dynamic-wind -------------------------------- */ static s7_pointer closure_or_f(s7_scheme *sc, s7_pointer p) { s7_pointer body; @@ -47346,7 +47503,6 @@ static s7_pointer make_baffled_closure(s7_scheme *sc, s7_pointer inp) return(nclo); } -/* -------------------------------- dynamic-wind -------------------------------- */ static bool is_dwind_thunk(s7_scheme *sc, s7_pointer x) { switch (type(x)) @@ -47390,13 +47546,10 @@ each a function of no arguments, guaranteeing that finish is called even if body (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. - * + * 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. */ - 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); @@ -47427,7 +47580,6 @@ each a function of no arguments, guaranteeing that finish is called even if body return(sc->F); } - s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish) { /* this is essentially s7_call with a dynamic-wind wrapper around "body" */ @@ -47475,6 +47627,7 @@ s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_p return(sc->value); } + /* -------------------------------- catch -------------------------------- */ static s7_pointer g_catch(s7_scheme *sc, s7_pointer args) { @@ -47510,7 +47663,7 @@ static s7_pointer g_catch(s7_scheme *sc, s7_pointer args) if (!is_applicable(err)) return(wrong_type_argument_with_type(sc, sc->catch_symbol, 3, err, something_applicable_string)); - /* should we check here for (aritable? err 2)? -- right now: + /* should we check here for (aritable? err 2)? * (catch #t (lambda () 1) "hiho") -> 1 * currently this is checked only if the error handler is called */ @@ -47603,8 +47756,6 @@ It has the additional local variables: error-type, error-data, error-code, error s7_pointer e, x; s7_int gc_loc; - /* try_to_call_gc(sc); */ - /* since error-data et al can be set at any time, and owlet can be called at any time, these fields * can be free cells (or anything) without that representing an error. So, before copying, we need * to check that all cells (that will be copied) look ok. @@ -47839,8 +47990,7 @@ static bool catch_1_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointe /* 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. + * 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) @@ -47931,7 +48081,7 @@ static bool catch_1_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointe closure_set_args(p, car(error_func)); closure_set_body(p, cdr(error_func)); closure_set_setter(p, sc->F); - closure_arity(p) = CLOSURE_ARITY_NOT_SET; + closure_set_arity(p, CLOSURE_ARITY_NOT_SET); closure_set_let(p, sc->temp4); sc->code = p; } @@ -47941,8 +48091,7 @@ static bool catch_1_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointe /* 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! + * when this apply tries to call the handler. So, we need a special case error check here! */ if (!s7_is_aritable(sc, sc->code, 2)) @@ -47982,8 +48131,8 @@ static bool catch_out_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_poin 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 #<gc-nil> */ - if (x != sc->gc_nil) + x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #<unused> */ + if (x != sc->unused) sc->output_port = x; return(false); } @@ -48022,10 +48171,6 @@ static bool catch_barrier_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_ static bool catch_hook_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointer info, bool *reset_hook) { sc->error_hook = stack_code(sc->stack, i); -#if S7_DEBUGGING - if (!s7_is_valid(sc, sc->error_hook)) - fprintf(stderr, "%s[%d]: error_hook bad\n", __func__, __LINE__); -#endif /* 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*! */ @@ -48067,6 +48212,7 @@ static void init_catchers(void) catchers[OP_ERROR_HOOK_QUIT] = catch_hook_function; } +/* -------------------------------- throw -------------------------------- */ static s7_pointer g_throw(s7_scheme *sc, s7_pointer args) { #define H_throw "(throw tag . info) is like (error ...) but it does not affect the owlet. \ @@ -48098,7 +48244,6 @@ It looks for an existing catch with a matching tag, and jumps to it if found. O set_elist_3(sc, wrap_string(sc, "no catch found for (throw ~W~{~^ ~S~})", 38), type, info))); } - static void s7_warn(s7_scheme *sc, s7_int len, const char *ctrl, ...) /* len = max size of output string (for vsnprintf) */ { if (sc->error_port != sc->F) @@ -48150,7 +48295,8 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) */ sc->format_depth = -1; sc->gc_off = false; /* this is in case we were triggered from the sort function -- clumsy! */ - sc->object_out_locked = false; /* poosible error in obj->str method after object_out has set this flag */ + sc->object_out_locked = false; /* possible error in obj->str method after object_out has set this flag */ + sc->has_openlets = true; /* same problem -- we need a cleaner way to handle this */ if (sc->current_safe_list > 0) { @@ -48327,8 +48473,6 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) { const char *call_name; call_name = sc->s7_call_name; - - /* sc->s7_call_name = NULL; */ if (call_name) { sc->s7_call_name = NULL; @@ -48392,7 +48536,6 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) return(type); } - static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args) { /* the operator type is needed here else the error message is confusing: @@ -48407,7 +48550,6 @@ static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args) type_name_string(sc, obj), obj, args, current_code(sc)))); } - static s7_pointer read_error_1(s7_scheme *sc, const char *errmsg, bool string_error) { /* reader errors happen before the evaluator gets involved, so forms such as: @@ -48522,7 +48664,6 @@ static s7_pointer string_read_error(s7_scheme *sc, const char *errmsg) return(read_error_1(sc, errmsg, true)); } - static s7_pointer g_error(s7_scheme *sc, s7_pointer args) { #define H_error "(error type ...) signals an error. The 'type' can be used with catch to trap \ @@ -48542,7 +48683,6 @@ and applies it to the rest of the arguments." return(s7_error(sc, sc->nil, sc->nil)); } - static char *truncate_string(char *form, s7_int len, use_write_t use_write) { uint8_t *f; @@ -48605,7 +48745,6 @@ static s7_pointer object_to_truncated_string(s7_scheme *sc, s7_pointer p, s7_int return(strp); } - static s7_pointer tree_descend(s7_scheme *sc, s7_pointer p, uint32_t line) { s7_pointer tp; @@ -48731,7 +48870,6 @@ static s7_pointer missing_close_paren_error(s7_scheme *sc) return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "missing close paren", 19)))); } - static void improper_arglist_error(s7_scheme *sc) { /* sc->code is the last (dotted) arg, sc->args is the arglist reversed not including sc->code @@ -48747,7 +48885,6 @@ static void improper_arglist_error(s7_scheme *sc) /* -------------------------------- leftovers -------------------------------- */ - void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val) { return(sc->begin_hook); @@ -48801,6 +48938,8 @@ static bool call_begin_hook(s7_scheme *sc) return(false); } + +/* -------------------------------- apply -------------------------------- */ static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d) { s7_pointer p, q; @@ -48818,7 +48957,6 @@ static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d) return(q); } - static s7_pointer apply_list_error(s7_scheme *sc, s7_pointer lst) { return(s7_error(sc, sc->wrong_type_arg_symbol, @@ -48880,14 +49018,13 @@ s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args) { s7_pointer p; int32_t argnum; - T_Pos(fnc); + T_App(fnc); for (argnum = 0, p = T_Pos(args); is_pair(p); argnum++, p = T_Pos(cdr(p))) T_Pos(car(p)); } #endif set_current_code(sc, history_cons(sc, fnc, args)); - if (is_c_function(fnc)) return(c_function_call(fnc)(sc, args)); @@ -48911,12 +49048,8 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic * ((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) + * 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) * maybe it should be (((lambda (arg) arg) "hi") 0) -> #\h * * implicit_index applies to non-homogeneous cases, so float|int-vectors don't get here @@ -49170,7 +49303,7 @@ s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args return(sc->value); } - +/* -------------------------------- eval -------------------------------- */ s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e) { declare_jump_info(); @@ -49266,10 +49399,10 @@ s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args) #endif if (is_c_function(func)) - return(c_function_call(func)(sc, T_Pos(args))); /* no check for wrong-number-of-args -- is that reasonable? */ + return(c_function_call(func)(sc, args)); /* no check for wrong-number-of-args -- is that reasonable? */ - sc->temp1 = T_Pos(func); /* this is feeble GC protection */ - sc->temp2 = T_Pos(args); + sc->temp1 = T_App(func); /* this is feeble GC protection */ + sc->temp2 = T_Lst(args); store_jump_info(sc); set_jump_info(sc, S7_CALL_SET_JUMP); @@ -49294,9 +49427,7 @@ s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args) 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. - */ + /* 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); } @@ -49310,9 +49441,7 @@ s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args sc->s7_call_file = file; sc->s7_call_line = line; } - result = s7_call(sc, func, args); - if (caller) { sc->s7_call_name = NULL; @@ -49399,18 +49528,17 @@ static s7_pointer g_type_of(s7_scheme *sc, s7_pointer args) /* -------------------------------- 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 sc->pcl_s - return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE)); } static s7_pointer s7_version_p(s7_scheme *sc) {return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE));} +/* -------------------------------- exit emergency-exit -------------------------------- */ void s7_quit(s7_scheme *sc) { sc->longjmp_ok = false; @@ -49419,7 +49547,6 @@ void s7_quit(s7_scheme *sc) push_stack_op_let(sc, OP_EVAL_DONE); } -/* -------------------------------- exit -------------------------------- */ static s7_pointer g_emergency_exit(s7_scheme *sc, s7_pointer args) { #define H_emergency_exit "(emergency-exit obj) exits s7 immediately" @@ -49455,6 +49582,7 @@ static s7_pointer g_exit(s7_scheme *sc, s7_pointer args) static s7_pointer g_abort(s7_scheme *sc, s7_pointer args) {abort();} #endif + /* -------------------------------- optimizer stuff -------------------------------- */ static s7_function fx_function[OPT_MAX_DEFINED]; @@ -49534,31 +49662,37 @@ static int32_t fx_count(s7_scheme *sc, s7_pointer x) return(count); } - -/* arg here is the full expression */ -static s7_pointer fx_c(s7_scheme *sc, s7_pointer arg) {return(arg);} -static s7_pointer fx_q(s7_scheme *sc, s7_pointer arg) {return(cadr(arg));} -static s7_pointer fx_unsafe_s(s7_scheme *sc, s7_pointer arg){return(lookup_checked(sc, arg));} -static s7_pointer fx_s(s7_scheme *sc, s7_pointer arg) {return(lookup(sc, arg));} -static s7_pointer fx_c_d(s7_scheme *sc, s7_pointer arg) {return(d_call(sc, arg));} -static s7_pointer fx_not_c_d(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, d_call(sc, cadr(arg)))));} - #if S7_DEBUGGING static void check_let_slots(s7_scheme *sc, const char* func, s7_pointer expr, s7_pointer var) { if (let_slots(sc->envir) != symbol_to_slot(sc, var)) - fprintf(stderr, "%s %s is out of date\n", func, DISPLAY(expr)); + { + fprintf(stderr, "%s %s is out of date\n", func, DISPLAY(expr)); + if (stop_at_error) abort(); + } } + static void check_next_let_slot(s7_scheme *sc, const char* func, s7_pointer expr, s7_pointer var) { if (next_slot(let_slots(sc->envir)) != symbol_to_slot(sc, var)) - fprintf(stderr, "%s %s is out of date\n", func, DISPLAY(expr)); + { + fprintf(stderr, "%s %s is out of date (%s in %s)\n", func, DISPLAY(expr), DISPLAY(var), DISPLAY(sc->envir)); + if (stop_at_error) abort(); + } } #else #define check_let_slots(Sc, Func, Expr, Var) #define check_next_let_slot(Sc, Func, Expr, Var) #endif +/* arg here is the full expression */ +static s7_pointer fx_c(s7_scheme *sc, s7_pointer arg) {return(arg);} +static s7_pointer fx_q(s7_scheme *sc, s7_pointer arg) {return(cadr(arg));} +static s7_pointer fx_unsafe_s(s7_scheme *sc, s7_pointer arg){return(lookup_checked(sc, arg));} +static s7_pointer fx_s(s7_scheme *sc, s7_pointer arg) {return(lookup(sc, arg));} +static s7_pointer fx_c_d(s7_scheme *sc, s7_pointer arg) {return(d_call(sc, arg));} +static s7_pointer fx_not_c_d(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, d_call(sc, cadr(arg)))));} + #if (!WITH_GMP) static s7_pointer fx_c_equal_s_ic_1(s7_scheme *sc, s7_pointer args, s7_pointer val, s7_int y) { @@ -49590,8 +49724,21 @@ static s7_pointer fx_c_equal_t_ic(s7_scheme *sc, s7_pointer arg) s7_int y; s7_pointer val, args; args = cdr(arg); - val = slot_value(let_slots(sc->envir)); check_let_slots(sc, __func__, arg, cadr(arg)); + val = slot_value(let_slots(sc->envir)); + y = integer(cadr(args)); + if (is_t_integer(val)) + return(make_boolean(sc, integer(val) == y)); + return(fx_c_equal_s_ic_1(sc, args, val, y)); +} + +static s7_pointer fx_c_equal_u_ic(s7_scheme *sc, s7_pointer arg) +{ + s7_int y; + s7_pointer val, args; + args = cdr(arg); + check_next_let_slot(sc, __func__, arg, cadr(arg)); + val = slot_value(next_slot(let_slots(sc->envir))); y = integer(cadr(args)); if (is_t_integer(val)) return(make_boolean(sc, integer(val) == y)); @@ -49615,18 +49762,26 @@ static s7_pointer fx_c_add_t1(s7_scheme *sc, s7_pointer arg) /* sub_t1 was not u check_let_slots(sc, __func__, arg, cadr(arg)); if (is_t_integer(x)) return(make_integer(sc, integer(x) + 1)); - return(add_p_pp(sc, x, small_int(1))); + return(g_add_s1_1(sc, x, cdr(arg))); } static s7_pointer fx_c_add_u1(s7_scheme *sc, s7_pointer arg) { s7_pointer x; - x = slot_value(next_slot(let_slots(sc->envir))); check_next_let_slot(sc, __func__, arg, cadr(arg)); + x = slot_value(next_slot(let_slots(sc->envir))); if (is_t_integer(x)) return(make_integer(sc, integer(x) + 1)); - return(add_p_pp(sc, x, small_int(1))); + return(g_add_s1_1(sc, x, cdr(arg))); +} + +#if (!WITH_GMP) +static s7_pointer fx_c_add_tf(s7_scheme *sc, s7_pointer arg) +{ + check_let_slots(sc, __func__, arg, cadr(arg)); + return(g_add_sfs(sc, slot_value(let_slots(sc->envir)), real(caddr(arg)))); } +#endif static s7_pointer fx_c_sub_s1(s7_scheme *sc, s7_pointer arg) { @@ -49637,6 +49792,16 @@ static s7_pointer fx_c_sub_s1(s7_scheme *sc, s7_pointer arg) return(minus_c1(sc, x)); } +static s7_pointer fx_c_sub_t1(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer x; + check_let_slots(sc, __func__, arg, cadr(arg)); + x = slot_value(let_slots(sc->envir)); + if (is_t_integer(x)) + return(make_integer(sc, integer(x) - 1)); + return(minus_c1(sc, x)); +} + static s7_pointer fx_c_add_si(s7_scheme *sc, s7_pointer arg) { s7_pointer x; @@ -49646,6 +49811,16 @@ static s7_pointer fx_c_add_si(s7_scheme *sc, s7_pointer arg) return(add_p_pp(sc, x, caddr(arg))); } +static s7_pointer fx_c_add_ti(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer x; + check_let_slots(sc, __func__, arg, cadr(arg)); + x = slot_value(let_slots(sc->envir)); + if (is_t_integer(x)) + return(make_integer(sc, integer(x) + integer(caddr(arg)))); + return(add_p_pp(sc, x, caddr(arg))); +} + static s7_pointer fx_c_sub_si(s7_scheme *sc, s7_pointer arg) { s7_pointer x; @@ -49799,11 +49974,23 @@ static s7_pointer fx_is_symbol_s(s7_scheme *sc, s7_pointer arg) return((is_symbol(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } +static s7_pointer fx_is_symbol_t(s7_scheme *sc, s7_pointer arg) +{ + check_let_slots(sc, __func__, arg, cadr(arg)); + return((is_symbol(slot_value(let_slots(sc->envir)))) ? sc->T : sc->F); +} + static s7_pointer fx_is_type_s(s7_scheme *sc, s7_pointer arg) { return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(lookup(sc, cadr(arg))))); } +static s7_pointer fx_is_type_t(s7_scheme *sc, s7_pointer arg) +{ + check_let_slots(sc, __func__, arg, cadr(arg)); + return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(slot_value(let_slots(sc->envir))))); +} + static s7_pointer fx_is_integer_s(s7_scheme *sc, s7_pointer arg) { #if WITH_GMP @@ -49828,6 +50015,12 @@ static s7_pointer fx_is_pair_s(s7_scheme *sc, s7_pointer arg) return((is_pair(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } +static s7_pointer fx_is_pair_t(s7_scheme *sc, s7_pointer arg) +{ + check_let_slots(sc, __func__, arg, cadr(arg)); + return((is_pair(slot_value(let_slots(sc->envir)))) ? sc->T : sc->F); +} + static s7_pointer fx_is_keyword_s(s7_scheme *sc, s7_pointer arg) { return((is_keyword(lookup(sc, cadr(arg)))) ? sc->T : sc->F); @@ -49848,6 +50041,12 @@ static s7_pointer fx_not_s(s7_scheme *sc, s7_pointer arg) return(make_boolean(sc, is_false(sc, lookup(sc, cadr(arg))))); } +static s7_pointer fx_not_t(s7_scheme *sc, s7_pointer arg) +{ + check_let_slots(sc, __func__, arg, cadr(arg)); + return(make_boolean(sc, is_false(sc, slot_value(let_slots(sc->envir))))); +} + static s7_pointer fx_not_is_pair_s(s7_scheme *sc, s7_pointer arg) { return((is_pair(lookup(sc, opt3_sym(arg)))) ? sc->F : sc->T); @@ -50177,7 +50376,7 @@ static s7_pointer fx_c_weak1_type(s7_scheme *sc, s7_pointer arg) val = lookup(sc, opt2_sym(cdr(arg))); if (is_c_pointer(val)) /* (let? (c-pointer-weak1 val)) etc */ return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(c_pointer_weak1(val)))); - return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(c_pointer_weak1_p_p(sc, val)))); + return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(c_pointer_weak1_p_p(sc, val)))); } static s7_pointer fx_not_opsq(s7_scheme *sc, s7_pointer arg) @@ -50212,7 +50411,7 @@ static s7_pointer fx_c_opstq(s7_scheme *sc, s7_pointer arg) static s7_pointer fx_c_opstq_direct(s7_scheme *sc, s7_pointer arg) { - return(((s7_p_p_t)opt2_direct_x_call(cdr(arg)))(sc, + return(((s7_p_p_t)opt2_direct_x_call(cdr(arg)))(sc, ((s7_p_pp_t)opt3_direct_x(cdr(arg)))(sc, lookup(sc, cadadr(arg)), slot_value(let_slots(sc->envir))))); } @@ -50283,7 +50482,7 @@ static s7_pointer fx_c_opssq_s_direct(s7_scheme *sc, s7_pointer arg) { s7_pointer largs; largs = cadr(arg); - return(((s7_p_pp_t)opt2_direct_x_call(cdr(arg)))(sc, + return(((s7_p_pp_t)opt2_direct_x_call(cdr(arg)))(sc, ((s7_p_pp_t)opt3_direct_x(cdr(arg)))(sc, lookup(sc, cadr(largs)), lookup(sc, opt2_sym(cdr(largs)))), lookup(sc, caddr(arg)))); } @@ -50372,7 +50571,7 @@ static s7_pointer fx_c_s_opssq_direct(s7_scheme *sc, s7_pointer arg) { s7_pointer largs; largs = caddr(arg); - return(((s7_p_pp_t)opt2_direct_x_call(cdr(arg)))(sc, lookup(sc, cadr(arg)), + return(((s7_p_pp_t)opt2_direct_x_call(cdr(arg)))(sc, lookup(sc, cadr(arg)), ((s7_p_pp_t)opt3_direct_x(cdr(arg)))(sc, lookup(sc, cadr(largs)), lookup(sc, opt2_sym(cdr(largs)))))); } @@ -51460,10 +51659,6 @@ static s7_function fx_choose(s7_scheme *sc, s7_pointer holder, s7_pointer e, saf set_opt3_direct_x(cdr(arg), (s7_pointer)(s7_p_pp_function(slot_value(global_slot(caaddr(arg)))))); return(fx_c_s_opssq_direct); } -#if 0 - else fprintf(stderr, "%s: %p %p\n", DISPLAY(arg), - s7_p_pp_function(slot_value(global_slot(car(arg)))), s7_p_pp_function(slot_value(global_slot(caaddr(arg))))); -#endif return(fx_c_s_opssq); case HOP_SAFE_C_opSSq_S: @@ -51554,7 +51749,7 @@ static s7_function fx_choose(s7_scheme *sc, s7_pointer holder, s7_pointer e, saf case HOP_SAFE_C_opAAq: if (aa_is_fx_safe(cadr(arg))) return(fx_c_opaaq); return(NULL); - + case HOP_SAFE_C_FX: if (is_fx_safe(sc, arg)) return(fx_c_fx); return(NULL); @@ -51577,8 +51772,7 @@ static s7_function fx_choose(s7_scheme *sc, s7_pointer holder, s7_pointer e, saf return(fx_closure_s_d); } } - /* let_a_a never happens in an fx context */ - + default: /* if ((!fx_function[optimize_op(arg)]) && (is_h_optimized(arg))) fprintf(stderr, "fx_choose %s %s\n", DISPLAY(arg), op_names[optimize_op(arg)]); */ return(fx_function[optimize_op(arg)]); @@ -51607,16 +51801,16 @@ static s7_function fx_choose(s7_scheme *sc, s7_pointer holder, s7_pointer e, saf /* -------------------------------------------------------------------------------- */ -enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_7pi, o_d_7pii, o_d_7piid, +enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_7pi, o_d_7pii, o_d_7piid, o_d_ip, o_d_pd, o_d_7pid, o_d, o_d_d, o_d_dd, o_d_7dd, o_d_ddd, o_d_dddd, o_i_i, o_i_7i, o_i_ii, o_i_7ii, o_i_iii, o_i_7pi, o_i_7pii, o_i_7piii, o_d_p, o_b_p, o_b_p_direct, o_b_7p, o_b_pp, o_b_7pp, o_b_pp_direct, o_b_pi, o_b_ii, o_b_dd, o_p, o_p_p, o_p_ii, o_p_d, o_p_dd, o_i_7d, o_i_7p, o_d_7d, o_d_7p, - o_p_pp, o_p_pp_direct, o_p_ppp, o_p_ppp_direct, o_p_pi, o_p_pi_direct, + 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_i, o_p_pii, o_p_pip, o_p_pip_direct, o_p_piip, o_b_i, o_b_d}; #if S7_DEBUGGING -static const char *o_names[] = {"o_d_v", "o_d_vd", "o_d_vdd", "o_d_vid", "o_d_id", "o_d_7pi", "o_d_7pii", "o_d_7piid", +static const char *o_names[] = {"o_d_v", "o_d_vd", "o_d_vdd", "o_d_vid", "o_d_id", "o_d_7pi", "o_d_7pii", "o_d_7piid", "o_d_ip", "o_d_pd", "o_d_7pid", "o_d", "o_d_d", "o_d_dd", "o_d_7dd", "o_d_ddd", "o_d_dddd", "o_i_i", "o_i_7i", "o_i_ii", "o_i_7ii", "o_i_iii", "o_i_7pi", "o_i_7pii", "o_i_7_piii", "o_d_p", "o_b_p", "o_b_p_direct", "o_b_7p", "o_b_pp", "o_b_7pp", "o_b_pp_direct", "o_b_pi", "o_b_ii", "o_b_dd", @@ -51652,7 +51846,7 @@ static void add_opt_func(s7_pointer f, int32_t typ, void *func) c_function_opt_data(f) = op; } #if S7_DEBUGGING - else + else { fprintf(stderr, "%s[%d]: 'f' is not a c_function\n", __func__, __LINE__); if (stop_at_error) abort(); @@ -51856,28 +52050,29 @@ static void s7_set_p_dd_function(s7_pointer f, s7_p_dd_t df) {add_opt_func(f, o_ static s7_p_dd_t s7_p_dd_function(s7_pointer f) {return((s7_p_dd_t)opt_func(f, o_p_dd));} enum {OO_P, OO_I, OO_D, OO_V, OO_IV, OO_FV, OO_PV, OO_R, OO_H, OO_S, OO_BV, OO_L, OO_E, OO_AV, OO_TV}; -#if OPT_INFO_DEBUGGING - static const char *oo_types[15] = {"OO_P", "OO_I", "OO_D", "OO_V", "OO_IV", "OO_FV", "OO_PV", "OO_R", "OO_H", "OO_S", "OO_BV", "OO_L", "OO_E", "OO_AV", "OO_TV"}; -#endif #define oo_slots(p) p->slots #define oo_size(p) p->size #if S7_DEBUGGING +#if OPT_INFO_DEBUGGING + static const char *oo_types[15] = {"OO_P", "OO_I", "OO_D", "OO_V", "OO_IV", "OO_FV", "OO_PV", "OO_R", "OO_H", "OO_S", "OO_BV", "OO_L", "OO_E", "OO_AV", "OO_TV"}; +#endif + #define oo_func(p) p->func #define oo_line(p) p->line static const s7_int oo_to_s7[15] = {-1, 1LL << T_INTEGER, 1LL << T_REAL, 1LL << T_C_OBJECT, 1LL << T_INT_VECTOR, 1LL << T_FLOAT_VECTOR, 1LL << T_VECTOR, (1LL << T_REAL) + (1LL << T_RATIO) + (1LL << T_INTEGER), 1LL << T_HASH_TABLE, 1LL << T_STRING, 1LL << T_BYTE_VECTOR, 1LL << T_PAIR, 1LL << T_LET, - (1LL << T_VECTOR) + (1LL << T_INT_VECTOR) + (1LL << T_FLOAT_VECTOR) + (1LL << T_BYTE_VECTOR), + (1LL << T_VECTOR) + (1LL << T_INT_VECTOR) + (1LL << T_FLOAT_VECTOR) + (1LL << T_BYTE_VECTOR), 1LL << T_VECTOR}; static bool check_slot_type(s7_scheme *sc, s7_pointer slot, opt_info *o, int32_t i, const char *func, int line) { s7_pointer val; uint8_t recorded_val_type; - + recorded_val_type = o->types[i] & 0xf; if (recorded_val_type == OO_P) return(true); val = slot_value(slot); @@ -52518,7 +52713,7 @@ static bool i_7pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer ((!is_int_vector(slot_value(slot))) || (vector_rank(slot_value(slot)) > 1))) return(return_false(sc, car_x, __func__, __LINE__)); - + opc->v[3].i_7pi_f = pfunc; p = opt_integer_symbol(sc, arg2); if (p) @@ -53278,7 +53473,6 @@ static bool i_7pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointe static bool i_7piii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { s7_i_7piii_t f; - /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(car_x)); */ f = s7_i_7piii_function(s_func); if ((f) && (is_symbol(cadr(car_x)))) @@ -53600,7 +53794,7 @@ static bool i_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) } return(return_false(sc, car_x, __func__, __LINE__)); } - + if ((int_optimize(sc, cdr(car_x))) && (int_optimize(sc, cddr(car_x)))) { @@ -53930,7 +54124,7 @@ static bool d_7pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer pc_fallback(sc, start); return(return_false(sc, car_x, __func__, __LINE__)); } - + if ((car(car_x) == sc->float_vector_ref_symbol) && ((!is_float_vector(cadr(car_x))) || (vector_rank(cadr(car_x)) > 1))) /* (float-vector-ref #r2d((.1 .2) (.3 .4)) 3) */ @@ -54546,7 +54740,7 @@ static bool d_dd_fs_combinable(s7_scheme *sc, opt_info *opc, s7_d_dd_t func) opc->v[4].d_dd_f = opc->v[3].d_dd_f; /* need room for 3 symbols */ opc->v[0].fd = opt_d_dd_fso; } - else + else { opc->v[4].d_7dd_f = opc->v[3].d_7dd_f; opc->v[0].fd = opt_d_7dd_fso; @@ -55010,7 +55204,7 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if (d_dd_ff_combinable(sc, start)) return(true); opc->v[0].fd = opt_d_dd_ff; - if (func == multiply_d_dd) + if (func == multiply_d_dd) opc->v[0].fd = opt_d_dd_ff_mul; else { @@ -55625,7 +55819,6 @@ static bool d_7pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointe static bool d_7piid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { s7_d_7piid_t f; - /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(car_x)); */ f = s7_d_7piid_function(s_func); if ((f) && (is_symbol(cadr(car_x)))) @@ -55918,7 +56111,6 @@ static s7_double opt_set_d_d_fm(void *p) static bool d_syntax_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) { - /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(car_x)); */ if ((len == 3) && (car(car_x) == sc->set_symbol)) { @@ -57011,7 +57203,7 @@ static bool opt_b_or_and(s7_scheme *sc, s7_pointer car_x, int32_t len, int32_t i if (o1->v[0].fb == opt_b_dd_ss) opc->v[3].b_dd_f = o1->v[3].b_dd_f; else if (o1->v[0].fb == opt_b_pp_ss) opc->v[3].b_pp_f = o1->v[3].b_pp_f; else if ((o1->v[0].fb == opt_b_7pp_ss) || (o1->v[0].fb == opt_lt_b_7pp_ss)) opc->v[3].b_7pp_f = o1->v[3].b_7pp_f; else - opc->v[3].b_ii_f = o1->v[3].b_ii_f; + opc->v[3].b_ii_f = o1->v[3].b_ii_f; #else opc->v[3].p = o1->v[3].p; /* this works only in the union vunion case (it's actually supposed to be b_dd_f etc) */ #endif @@ -57199,7 +57391,6 @@ static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c { s7_p_p_t ppf; int32_t start; - /* fprintf(stderr, "%s %s\n", __func__, DISPLAY(car_x)); */ start = sc->pc; if (is_t_integer(cadr(car_x))) { @@ -57597,22 +57788,22 @@ static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if (denominator(slot_value(slot1)) <= vector_length(obj)) opc->v[3].p_pi_f = vector_ref_unchecked; return(oo_set_type_2(opc, 4, 1, 2, OO_PV, OO_I)); - + case T_INT_VECTOR: if (denominator(slot_value(slot1)) <= vector_length(obj)) opc->v[3].p_pi_f = int_vector_ref_unchecked_p; return(oo_set_type_2(opc, 4, 1, 2, OO_IV, OO_I)); - + case T_FLOAT_VECTOR: if (denominator(slot_value(slot1)) <= vector_length(obj)) opc->v[3].p_pi_f = float_vector_ref_unchecked_p; return(oo_set_type_2(opc, 4, 1, 2, OO_FV, OO_I)); - + case T_STRING: if (denominator(slot_value(slot1)) <= string_length(obj)) opc->v[3].p_pi_f = string_ref_unchecked; return(oo_set_type_2(opc, 4, 1, 2, OO_S, OO_I)); - + case T_BYTE_VECTOR: if (denominator(slot_value(slot1)) <= string_length(obj)) opc->v[3].p_pi_f = byte_vector_ref_unchecked_p; @@ -58098,7 +58289,7 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (is_pair(cdr(sig))) && (is_symbol(cadr(sig)))) checker = cadr(sig); - + /* here we know cadr is a symbol */ slot1 = symbol_to_slot(sc, cadr(car_x)); if ((!is_slot(slot1)) || @@ -58123,7 +58314,7 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer case T_HASH_TABLE: op2 = OO_H; break; default: op2 = OO_P; break; } - + opc->v[3].p_pip_f = func; if ((s7_p_pip_direct_function(s_func)) && (checker)) @@ -58169,28 +58360,28 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if (denominator(slot_value(slot2)) <= vector_length(obj)) opc->v[3].p_pip_f = (is_typed_vector(obj)) ? typed_vector_set_unchecked : vector_set_unchecked; break; - + case T_INT_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) opc->v[3].p_pip_f = int_vector_set_unchecked_p; break; - + case T_FLOAT_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) opc->v[3].p_pip_f = float_vector_set_unchecked_p; break; - + case T_STRING: if (denominator(slot_value(slot2)) <= string_length(obj)) opc->v[3].p_pip_f = string_set_unchecked; break; - + case T_BYTE_VECTOR: if (denominator(slot_value(slot2)) <= string_length(obj)) opc->v[3].p_pip_f = byte_vector_set_unchecked_p; break; } - + if (is_symbol(cadddr(car_x))) { s7_pointer val_slot; @@ -58514,18 +58705,26 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((!is_slot(slot)) || (has_methods(slot_value(slot)))) return(return_false(sc, car_x, __func__, __LINE__)); - + obj = slot_value(slot); if ((is_any_vector(obj)) && (vector_rank(obj) > 1)) return(return_false(sc, car_x, __func__, __LINE__)); - if ((car(car_x) == sc->hash_table_set_symbol) || /* the other setters won't happen here -- no p_ppp function */ - (car(car_x) == sc->let_set_symbol)) + if (car(car_x) == sc->hash_table_set_symbol) /* the other setters (than nash-table/let) won't happen here -- no p_ppp function */ { - if (is_immutable(obj)) + if ((!is_hash_table(obj)) || (is_immutable(obj))) return(return_false(sc, car_x, __func__, __LINE__)); - op2 = (is_hash_table(obj)) ? OO_H : OO_E; + op2 = OO_H; + } + else + { + if (car(car_x) == sc->let_set_symbol) + { + if ((!is_let(obj)) || (is_immutable(obj))) + return(return_false(sc, car_x, __func__, __LINE__)); + op2 = OO_E; + } } opc->v[1].p = slot; @@ -58583,10 +58782,12 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer opc->v[4].p = cadr(arg2); opc->v[2].p = val_slot; opc->v[0].fp = opt_p_ppp_scs; - if ((opc->v[3].p_ppp_f == let_set_p_ppp) && - (is_let(slot_value(slot))) && /* checked has_methods and is_immutable above */ - (is_symbol(cadr(arg2)))) - opc->v[3].p_ppp_f = let_set_p_ppp_1; + if (opc->v[3].p_ppp_f == let_set_p_ppp) + { + if (is_symbol(cadr(arg2))) /* checked is_let, has_methods and is_immutable above */ + opc->v[3].p_ppp_f = let_set_p_ppp_1; + else return(return_false(sc, car_x, __func__, __LINE__)); + } return(oo_set_type_2(opc, 5, 1, 2, op2, OO_P)); } } @@ -59187,7 +59388,6 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) /* len == 3 here (p_sy { opt_info *opc; s7_pointer target; - /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(car_x)); */ opc = alloc_opo(sc, car_x); target = cadr(car_x); @@ -59258,7 +59458,6 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) /* len == 3 here (p_sy } else { - /* fprintf(stderr, "%d float: %s\n", __LINE__, DISPLAY(car_x)); */ if ((is_pair(caddr(car_x))) && (float_optimize(sc, cddr(car_x)))) { @@ -60960,7 +61159,6 @@ static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len) s7_pointer p, end, frame = NULL, old_e, slot, stop, ind, ind_step, var; int32_t i, var_len, body_len, body_index, step_len, rtn_len; bool has_set = false; - /* fprintf(stderr, "%s[%d]: %s\n", __func__, __LINE__, DISPLAY(car_x)); */ if (len < 3) return(return_false(sc, car_x, __func__, __LINE__)); @@ -61213,7 +61411,7 @@ static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len) sc->envir = old_e; return(return_false(sc, car_x, __func__, __LINE__)); } - + opc->v[0].fp = (body_len == 1) ? opt_do_1 : opt_do_n; /* just a first stab at this @@ -61361,15 +61559,14 @@ static bool p_syntax(s7_scheme *sc, s7_pointer car_x, int32_t len) return(return_false(sc, car_x, __func__, __LINE__)); } -/* -------------------------------------------------------------------------------- */ +/* -------------------------------------------------------------------------------- */ static bool float_optimize(s7_scheme *sc, s7_pointer expr) { s7_pointer car_x, head; #if (WITH_GMP) return(return_false(sc, car_x, __func__, __LINE__)); #endif - /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(expr)); */ car_x = car(expr); if (!is_pair(car_x)) /* wrap constants/symbols */ return(opt_float_not_pair(sc, car_x)); @@ -61398,7 +61595,6 @@ static bool float_optimize(s7_scheme *sc, s7_pointer expr) { opt_info *opc; opc = alloc_opo(sc, car_x); - /* fprintf(stderr, "%d: %ld %s\n", __LINE__, len, DISPLAY(car_x)); */ switch (len) { case 1: @@ -61960,8 +62156,6 @@ static s7_function s7_cell_optimize(s7_scheme *sc, s7_pointer expr, bool nr) * finally that calls the actual function such as abs_d */ - -/* -------------------------------------------------------------------------------- */ static void clear_optimizer_fixups(s7_scheme *sc) { optfix_t *p, *n; @@ -62496,7 +62690,6 @@ static s7_pointer g_map_closure(s7_scheme *sc, s7_pointer f, s7_pointer seq) return(sc->nil); } - static s7_pointer g_map(s7_scheme *sc, s7_pointer args) { #define H_map "(map proc object . objects) applies proc to a list made up of the next element of each of its arguments, returning \ @@ -62804,15 +62997,18 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) /* in the next set, the main evaluator branches blithely assume no multiple-values, * and if it happens anyway, we go to a different branch here */ - case OP_SAFE_C_FP_1: + case OP_SAFE_C_FP_1: stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_FP_MV_1; - case OP_SAFE_C_FP_MV_1: + case OP_SAFE_C_FP_MV_1: + if (is_immutable(args)) /* (let () (define (func) (with-output-to-string (lambda () (apply-values (write '(1 2)))))) (func) (func)) */ + args = copy_list(sc, args); set_multiple_value(args); return(args); - case OP_SAFE_C_SSP_1: + + case OP_SAFE_C_SSP_1: stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_SSP_MV_1; return(args); - + case OP_C_AP_1: case OP_SAFE_C_SP_1: case OP_SAFE_CONS_SP_1: @@ -62929,6 +63125,7 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) /* handle 'and' and 'or' specially */ case OP_AND_P1: case OP_AND1: + case OP_AND_SAFE_P_REST: /* from OP_AND_SAFE_P1 or P2 */ for (x = args; is_not_null(cdr(x)); x = cdr(x)) if (car(x) == sc->F) return(sc->F); @@ -62972,8 +63169,7 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) case OP_BEGIN1: /* here we have a values call with nothing to splice into. So flush it... * otherwise the multiple-values bit gets set in some innocent list and never unset: - * :(let ((x '((1 2)))) (eval `(apply apply values x)) x) - * ((values 1 2)) + * (let ((x '((1 2)))) (eval `(apply apply values x)) x) -> ((values 1 2)) * other cases: (+ 1 (begin (values 5 6) (values 2 3)) 4) -> 10 -- the (5 6) is dropped * (let () (values 1 2 3) 4) but (+ (let () (values 1 2))) -> 3 */ @@ -63015,7 +63211,6 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) return(args); } - s7_pointer s7_values(s7_scheme *sc, s7_pointer args) { #define H_values "(values obj ...) splices its arguments into whatever list holds it (its 'continuation')" @@ -63023,10 +63218,8 @@ s7_pointer s7_values(s7_scheme *sc, s7_pointer args) if (is_null(args)) /* ((lambda () (let ((x 1)) (set! x (boolean? (values)))))) */ return(sc->no_value); - if (is_null(cdr(args))) return(car(args)); - return(splice_in_values(sc, args)); } @@ -63094,7 +63287,7 @@ static s7_pointer g_list_values(s7_scheme *sc, s7_pointer args) * we can't set_cdr(pc...) as in earlier versions of this code -- might be an embedded permanent list */ - /* splice out #<no-values>, (list-values (apply-values ())) -> () etc */ + /* splice out #<values>, (list-values (apply-values ())) -> () etc */ sc->w = sc->nil; for (x = args; is_pair(x); x = cdr(x)) if (car(x) != sc->no_value) @@ -63131,23 +63324,18 @@ static s7_pointer g_apply_values(s7_scheme *sc, s7_pointer args) } /* (apply values ...) replaces (unquote_splicing ...) - * - * (define-macro (hi a) `(+ 1 ,a) == (list '+ 1 a) - * (define-macro (hi a) ``(+ 1 ,,a) == (list list '+ 1 (list quote a))) - * - * (define-macro (hi a) `(+ 1 ,@a) == (list '+ 1 (apply values a)) - * (define-macro (hi a) ``(+ 1 ,,@a) == (list list '+ 1 (apply values a)) + * (define-macro (hi a) `(+ 1 ,a) == (list '+ 1 a) + * (define-macro (hi a) ``(+ 1 ,,a) == (list list '+ 1 (list quote a))) + * (define-macro (hi a) `(+ 1 ,@a) == (list '+ 1 (apply values a)) + * (define-macro (hi a) ``(+ 1 ,,@a) == (list list '+ 1 (apply values a)) * * this is not the same as CL's quasiquote; for example: - * [1]> (let ((a 1) (b 2)) `(,a ,@b)) - * (1 . 2) + * [1]> (let ((a 1) (b 2)) `(,a ,@b)) -> '(1 . 2) * in s7 this is an error. * * also in CL the target of ,@ can apparently be a circular list - * * one surprising twist: write/display return their first argument directly, so (apply-values (write `(+ x 1))) is the same as (apply-values `(+ x 1)) * If this is in a function body, and the function is called twice, it is self-modifying code and behaves in unexpected ways. - * should apply-values copy in this case? */ static bool is_simple_code(s7_scheme *sc, s7_pointer form) @@ -63184,6 +63372,10 @@ static bool is_simple_code(s7_scheme *sc, s7_pointer form) return(is_null(tmp)); } +/* since the reader expands unquote et al, and the printer does not unexpand them, the standard scheme quine in s7 is: + * ((lambda (x) (list-values x (list-values 'quote x))) '(lambda (x) (list-values x (list-values 'quote x)))) + * but that depends on the "p" in repl... + */ static s7_pointer g_quasiquote_1(s7_scheme *sc, s7_pointer form, bool check_cycles) { @@ -63316,7 +63508,6 @@ static void back_up_stack(s7_scheme *sc) pop_stack(sc); } - static token_t read_sharp(s7_scheme *sc, s7_pointer pt) { int32_t c; @@ -63365,17 +63556,12 @@ static token_t read_sharp(s7_scheme *sc, s7_pointer pt) 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() - * and we can't shrug it off: - * :#2147483649123D() - * ;#nD(...) dimensions argument 1, -2147483647, is out of range (must be 1 or more) - * but - * :#2147483649123D() - * creates a vector with 512 dimensions! - * ndims in the vector struct is an uint32_t, so we'll complain if it goes over short max for now + * ndims in the vector struct is an uint32_t, so we'll complain if it goes over short max for now: + * #50000d() -> error: overflow while reading #nD: 50000 */ s7_int dims; int32_t d, loc = 0; - sc->strbuf[loc++] = c; + sc->strbuf[loc++] = (unsigned char)c; dims = digits[c]; while (true) @@ -63393,7 +63579,7 @@ static token_t read_sharp(s7_scheme *sc, s7_pointer pt) (dims > S7_SHORT_MAX)) s7_error(sc, sc->read_error_symbol, set_elist_2(sc, wrap_string(sc, "overflow while reading #nD: ~A", 30), wrap_integer1(sc, dims))); - sc->strbuf[loc++] = d; + sc->strbuf[loc++] = (unsigned char)d; } sc->strbuf[loc++] = d; if ((d == 'd') || (d == 'i') || (d == 'r') || (d == 'u')) @@ -63403,7 +63589,7 @@ static token_t read_sharp(s7_scheme *sc, s7_pointer pt) if (e == EOF) s7_error(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "unexpected end of input while reading #n()", 42))); - sc->strbuf[loc++] = e; + sc->strbuf[loc++] = (unsigned char)e; if (e == '(') { sc->w = make_integer(sc, dims); @@ -63444,7 +63630,7 @@ static token_t read_sharp(s7_scheme *sc, s7_pointer pt) for (reader = slot_value(sc->sharp_readers); is_pair(reader); reader = cdr(reader)) if (s7_character(caar(reader)) == '!') { - sc->strbuf[0] = c; + sc->strbuf[0] = (unsigned char)c; return(TOKEN_SHARP_CONST); /* next stage notices any errors */ } @@ -63528,26 +63714,21 @@ static token_t read_sharp(s7_scheme *sc, s7_pointer pt) } } } - sc->strbuf[0] = c; + sc->strbuf[0] = (unsigned char)c; return(TOKEN_SHARP_CONST); /* next stage notices any errors */ } - static token_t read_comma(s7_scheme *sc, s7_pointer pt) { int32_t c; /* here we probably should check for symbol names that start with "@": - :(define-macro (hi @foo) `(+ ,@foo 1)) - hi - :(hi 2) - ;foo: unbound variable + (define-macro (hi @foo) `(+ ,@foo 1)) -> hi + (hi 2) -> ;foo: unbound variable but - :(define-macro (hi .foo) `(+ ,.foo 1)) - hi - :(hi 2) - 3 + (define-macro (hi .foo) `(+ ,.foo 1)) -> hi + (hi 2) -> 3 and ambiguous: - :(define-macro (hi @foo . foo) `(list ,@foo)) + (define-macro (hi @foo . foo) `(list ,@foo)) what about , @foo -- is the space significant? We accept ,@ foo. */ @@ -63564,7 +63745,6 @@ static token_t read_comma(s7_scheme *sc, s7_pointer pt) return(TOKEN_COMMA); } - static token_t read_dot(s7_scheme *sc, s7_pointer pt) { int32_t c; @@ -63584,7 +63764,6 @@ static token_t read_dot(s7_scheme *sc, s7_pointer pt) return(TOKEN_ATOM); /* i.e. something that can start with a dot like a number */ } - static token_t token(s7_scheme *sc) /* inline here is slower */ { int32_t c; @@ -63603,7 +63782,7 @@ static token_t token(s7_scheme *sc) /* inline here is slower */ case '\0': case EOF: return(TOKEN_EOF); default: - sc->strbuf[0] = c; /* every TOKEN_ATOM return goes to port_read_name, so we save a backchar/inchar shuffle by starting the read here */ + sc->strbuf[0] = (unsigned char)c; /* every TOKEN_ATOM return goes to port_read_name, so we save a backchar/inchar shuffle by starting the read here */ return(TOKEN_ATOM); } } @@ -63631,14 +63810,14 @@ static int32_t read_x_char(s7_scheme *sc, int32_t i, s7_pointer pt) d1 = digits[c]; if (d1 >= 16) { - sc->strbuf[i++] = c; /* just go on -- maybe a special char is not intended */ + sc->strbuf[i++] = (unsigned char)c; /* just go on -- maybe a special char is not intended */ return(i); } c = inchar(pt); if (c == '"') { - sc->strbuf[i++] = d1; - backchar(c, pt); + sc->strbuf[i++] = (unsigned char)d1; + backchar((char)c, pt); return(i); } if (c == EOF) @@ -63648,16 +63827,16 @@ static int32_t read_x_char(s7_scheme *sc, int32_t i, s7_pointer pt) } if (c == ';') { - sc->strbuf[i++] = d1; + sc->strbuf[i++] = (unsigned char)d1; return(i); } d2 = digits[c]; if (d2 >= 16) { - sc->strbuf[i++] = c; /* just go on -- maybe a special char is not intended */ + sc->strbuf[i++] = (unsigned char)c; /* just go on -- maybe a special char is not intended */ return(i); } - sc->strbuf[i++] = 16 * d1 + d2; + sc->strbuf[i++] = (unsigned char)(16 * d1 + d2); } return(i); } @@ -63754,7 +63933,7 @@ static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt) { case '\n': port_line_number(pt)++; - sc->strbuf[i++] = c; + sc->strbuf[i++] = (unsigned char)c; break; case EOF: @@ -63774,15 +63953,15 @@ static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt) return(sc->F); case '\\': case '"': case '|': - sc->strbuf[i++] = c; + sc->strbuf[i++] = (unsigned char)c; break; case 'n': sc->strbuf[i++] = '\n'; break; case 't': sc->strbuf[i++] = '\t'; break; case 'r': sc->strbuf[i++] = '\r'; break; case '/': sc->strbuf[i++] = '/'; break; - case 'b': sc->strbuf[i++] = 8; break; - case 'f': sc->strbuf[i++] = 12; break; + case 'b': sc->strbuf[i++] = (unsigned char)8; break; + case 'f': sc->strbuf[i++] = (unsigned char)12; break; case 'x': i = read_x_char(sc, i, pt); @@ -63807,7 +63986,7 @@ static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt) break; default: - sc->strbuf[i++] = c; + sc->strbuf[i++] = (unsigned char)c; break; } @@ -63961,7 +64140,7 @@ static s7_pointer read_expression(s7_scheme *sc) static s7_pointer loaded_library(s7_scheme *sc, const char *file) { s7_pointer p; - for (p = slot_value(sc->libraries); is_pair(p); p = cdr(p)) + for (p = slot_value(global_slot(sc->libraries_symbol)); is_pair(p); p = cdr(p)) if (local_strcmp(file, string_value(caar(p)))) return(cdar(p)); return(sc->nil); @@ -64030,11 +64209,10 @@ static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym) z = sc->z; sc->temp7 = cons(sc, code, cons(sc, args, cons(sc, value, cons(sc, cur_code, cons(sc, x, cons(sc, z, sc->nil)))))); /* not s7_list (debugger checks) */ - if (!is_pair(cur_code)) + if ((port_file_number(sc->input_port) > 1) && + (!is_pair(cur_code))) { - /* isolated typo perhaps -- no pair to hold the position info, so make one. - * current_code(sc) is GC-protected, so this should be safe. - */ + /* isolated typo perhaps -- no pair to hold the position info, so make one. current_code(sc) is GC-protected, so this should be safe. */ cur_code = cons(sc, sym, sc->nil); /* the error will say "(sym)" which is not too misleading */ pair_set_line(cur_code, port_line_number(sc->input_port)); pair_set_file(cur_code, port_file_number(sc->input_port)); @@ -64171,49 +64349,6 @@ static s7_pointer binder_syntax(s7_scheme *sc, const char *name, opcode_t op, s7 return(x); } -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->not_symbol), sc->is_pair_symbol) - - p = car(args); - if (!is_pair(p)) - return(method_or_bust_one_arg(sc, p, sc->pair_line_number_symbol, set_plist_1(sc, p), T_PAIR)); - - if (has_line_number(p)) - return(make_integer(sc, pair_line(p))); - return(sc->F); /* was 0 21-Mar-17 */ -} - -static s7_pointer pair_line_number_p_p(s7_scheme *sc, s7_pointer p) -{ - if (!is_pair(p)) - return(method_or_bust_one_arg(sc, p, sc->pair_line_number_symbol, set_plist_1(sc, p), T_PAIR)); - if (has_line_number(p)) - return(make_integer(sc, pair_line(p))); - return(sc->F); -} - - -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, s7_make_signature(sc, 2, sc->is_string_symbol, sc->not_symbol), sc->is_pair_symbol) - s7_pointer p; - p = car(args); - - if (!is_pair(p)) - { - check_method(sc, p, sc->pair_filename_symbol, args); - return(simple_wrong_type_argument(sc, sc->pair_filename_symbol, p, T_PAIR)); - } - if (has_line_number(p)) - return(sc->file_names[pair_file(p)]); - return(sc->F); -} - - static s7_pointer g_is_pair_car_s(s7_scheme *sc, s7_pointer args) { s7_pointer val; @@ -64564,7 +64699,6 @@ static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_po return(f); } - static s7_pointer g_not_is_pair_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_pair, sc->is_pair_symbol, args);} static s7_pointer g_not_is_null_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_null, sc->is_null_symbol, args);} static s7_pointer g_not_is_symbol_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_symbol, sc->is_symbol_symbol, args);} @@ -64662,7 +64796,6 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin return(g); } - static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { /* if (symbol_id(sc->vector_ref_symbol) != 0) return(f); */ @@ -64709,7 +64842,6 @@ static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, return(f); } - static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 3) return(sc->vector_set_3); @@ -64717,7 +64849,6 @@ static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, return(f); } - static s7_pointer list_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if ((args == 3) && @@ -64977,7 +65108,6 @@ static s7_pointer multiply_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 return(f); } - static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { #if (!WITH_GMP) @@ -65042,7 +65172,6 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 return(f); } - static s7_pointer divide_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { #if (!WITH_GMP) @@ -65076,7 +65205,7 @@ static s7_pointer equal_chooser(s7_scheme *sc, s7_pointer ur_f, int32_t args, s7 if (s7_is_integer(arg2)) { - if ((is_safely_optimized(arg1)) && + if ((is_safely_optimized(arg1)) && (has_fx(arg1))) { s7_function f; @@ -65137,7 +65266,6 @@ static s7_pointer less_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poi return(f); } - static s7_pointer leq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) @@ -65156,7 +65284,6 @@ static s7_pointer leq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poin return(f); } - static s7_pointer greater_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) @@ -65181,7 +65308,6 @@ static s7_pointer greater_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_ return(f); } - static s7_pointer geq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) @@ -65500,7 +65626,6 @@ static s7_pointer g_and_s_direct_2(s7_scheme *sc, s7_pointer args) return(c_call(cadr(args))(sc, sc->t1_1)); } - static s7_pointer make_function_with_class(s7_scheme *sc, s7_pointer cls, const char *name, s7_function f, int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc) { @@ -65512,7 +65637,6 @@ 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, int32_t args, s7_pointer expr, bool ops)) { s7_pointer f; @@ -65523,7 +65647,6 @@ static s7_pointer set_function_chooser(s7_scheme *sc, s7_pointer sym, s7_pointer return(f); } - static void init_choosers(s7_scheme *sc) { s7_pointer f; @@ -65951,7 +66074,6 @@ static opt_t optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int return(OPT_F); } - static opt_t optimize_func_dotted_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t args, s7_pointer e) { if (fx_count(sc, expr) == args) @@ -66059,10 +66181,10 @@ static int32_t combine_ops(s7_scheme *sc, s7_pointer func, s7_pointer expr, comb 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_opSq: return(OP_SAFE_C_op_opSq_q_S); - case OP_SAFE_C_opSSq: + case OP_SAFE_C_opSSq: set_opt3_pair(expr, cadadr(expr)); return(OP_SAFE_C_op_opSSq_q_S); - case OP_SAFE_C_opSSq_S: + case OP_SAFE_C_opSSq_S: set_opt3_pair(expr, cadadr(expr)); return(OP_SAFE_C_op_opSSq_Sq_S); case OP_SAFE_C_A: return(OP_SAFE_C_opAq_S); @@ -66352,7 +66474,7 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu { int32_t op; op = combine_ops(sc, func, expr, E_C_P, arg1, NULL); - if ((hop == 1) && + if ((hop == 1) && (is_not_h_optimized(arg1))) hop = 0; set_safe_optimize_op(expr, hop + op); @@ -66401,7 +66523,7 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu s7_pointer lambda_expr; lambda_expr = arg1; if ((is_pair(lambda_expr)) && - (is_lambda(sc, car(lambda_expr))) && /* check for stuff like (define (f) (eval (lambda 2))) */ + (is_lambda(sc, car(lambda_expr))) && /* check for stuff like (define (f) (eval (lambda 2))) */ (is_pair(cdr(lambda_expr))) && (is_pair(cddr(lambda_expr)))) { @@ -66409,7 +66531,8 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu (is_pair(cadr(lambda_expr))) && (is_null(cdadr(lambda_expr))) && (is_symbol(caadr(lambda_expr))) && - (!direct_memq(car(lambda_expr), e)) && /* (let ((lambda #f)) (call-with-exit (lambda ...))) */ + (!is_probably_constant(caadr(lambda_expr))) && /* (call-with-exit (lambda (pi) ...) */ + (!direct_memq(car(lambda_expr), e)) && /* (let ((lambda #f)) (call-with-exit (lambda ...))) */ (s7_is_proper_list(sc, cddr(lambda_expr)))) { if (is_null(cdddr(lambda_expr))) @@ -66587,7 +66710,6 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu return((is_optimized(expr)) ? OPT_T : OPT_F); } - static bool let_memq(s7_pointer symbol, s7_pointer symbols) { s7_pointer x; @@ -66599,7 +66721,6 @@ static bool let_memq(s7_pointer symbol, s7_pointer symbols) return(false); } - static inline s7_pointer find_uncomplicated_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e) { s7_pointer x; @@ -66654,7 +66775,6 @@ static bool unsafe_is_safe(s7_scheme *sc, s7_pointer f, s7_pointer e) static bool two_args_ok(s7_scheme *sc, s7_pointer expr, s7_pointer e) { if ((car(expr) == sc->member_symbol) || (car(expr) == sc->assoc_symbol)) return(true); - /* fprintf(stderr, "%s: %d\n", DISPLAY(expr), unsafe_is_safe(sc, cadr(expr), e)); */ return(unsafe_is_safe(sc, cadr(expr), e)); } @@ -66729,7 +66849,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f func_is_safe = is_safe_procedure(func); if (pairs == 0) { - if ((func_is_safe) || + if ((func_is_safe) || ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e)))) { /* another case here: set-car! and set-cdr! are safe if symbols==1 and arg1 is the symbol (i.e. arg2 is a constant) */ @@ -66749,7 +66869,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_opt2_con(cdr(expr), arg2); set_optimize_op(expr, hop + OP_SAFE_C_SC); } - else + else { set_opt1_con(cdr(expr), arg1); set_optimize_op(expr, hop + OP_SAFE_C_CS); @@ -66793,7 +66913,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_optimize_op(expr, hop + OP_SAFE_C_SC); set_opt2_con(cdr(expr), arg2); } - else + else { set_opt1_con(cdr(expr), arg1); set_optimize_op(expr, hop + OP_SAFE_C_CS); @@ -66818,7 +66938,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if ((bad_pairs == 0) && (pairs == 2)) { - if ((func_is_safe) || + if ((func_is_safe) || ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e)))) { int32_t op; @@ -66872,7 +66992,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if ((bad_pairs == 0) && (pairs == 1)) { - if ((func_is_safe) || + if ((func_is_safe) || ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e)))) { combine_op_t orig_op; @@ -66894,7 +67014,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f op = combine_ops(sc, func, expr, orig_op, arg1, arg2); if ((!hop) && (is_h_optimized(arg2))) clear_hop(arg2); } - if ((hop == 1) && + if ((hop == 1) && ((is_not_h_optimized(arg1)) || (is_not_h_optimized(arg2)))) hop = 0; if ((((op == OP_SAFE_C_SP) || (op == OP_SAFE_C_CP)) && @@ -66948,7 +67068,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if ((bad_pairs == 1) && (quotes == 1)) { - if ((func_is_safe) || + if ((func_is_safe) || ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e)))) { if (symbols == 1) @@ -66959,7 +67079,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_opt2_con(cdr(expr), cadr(caddr(expr))); set_optimize_op(expr, hop + OP_SAFE_C_SC); } - else + else { set_opt1_con(cdr(expr), cadadr(expr)); set_optimize_op(expr, hop + OP_SAFE_C_CS); @@ -67005,7 +67125,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if ((pairs == 1) && (quotes == 0) && - ((func_is_safe) || + ((func_is_safe) || ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e))))) { if (symbols == 1) @@ -67058,7 +67178,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f } if ((pairs == 2) && - ((func_is_safe) || + ((func_is_safe) || ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e))))) { if ((bad_pairs == 1) && @@ -67333,7 +67453,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f code = sc->code; sc->code = cadr(expr); check_lambda(sc); - clear_safe_closure(cdr(sc->code)); /* otherwise we need to fixup the local let for the optimizer */ + clear_safe_closure_body(cdr(sc->code)); /* otherwise we need to fixup the local let for the optimizer */ sc->code = code; set_opt1_lambda(expr, func); return(OPT_F); @@ -67391,7 +67511,6 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f (is_fx_safe(sc, arg1)) && (is_fx_safe(sc, arg2))) { - /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(expr)); */ set_unsafe_optimize_op(expr, OP_VECTOR_AA); annotate_args(sc, cdr(expr), e); set_opt3_arglen(expr, small_int(2)); @@ -67401,7 +67520,6 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f return((is_optimized(expr)) ? OPT_T : OPT_F); } - static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t pairs, int32_t symbols, int32_t quotes, int32_t bad_pairs, s7_pointer e) { s7_pointer arg1, arg2, arg3; @@ -67601,13 +67719,12 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer if ((is_normal_symbol(arg1)) && (is_normal_symbol(arg2))) { set_opt3_pair(expr, cadddr(expr)); - /* fprintf(stderr, "ssp: %s %s\n", DISPLAY(expr), (is_optimized(arg3)) ? op_names[optimize_op(arg3)] : "unopt"); */ set_unsafe_optimize_op(expr, hop + OP_SAFE_C_SSP); choose_c_function(sc, expr, func, 3); return(OPT_F); } } - + /* op_safe_c_fp, similar to op_and_p etc, but we have C_AAA above (fx_count==3) so any_nils is not needed */ { s7_pointer p; @@ -67670,10 +67787,12 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer (is_null(cadr(body_lambda))) && (is_not_null(cddr(body_lambda))) && (((is_symbol(cadr(error_lambda))) && /* (lambda args ... */ - (!is_possibly_constant(cadr(error_lambda)))) || + (!is_probably_constant(cadr(error_lambda)))) || ((is_pair(cadr(error_lambda))) && /* (lambda (type info) ... */ (is_pair(cdadr(error_lambda))) && - (is_null(cddadr(error_lambda))))) && + (is_null(cddadr(error_lambda))) && + (!is_probably_constant(caadr(error_lambda))) && /* (lambda (pi ...) ...) */ + (!is_probably_constant(cadadr(error_lambda))))) && (is_not_null(cddr(error_lambda)))) { s7_pointer error_result; @@ -67852,7 +67971,7 @@ static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer set_optimized(expr); if (args == 4) { - if ((symbols == 3) && (pairs == 0) && + if ((symbols == 3) && (pairs == 0) && (!is_symbol(car(cddddr(expr)))) && (arg_findable(sc, cadr(expr), e)) && (arg_findable(sc, caddr(expr), e)) && @@ -67876,7 +67995,7 @@ static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer { if (is_normal_symbol(car(p))) break; - if ((is_pair(car(p))) && + if ((is_pair(car(p))) && ((!is_pair(cdar(p))) || (caar(p) != sc->quote_symbol))) break; } @@ -68342,7 +68461,6 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in return(OPT_OOPS); } sc->temp9 = sc->nil; - if ((hop == 1) && (symbol_id(car(expr)) == 0)) { @@ -68669,7 +68787,7 @@ static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int32_t hop, s7 (!is_optimized(expr))) { /* len=0 case is almost entirely arglists */ - set_opt1_con(expr, sc->gc_nil); + set_opt1_con(expr, sc->unused); if (pairs == 0) { @@ -68815,7 +68933,6 @@ static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int32_t hop, s7 return(OPT_F); } - static opt_t optimize(s7_scheme *sc, s7_pointer code, int32_t hop, s7_pointer e) { s7_pointer x; @@ -68894,7 +69011,6 @@ static s7_pointer check_lambda_args(s7_scheme *sc, s7_pointer args, int32_t *ari return(sc->F); } - static s7_pointer check_lambda_star_args(s7_scheme *sc, s7_pointer args, int32_t *arity) { s7_pointer top, v, w; @@ -69000,13 +69116,6 @@ 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);} static body_t body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool at_end); -#define SAFE_FORM_PRINT 0 -#if SAFE_FORM_PRINT -static const char *display_min_body(body_t result) -{ - return((result == UNSAFE_BODY) ? "unsafe" : ((result == SAFE_BODY) ? "safe" : "very-safe")); -} -#endif static body_t form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at_end) { @@ -69015,8 +69124,6 @@ static body_t form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at #if S7_DEBUGGING if (!is_pair(x)) {fprintf(stderr, "form_is_safe x is not a pair! %s\n", DISPLAY(x)); abort();} #endif - /* fprintf(stderr, "%s\n", DISPLAY(x)); */ - expr = car(x); if (is_syntactic_symbol(expr)) { @@ -69185,7 +69292,7 @@ static body_t form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at body = cddr(x); if (is_symbol(vars)) { - if (!is_pair(body)) + if (!is_pair(body)) return(UNSAFE_BODY); /* (let name . res) */ if (vars == func) /* named let shadows caller */ return(UNSAFE_BODY); @@ -69343,12 +69450,7 @@ static body_t form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at if (is_unquoted_pair(car(p))) { if (caar(p) == func) - { -#if SAFE_FORM_PRINT - fprintf(stderr, " (%d) found %s -> unsafe\n", __LINE__, DISPLAY(func)); -#endif - return(UNSAFE_BODY); - } + return(UNSAFE_BODY); if ((is_c_function(f)) && (is_scope_safe(f)) && (caar(p) == sc->lambda_symbol)) { @@ -69368,16 +69470,7 @@ static body_t form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at lresult = body_is_safe(sc, func, lbody, false); result = min_body(result, lresult); } - else - { - result = min_body(result, form_is_safe(sc, func, car(p), false)); -#if SAFE_FORM_PRINT - fprintf(stderr, "%d: %s %s\n", __LINE__, DISPLAY_80(car(p)), display_min_body(result)); -#endif - } -#if SAFE_FORM_PRINT - fprintf(stderr, "%d: %s: %s\n", __LINE__, DISPLAY_80(car(p)), display_min_body(result)); -#endif + else result = min_body(result, form_is_safe(sc, func, car(p), false)); if (result == UNSAFE_BODY) return(UNSAFE_BODY); } @@ -69419,9 +69512,6 @@ static body_t body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool } if (!is_null(p)) return(UNSAFE_BODY); -#if SAFE_FORM_PRINT - fprintf(stderr, "body_is_safe: %d: %s\n", __LINE__, display_min_body(result)); -#endif return(result); } @@ -69445,14 +69535,11 @@ static bool tree_has_definers_or_binders(s7_scheme *sc, s7_pointer tree) (is_definer_or_binder(tree))); } -/* null not pair (lg, closure-related), add_ss tbig - * steps? first of safe? or any of very-safe? first of any if safe? other A choices in check_*? - */ -static void fx_tree(s7_scheme *sc, s7_pointer tree, s7_pointer stepper, s7_pointer previous_stepper) +static void fx_tree(s7_scheme *sc, s7_pointer tree, s7_pointer stepper, s7_pointer previous_stepper) /* previous_stepper can be NULL */ { s7_pointer p; + /* fprintf(stderr, "fx_tree %s %s: %s\n", DISPLAY(stepper), (previous_stepper) ? DISPLAY(previous_stepper) : "", DISPLAY(tree)); */ p = car(tree); - /* fprintf(stderr, "fx_tree %s %s %d\n", DISPLAY_80(tree), DISPLAY(stepper), has_fx(tree)); */ if (has_fx(tree)) { @@ -69461,19 +69548,42 @@ static void fx_tree(s7_scheme *sc, s7_pointer tree, s7_pointer stepper, s7_point #if (!WITH_GMP) if ((c_callee(tree) == fx_geq_ss) && (cadr(p) == stepper)) {set_c_call(tree, fx_geq_ts); return;} if ((c_callee(tree) == fx_equal_ss) && (cadr(p) == stepper)) {set_c_call(tree, fx_equal_ts); return;} - if ((c_callee(tree) == fx_c_equal_s_ic) && (cadr(p) == stepper)) {set_c_call(tree, fx_c_equal_t_ic); return;} + if (c_callee(tree) == fx_c_equal_s_ic) + { + if (cadr(p) == stepper) {set_c_call(tree, fx_c_equal_t_ic); return;} + if (cadr(p) == previous_stepper) {set_c_call(tree, fx_c_equal_u_ic); return;} + } + if ((c_callee(tree) == fx_c_d) && (is_pair(p)) && (is_pair(cdr(p)))) + { + if (c_callee(p) == g_equal_s_ic) + { + if (cadr(p) == stepper) {set_c_call(tree, fx_c_equal_t_ic); return;} + if (cadr(p) == previous_stepper) {set_c_call(tree, fx_c_equal_u_ic); return;} + } + if ((c_callee(p) == g_add_sf) && (cadr(p) == stepper)) {set_c_call(tree, fx_c_add_tf); return;} + } #endif if ((c_callee(tree) == fx_c_s) && (cadr(p) == stepper)) {set_c_call(tree, fx_c_t); return;} + if ((c_callee(tree) == fx_not_s) && (cadr(p) == stepper)) {set_c_call(tree, fx_not_t); return;} if ((c_callee(tree) == fx_is_null_s) && (cadr(p) == stepper)) {set_c_call(tree, fx_is_null_t); return;} + if ((c_callee(tree) == fx_is_pair_s) && (cadr(p) == stepper)) {set_c_call(tree, fx_is_pair_t); return;} + if ((c_callee(tree) == fx_is_symbol_s) && (cadr(p) == stepper)) {set_c_call(tree, fx_is_symbol_t); return;} + if ((c_callee(tree) == fx_is_type_s) && (cadr(p) == stepper)) {set_c_call(tree, fx_is_type_t); return;} if ((c_callee(tree) == fx_add_ss) && (cadr(p) == stepper)) {set_c_call(tree, fx_add_ts); return;} + if ((c_callee(tree) == fx_c_add_si) && (cadr(p) == stepper)) {set_c_call(tree, fx_c_add_ti); return;} if (c_callee(tree) == fx_c_add_s1) { - /* fprintf(stderr, "%s %s: %s\n", DISPLAY(stepper), (previous_stepper) ? symbol_name(previous_stepper) : "none", DISPLAY(tree)); */ if (cadr(p) == stepper) {set_c_call(tree, fx_c_add_t1); return;} if (cadr(p) == previous_stepper) {set_c_call(tree, fx_c_add_u1); return;} } - if ((c_callee(tree) == fx_c_opssq) && (caddr(cadr(p)) == stepper)) + if ((c_callee(tree) == fx_c_sub_s1) && (cadr(p) == stepper)) {set_c_call(tree, fx_c_sub_t1); return;} +#if 0 + if ((c_callee(tree) == fx_c_opsq) && (cadadr(p) == stepper)) fprintf(stderr, "opsq: %s\n", DISPLAY(tree)); + if ((c_callee(tree) == fx_c_opsq) && (cadadr(p) == previous_stepper)) fprintf(stderr, "opsq: %s (prev)\n", DISPLAY(tree)); + if ((c_callee(tree) == fx_c_opsq_c) && (cadadr(p) == stepper)) fprintf(stderr, "opsq_c: %s\n", DISPLAY(tree)); +#endif + if ((c_callee(tree) == fx_c_opssq) && (caddr(cadr(p)) == stepper)) { if ((s7_p_p_function(slot_value(global_slot(car(p))))) && (s7_p_pp_function(slot_value(global_slot(caadr(p)))))) @@ -69483,11 +69593,10 @@ static void fx_tree(s7_scheme *sc, s7_pointer tree, s7_pointer stepper, s7_point set_opt3_direct_x(cdr(p), (s7_pointer)(s7_p_pp_function(slot_value(global_slot(caadr(p)))))); set_c_call(tree, fx_c_opstq_direct); } - else set_c_call(tree, fx_c_opstq); + else set_c_call(tree, fx_c_opstq); return; } } - if ((is_pair(p)) && (is_pair(cdr(p)))) { if (is_pair(cadr(p))) @@ -69521,9 +69630,6 @@ static void optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer fun if (!is_null(p)) add_symbol_to_list(sc, p); result = body_is_safe(sc, func, body, true); -#if SAFE_FORM_PRINT - fprintf(stderr, "optimize_lambda %s: %s\n", DISPLAY_80(body), display_min_body(result)); -#endif clear_symbol_list(sc); /* if the body is safe, we can optimize the calling sequence */ @@ -69549,18 +69655,13 @@ static void optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer fun } if (result > UNSAFE_BODY) { -#if SAFE_FORM_PRINT - fprintf(stderr, "%s %s is a safe-closure\n", __func__, DISPLAY_80(body)); -#endif - set_safe_closure(body); - /* this bit is set on the function itself in make_closure and friends */ + set_safe_closure_body(body); /* this bit is set on the function itself in make_closure and friends */ if (result == VERY_SAFE_BODY) - set_very_safe_closure(body); + set_very_safe_closure_body(body); } } - /* else fprintf(stderr, "rest: %d %s\n", result, DISPLAY(body)); */ - if (is_symbol(func)) /* func can be sc->gc_nil (see check_lambda and check_lambda_star) */ + if (is_symbol(func)) /* func can be sc->unused (see check_lambda and check_lambda_star) */ { s7_pointer lst; lst = cons(sc, add_symbol_to_list(sc, func), sc->nil); @@ -69571,8 +69672,8 @@ static void optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer fun { if ((unstarred_lambda) && (is_pair(args)) && - (is_null(cdr(args))) && - (is_very_safe_closure(body)) && + (is_null(cdr(args))) && + (is_very_safe_closure_body(body)) && (!tree_has_definers_or_binders(sc, body))) fx_tree(sc, body, car(args), NULL); } @@ -69593,6 +69694,10 @@ static void check_lambda(s7_scheme *sc) s7_pointer code, body, form; form = sc->code; + if ((sc->safety > NO_SAFETY) && + (tree_is_cyclic(sc, form))) + s7_error(sc, sc->wrong_type_arg_symbol, wrap_string(sc, "lambda: body is cyclic", 22)); + sc->code = cdr(sc->code); code = sc->code; if (!is_pair(code)) /* (lambda) or (lambda . 1) */ @@ -69615,7 +69720,7 @@ static void check_lambda(s7_scheme *sc) (((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? */ + optimize_lambda(sc, true, sc->unused, car(code), body); /* why was lambda the func? */ else { if (optimize(sc, body, 0, @@ -69631,8 +69736,11 @@ static void check_lambda_star(s7_scheme *sc) { s7_pointer form; form = sc->code; - sc->code = cdr(sc->code); + if ((sc->safety > NO_SAFETY) && + (tree_is_cyclic(sc, form))) + s7_error(sc, sc->wrong_type_arg_symbol, wrap_string(sc, "lambda*: body is cyclic", 23)); + sc->code = cdr(sc->code); if ((!is_pair(sc->code)) || (!is_pair(cdr(sc->code)))) /* (lambda*) or (lambda* #f) */ eval_error_no_return(sc, sc->syntax_error_symbol, "lambda*: no args or no body? ~A", 31, form); @@ -69646,7 +69754,7 @@ static void check_lambda_star(s7_scheme *sc) 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)); + else optimize_lambda(sc, false, sc->unused, car(sc->code), cdr(sc->code)); pair_set_syntax_op(form, OP_LAMBDA_STAR_UNCHECKED); } @@ -69806,7 +69914,7 @@ static s7_pointer check_case(s7_scheme *sc) } else /* x_e_g */ { - if (!has_else) set_opt3_any(sc->code, sc->gc_nil); /* affects all that goto CASE_E_G */ + if (!has_else) set_opt3_any(sc->code, sc->unused); /* affects all that goto CASE_E_G */ if (is_symbol(car(sc->code))) pair_set_syntax_op(form, (key_type == T_SYMBOL) ? OP_CASE_S_S_G : OP_CASE_S_E_G); else @@ -69931,7 +70039,7 @@ static bool op_case_e_g_1(s7_scheme *sc, s7_pointer selector, bool ok) else { sc->code = opt3_any(sc->code); - if (sc->code == sc->gc_nil) /* set in check_case if no else clause */ + if (sc->code == sc->unused) /* set in check_case if no else clause */ sc->value = sc->unspecified; else { @@ -70079,6 +70187,30 @@ static void op_case_g_s(s7_scheme *sc) /* -------------------------------- let -------------------------------- */ +static void check_let_a_body(s7_scheme *sc, s7_pointer form) +{ + if (is_fx_safe(sc, cadr(sc->code))) + { + annotate_arg(sc, cdr(sc->code), sc->envir); + pair_set_syntax_op(form, OP_LET_A_A); + } + else + { + if ((is_optimized(cadr(sc->code))) || + (is_syntactic_pair(cadr(sc->code)))) + pair_set_syntax_op(form, OP_LET_A_P); + else + { + if ((is_pair(cadr(sc->code))) && + (is_syntactic(caadr(sc->code)))) + { + pair_set_syntax_op(form, OP_LET_A_P); + set_optimize_op(cadr(sc->code), syntax_opcode(slot_value(global_slot(caadr(sc->code))))); + } + } + } +} + static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer start) { s7_pointer binding; @@ -70112,30 +70244,10 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer s { pair_set_syntax_op(form, OP_LET_A); annotate_arg(sc, cdr(binding), sc->envir); - if (is_fx_safe(sc, cadr(sc->code))) - { - annotate_arg(sc, cdr(sc->code), sc->envir); - pair_set_syntax_op(form, OP_LET_A_A); - } - else - { - if ((is_optimized(cadr(sc->code))) || - (is_syntactic_pair(cadr(sc->code)))) - pair_set_syntax_op(form, OP_LET_A_P); - else - { - if ((is_pair(cadr(sc->code))) && - (is_syntactic(caadr(sc->code)))) - { - pair_set_syntax_op(form, OP_LET_A_P); - set_optimize_op(cadr(sc->code), syntax_opcode(slot_value(global_slot(caadr(sc->code))))); - } - } - } + check_let_a_body(sc, form); return(sc->code); } - } /* end is_null(cddr(sc->code)) */ - + } if (optimize_op(cadr(binding)) == HOP_SAFE_C_SS) { if (c_callee(cadr(binding)) == g_assq) @@ -70149,6 +70261,7 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer s { pair_set_syntax_op(form, OP_LET_A); annotate_arg(sc, cdr(binding), sc->envir); + if (is_null(cddr(sc->code))) check_let_a_body(sc, form); } } } @@ -70157,11 +70270,11 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer s { pair_set_syntax_op(form, OP_LET_A); annotate_arg(sc, cdr(binding), sc->envir); + if (is_null(cddr(sc->code))) check_let_a_body(sc, form); } return(sc->code); } - static s7_pointer check_let(s7_scheme *sc) { s7_pointer x, start, form; @@ -70302,7 +70415,6 @@ static s7_pointer check_let(s7_scheme *sc) { for (p = start; is_pair(p); p = cdr(p)) /* optimizing the value form here: car(p)=var+val, cdar(p)=val */ set_c_call(cdar(p), fx_choose(sc, cdar(p), sc->envir, let_symbol_is_safe)); - /* op_let_fx_a got very few hits */ } } else pair_set_syntax_op(form, OP_LET_UNCHECKED); @@ -70432,10 +70544,10 @@ static bool op_let1(s7_scheme *sc) for (n = 0, x = cadr(sc->code); is_pair(x); n++, x = cdr(x)) sc->w = cons(sc, caar(x), sc->w); - if (is_safe_closure(body)) + if (is_safe_closure_body(body)) { s7_pointer arg, new_env; - sc->x = make_closure(sc, sc->w = safe_reverse_in_place(sc, sc->w), body, T_CLOSURE | T_COPY_ARGS, n); + sc->x = make_closure(sc, sc->w = safe_reverse_in_place(sc, sc->w), body, T_CLOSURE | T_COPY_ARGS, n); new_env = new_frame_in_env(sc, sc->envir); closure_set_let(sc->x, new_env); for (arg = closure_args(sc->x); is_pair(arg); arg = cdr(arg)) @@ -70496,9 +70608,9 @@ static bool op_let1(s7_scheme *sc) static void op_let_no_vars(s7_scheme *sc) { - start_let(sc); + set_current_code(sc, sc->code); new_frame(sc, sc->envir, sc->envir); - sc->code = T_Pair(cdr(sc->code)); /* ignore the () */ + sc->code = T_Pair(cddr(sc->code)); /* ignore the () */ } static void op_named_let_no_vars(s7_scheme *sc) @@ -70608,8 +70720,7 @@ static bool check_let_star(s7_scheme *sc) bool named_let; form = sc->code; - sc->code = cdr(sc->code); - /* sc->code is cdr of let form (no let*) */ + sc->code = cdr(sc->code); /* sc->code is cdr of let* form (no let*) */ if (!is_pair(sc->code)) /* (let* . 1) */ eval_error_no_return(sc, sc->syntax_error_symbol, "let* variable list is messed up: ~A", 35, form); @@ -70697,7 +70808,7 @@ static bool check_let_star(s7_scheme *sc) s7_pointer p; opcode_t opt; clear_symbol_list(sc); - opt = OP_LET_STAR_FX; + opt = OP_LET_STAR_FX; /* 2 var fx case is common */ set_opt2_con(sc->code, cadaar(sc->code)); for (p = car(sc->code); is_pair(p); p = cdr(p)) { @@ -70821,7 +70932,7 @@ static void op_let_star_fx(s7_scheme *sc) arg = cdar(p); new_frame_with_slot(sc, sc->envir, e, caar(p), fx_call(sc, arg)); /* since each value is fx safe, there are no internal closures over the on-going stack of lets here (so use one frame) */ - sc->envir = e; + sc->envir = e; for (p = cdr(p); is_pair(p); p = cdr(p)) { arg = cdar(p); @@ -71129,7 +71240,7 @@ static s7_pointer op_let_temp_init2(s7_scheme *sc) push_stack(sc, OP_LET_TEMP_DONE, sc->args, sc->code); sc->code = cdr(sc->code); if (is_pair(sc->code)) - return(sc->gc_nil); + return(sc->unused); sc->value = sc->nil; /* so (let-temporarily (<vars)) -> () like begin I guess */ return(sc->code); } @@ -71164,6 +71275,7 @@ static bool op_let_temp_done1(s7_scheme *sc) return(true); } + /* -------------------------------- quote -------------------------------- */ static inline s7_pointer check_quote(s7_scheme *sc, s7_pointer code) { @@ -71181,12 +71293,13 @@ static inline s7_pointer check_quote(s7_scheme *sc, s7_pointer code) return(code); } + /* -------------------------------- and -------------------------------- */ static bool check_and(s7_scheme *sc) { /* this and check_or and check_if may not be called -- optimize_syntax can short-circuit it to return fx* choices */ s7_pointer p, form; - bool any_nils = false; + int32_t any_nils = 0, len; form = sc->code; sc->code = cdr(sc->code); @@ -71196,13 +71309,12 @@ static bool check_and(s7_scheme *sc) sc->value = sc->T; return(true); } - - for (p = sc->code; is_pair(p); p = cdr(p)) + for (len = 0, p = sc->code; is_pair(p); p = cdr(p), len++) { s7_function callee; callee = fx_choose(sc, p, sc->envir, let_symbol_is_safe); /* c_callee can be nil! */ if (!callee) - any_nils = true; + any_nils++; set_c_call_checked(p, callee); } @@ -71210,24 +71322,45 @@ static bool check_and(s7_scheme *sc) eval_error_no_return(sc, sc->syntax_error_symbol, "and: stray dot?: ~A", 19, form); if ((c_callee(sc->code)) && - (is_pair(cdr(sc->code))) && - (is_null(cddr(sc->code)))) - pair_set_syntax_op(form, (c_callee(sc->code) == fx_is_pair_s) ? OP_AND_PAIR_P : ((any_nils) ? OP_AND_AP : OP_AND_SAFE_AA)); - else pair_set_syntax_op(form, (any_nils) ? OP_AND_P : OP_AND_SAFE_P); - + (is_pair(cdr(sc->code))) && + (is_null(cddr(sc->code)))) + { + if ((c_callee(sc->code) == fx_is_pair_s) || (c_callee(sc->code) == fx_is_pair_t)) + { + pair_set_syntax_op(form, OP_AND_PAIR_P); + set_opt3_sym(form, cadar(sc->code)); + set_opt2_con(form, cadr(sc->code)); + } + else pair_set_syntax_op(form, (any_nils > 0) ? OP_AND_AP : OP_AND_SAFE_AA); + } + else + { + pair_set_syntax_op(form, (any_nils > 0) ? OP_AND_P : OP_AND_SAFE_P); + if ((any_nils == 1) && (len > 2)) + { + if (!has_fx(sc->code)) + pair_set_syntax_op(form, OP_AND_SAFE_P1); + else + { + if (!has_fx(cdr(sc->code))) + pair_set_syntax_op(form, OP_AND_SAFE_P2); + else + { + if ((!has_fx(cddr(sc->code))) && (len == 3)) + pair_set_syntax_op(form, OP_AND_SAFE_P3); + }}}} sc->code = form; return(false); } static bool op_and_pair_p(s7_scheme *sc) { - sc->code = cdr(sc->code); - if (!is_pair(lookup(sc, cadar(sc->code)))) + if (!is_pair(lookup(sc, opt3_sym(sc->code)))) /* cadadr(sc->code) */ { sc->value = sc->F; return(true); } - sc->code = cadr(sc->code); + sc->code = opt2_con(sc->code); /* caddr(sc->code); */ return(false); } @@ -71244,9 +71377,16 @@ static bool op_and_ap(s7_scheme *sc) return(false); } -static void op_safe_and_p(s7_scheme *sc) +static void op_and_safe_aa(s7_scheme *sc) { sc->code = cdr(sc->code); + sc->value = fx_call(sc, sc->code); + if (is_true(sc, sc->value)) + sc->value = fx_call(sc, cdr(sc->code)); +} + +static void op_and_safe_p(s7_scheme *sc) +{ while (true) { sc->value = fx_call(sc, sc->code); @@ -71306,6 +71446,14 @@ static bool op_or_ap(s7_scheme *sc) return(false); } +static void op_or_safe_aa(s7_scheme *sc) +{ + sc->code = cdr(sc->code); + sc->value = fx_call(sc, sc->code); + if (is_false(sc, sc->value)) + sc->value = fx_call(sc, cdr(sc->code)); +} + static void op_or_safe_p(s7_scheme *sc) { sc->code = cdr(sc->code); @@ -71454,8 +71602,8 @@ static void set_if_opts(s7_scheme *sc, s7_pointer form, bool one_branch, bool re if (symbol_syntax_op(car(test)) == OP_AND) check_and(sc); else check_or(sc); new_op = symbol_syntax_op_checked(test); sc->code = old_code; - if ((new_op == OP_AND_P) || (new_op == OP_AND_AP) || (new_op == OP_AND_PAIR_P) || - (new_op == OP_AND_SAFE_P) || (new_op == OP_AND_SAFE_AA)) + if ((new_op == OP_AND_P) || (new_op == OP_AND_AP) || (new_op == OP_AND_PAIR_P) || (new_op == OP_AND_SAFE_AA) || + (new_op == OP_AND_SAFE_P) || (new_op == OP_AND_SAFE_P1) || (new_op == OP_AND_SAFE_P2) || (new_op == OP_AND_SAFE_P3)) pair_set_syntax_op(form, choose_if_optc(IF_ANDP, one_branch, reversed, not_case)); else { @@ -71471,7 +71619,6 @@ static void set_if_opts(s7_scheme *sc, s7_pointer form, bool one_branch, bool re } } - /* (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?? */ @@ -71505,6 +71652,7 @@ static s7_pointer check_if(s7_scheme *sc) return(sc->code); } + /* -------------------------------- when -------------------------------- */ static s7_pointer check_when(s7_scheme *sc) { @@ -71529,12 +71677,18 @@ static s7_pointer check_when(s7_scheme *sc) else { if (is_safe_symbol(car(sc->code))) - pair_set_syntax_op(form, OP_WHEN_S); + { + pair_set_syntax_op(form, OP_WHEN_S); + set_opt2_con(form, cadr(sc->code)); + set_opt3_pair(form, cddr(sc->code)); + } else { if (is_fx_safe(sc, car(sc->code))) { pair_set_syntax_op(form, OP_WHEN_A); + set_opt2_con(form, cadr(sc->code)); + set_opt3_pair(form, cddr(sc->code)); set_c_call(sc->code, fx_choose(sc, sc->code, sc->envir, let_symbol_is_safe)); } } @@ -71548,11 +71702,10 @@ static s7_pointer check_when(s7_scheme *sc) static bool op_when_s(s7_scheme *sc) { set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - if (is_true(sc, lookup(sc, car(sc->code)))) + if (is_true(sc, lookup(sc, cadr(sc->code)))) { - push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); - sc->code = cadr(sc->code); + push_stack_no_args(sc, sc->begin_op, opt3_pair(sc->code)); /* cdddr(sc->code) */ + sc->code = opt2_con(sc->code); /* caddr(sc->code) */ return(false); } sc->value = sc->unspecified; @@ -71562,11 +71715,10 @@ static bool op_when_s(s7_scheme *sc) static bool op_when_a(s7_scheme *sc) { set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - if (is_true(sc, fx_call(sc, sc->code))) + if (is_true(sc, fx_call(sc, cdr(sc->code)))) { - push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); - sc->code = cadr(sc->code); + push_stack_no_args(sc, sc->begin_op, opt3_pair(sc->code)); /* cdddr(sc->code) */ + sc->code = opt2_con(sc->code); /* caddr(sc->code) */ return(false); } sc->value = sc->unspecified; @@ -71576,9 +71728,8 @@ static bool op_when_a(s7_scheme *sc) static void op_when_p(s7_scheme *sc) { set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - push_stack_no_args(sc, OP_WHEN_PP, cdr(sc->code)); - sc->code = car(sc->code); + push_stack_no_args(sc, OP_WHEN_PP, cddr(sc->code)); + sc->code = cadr(sc->code); } static bool op_when_pp(s7_scheme *sc) @@ -71594,6 +71745,7 @@ static bool op_when_pp(s7_scheme *sc) return(true); } + /* -------------------------------- unless -------------------------------- */ static s7_pointer check_unless(s7_scheme *sc) { @@ -71618,12 +71770,18 @@ static s7_pointer check_unless(s7_scheme *sc) else { if (is_safe_symbol(car(sc->code))) - pair_set_syntax_op(form, OP_UNLESS_S); + { + pair_set_syntax_op(form, OP_UNLESS_S); + set_opt2_con(form, cadr(sc->code)); + set_opt3_pair(form, cddr(sc->code)); + } else { if (is_fx_safe(sc, car(sc->code))) { pair_set_syntax_op(form, OP_UNLESS_A); + set_opt2_con(form, cadr(sc->code)); + set_opt3_pair(form, cddr(sc->code)); set_c_call(sc->code, fx_choose(sc, sc->code, sc->envir, let_symbol_is_safe)); } } @@ -71637,11 +71795,10 @@ static s7_pointer check_unless(s7_scheme *sc) static bool op_unless_s(s7_scheme *sc) { set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - if (is_false(sc, lookup(sc, car(sc->code)))) + if (is_false(sc, lookup(sc, cadr(sc->code)))) { - push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); - sc->code = cadr(sc->code); + push_stack_no_args(sc, sc->begin_op, opt3_pair(sc->code)); /* cdddr(sc->code) */ + sc->code = opt2_con(sc->code); /* caddr(sc->code) */ return(false); } sc->value = sc->unspecified; @@ -71651,11 +71808,10 @@ static bool op_unless_s(s7_scheme *sc) static bool op_unless_a(s7_scheme *sc) { set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - if (is_false(sc, fx_call(sc, sc->code))) + if (is_false(sc, fx_call(sc, cdr(sc->code)))) { - push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); - sc->code = cadr(sc->code); + push_stack_no_args(sc, sc->begin_op, opt3_pair(sc->code)); /* cdddr(sc->code) */ + sc->code = opt2_con(sc->code); /* caddr(sc->code) */ return(false); } sc->value = sc->unspecified; @@ -71665,9 +71821,8 @@ static bool op_unless_a(s7_scheme *sc) static void op_unless_p(s7_scheme *sc) { set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - push_stack_no_args(sc, OP_UNLESS_PP, cdr(sc->code)); - sc->code = car(sc->code); + push_stack_no_args(sc, OP_UNLESS_PP, cddr(sc->code)); + sc->code = cadr(sc->code); } static bool op_unless_pp(s7_scheme *sc) @@ -71750,6 +71905,8 @@ static s7_pointer check_define(s7_scheme *sc) /* 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", 17, caller, form); + if (!is_pair(cddr(cadr(sc->code)))) /* (define (f (arg))) or (define f (lambda (arg))) */ + eval_error_with_caller(sc, "~A: no body: ~A", 15, caller, form); 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); @@ -71798,13 +71955,13 @@ static bool define_unchecked_ex(s7_scheme *sc) { s7_pointer x; uint64_t typ; - typ = (!is_pair(cdar(sc->code))) ? T_CLOSURE : T_CLOSURE_STAR | closure_bits(cdr(sc->code)); + if (is_pair(cdar(sc->code))) typ = T_CLOSURE_STAR | closure_bits(cdr(sc->code)); else typ = T_CLOSURE; new_cell(sc, x, typ); closure_set_args(x, cdar(sc->code)); closure_set_body(x, cdr(sc->code)); if (is_pair(cddr(sc->code))) set_closure_has_multiform(x); else set_closure_has_one_form(x); closure_set_let(x, sc->envir); - closure_arity(x) = CLOSURE_ARITY_NOT_SET; + closure_set_arity(x, CLOSURE_ARITY_NOT_SET); closure_set_setter(x, sc->F); sc->capture_let_counter++; sc->value = x; @@ -71849,7 +72006,6 @@ static bool define_unchecked_ex(s7_scheme *sc) static s7_pointer make_funclet(s7_scheme *sc, s7_pointer new_func, s7_pointer func_name, s7_pointer outer_env) { s7_pointer new_env; - /* fprintf(stderr, "make_funclet: %s %d\n", DISPLAY(new_func), is_safe_closure(new_func)); */ new_cell_no_check(sc, new_env, T_LET | T_FUNCLET); let_id(new_env) = ++sc->let_number; let_set_slots(new_env, slot_end(sc)); @@ -71869,7 +72025,6 @@ static s7_pointer make_funclet(s7_scheme *sc, s7_pointer new_func, s7_pointer fu else { s7_pointer slot; - /* fprintf(stderr, "args: %s\n", DISPLAY(closure_args(new_func))); */ for (arg = closure_args(new_func); is_pair(arg); arg = cdr(arg)) { if (is_pair(car(arg))) @@ -71885,7 +72040,7 @@ static s7_pointer make_funclet(s7_scheme *sc, s7_pointer new_func, s7_pointer fu set_slot_defaults(slot); } } - else + else { if (is_keyword(car(arg))) { @@ -71952,16 +72107,13 @@ static void define_funchecked(s7_scheme *sc) closure_set_body(new_func, cdr(code)); if (is_pair(cddr(code))) set_closure_has_multiform(new_func); else set_closure_has_one_form(new_func); closure_set_setter(new_func, sc->F); - closure_arity(new_func) = CLOSURE_ARITY_NOT_SET; + closure_set_arity(new_func, CLOSURE_ARITY_NOT_SET); sc->capture_let_counter++; - if (is_safe_closure(cdr(code))) + if (is_safe_closure_body(cdr(code))) { -#if SAFE_FORM_PRINT - fprintf(stderr, "%s %s is a safe-closure\n", __func__, DISPLAY_80(code)); -#endif set_safe_closure(new_func); - if (is_very_safe_closure(cdr(code))) + if (is_very_safe_closure_body(cdr(code))) set_very_safe_closure(new_func); make_funclet(sc, new_func, sc->value, sc->envir); } @@ -71982,7 +72134,6 @@ static void define_funchecked(s7_scheme *sc) sc->value = new_func; } - static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op) { s7_pointer x, y, caller; @@ -72551,7 +72702,7 @@ static bool op_cond_fx_2(s7_scheme *sc) return(is_null(sc->code)); } -static bool fx_cond_value(s7_scheme *sc) +static inline bool fx_cond_value(s7_scheme *sc) { if (is_null(sc->code)) return(true); @@ -72615,7 +72766,7 @@ static bool op_cond_fx_2p_else(s7_scheme *sc) sc->value = sc->else_symbol; /* in case (else) */ } } - return(fx_cond_value(sc)); + return(fx_cond_value(sc)); } @@ -72625,6 +72776,7 @@ static void set_dilambda_opt(s7_scheme *sc, s7_pointer form, opcode_t opt, s7_po s7_pointer func; func = lookup_checked(sc, car(expr)); if ((is_closure(func)) && + (is_closure(closure_setter(func))) && (is_safe_closure(closure_setter(func)))) { s7_pointer setter; @@ -72734,7 +72886,7 @@ static inline s7_pointer check_set(s7_scheme *sc) { if ((caadr(inner) == sc->quote_symbol) && (is_symbol(car(inner))) && - ((is_normal_symbol(value)) || + ((is_normal_symbol(value)) || (is_fx_safe(sc, value)))) { if (is_safe_symbol(value)) @@ -72765,7 +72917,7 @@ static inline s7_pointer check_set(s7_scheme *sc) } else { - if ((!is_pair(value)) || + if ((!is_pair(value)) || ((car(value) == sc->quote_symbol) && (is_pair(cdr(value))))) /* (quote . 1) ? */ { pair_set_syntax_op(form, OP_SET_SYMBOL_C); @@ -72779,7 +72931,7 @@ static inline s7_pointer check_set(s7_scheme *sc) * car(sc->t2_1) = slot_value(slot), car(sc->t2_2) = increment, call <op>, set slot_value(slot) * this can be done in all combined cases where a symbol is repeated (do in particular) */ - + /* (define (hi) (let ((x 1)) (set! x (+ x 1)))) * but the value might be values: * (let () (define (hi) (let ((x 0)) (set! x (values 1 2)) x)) (catch #t hi (lambda a a)) (hi)) @@ -72893,7 +73045,6 @@ static inline s7_pointer check_set(s7_scheme *sc) pair_set_syntax_op(form, OP_SET_CONS); set_opt2_sym(sc->code, cadr(value)); }}}}}}}}} - /* fprintf(stderr, "%s -> %s\n", DISPLAY_80(form), op_names[optimize_op(form)]); */ sc->code = form; return(sc->code); } @@ -73201,7 +73352,7 @@ static s7_pointer op_set1(s7_scheme *sc) else { if (has_let_set_fallback(sc->envir)) /* (with-let (mock-hash-table 'b 2) (set! b 3)) */ - return(call_let_set_fallback(sc, sc->envir, sc->code, sc->value)); + return(call_let_set_fallback(sc, sc->envir, sc->code, sc->value)); } eval_type_error(sc, "set! ~A: unbound variable", 25, sc->code); } @@ -73368,7 +73519,7 @@ static void op_increment_sp_mv(s7_scheme *sc) /* -------------------------------- do -------------------------------- */ -static bool safe_stepper(s7_pointer expr, s7_pointer vars) +static bool safe_stepper_expr(s7_pointer expr, s7_pointer vars) { /* for now, just look for stepper as last element of any list * any embedded set is handled by do-is-safe, so we don't need to descend into the depths @@ -73397,6 +73548,553 @@ static bool safe_stepper(s7_pointer expr, s7_pointer vars) return(true); } +static int32_t set_c_object_ex(s7_scheme *sc, s7_pointer cx) +{ + s7_pointer settee, index, val; + + if (is_null(cdr(sc->code))) + s7_wrong_number_of_args_error(sc, "no value for object-set!: ~S", sc->code); + if (!is_null(cddr(sc->code))) + s7_wrong_number_of_args_error(sc, "too many values for object-set!: ~S", sc->code); + + settee = car(sc->code); + if ((is_null(cdr(settee))) || + (!is_null(cddr(settee)))) + { + push_op_stack(sc, sc->c_object_set_function); + if (is_null(cdr(settee))) + { + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cddr(sc->code)); + sc->code = cadr(sc->code); + } + else + { + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code))); + sc->code = cadr(settee); + } + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + + index = cadr(settee); + if (!is_pair(index)) + { + if (is_symbol(index)) + index = lookup_checked(sc, index); + + val = cadr(sc->code); + if (!is_pair(val)) + { + if (is_symbol(val)) + val = lookup_checked(sc, val); + set_car(sc->t3_1, cx); + set_car(sc->t3_2, index); + set_car(sc->t3_3, val); + sc->value = (*(c_object_set(sc, cx)))(sc, sc->t3_1); + return(goto_START); + } + push_op_stack(sc, sc->c_object_set_function); + sc->args = list_2(sc, index, cx); + sc->code = cdr(sc->code); + return(goto_EVAL_ARGS); + } + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); + push_op_stack(sc, sc->c_object_set_function); + sc->code = cadr(settee); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_vector_ex(s7_scheme *sc, s7_pointer cx) +{ + /* cx is the vector, sc->code is expr without the set! */ + /* args have not been evaluated! */ + + s7_pointer settee, index, val; + s7_int argnum; + + if (is_null(cdr(sc->code))) /* (set! (v 0)) */ + s7_wrong_number_of_args_error(sc, "no value for vector-set!: ~S", sc->code); + if (!is_null(cddr(sc->code))) /* (set! (v 0) 1 2) */ + s7_wrong_number_of_args_error(sc, "too many values for vector-set!: ~S", sc->code); + + settee = car(sc->code); + if (is_null(cdr(settee))) + s7_wrong_number_of_args_error(sc, "no index for vector-set!: ~S", sc->code); + if (is_immutable(cx)) + immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, cx)); + + argnum = safe_list_length(cdr(settee)); + if ((argnum > 1) && + (is_normal_vector(cx)) && + (argnum != vector_rank(cx))) + { + /* this block needs to be first to handle (eg): + * (let ((v (vector (inlet 'a 0)))) (set! (v 0 'a) 32) v): #((inlet 'a 32)) + */ + push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); + sc->code = list_2(sc, car(settee), cadr(settee)); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + + if ((argnum > 1) || (vector_rank(cx) > 1)) + { + if ((argnum == vector_rank(cx)) && + (!is_pair(cadr(sc->code)))) + { + s7_pointer p; + for (p = cdr(settee); is_pair(p); p = cdr(p)) + if (is_pair(car(p))) break; + if (is_null(p)) + { + s7_pointer args, pa; + args = safe_list_if_possible(sc, argnum + 2); + car(args) = cx; + for (p = cdr(settee), pa = cdr(args); is_pair(p); p = cdr(p), pa = cdr(pa)) + { + index = car(p); + if (is_symbol(index)) + index = lookup_checked(sc, index); + if (!s7_is_integer(index)) + eval_error_no_return(sc, sc->wrong_type_arg_symbol, "vector-set!: index must be an integer: ~S", 41, sc->code); + car(pa) = index; + } + car(pa) = cadr(sc->code); + if (is_symbol(car(pa))) + car(pa) = lookup_checked(sc, car(pa)); + sc->value = g_vector_set(sc, args); + clear_list_in_use(args); + return(goto_START); + } + } + push_op_stack(sc, sc->vector_set_function); /* vector_setter(cx) has wrong args */ + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code))); /* i.e. rest(args) + val */ + sc->code = cadr(settee); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + + /* one index, rank == 1 */ + index = cadr(settee); + if (!is_pair(index)) + { + s7_int ind; + + if (is_symbol(index)) + index = lookup_checked(sc, index); + if (!s7_is_integer(index)) + eval_error_no_return(sc, sc->wrong_type_arg_symbol, "vector-set!: index must be an integer: ~S", 41, sc->code); + ind = s7_integer(index); + if ((ind < 0) || + (ind >= vector_length(cx))) + out_of_range(sc, sc->vector_set_symbol, small_int(2), index, (ind < 0) ? its_negative_string : its_too_large_string); + val = cadr(sc->code); + if (!is_pair(val)) + { + if (is_symbol(val)) + val = lookup_checked(sc, val); + if (is_typed_vector(cx)) + typed_vector_setter(sc, cx, ind, val); + else vector_setter(cx)(sc, cx, ind, val); + sc->value = T_Pos(val); + return(goto_START); + } + push_op_stack(sc, sc->vector_set_function); + sc->args = list_2(sc, index, cx); + sc->code = cdr(sc->code); + return(goto_EVAL_ARGS); + } + /* here the index calc might be trivial -- (+ i 1) or (- j 1) but this branch hardly ever happens */ + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); + push_op_stack(sc, sc->vector_set_function); + sc->code = cadr(settee); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_string_ex(s7_scheme *sc, s7_pointer cx) +{ + /* sc->code = cons(sc, sc->string_set_function, s7_append(sc, car(sc->code), cdr(sc->code))); + * + * here only one index makes sense, and it is required, so + * (set! ("str") #\a), (set! ("str" . 1) #\a) and (set! ("str" 1 2) #\a) + * are all errors (but see below!). + */ + s7_pointer settee, index, val; + + if (is_null(cdr(sc->code))) s7_wrong_number_of_args_error(sc, "no value for string-set!: ~S", sc->code); + if (!is_null(cddr(sc->code))) s7_wrong_number_of_args_error(sc, "too many values for string-set!: ~S", sc->code); + + settee = car(sc->code); + if (is_null(cdr(settee))) s7_wrong_number_of_args_error(sc, "no index for string-set!: ~S", sc->code); + if (!is_null(cddr(settee))) s7_wrong_number_of_args_error(sc, "too many indices for string-set!: ~S", sc->code); + + /* if there's one index (the standard case), and it is not a pair, and there's one value (also standard) + * and it is not a pair, let's optimize this thing! + * cx is what we're setting, cadar is the index, cadr is the new value + */ + index = cadr(settee); + if (!is_pair(index)) + { + s7_int ind; + + if (is_symbol(index)) + index = lookup_checked(sc, index); + if (!s7_is_integer(index)) + eval_error_no_return(sc, sc->wrong_type_arg_symbol, "index must be an integer: ~S", 28, sc->code); + ind = s7_integer(index); + if ((ind < 0) || + (ind >= string_length(cx))) + out_of_range(sc, sc->string_set_symbol, small_int(2), index, (ind < 0) ? its_negative_string : its_too_large_string); + if (is_immutable(cx)) + immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->string_set_symbol, cx)); + + val = cadr(sc->code); + if (!is_pair(val)) + { + if (is_symbol(val)) + val = lookup_checked(sc, val); + if (s7_is_character(val)) + { + string_value(cx)[ind] = character(val); + sc->value = val; + return(goto_START); + } + eval_error_no_return(sc, sc->wrong_type_arg_symbol, "value must be a character: ~S", 29, sc->code); + } + push_op_stack(sc, sc->string_set_function); + sc->args = list_2(sc, index, cx); + sc->code = cdr(sc->code); + return(goto_EVAL_ARGS); + } + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); + push_op_stack(sc, sc->string_set_function); + sc->code = cadar(sc->code); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_cons_ex(s7_scheme *sc, s7_pointer cx) /* code: ((lst 1) 32) from (let ((lst (list 1 2 3))) (set! (lst 1) 32)) */ +{ + s7_pointer settee, index, val; + + if (is_null(cdr(sc->code))) + s7_wrong_number_of_args_error(sc, "no value for list-set!: ~S", sc->code); + if (!is_null(cddr(sc->code))) + s7_wrong_number_of_args_error(sc, "too many values for list-set!: ~S", sc->code); + + settee = car(sc->code); + if (is_null(cdr(settee))) + s7_wrong_number_of_args_error(sc, "no index for list-set!: ~S", sc->code); + + if (!is_null(cddr(settee))) + { + /* split (set! (a b c...) v) into (set! ((a b) c ...) v), eval (a b), return + * (let ((L (list (list 1 2)))) (set! (L 0 0) 3) L) + */ + push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); + sc->code = list_2(sc, car(settee), cadr(settee)); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + + index = cadr(settee); + val = cadr(sc->code); + + if ((is_pair(index)) || + (is_pair(val))) + { + push_op_stack(sc, sc->list_set_function); + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code))); + sc->code = index; + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + + if (is_symbol(index)) + index = lookup_checked(sc, index); + if (is_symbol(val)) + val = lookup_checked(sc, val); + + set_car(sc->t2_1, index); + set_car(sc->t2_2, val); + sc->value = g_list_set_1(sc, cx, sc->t2_1, 2); + return(goto_START); +} + +static int32_t set_hash_table_ex(s7_scheme *sc, s7_pointer cx) +{ + s7_pointer settee, key; + + if (is_null(cdr(sc->code))) + s7_wrong_number_of_args_error(sc, "no value for hash-table-set!: ~S", sc->code); + if (!is_null(cddr(sc->code))) + s7_wrong_number_of_args_error(sc, "too many values for hash-table-set!: ~S", sc->code); + + settee = car(sc->code); + if (is_null(cdr(settee))) + s7_wrong_number_of_args_error(sc, "no key for hash-table-set!: ~S", sc->code); + if (is_immutable(cx)) + immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->hash_table_set_symbol, cx)); + + if (!is_null(cddr(settee))) + { + push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); + sc->code = list_2(sc, car(settee), cadr(settee)); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + + key = cadr(settee); + if (!is_pair(key)) + { + s7_pointer val; + if (is_symbol(key)) + key = lookup_checked(sc, key); + val = cadr(sc->code); + if (!is_pair(val)) + { + if (is_symbol(val)) + val = lookup_checked(sc, val); + sc->value = s7_hash_table_set(sc, cx, key, val); + return(goto_START); + } + push_op_stack(sc, sc->hash_table_set_function); + sc->args = list_2(sc, key, cx); + sc->code = cdr(sc->code); + return(goto_EVAL_ARGS); + } + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); + push_op_stack(sc, sc->hash_table_set_function); + sc->code = cadar(sc->code); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_let_ex(s7_scheme *sc, s7_pointer cx) /* sc->code = cons(sc, sc->let_set_function, s7_append(sc, car(sc->code), cdr(sc->code))); */ +{ + s7_pointer settee, key; + /* code: ((gen 'input) input) from (set! (gen 'input) input) */ + + if (is_null(cdr(sc->code))) + s7_wrong_number_of_args_error(sc, "no value for let-set!: ~S", sc->code); + if (!is_null(cddr(sc->code))) + s7_wrong_number_of_args_error(sc, "too many values for let-set!: ~S", sc->code); + + settee = car(sc->code); + if (is_null(cdr(settee))) + s7_wrong_number_of_args_error(sc, "no symbol (variable name) for let-set!: ~S", sc->code); + if (is_immutable(cx)) + immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->let_set_symbol, cx)); + + if (!is_null(cddr(settee))) + { + push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); + sc->code = list_2(sc, car(settee), cadr(settee)); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + + key = cadr(settee); + if (is_proper_quote(sc, key)) + { + s7_pointer val; + key = cadr(key); + val = cadr(sc->code); + if (!is_pair(val)) + { + if (is_symbol(val)) + val = lookup_checked(sc, val); + sc->value = s7_let_set(sc, cx, key, val); + return(goto_START); + } + push_op_stack(sc, sc->let_set_function); + sc->args = list_2(sc, key, cx); + sc->code = cdr(sc->code); + return(goto_EVAL_ARGS); + } + push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); + push_op_stack(sc, sc->let_set_function); + sc->code = cadar(sc->code); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_function_ex(s7_scheme *sc, s7_pointer cx) /* (let ((lst (list 1 2))) (set! (list-ref lst 0) 2) lst) */ +{ + /* perhaps it has a setter */ + if (is_t_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))) + { + if ((is_symbol(cadr(sc->code))) && + (is_symbol(cadar(sc->code)))) + { + if (is_null(cddar(sc->code))) + { + if (needs_copied_args(c_function_setter(cx))) + sc->args = list_2(sc, lookup_checked(sc, cadar(sc->code)), lookup_checked(sc, cadr(sc->code))); + else + { + set_car(sc->t2_1, lookup_checked(sc, cadar(sc->code))); + set_car(sc->t2_2, lookup_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)))) + { + if (needs_copied_args(c_function_setter(cx))) + sc->args = list_3(sc, + lookup_checked(sc, cadar(sc->code)), + lookup_checked(sc, caddar(sc->code)), + lookup_checked(sc, cadr(sc->code))); + else + { + set_car(sc->t3_1, lookup_checked(sc, cadar(sc->code))); + set_car(sc->t3_2, lookup_checked(sc, caddar(sc->code))); + set_car(sc->t3_3, lookup_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); + } + else + { + if ((is_null(cddr(sc->code))) && + (!is_pair(cadr(sc->code)))) + { + if (needs_copied_args(c_function_setter(cx))) + sc->args = list_1(sc, (is_symbol(cadr(sc->code))) ? lookup_checked(sc, cadr(sc->code)) : cadr(sc->code)); + else + { + if (is_symbol(cadr(sc->code))) + set_car(sc->t1_1, lookup_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 */ + } + push_op_stack(sc, c_function_setter(cx)); + push_stack(sc, OP_EVAL_ARGS1, sc->nil, cddr(sc->code)); + sc->code = cadr(sc->code); + } + } + else + { + if (is_any_macro(c_function_setter(cx))) + { + if (is_null(cdar(sc->code))) + sc->args = copy_list(sc, cdr(sc->code)); + else sc->args = s7_append(sc, cdar(sc->code), copy_list(sc, cdr(sc->code))); + /* append copies except for its last arg, but for macros, we have to copy everything, hence the extra copy_list */ + sc->code = c_function_setter(cx); + return(goto_APPLY); + } + eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar(sc->code)); + } + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_closure_ex(s7_scheme *sc, s7_pointer cx) +{ + s7_pointer setter; + setter = closure_setter(cx); + if ((setter == sc->F) && + (!closure_no_setter(cx))) + setter = g_setter(sc, set_plist_1(sc, cx)); + if (is_t_procedure(setter)) /* appears to be caar_code */ + { + /* (set! (o g) ...), here cx = o, sc->code = ((o g) ...) */ + push_op_stack(sc, setter); + if (is_null(cdar(sc->code))) + { + push_stack(sc, OP_EVAL_ARGS1, sc->nil, cddr(sc->code)); + sc->code = cadr(sc->code); + } + else + { + if (is_null(cddar(sc->code))) + push_stack(sc, OP_EVAL_ARGS1, sc->nil, cdr(sc->code)); + else push_stack(sc, OP_EVAL_ARGS1, sc->nil, s7_append(sc, cddar(sc->code), cdr(sc->code))); + sc->code = cadar(sc->code); + } + } + else + { + if (is_any_macro(setter)) + { + if (is_null(cdar(sc->code))) + sc->args = copy_list(sc, cdr(sc->code)); + else sc->args = s7_append(sc, cdar(sc->code), copy_list(sc, cdr(sc->code))); + sc->code = setter; + return(goto_APPLY); + } + eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar(sc->code)); + } + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_iterator_ex(s7_scheme *sc, s7_pointer cx) +{ + s7_pointer setter; + setter = iterator_sequence(cx); + if ((is_any_closure(setter)) || (is_any_macro(setter))) + setter = closure_setter(iterator_sequence(cx)); + else setter = sc->F; + if (is_procedure(setter)) + { + push_op_stack(sc, setter); + push_stack(sc, OP_EVAL_ARGS1, sc->nil, sc->nil); + sc->code = cadr(sc->code); /* the (as yet unevaluated) value, incoming code was ((obj) val) */ + } + else + { + if (is_any_macro(setter)) + { + sc->args = list_1(sc, cadr(sc->code)); + sc->code = setter; + return(goto_APPLY); + } + eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar(sc->code)); + } + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); +} + +static int32_t set_syntax_ex(s7_scheme *sc, s7_pointer cx) +{ + if (cx == slot_value(global_slot(sc->with_let_symbol))) + { + /* (set! (with-let a b) x), cx = with-let, sc->code = ((with-let a b) x) + * a and x are in the current env, b is in a, we need to evaluate a and x, then + * call (with-let a-value (set! b x-value)) + */ + sc->args = cdar(sc->code); + sc->code = cadr(sc->code); + push_stack(sc, OP_SET_WITH_LET_1, sc->args, sc->code); + sc->cur_op = optimize_op(sc->code); + return(goto_TOP_NO_POP); + } + eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar(sc->code)); + return(goto_TOP_NO_POP); +} + static int32_t set_pair_ex(s7_scheme *sc) { s7_pointer caar_code, cx; @@ -73425,578 +74123,53 @@ static int32_t set_pair_ex(s7_scheme *sc) /* for these kinds of objects, some Schemes restrict set! * (list-set! '(1 2 3) 1 32) is accepted but does it make sense? - * (set-car! '(1 . 2) 32) * (string-set! "hiho" 1 #\z) * (vector-set! #(1 2 3) 1 32) - * (let ((x (lambda () "hiho"))) (string-set! (x) 1 #\a)) * (let ((x (lambda () #(1 2 3)))) (vector-set! (x) 1 32)) * (let ((str "hiho")) (string-set! str 1 #\x) str) - * (let ((v #(1 2 3))) (vector-set! v 1 32) v) * (let ((x (lambda () "hiho"))) (string-set! (x) 1 #\x) (x)) - * - * It seems weird that we can reach into both the function body, and its closure: - * (let ((xx (let ((x '(1 2 3))) (lambda () x)))) (list-set! (xx) 1 32) (xx)) -> '(1 32 3) - * - * (let* ((x '(1 2)) (y (list x)) (z (car y))) (list-set! z 1 32) (list x y z)) - * ((1 32) ((1 32)) (1 32)) - * - * (string-set! (symbol->string 'symbol->string) 1 #\X) -> error currently also in Guile "string is read-only" - * (setf (elt (symbol-name 'xyz) 1) #\X) -> error in CL "read-only string" + * (let ((xx (let ((x '(1 2 3))) (lambda () x)))) (list-set! (xx) 1 32) (xx)) -> '(1 32 3) + * (let* ((x '(1 2)) (y (list x)) (z (car y))) (list-set! z 1 32) (list x y z)) -> '((1 32) ((1 32)) (1 32)) */ /* for gmp case, indices need to be decoded via s7_integer, not just integer */ - /* fprintf(stderr, "code: %s, cx: %s\n", DISPLAY(sc->code), DISPLAY(cx)); */ switch (type(cx)) { case T_C_OBJECT: - { - s7_pointer settee, index, val; - - if (is_null(cdr(sc->code))) - s7_wrong_number_of_args_error(sc, "no value for object-set!: ~S", sc->code); - if (!is_null(cddr(sc->code))) - s7_wrong_number_of_args_error(sc, "too many values for object-set!: ~S", sc->code); - - settee = car(sc->code); - if ((is_null(cdr(settee))) || - (!is_null(cddr(settee)))) - { - push_op_stack(sc, sc->c_object_set_function); - if (is_null(cdr(settee))) - { - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cddr(sc->code)); - sc->code = cadr(sc->code); - } - else - { - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code))); - sc->code = cadr(settee); - } - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - - index = cadr(settee); - if (!is_pair(index)) - { - if (is_symbol(index)) - index = lookup_checked(sc, index); - - val = cadr(sc->code); - if (!is_pair(val)) - { - if (is_symbol(val)) - val = lookup_checked(sc, val); - set_car(sc->t3_1, cx); - set_car(sc->t3_2, index); - set_car(sc->t3_3, val); - sc->value = (*(c_object_set(sc, cx)))(sc, sc->t3_1); - return(goto_START); - } - push_op_stack(sc, sc->c_object_set_function); - sc->args = list_2(sc, index, cx); - sc->code = cdr(sc->code); - return(goto_EVAL_ARGS); - } - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); - push_op_stack(sc, sc->c_object_set_function); - sc->code = cadr(settee); - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } + return(set_c_object_ex(sc, cx)); case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR: case T_BYTE_VECTOR: - { - /* cx is the vector, sc->code is expr without the set! */ - /* args have not been evaluated! */ - - s7_pointer settee, index, val; - s7_int argnum; - /* fprintf(stderr, "%s\n", DISPLAY_80(sc->code)); */ - - if (is_null(cdr(sc->code))) /* (set! (v 0)) */ - s7_wrong_number_of_args_error(sc, "no value for vector-set!: ~S", sc->code); - if (!is_null(cddr(sc->code))) /* (set! (v 0) 1 2) */ - s7_wrong_number_of_args_error(sc, "too many values for vector-set!: ~S", sc->code); - - settee = car(sc->code); - if (is_null(cdr(settee))) - s7_wrong_number_of_args_error(sc, "no index for vector-set!: ~S", sc->code); - if (is_immutable(cx)) - immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, cx)); - - argnum = safe_list_length(cdr(settee)); - if ((argnum > 1) && - (is_normal_vector(cx)) && - (argnum != vector_rank(cx))) - { - /* this block needs to be first to handle (eg): - * (let ((v (vector (inlet 'a 0)))) (set! (v 0 'a) 32) v): #((inlet 'a 32)) - */ - push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); - sc->code = list_2(sc, car(settee), cadr(settee)); - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - - if ((argnum > 1) || (vector_rank(cx) > 1)) - { - if ((argnum == vector_rank(cx)) && - (!is_pair(cadr(sc->code)))) - { - s7_pointer p; - for (p = cdr(settee); is_pair(p); p = cdr(p)) - if (is_pair(car(p))) break; - if (is_null(p)) - { - s7_pointer args, pa; - args = safe_list_if_possible(sc, argnum + 2); - car(args) = cx; - for (p = cdr(settee), pa = cdr(args); is_pair(p); p = cdr(p), pa = cdr(pa)) - { - index = car(p); - if (is_symbol(index)) - index = lookup_checked(sc, index); - if (!s7_is_integer(index)) - eval_error_no_return(sc, sc->wrong_type_arg_symbol, "vector-set!: index must be an integer: ~S", 41, sc->code); - car(pa) = index; - } - car(pa) = cadr(sc->code); - if (is_symbol(car(pa))) - car(pa) = lookup_checked(sc, car(pa)); - sc->value = g_vector_set(sc, args); - clear_list_in_use(args); - return(goto_START); - } - } - push_op_stack(sc, sc->vector_set_function); /* vector_setter(cx) has wrong args */ - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code))); /* i.e. rest(args) + val */ - sc->code = cadr(settee); - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - - /* one index, rank == 1 */ - index = cadr(settee); - if (!is_pair(index)) - { - s7_int ind; - - if (is_symbol(index)) - index = lookup_checked(sc, index); - if (!s7_is_integer(index)) - eval_error_no_return(sc, sc->wrong_type_arg_symbol, "vector-set!: index must be an integer: ~S", 41, sc->code); - ind = s7_integer(index); - if ((ind < 0) || - (ind >= vector_length(cx))) - out_of_range(sc, sc->vector_set_symbol, small_int(2), index, (ind < 0) ? its_negative_string : its_too_large_string); - val = cadr(sc->code); - if (!is_pair(val)) - { - if (is_symbol(val)) - val = lookup_checked(sc, val); - if (is_typed_vector(cx)) - typed_vector_setter(sc, cx, ind, val); - else vector_setter(cx)(sc, cx, ind, val); - sc->value = T_Pos(val); - return(goto_START); - } - push_op_stack(sc, sc->vector_set_function); - sc->args = list_2(sc, index, cx); - sc->code = cdr(sc->code); - return(goto_EVAL_ARGS); - } - /* here the index calc might be trivial -- (+ i 1) or (- j 1) but this branch hardly ever happens */ - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); - push_op_stack(sc, sc->vector_set_function); - sc->code = cadr(settee); - } - break; + return(set_vector_ex(sc, cx)); case T_STRING: - { - /* sc->code = cons(sc, sc->string_set_function, s7_append(sc, car(sc->code), cdr(sc->code))); - * - * here only one index makes sense, and it is required, so - * (set! ("str") #\a), (set! ("str" . 1) #\a) and (set! ("str" 1 2) #\a) - * are all errors (but see below!). - */ - s7_pointer settee, index, val; - - if (is_null(cdr(sc->code))) s7_wrong_number_of_args_error(sc, "no value for string-set!: ~S", sc->code); - if (!is_null(cddr(sc->code))) s7_wrong_number_of_args_error(sc, "too many values for string-set!: ~S", sc->code); - - settee = car(sc->code); - if (is_null(cdr(settee))) s7_wrong_number_of_args_error(sc, "no index for string-set!: ~S", sc->code); - if (!is_null(cddr(settee))) s7_wrong_number_of_args_error(sc, "too many indices for string-set!: ~S", sc->code); - - /* if there's one index (the standard case), and it is not a pair, and there's one value (also standard) - * and it is not a pair, let's optimize this thing! - * cx is what we're setting, cadar is the index, cadr is the new value - */ - index = cadr(settee); - if (!is_pair(index)) - { - s7_int ind; - - if (is_symbol(index)) - index = lookup_checked(sc, index); - if (!s7_is_integer(index)) - eval_error_no_return(sc, sc->wrong_type_arg_symbol, "index must be an integer: ~S", 28, sc->code); - ind = s7_integer(index); - if ((ind < 0) || - (ind >= string_length(cx))) - out_of_range(sc, sc->string_set_symbol, small_int(2), index, (ind < 0) ? its_negative_string : its_too_large_string); - if (is_immutable(cx)) - immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->string_set_symbol, cx)); - - val = cadr(sc->code); - if (!is_pair(val)) - { - if (is_symbol(val)) - val = lookup_checked(sc, val); - if (s7_is_character(val)) - { - string_value(cx)[ind] = character(val); - sc->value = val; - return(goto_START); - } - eval_error_no_return(sc, sc->wrong_type_arg_symbol, "value must be a character: ~S", 29, sc->code); - } - push_op_stack(sc, sc->string_set_function); - sc->args = list_2(sc, index, cx); - sc->code = cdr(sc->code); - return(goto_EVAL_ARGS); - } - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); - push_op_stack(sc, sc->string_set_function); - sc->code = cadar(sc->code); - } - break; + return(set_string_ex(sc, cx)); case T_PAIR: - /* code: ((lst 1) 32) from (let ((lst (list 1 2 3))) (set! (lst 1) 32)) */ - { - s7_pointer settee, index, val; - - if (is_null(cdr(sc->code))) - s7_wrong_number_of_args_error(sc, "no value for list-set!: ~S", sc->code); - if (!is_null(cddr(sc->code))) - s7_wrong_number_of_args_error(sc, "too many values for list-set!: ~S", sc->code); - - settee = car(sc->code); - if (is_null(cdr(settee))) - s7_wrong_number_of_args_error(sc, "no index for list-set!: ~S", sc->code); - - if (!is_null(cddr(settee))) - { - /* split (set! (a b c...) v) into (set! ((a b) c ...) v), eval (a b), return - * (let ((L (list (list 1 2)))) (set! (L 0 0) 3) L) - */ - push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); - sc->code = list_2(sc, car(settee), cadr(settee)); - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - - index = cadr(settee); - val = cadr(sc->code); - - if ((is_pair(index)) || - (is_pair(val))) - { - push_op_stack(sc, sc->list_set_function); - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code))); - sc->code = index; - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - - if (is_symbol(index)) - index = lookup_checked(sc, index); - if (is_symbol(val)) - val = lookup_checked(sc, val); - - set_car(sc->t2_1, index); - set_car(sc->t2_2, val); - sc->value = g_list_set_1(sc, cx, sc->t2_1, 2); - return(goto_START); - } + return(set_cons_ex(sc, cx)); case T_HASH_TABLE: - { - s7_pointer settee, key; - - if (is_null(cdr(sc->code))) - s7_wrong_number_of_args_error(sc, "no value for hash-table-set!: ~S", sc->code); - if (!is_null(cddr(sc->code))) - s7_wrong_number_of_args_error(sc, "too many values for hash-table-set!: ~S", sc->code); - - settee = car(sc->code); - if (is_null(cdr(settee))) - s7_wrong_number_of_args_error(sc, "no key for hash-table-set!: ~S", sc->code); - if (is_immutable(cx)) - immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->hash_table_set_symbol, cx)); - - if (!is_null(cddr(settee))) - { - push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); - sc->code = list_2(sc, car(settee), cadr(settee)); - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - - key = cadr(settee); - if (!is_pair(key)) - { - s7_pointer val; - if (is_symbol(key)) - key = lookup_checked(sc, key); - val = cadr(sc->code); - if (!is_pair(val)) - { - if (is_symbol(val)) - val = lookup_checked(sc, val); - sc->value = s7_hash_table_set(sc, cx, key, val); - return(goto_START); - } - push_op_stack(sc, sc->hash_table_set_function); - sc->args = list_2(sc, key, cx); - sc->code = cdr(sc->code); - return(goto_EVAL_ARGS); - } - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); - push_op_stack(sc, sc->hash_table_set_function); - sc->code = cadar(sc->code); - } - break; + return(set_hash_table_ex(sc, cx)); case T_LET: - /* sc->code = cons(sc, sc->let_set_function, s7_append(sc, car(sc->code), cdr(sc->code))); */ - { - s7_pointer settee, key; - /* code: ((gen 'input) input) from (set! (gen 'input) input) */ - - if (is_null(cdr(sc->code))) - s7_wrong_number_of_args_error(sc, "no value for let-set!: ~S", sc->code); - if (!is_null(cddr(sc->code))) - s7_wrong_number_of_args_error(sc, "too many values for let-set!: ~S", sc->code); - - settee = car(sc->code); - if (is_null(cdr(settee))) - s7_wrong_number_of_args_error(sc, "no symbol (variable name) for let-set!: ~S", sc->code); - if (is_immutable(cx)) - immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->let_set_symbol, cx)); - - if (!is_null(cddr(settee))) - { - push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code)); - sc->code = list_2(sc, car(settee), cadr(settee)); - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - - key = cadr(settee); - if (is_proper_quote(sc, key)) - { - s7_pointer val; - key = cadr(key); - val = cadr(sc->code); - if (!is_pair(val)) - { - if (is_symbol(val)) - val = lookup_checked(sc, val); - sc->value = s7_let_set(sc, cx, key, val); - return(goto_START); - } - push_op_stack(sc, sc->let_set_function); - sc->args = list_2(sc, key, cx); - sc->code = cdr(sc->code); - return(goto_EVAL_ARGS); - } - push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code)); - push_op_stack(sc, sc->let_set_function); - sc->code = cadar(sc->code); - } - break; + return(set_let_ex(sc, cx)); - case T_C_MACRO: - case T_C_OPT_ARGS_FUNCTION: - case T_C_RST_ARGS_FUNCTION: - case T_C_ANY_ARGS_FUNCTION: /* (let ((lst (list 1 2))) (set! (list-ref lst 0) 2) lst) */ - case T_C_FUNCTION: - case T_C_FUNCTION_STAR: - /* perhaps it has a setter */ - if (is_t_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))) - { - if ((is_symbol(cadr(sc->code))) && - (is_symbol(cadar(sc->code)))) - { - if (is_null(cddar(sc->code))) - { - if (needs_copied_args(c_function_setter(cx))) - sc->args = list_2(sc, lookup_checked(sc, cadar(sc->code)), lookup_checked(sc, cadr(sc->code))); - else - { - set_car(sc->t2_1, lookup_checked(sc, cadar(sc->code))); - set_car(sc->t2_2, lookup_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)))) - { - if (needs_copied_args(c_function_setter(cx))) - sc->args = list_3(sc, - lookup_checked(sc, cadar(sc->code)), - lookup_checked(sc, caddar(sc->code)), - lookup_checked(sc, cadr(sc->code))); - else - { - set_car(sc->t3_1, lookup_checked(sc, cadar(sc->code))); - set_car(sc->t3_2, lookup_checked(sc, caddar(sc->code))); - set_car(sc->t3_3, lookup_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); - } - else - { - if ((is_null(cddr(sc->code))) && - (!is_pair(cadr(sc->code)))) - { - if (needs_copied_args(c_function_setter(cx))) - sc->args = list_1(sc, (is_symbol(cadr(sc->code))) ? lookup_checked(sc, cadr(sc->code)) : cadr(sc->code)); - else - { - if (is_symbol(cadr(sc->code))) - set_car(sc->t1_1, lookup_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 */ - } - push_op_stack(sc, c_function_setter(cx)); - push_stack(sc, OP_EVAL_ARGS1, sc->nil, cddr(sc->code)); - sc->code = cadr(sc->code); - } - } - else - { - if (is_any_macro(c_function_setter(cx))) - { - if (is_null(cdar(sc->code))) - sc->args = copy_list(sc, cdr(sc->code)); - else sc->args = s7_append(sc, cdar(sc->code), copy_list(sc, cdr(sc->code))); - /* append copies except for its last arg, but for macros, we have to copy everything, hence the extra copy_list */ - sc->code = c_function_setter(cx); - return(goto_APPLY); - } - eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar_code); - } - break; + case T_C_MACRO: 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: + return(set_function_ex(sc, cx)); - case T_MACRO: case T_MACRO_STAR: - case T_BACRO: case T_BACRO_STAR: + case T_MACRO: case T_MACRO_STAR: case T_BACRO: case T_BACRO_STAR: case T_CLOSURE: case T_CLOSURE_STAR: - { - s7_pointer setter; - setter = closure_setter(cx); - if ((setter == sc->F) && - (!closure_no_setter(cx))) - setter = g_setter(sc, set_plist_1(sc, cx)); - if (is_t_procedure(setter)) /* appears to be caar_code */ - { - /* (set! (o g) ...), here cx = o, sc->code = ((o g) ...) */ - push_op_stack(sc, setter); - if (is_null(cdar(sc->code))) - { - push_stack(sc, OP_EVAL_ARGS1, sc->nil, cddr(sc->code)); - sc->code = cadr(sc->code); - } - else - { - if (is_null(cddar(sc->code))) - push_stack(sc, OP_EVAL_ARGS1, sc->nil, cdr(sc->code)); - else push_stack(sc, OP_EVAL_ARGS1, sc->nil, s7_append(sc, cddar(sc->code), cdr(sc->code))); - sc->code = cadar(sc->code); - } - } - else - { - if (is_any_macro(setter)) - { - if (is_null(cdar(sc->code))) - sc->args = copy_list(sc, cdr(sc->code)); - else sc->args = s7_append(sc, cdar(sc->code), copy_list(sc, cdr(sc->code))); - sc->code = setter; - return(goto_APPLY); - } - eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar_code); - } - } - break; + return(set_closure_ex(sc, cx)); case T_ITERATOR: /* not sure this makes sense */ - { - s7_pointer setter; - setter = iterator_sequence(cx); - if ((is_any_closure(setter)) || (is_any_macro(setter))) - setter = closure_setter(iterator_sequence(cx)); - else setter = sc->F; - if (is_procedure(setter)) - { - push_op_stack(sc, setter); - push_stack(sc, OP_EVAL_ARGS1, sc->nil, sc->nil); - sc->code = cadr(sc->code); /* the (as yet unevaluated) value, incoming code was ((obj) val) */ - } - else - { - if (is_any_macro(setter)) - { - sc->args = list_1(sc, cadr(sc->code)); - sc->code = setter; - return(goto_APPLY); - } - eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar_code); - } - } - break; + return(set_iterator_ex(sc, cx)); case T_SYNTAX: - if (cx == slot_value(global_slot(sc->with_let_symbol))) - { - /* (set! (with-let a b) x), cx = with-let, sc->code = ((with-let a b) x) - * a and x are in the current env, b is in a, we need to evaluate a and x, then - * call (with-let a-value (set! b x-value)) - */ - sc->args = cdar(sc->code); - sc->code = cadr(sc->code); - push_stack(sc, OP_SET_WITH_LET_1, sc->args, sc->code); - sc->cur_op = optimize_op(sc->code); - return(goto_TOP_NO_POP); - } - /* else fall through */ + return(set_syntax_ex(sc, cx)); default: /* (set! (1 2) 3) */ eval_error_no_return(sc, sc->syntax_error_symbol, "no generalized set for ~A", 25, caar_code); } - sc->cur_op = optimize_op(sc->code); return(goto_TOP_NO_POP); } @@ -74161,7 +74334,7 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p } if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set)) {if (DO_PRINT) fprintf(stderr, "end-test: %d\n", __LINE__); return(false);} - if (!safe_stepper(expr, steppers)) /* is step var's value used as the stored value by set!? */ + if (!safe_stepper_expr(expr, steppers)) /* is step var's value used as the stored value by set!? */ {if (DO_PRINT) fprintf(stderr, "unsafe stepper: %d\n", __LINE__); return(false);} } break; @@ -74258,7 +74431,7 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p } if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set)) {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);} - if (!safe_stepper(expr, steppers)) + if (!safe_stepper_expr(expr, steppers)) {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);} } } @@ -74402,11 +74575,7 @@ static s7_pointer check_do(s7_scheme *sc) return(code); if (is_simple_expression(sc, car(end))) set_c_call(end, fx_choose(sc, end, sc->envir, let_symbol_is_safe)); - else - { - /* fprintf(stderr, "%s\n", DISPLAY_80(code)); */ - return(code); /* if end is not fxable, give up */ - } + else return(code); /* if end is not fxable, give up */ vars = car(code); if (is_null(vars)) { @@ -74414,31 +74583,15 @@ static s7_pointer check_do(s7_scheme *sc) return(sc->nil); } - /* an annoying kludge -- define in the body can clobber the step expressions set up below! + /* an annoying kludge -- define in the body can clobber (move) 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 - * but varlet is actually ok most of the time, so handle it separately + * or much trickier: (apply (inlet) (func)) as do body where func returns '(define y 32)! * tree_has_definers can't ignore a quoted list because the 'quote might be interpreted separately: * ... (cond '(define x 0)) ... */ - body = cddr(code); - if (tree_has_definers(sc, body)) + if (tree_has_definers(sc, form)) /* we don't want definers in body, vars, or end test */ return(code); - /* 1/1 is of course the biggy -- can 1/n share its code? */ - /* need at start, do_op_1step_no_opt[_1] = set up frame goto check end, then push _1, set code, goto begin1, step via fx - * :set frame non-steppers, then stepper at front, goto CHECK - * _1: step, CHECK: check end, push, code=, go begin1 - * - * then add op_do_1step_add_s1: like do_no_vars but frame setup is more complicated, and need - * all the safe-stepper mutable ints and so on - */ - - /* are inits fxable, are steppers fxable, +/- 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 */ @@ -74446,11 +74599,11 @@ static s7_pointer check_do(s7_scheme *sc) /* (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 + * geq happens as often as =, and -1 as step, also cdr as step to is_null as end * also do body is optimized expr: vector_set_3 via hop_safe_c_sss for example or (vset v i (vref w i)) */ + body = cddr(code); if ((is_pair(end)) && (is_pair(car(end))) && (is_pair(vars)) && (is_null(cdr(vars))) && (is_pair(body)) && (is_pair(car(body))) && (is_symbol(caar(body)))) @@ -74591,7 +74744,7 @@ static s7_pointer check_do(s7_scheme *sc) /* end and steps look ok! */ pair_set_syntax_op(form, OP_DOX); /* dox: vars/end are fxable */ - + /* each step expr is safe so not an explicit set! * the symbol_is_safe check in fx_choose needs to see the do envir, not the caller's * but that means the is_fx_safe check above also needs to use the local env? @@ -74606,11 +74759,11 @@ static s7_pointer check_do(s7_scheme *sc) s7_pointer step_expr; step_expr = caddr(var); set_c_call(cddr(var), fx_choose(sc, cddr(var), vars, do_symbol_is_safe)); /* sets opt2(cddr(var)), not opt1 */ - + if (!is_pair(step_expr)) /* (i 0 0) */ { if (cadr(var) == caddr(var)) /* not types match: (i x y) etc */ - set_safe_stepper(cddr(var)); + set_safe_stepper_expr(cddr(var)); } else { @@ -74622,12 +74775,12 @@ static s7_pointer check_do(s7_scheme *sc) (is_pair(c_function_signature(c_function_base(opt1_cfunc(step_expr))))) && (car(c_function_signature(c_function_base(opt1_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)); + set_safe_stepper_expr(cddr(var)); } } } /* there are only a couple of cases in snd-test where a multi-statement do body is completely fx-able */ - + if ((is_null(body)) && (is_null(cdr(vars))) && (is_pair(cdr(end))) && @@ -74673,7 +74826,7 @@ static bool has_safe_steppers(s7_scheme *sc, s7_pointer frame) } else { - if (is_safe_stepper(step_expr)) + if (is_safe_stepper_expr(step_expr)) { if (is_t_integer(val)) /* a temporary kludge */ { @@ -74703,7 +74856,6 @@ static bool has_safe_steppers(s7_scheme *sc, s7_pointer frame) return(true); } - static int32_t dox_ex(s7_scheme *sc) { /* any number of steppers using dox exprs, end also dox, body and end result arbitrary. @@ -75066,14 +75218,14 @@ static void op_simple_dox(s7_scheme *sc) new_frame_with_slot(sc, sc->envir, sc->envir, car(var), fx_call(sc, cdr(var))); slot = let_slots(sc->envir); - if (is_safe_stepper(cddr(var))) + if (is_safe_stepper_expr(cddr(var))) { if ((is_t_integer(slot_value(slot))) && - ((stepf == fx_c_sub_s1) || (stepf == fx_c_add_s1) || (stepf == fx_c_add_t1) || (stepf == fx_c_add_u1))) + ((stepf == fx_c_sub_s1) || (stepf == fx_c_add_s1) || (stepf == fx_c_add_t1) || (stepf == fx_c_sub_t1) || (stepf == fx_c_add_u1))) { s7_int incr; s7_pointer istep; - incr = (stepf == fx_c_sub_s1) ? -1 : 1; + incr = ((stepf == fx_c_sub_s1) || (stepf == fx_c_sub_t1)) ? -1 : 1; istep = make_mutable_integer(sc, integer(slot_value(slot))); slot_set_value(slot, istep); while (true) @@ -75191,7 +75343,6 @@ static int32_t simple_do_ex(s7_scheme *sc, s7_pointer code) func(sc, body); } } - sc->value = sc->T; sc->code = cdadr(code); return(goto_DO_END_CLAUSES); @@ -75410,11 +75561,11 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf else { int32_t first_pc = 0; - if (fp == opt_if_bp) + if (fp == opt_if_bp) fp = opt_if_bp_nr; else { - if (fp == opt_if_nbp_fs) + if (fp == opt_if_nbp_fs) { fp = opt_if_nbp_fs_nr; first_pc = 2; @@ -75665,7 +75816,6 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf return(false); } - static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc) { s7_pointer let_body, p = NULL, let_vars, let_code; @@ -75723,47 +75873,47 @@ static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc) if (is_null(p)) { s7_int k, end; + s7_pointer ip; end = denominator(stepper); let_set_slots(sc->envir, reverse_slots(sc, let_slots(sc->envir))); + ip = slot_value(step_slot); if ((var_len == 1) && (body_len == 1)) { - s7_pointer ip, xp; + s7_pointer xp; int32_t pc2; - opt_info *first, *second; + opt_info *first, *o; 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->v[0].fd; integer(ip) = numerator(stepper); sc->pc = 0; set_real(xp, f1(first)); pc2 = ++sc->pc; - second = sc->opts[pc2]; - f2 = second->v[0].fd; - f2(second); + o = sc->opts[pc2]; + f2 = o->v[0].fd; + f2(o); if ((f2 == opt_fmv) && (f1 == opt_d_dd_ff_o2) && - (first->v[3].d_dd_f == add_d_dd)) + (first->v[3].d_dd_f == add_d_dd) && + (slot_symbol(step_slot) == slot_symbol(o->v[2].p))) /* and _dv et al throughout (so sc->pc ignored) etc */ { /* gcc now refuses to inline opt_fmv -- we are not amused... */ - opt_info *o = (opt_info *)second; opt_info *o1, *o2, *o3; s7_d_v_t vf1, vf2, vf3, vf4; s7_d_vd_t vf5, vf6; s7_d_vid_t vf7; - s7_pointer s1, s2; void *obj1, *obj2, *obj3, *obj4, *obj5, *obj6, *obj7; - int32_t pc5; + /* int32_t pc5; */ sc->pc = pc2; o1 = o->sc->opts[o->sc->pc + 1]; o2 = o->sc->opts[o->sc->pc + 3]; o3 = o->sc->opts[o->sc->pc + 5]; - pc5 = sc->pc + 5; + /* pc5 = sc->pc + 5; */ vf1 = first->v[4].d_v_f; vf2 = first->v[5].d_v_f; vf3 = o1->v[2].d_v_f; @@ -75778,20 +75928,16 @@ static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc) obj5 = o->v[5].obj; obj6 = o2->v[5].obj; obj7 = o3->v[2].obj; - s1 = o2->v[2].p; - s2 = o->v[2].p; for (k = numerator(stepper) + 1; k < end; k++) { s7_double amp_env, vib; - integer(ip) = k; - sc->pc = 0; - set_real(xp, vf1(obj1) + vf2(obj2)); - sc->pc = pc2; + /* sc->pc = 0; */ + vib = vf1(obj1) + vf2(obj2); + /* sc->pc = pc2; */ amp_env = vf3(obj3); - vib = real(slot_value(s1)); - sc->pc = pc5; - vf7(obj5, integer(slot_value(s2)), amp_env * vf5(obj6, vib + (vf4(obj4) * vf6(obj7, vib)))); + /* sc->pc = pc5; */ + vf7(obj5, k, amp_env * vf5(obj6, vib + (vf4(obj4) * vf6(obj7, vib)))); } } else @@ -75802,26 +75948,48 @@ static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc) sc->pc = 0; set_real(xp, f1(first)); sc->pc = pc2; - f2(second); + f2(o); } } } else { - for (k = numerator(stepper); k < end; k++) + int32_t i; + for (i = 0, p = let_slots(sc->envir); tis_slot(p); i++, p = next_slot(p)); + if ((body_len == 1) && (i == 2)) { - int32_t i; - integer(slot_value(step_slot)) = k; - sc->pc = 0; - for (p = let_slots(sc->envir); tis_slot(p); p = next_slot(p)) + s7_pointer s1, s2; + s1 = let_slots(sc->envir); + s2 = next_slot(s1); + for (k = numerator(stepper); k < end; k++) { - set_real(slot_value(p), sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc])); + integer(ip) = k; + sc->pc = 0; + set_real(slot_value(s1), sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc])); + sc->pc++; + set_real(slot_value(s2), sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc])); sc->pc++; + sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc]); } - for (i = 0; i < body_len; i++) + } + else + { + /* next biggest: body_len==2 and i==1 */ + for (k = numerator(stepper); k < end; k++) { - sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc]); - sc->pc++; + int32_t i; + integer(ip) = k; + sc->pc = 0; + for (p = let_slots(sc->envir); tis_slot(p); p = next_slot(p)) + { + set_real(slot_value(p), sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc])); + sc->pc++; + } + for (i = 0; i < body_len; i++) + { + sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc]); + sc->pc++; + } } } } @@ -76149,7 +76317,7 @@ static int32_t 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), sc->gc_nil); /* this is where we store the new value */ + p = cons(sc, caddar(x), sc->unused); /* this is where we store the new value */ set_opt1_slot(p, y); sc->value = cons_unchecked(sc, p, sc->value); } @@ -76163,8 +76331,9 @@ static int32_t do_init_ex(s7_scheme *sc) */ return(fall_through); } -/* -------------------------------------------------------------------------------- */ + +/* -------------------------------------------------------------------------------- */ static inline bool closure_is_ok_1(s7_scheme *sc, s7_pointer code, uint16_t type, int32_t args) { s7_pointer f; @@ -76172,7 +76341,7 @@ static inline bool closure_is_ok_1(s7_scheme *sc, s7_pointer code, uint16_t type if ((f == opt1_lambda_unchecked(code)) || ((f) && (typesflag(f) == type) && - ((closure_arity(f) == args) || (closure_arity_to_int(sc, f) == args)) && + ((closure_arity(f) == args) || (closure_arity_to_int(sc, f) == args)) && /* 3 type bits to replace this but not hit enough to warrant them */ (set_opt1_lambda(code, f)))) return(true); sc->last_function = f; @@ -76202,6 +76371,8 @@ static inline bool closure_is_ok_2(s7_scheme *sc, s7_pointer code, uint16_t type * symbol_ctr==1 does not guarantee that local_slot is a slot (the one definition was local, env has been * exited, slot freed), but it's a cell (not NULL), so we can look at local_slot->object.slt.val no matter * what its true type is. Then if slot_value==opt_lambda incorrectly, we are incredibly unlucky. + * The problem may be that set! does not increment symbol_ctr, and also maybe not (define f1 f2), + * but those cases will change the local_slot value. So, the combination as it is now is safe but stupid? */ #define closure_is_ok(Sc, Code, Type, Args) \ @@ -76214,7 +76385,6 @@ static inline bool closure_is_ok_2(s7_scheme *sc, s7_pointer code, uint16_t type (unchecked_slot_value(local_slot(car(Code))) == opt1_lambda_unchecked(Code))) || \ (closure_is_ok_2(Sc, Code, Type, Args))) - static bool star_arity_is_ok(s7_scheme *sc, s7_pointer val, int32_t args) { int32_t arity; @@ -76251,12 +76421,10 @@ static bool closure_star_is_ok_1(s7_scheme *sc, s7_pointer code, uint16_t type, #define MATCH_UNSAFE_CLOSURE_M (T_CLOSURE | T_MULTIFORM) #define MATCH_SAFE_CLOSURE_M (T_CLOSURE | T_SAFE_CLOSURE | T_MULTIFORM) #define MATCH_SAFE_CLOSURE_A (T_CLOSURE | T_SAFE_CLOSURE | T_ONE_FORM | T_MULTIFORM) - /* since T_HAS_METHODS is on if there might be methods, this can protect us from that case */ static int32_t fixup_unknown_op(s7_pointer code, s7_pointer func, opcode_t op) { - /* sc arg used if debugging */ set_optimize_op(code, op); set_opt1_lambda(code, func); /* opt_lambda works here because it is the only checked case, but ideally we'd split out all the cases via switch (op) */ return(goto_EVAL); @@ -76264,7 +76432,6 @@ static int32_t fixup_unknown_op(s7_pointer code, s7_pointer func, opcode_t op) static int32_t unknown_unknown(s7_scheme *sc) { - /* fprintf(stderr, "unknown %s\n", DISPLAY(sc->code)); */ if ((is_symbol(car(sc->code))) && (!is_slot(symbol_to_slot(sc, car(sc->code))))) eval_error_no_return(sc, sc->unbound_variable_symbol, "~A: unbound variable", 20, car(sc->code)); @@ -76280,10 +76447,7 @@ static int32_t unknown_ex(s7_scheme *sc, s7_pointer f) increment_opt3_ctr(code); if (opt3_ctr(code) > 100) - { - /* fprintf(stderr, "unopt %s\n", DISPLAY_80(code)); */ - return(fixup_unknown_op(code, f, OP_S)); - } + return(fixup_unknown_op(code, f, OP_S)); switch (type(f)) { @@ -76297,7 +76461,7 @@ static int32_t unknown_ex(s7_scheme *sc, s7_pointer f) bool safe_case; body = closure_body(f); safe_case = is_safe_closure(f); - + if (is_null(cdr(body))) { if (safe_case) @@ -76308,7 +76472,7 @@ static int32_t unknown_ex(s7_scheme *sc, s7_pointer f) set_optimize_op(code, OP_SAFE_THUNK_A); set_closure_has_fx(f); } - else + else { set_optimize_op(code, OP_SAFE_THUNK_P); closure_clear_multiform(f); /* i.e. clear possible has_fx */ @@ -76366,7 +76530,7 @@ static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f) if (opt3_ctr(code) > 100) { /* fprintf(stderr, "unopt %s\n", DISPLAY_80(code)); */ - return(fixup_unknown_op(code, f, (sym_case) ? OP_S_S : OP_S_C)); + return(fixup_unknown_op(code, f, (sym_case) ? OP_S_S : OP_S_C)); } switch (type(f)) @@ -76414,8 +76578,9 @@ static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f) set_optimize_op(code, (sym_case) ? OP_SAFE_CLOSURE_S_A : OP_SAFE_CLOSURE_C_A); set_closure_has_fx(f); } - else + else { + /* hop if is_constant(sc, car(code)) is not foolproof here -- see t967.scm */ set_optimize_op(code, (sym_case) ? OP_SAFE_CLOSURE_S_P : OP_SAFE_CLOSURE_C_P); closure_clear_multiform(f); } @@ -76513,7 +76678,6 @@ static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f) if (!f) /* can be NULL if unbound variable */ return(unknown_unknown(sc)); code = sc->code; - /* fprintf(stderr, "%s: %s %d\n", __func__, DISPLAY_80(code), type(f)); */ #if S7_DEBUGGING if (!has_fx(cdr(code))) fprintf(stderr, "unknown_a_ex missing _a support? %s\n", DISPLAY_80(code)); @@ -76523,7 +76687,7 @@ static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f) if (opt3_ctr(code) > 100) { /* fprintf(stderr, "unopt %s\n", DISPLAY_80(code)); */ - return(fixup_unknown_op(code, f, OP_S_A)); + return(fixup_unknown_op(code, f, OP_S_A)); } switch (type(f)) @@ -76561,15 +76725,15 @@ static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f) set_optimize_op(code, OP_SAFE_CLOSURE_A_A); set_closure_has_fx(f); } - else + else { set_optimize_op(code, OP_SAFE_CLOSURE_A_P); closure_clear_multiform(f); } } - else + else { - if ((c_callee(cdr(code)) == fx_c_sub_si) || (c_callee(cdr(code)) == fx_c_sub_s1)) + if ((c_callee(cdr(code)) == fx_c_sub_si) || (c_callee(cdr(code)) == fx_c_sub_s1) || (c_callee(cdr(code)) == fx_c_sub_t1)) { set_opt2_pair(code, cdadr(code)); set_optimize_op(code, OP_CLOSURE_SUB_P); @@ -76585,7 +76749,6 @@ static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f) (!tree_has_definers_or_binders(sc, body)) && (s7_tree_memq(sc, code, body))) fx_tree(sc, cdr(code), car(closure_args(f)), NULL); - set_opt1_lambda(code, f); return(goto_EVAL); } @@ -76615,7 +76778,7 @@ static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f) case T_HASH_TABLE: return(fixup_unknown_op(code, f, OP_HASH_TABLE_A)); case T_GOTO: return(fixup_unknown_op(code, f, OP_GOTO_A)); - case T_LET: + case T_LET: { s7_pointer arg1; arg1 = cadr(code); @@ -76708,7 +76871,7 @@ static int32_t unknown_gg_ex(s7_scheme *sc, s7_pointer f) set_optimize_op(code, OP_SAFE_C_SC); } } - else + else { if (s2) { @@ -76751,7 +76914,7 @@ static int32_t unknown_gg_ex(s7_scheme *sc, s7_pointer f) set_optimize_op(code, OP_SAFE_CLOSURE_SS_A); set_closure_has_fx(f); } - else + else { set_optimize_op(code, OP_SAFE_CLOSURE_SS_P); closure_clear_multiform(f); @@ -76871,7 +77034,6 @@ static int32_t unknown_all_s_ex(s7_scheme *sc, s7_pointer f) return(unknown_unknown(sc)); } - static int32_t unknown_aa_ex(s7_scheme *sc, s7_pointer f) { s7_pointer code; @@ -76885,7 +77047,7 @@ static int32_t unknown_aa_ex(s7_scheme *sc, s7_pointer f) increment_opt3_ctr(code); if (opt3_ctr(code) > 100) - return(fixup_unknown_op(code, f, OP_S_AA)); + return(fixup_unknown_op(code, f, OP_S_AA)); switch (type(f)) { @@ -76922,7 +77084,7 @@ static int32_t unknown_aa_ex(s7_scheme *sc, s7_pointer f) set_optimize_op(code, OP_SAFE_CLOSURE_AA_A); set_closure_has_fx(f); } - else + else { set_optimize_op(code, OP_SAFE_CLOSURE_AA_P); closure_clear_multiform(f); @@ -77019,7 +77181,6 @@ static int32_t unknown_fx_ex(s7_scheme *sc, s7_pointer f) return(unknown_unknown(sc)); } - static void unwind_output_ex(s7_scheme *sc) { bool is_file; @@ -77395,14 +77556,11 @@ static void apply_syntax(s7_scheme *sc) /* -------- s len = s7_list_length(sc, sc->args); if (len == 0) eval_error_no_return(sc, sc->syntax_error_symbol, "attempt to evaluate a circular list: ~S", 39, sc->args); - if (is_pair(car(sc->args))) /* this is the arglist */ - { - s7_int alen; - alen = s7_list_length(sc, car(sc->args)); /* (apply lambda (signature +)...) */ - if (alen == 0) - s7_error(sc, sc->syntax_error_symbol, - set_elist_3(sc, wrap_string(sc, "apply ~S involves a circular list: ~S", 37), sc->code, sc->args)); - } + + if ((sc->safety > NO_SAFETY) && + (tree_is_cyclic(sc, sc->args))) + s7_error(sc, sc->syntax_error_symbol, + set_elist_3(sc, wrap_string(sc, "apply ~S: body is circular: ~S", 30), sc->code, sc->args)); } else len = 0; @@ -77520,48 +77678,28 @@ static void apply_lambda(s7_scheme *sc) /* -------- n e = sc->envir; id = let_id(e); - for (x = closure_args(sc->code), z = T_Lst(sc->args); is_pair(x); x = cdr(x)) /* closure_args can be a symbol, for example */ + for (x = closure_args(sc->code), z = T_Lst(sc->args); is_pair(x); x = cdr(x), z = cdr(z)) /* closure_args can be a symbol, for example */ { - s7_pointer sym, args; - /* reuse the value cells as the new frame slots */ - + s7_pointer sym, slot; if (is_null(z)) - { - s7_pointer name, ccode; - name = closure_name(sc, sc->code); - ccode = current_code(sc); - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, (name == ccode) ? sc->code : name, ccode)); - } - /* now that args are being reused as slots, the error message can't use sc->args, - * 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! - */ - + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args)); + new_cell(sc, slot, T_SLOT); +#if S7_DEBUGGING + slot->debugger_bits = 0; +#endif 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; + slot_set_symbol(slot, sym); + slot_set_value(slot, T_Pos(unchecked_car(z))); + symbol_set_local(sym, id, slot); + set_next_slot(slot, let_slots(e)); + let_set_slots(e, slot); } - if (is_null(x)) { if (is_not_null(z)) - { - s7_pointer name, ccode; - name = closure_name(sc, sc->code); - ccode = current_code(sc); - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, (name == ccode) ? sc->code : name, ccode)); - } - } - else - { - sc->temp6 = z; /* the rest arg */ - make_slot_1(sc, sc->envir, x, z); - sc->temp6 = sc->nil; + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args)); } + else make_slot_1(sc, sc->envir, x, z); sc->code = closure_body(sc->code); } @@ -77570,7 +77708,7 @@ static void apply_lambda(s7_scheme *sc) /* -------- n static s7_pointer star_set(s7_scheme *sc, s7_pointer slot, s7_pointer val, bool check_rest) { if (is_checked_slot(slot)) - return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_4(sc, parameter_set_twice_string, closure_name(sc, sc->code), slot_symbol(slot), sc->args))); + return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, parameter_set_twice_string, slot_symbol(slot), sc->args))); if ((check_rest) && (is_rest_slot(slot))) return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, wrap_string(sc, "can't set rest arg ~S to ~S via keyword", 39), @@ -77612,12 +77750,11 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) /* next arg is bound to trailing args from this point as a list */ zx = sc->key_rest_symbol; cx = cdr(cx); - if ((is_keyword(car(lx))) && + if ((is_keyword(car(lx))) && (is_pair(cdr(lx))) && (keyword_symbol(car(lx)) == car(cx))) return(s7_error(sc, sc->wrong_type_arg_symbol, - set_elist_3(sc, wrap_string(sc, "can't set rest arg ~S to ~S via keyword", 39), - car(cx), cadr(lx)))); + set_elist_3(sc, wrap_string(sc, "can't set rest arg ~S to ~S via keyword", 39), car(cx), cadr(lx)))); lambda_star_argument_set_value(sc, car(cx), lx, slot, false); lx = cdr(lx); cx = cdr(cx); @@ -77627,22 +77764,12 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) { s7_pointer car_lx; car_lx = car(lx); -#if 0 - if (has_active_methods(sc, car_lx)) /* perhaps call is_keyword as a method? then symbol->value? */ - { - s7_pointer f; - f = find_method(sc, car_lx, sc->symbol_to_value_symbol); - if (f != sc->undefined) - car_lx = s7_apply_function(sc, f, list_1(sc, car_lx)); - } -#endif 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, wrap_string(sc, "~A: keyword argument's value is missing: ~S in ~S", 49), - closure_name(sc, code), lx, args))); + set_elist_4(sc, wrap_string(sc, "~A: keyword argument's value is missing: ~S in ~S", 49), closure_name(sc, code), lx, args))); sym = keyword_symbol(car_lx); if (lambda_star_argument_set_value(sc, sym, cadr(lx), slot, true) == sc->no_value) { @@ -77659,8 +77786,7 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) continue; } else return(s7_error(sc, sc->wrong_type_arg_symbol, - set_elist_4(sc, wrap_string(sc, "~A: unknown key: ~S in ~S", 25), - closure_name(sc, code), lx, args))); + set_elist_4(sc, wrap_string(sc, "~A: unknown key: ~S in ~S", 25), closure_name(sc, code), lx, args))); } lx = cddr(lx); slot = next_slot(slot); @@ -77668,7 +77794,7 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) else /* not a key/value pair */ { if (is_checked_slot(slot)) - return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_4(sc, parameter_set_twice_string, closure_name(sc, sc->code), slot_symbol(slot), sc->args))); + return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, parameter_set_twice_string, slot_symbol(slot), sc->args))); set_checked_slot(slot); slot_set_value(slot, car(lx)); slot = next_slot(slot); @@ -77677,9 +77803,8 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) 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))) */ + /* (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) -> 'error */ + /* (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) -> 'error */ /* check for trailing args with no :rest arg */ if (is_not_null(lx)) @@ -77689,12 +77814,11 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) { if (is_symbol(cx)) { - if ((is_keyword(car(lx))) && + if ((is_keyword(car(lx))) && (is_pair(cdr(lx))) && (keyword_symbol(car(lx)) == cx)) return(s7_error(sc, sc->wrong_type_arg_symbol, - set_elist_3(sc, wrap_string(sc, "can't set rest arg ~S to ~S via keyword", 39), - cx, cadr(lx)))); + set_elist_3(sc, wrap_string(sc, "can't set rest arg ~S to ~S via keyword", 39), cx, cadr(lx)))); slot_set_value(slot, lx); } } @@ -77708,12 +77832,11 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) 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, wrap_string(sc, "~A: not a key/value pair: ~S", 28), - 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) - */ + set_elist_3(sc, wrap_string(sc, "~A: not a key/value pair: ~S", 28), closure_name(sc, code), lx))); + slot = symbol_to_local_slot(sc, keyword_symbol(car(lx)), sc->envir); + if ((is_slot(slot)) && + (is_checked_slot(slot))) + return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, parameter_set_twice_string, slot_symbol(slot), sc->args))); lx = cddr(lx); } } @@ -77729,9 +77852,11 @@ static inline int32_t lambda_star_default(s7_scheme *sc) z = sc->args; if (tis_slot(z)) { - if ((slot_value(z) == sc->undefined) && (!is_checked_slot(z))) + if ((slot_value(z) == sc->undefined) && /* trouble: (lambda* ((e #<undefined>))...) */ + (slot_has_expression(z)) && /* if default val is not a pair or a symbol, this is false */ + (!is_checked_slot(z))) { - if (is_closure_star(sc->code)) /* as opposed to macro* and bacro* */ + if (is_closure_star(sc->code)) /* as opposed to macro* and bacro* */ { s7_pointer val; val = slot_expression(z); @@ -77741,7 +77866,7 @@ static inline int32_t lambda_star_default(s7_scheme *sc) if (slot_value(z) == sc->undefined) { /* the current environment here contains the function parameters which - * defaulted to #<undefined> (or maybe #<gc-nil>?) earlier in apply_lambda_star, + * defaulted to #<undefined> (or maybe #<unused>?) 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. @@ -78064,7 +78189,6 @@ static inline void closure_star_fx(s7_scheme *sc, s7_pointer code) new_frame(sc, closure_let(sc->code), sc->envir); } - static int32_t define1_ex(s7_scheme *sc) { /* sc->code is the symbol being defined, sc->value is its value @@ -78087,6 +78211,7 @@ static int32_t define1_ex(s7_scheme *sc) if (is_slot(global_slot(sc->code))) x = global_slot(sc->code); else x = symbol_to_slot(sc, sc->code); /* local_slot can be free even if sc->code is immutable (local constant now defunct) */ + if (!((is_slot(x)) && (type(sc->value) == unchecked_type(slot_value(x))) && (s7_is_equivalent(sc, sc->value, slot_value(x))))) /* if value is unchanged, just ignore this (re)definition */ @@ -78176,11 +78301,12 @@ static void define2_ex(s7_scheme *sc) if ((is_slot(global_slot(sc->code))) && (is_immutable(global_slot(sc->code)))) { - s7_pointer old_value; + s7_pointer old_value, old_symbol; + old_symbol = sc->code; old_value = slot_value(global_slot(sc->code)); if ((type(old_value) != type(new_func)) || (!s7_is_equivalent(sc, old_value, new_func))) /* if value is unchanged, just ignore this (re)definition */ - eval_error_no_return(sc, sc->syntax_error_symbol, "define ~S: but it is immutable", 30, sc->code); + eval_error_no_return(sc, sc->syntax_error_symbol, "define ~S: but it is immutable", 30, old_symbol); } s7_make_slot(sc, sc->envir, sc->code, new_func); } @@ -78195,11 +78321,12 @@ static void define2_ex(s7_scheme *sc) { if (is_immutable(lx)) { - s7_pointer old_value; + s7_pointer old_value, old_symbol; + old_symbol = sc->code; old_value = slot_value(lx); if ((type(old_value) != type(sc->value)) || (!s7_is_equivalent(sc, old_value, sc->value))) /* if value is unchanged, just ignore this (re)definition */ - eval_error_no_return(sc, sc->syntax_error_symbol, "define ~S: but it is immutable", 30, sc->code); + eval_error_no_return(sc, sc->syntax_error_symbol, "define ~S: but it is immutable", 30, old_symbol); } slot_set_value_with_hook(lx, sc->value); } @@ -78221,6 +78348,7 @@ static void define2_ex(s7_scheme *sc) #endif +/* -------------------------------- profile -------------------------------- */ #if WITH_PROFILE #define profile_location(p) p->file_and_line #define profile_set_location(p, N) p->file_and_line = N @@ -78400,7 +78528,7 @@ static void op_closure_ap(s7_scheme *sc) s7_pointer val, code; code = sc->code; val = fx_call(sc, cdr(code)); - /* (hook-push (undo-hook ind 0) (lambda (hook) (set! u0 #t))) -> #<gc-nil> + /* (hook-push (undo-hook ind 0) (lambda (hook) (set! u0 #t))) -> #<unused> * g_undo_hook calls s7_eval_c_string so it obviously should be declared unsafe! */ push_stack(sc, OP_CLOSURE_AP_1, val, code); @@ -78485,105 +78613,105 @@ static void op_safe_closure_sa(s7_scheme *sc) static void op_safe_closure_ss(s7_scheme *sc) { - sc->temp11 = lookup(sc, opt2_sym(sc->code)); + sc->temp5 = lookup(sc, opt2_sym(sc->code)); sc->value = lookup(sc, cadr(sc->code)); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); closure_push(sc); } static void op_safe_closure_ss_p(s7_scheme *sc) { - sc->temp11 = lookup(sc, opt2_sym(sc->code)); + sc->temp5 = lookup(sc, opt2_sym(sc->code)); sc->value = lookup(sc, cadr(sc->code)); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); sc->code = car(closure_body(sc->code)); } static void op_safe_closure_ss_a(s7_scheme *sc) { - sc->temp11 = lookup(sc, opt2_sym(sc->code)); + sc->temp5 = lookup(sc, opt2_sym(sc->code)); sc->value = lookup(sc, cadr(sc->code)); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); sc->value = fx_call(sc, closure_body(sc->code)); } static void op_closure_ss(s7_scheme *sc) { - sc->temp11 = lookup(sc, opt2_sym(sc->code)); + sc->temp5 = lookup(sc, opt2_sym(sc->code)); sc->value = lookup(sc, cadr(sc->code)); check_stack_size(sc); sc->code = opt1_lambda(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->temp11); + 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->temp5); closure_push(sc); } static void op_closure_ss_p(s7_scheme *sc) { - sc->temp11 = lookup(sc, opt2_sym(sc->code)); + sc->temp5 = lookup(sc, opt2_sym(sc->code)); sc->value = lookup(sc, cadr(sc->code)); check_stack_size(sc); sc->code = opt1_lambda(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->temp11); + 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->temp5); sc->code = car(closure_body(sc->code)); } static void op_safe_closure_sc(s7_scheme *sc) { - sc->temp11 = opt2_con(sc->code); + sc->temp5 = opt2_con(sc->code); sc->value = lookup(sc, cadr(sc->code)); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); closure_push(sc); } static void op_safe_closure_sc_p(s7_scheme *sc) { - sc->temp11 = opt2_con(sc->code); + sc->temp5 = opt2_con(sc->code); sc->value = lookup(sc, cadr(sc->code)); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); sc->code = car(closure_body(sc->code)); } static void op_closure_sc(s7_scheme *sc) { - sc->temp11 = opt2_con(sc->code); + sc->temp5 = opt2_con(sc->code); sc->value = lookup(sc, cadr(sc->code)); check_stack_size(sc); sc->code = opt1_lambda(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->temp11); + 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->temp5); closure_push(sc); } static void op_closure_sc_p(s7_scheme *sc) { - sc->temp11 = opt2_con(sc->code); + sc->temp5 = opt2_con(sc->code); sc->value = lookup(sc, cadr(sc->code)); check_stack_size(sc); sc->code = opt1_lambda(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->temp11); + 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->temp5); sc->code = car(closure_body(sc->code)); } static void op_safe_closure_cs(s7_scheme *sc) { - sc->temp11 = lookup(sc, opt2_sym(sc->code)); + sc->temp5 = lookup(sc, opt2_sym(sc->code)); sc->value = cadr(sc->code); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); sc->code = T_Pair(closure_body(sc->code)); } static void op_closure_cs(s7_scheme *sc) { - sc->temp11 = lookup(sc, opt2_sym(sc->code)); + sc->temp5 = lookup(sc, opt2_sym(sc->code)); sc->value = cadr(sc->code); check_stack_size(sc); sc->code = opt1_lambda(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->temp11); + 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->temp5); sc->code = T_Pair(closure_body(sc->code)); } @@ -78591,10 +78719,10 @@ static void op_safe_closure_aa(s7_scheme *sc) { s7_pointer p; p = cdr(sc->code); - sc->temp11 = fx_call(sc, cdr(p)); + sc->temp5 = fx_call(sc, cdr(p)); sc->value = fx_call(sc, p); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); closure_push(sc); } @@ -78602,10 +78730,10 @@ static void op_safe_closure_aa_p(s7_scheme *sc) { s7_pointer p; p = cdr(sc->code); - sc->temp11 = fx_call(sc, cdr(p)); + sc->temp5 = fx_call(sc, cdr(p)); sc->value = fx_call(sc, p); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); sc->code = car(closure_body(sc->code)); } @@ -78613,10 +78741,10 @@ static void op_safe_closure_aa_a(s7_scheme *sc) { s7_pointer p; p = cdr(sc->code); - sc->temp11 = fx_call(sc, cdr(p)); + sc->temp5 = fx_call(sc, cdr(p)); sc->value = fx_call(sc, p); sc->code = opt1_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp5); sc->value = fx_call(sc, closure_body(sc->code)); } @@ -78624,11 +78752,11 @@ static void op_closure_aa(s7_scheme *sc) { s7_pointer p; p = cdr(sc->code); - sc->temp11 = fx_call(sc, cdr(p)); + sc->temp5 = fx_call(sc, cdr(p)); sc->value = fx_call(sc, p); check_stack_size(sc); sc->code = opt1_lambda(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->temp11); + 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->temp5); closure_push(sc); } @@ -78636,11 +78764,11 @@ static void op_closure_aa_p(s7_scheme *sc) { s7_pointer p; p = cdr(sc->code); - sc->temp11 = fx_call(sc, cdr(p)); + sc->temp5 = fx_call(sc, cdr(p)); sc->value = fx_call(sc, p); check_stack_size(sc); sc->code = opt1_lambda(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->temp11); + 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->temp5); sc->code = car(closure_body(sc->code)); } @@ -78740,7 +78868,6 @@ static void op_closure_any_fx(s7_scheme *sc) sc->code = T_Pair(closure_body(sc->code)); } -/* ---------------- */ static void op_safe_c_cs(s7_scheme *sc) { s7_pointer args; @@ -78880,22 +79007,6 @@ static s7_pointer safe_c_opaaq(s7_scheme *sc, s7_pointer code) return(c_call(code)(sc, sc->t1_1)); } -static void op_and_safe_aa(s7_scheme *sc) -{ - sc->code = cdr(sc->code); - sc->value = fx_call(sc, sc->code); - if (is_true(sc, sc->value)) - sc->value = fx_call(sc, cdr(sc->code)); -} - -static void op_or_safe_aa(s7_scheme *sc) -{ - sc->code = cdr(sc->code); - sc->value = fx_call(sc, sc->code); - if (is_false(sc, sc->value)) - sc->value = fx_call(sc, cdr(sc->code)); -} - static void op_safe_c_css(s7_scheme *sc) { s7_pointer val1, args; @@ -79196,7 +79307,6 @@ static void op_eval_args5(s7_scheme *sc) /* sc->value is the last arg, sc-> sc->code = pop_op_stack(sc); } - static bool op_read_vector(s7_scheme *sc) { if (is_dotted_pair(sc->value)) /* #(1 . 2) */ @@ -79306,7 +79416,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = car(sc->code); set_current_code(sc, sc->code); - EVAL: + EVAL: sc->cur_op = optimize_op(sc->code); TOP_NO_POP: @@ -79337,7 +79447,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } /* break = fall into the "trailers" section where optimizations are cleared */ case HOP_SAFE_C_D: - sc->value = d_call(sc, sc->code); + sc->value = d_call(sc, sc->code); goto START; case OP_SAFE_C_AND2: @@ -79349,8 +79459,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->value = sc->F; goto START; } - sc->code = cdr(sc->code); - sc->value = fx_call(sc, sc->code); + sc->value = fx_call(sc, cdr(sc->code)); goto START; case OP_SAFE_C_OR2: @@ -79360,8 +79469,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->value = fx_call(sc, sc->code); if (is_true(sc, sc->value)) goto START; - sc->code = cdr(sc->code); - sc->value = fx_call(sc, sc->code); + sc->value = fx_call(sc, cdr(sc->code)); goto START; case OP_SAFE_C_S: @@ -79473,7 +79581,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) do {sc->stack_end -= 4;} while (((opcode_t)sc->stack_end[3]) == OP_GC_PROTECT); /* perhaps use a cons to carry this info instead */ /* normally an outside function that calls gc_protect_via_stack should be declared unsafe (since it messes with the stack), * but block_copy is a method with no way to say that it is unsafe! so (c-fnc ... (copy (block)...) ...) will insert - * the OP_GC_PROTECT frame in the midst of our args, but we're expecting to get the original sc->code pointer from + * the OP_GC_PROTECT frame in the midst of our args, but we're expecting to get the original sc->code pointer from * the previous stack frame. */ sc->code = sc->stack_end[0]; @@ -79489,7 +79597,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->args = safe_reverse_in_place(sc, sc->args); goto APPLY; - + case OP_SAFE_C_SSP: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_SSP: @@ -79796,7 +79904,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_SAFE_C_PP_5: /* 1 mv, 2, normal */ - /* fprintf(stderr, "pp_5: args: %s, value: %s, code: %s\n", DISPLAY(sc->args), DISPLAY(sc->value), DISPLAY(sc->code)); */ sc->args = s7_append(sc, sc->args, list_1(sc, sc->value)); sc->code = c_function_base(opt1_cfunc(sc->code)); goto APPLY; @@ -80138,7 +80245,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_C_CATCH_ALL: if (!c_function_is_ok(sc, sc->code)) break; - case HOP_C_CATCH_ALL: /* (catch #t (lambda () ...) (lambda args #f) */ + case HOP_C_CATCH_ALL: /* (catch #t (lambda () ...) (lambda args #f) */ set_current_code(sc, sc->code); new_frame(sc, sc->envir, sc->envir); catch_all_set_goto_loc(sc->envir, s7_stack_top(sc)); @@ -80150,7 +80257,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_C_CATCH_ALL_P: if (!c_function_is_ok(sc, sc->code)) break; case HOP_C_CATCH_ALL_P: - new_frame(sc, sc->envir, sc->envir); + new_frame(sc, sc->envir, sc->envir); /* frame is needed even if no definers because we're setting the dox1/2 slots */ catch_all_set_goto_loc(sc->envir, s7_stack_top(sc)); catch_all_set_op_loc(sc->envir, sc->op_stack_now - sc->op_stack); push_stack(sc, OP_CATCH_ALL, opt2_con(sc->code), sc->code); @@ -80253,7 +80360,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->envir = closure_let(sc->code); sc->value = fx_call(sc, closure_body(sc->code)); goto START; - /* -------------------------------- */ + case OP_CLOSURE_S: if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} @@ -80297,7 +80404,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); sc->value = fx_call(sc, closure_body(sc->code)); goto START; - /* -------------------------------- */ + case OP_CLOSURE_C: if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} @@ -80341,7 +80448,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); sc->value = fx_call(sc, closure_body(sc->code)); goto START; - /* -------------------------------- */ + case OP_CLOSURE_P: if (!closure_is_fine(sc, sc->code, MATCH_UNSAFE_CLOSURE, 1)) break; @@ -80373,7 +80480,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(sc->code)), sc->value); sc->code = T_Pair(closure_body(opt1_lambda(sc->code))); goto BEGIN; - /* -------------------------------- */ + case OP_CLOSURE_A: if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} @@ -80583,40 +80690,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) /* -------------------------------------------------------------------------------- */ - case OP_UNKNOWN: - if (unknown_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) - goto EVAL; - break; - - case OP_UNKNOWN_G: - if (unknown_g_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) - goto EVAL; - break; - - case OP_UNKNOWN_GG: - if (unknown_gg_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) - goto EVAL; - break; - - case OP_UNKNOWN_ALL_S: - if (unknown_all_s_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) - goto EVAL; - break; - - case OP_UNKNOWN_A: - if (unknown_a_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) - goto EVAL; - break; - - case OP_UNKNOWN_AA: - if (unknown_aa_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) - goto EVAL; - break; - - case OP_UNKNOWN_FX: - if (unknown_fx_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) - goto EVAL; - break; + case OP_UNKNOWN: if (unknown_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; + case OP_UNKNOWN_G: if (unknown_g_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; + case OP_UNKNOWN_GG: if (unknown_gg_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; + case OP_UNKNOWN_ALL_S: if (unknown_all_s_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; + case OP_UNKNOWN_A: if (unknown_a_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; + case OP_UNKNOWN_AA: if (unknown_aa_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; + case OP_UNKNOWN_FX: if (unknown_fx_ex(sc, lookup_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; /* -------------------------------------------------------------------------------- */ @@ -80822,9 +80902,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->value = lookup_checked(sc, car_code); else sc->value = T_Pos(car_code); /* sc->value is the current arg's value, sc->code is pointing to the next */ - /* fprintf(stderr, "value: %s from %s\n", DISPLAY(sc->value), DISPLAY(car_code)); */ - /* fprintf(stderr, "code: %s\n", DISPLAY(sc->code)); */ /* cdr(sc->code) may not be a pair or nil here! (eq? #f . 1) -> sc->code is 1 */ if (is_null(cdr(sc->code))) { @@ -80859,9 +80937,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } else { - /* here we know sc->code is a pair, cdr(sc->code) is not null - * sc->value is the previous arg's value - */ + /* here we know sc->code is a pair, cdr(sc->code) is not null, sc->value is the previous arg's value */ s7_pointer x; new_cell(sc, x, T_PAIR); set_car(x, sc->value); @@ -81101,7 +81177,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) free_cell(sc, sc->args); goto START; - /* -------------------------------- map -------------------------------- */ + case OP_MAP_GATHER_1: if (sc->value != sc->no_value) { @@ -81153,6 +81229,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (op_for_each_2(sc)) goto START; goto EVAL; + case OP_MEMBER_IF: case OP_MEMBER_IF1: if (member_if(sc)) goto START; @@ -81466,9 +81543,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) * * here we know car(sc->args) is not null, args is the list of steppable vars, * any unstepped vars in the do var section are not in this list, so - * (do ((i 0 (+ i 1)) (j 2)) ...) - * arrives here with sc->args: - * '(((+ i 1) . 0)) + * (do ((i 0 (+ i 1)) (j 2)) ...) arrives here with sc->args: '(((+ i 1) . 0)) */ push_stack(sc, OP_DO_END, sc->args, sc->code); sc->args = car(sc->args); /* the var data lists */ @@ -81946,9 +82021,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_IF_UNCHECKED: set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - push_stack_no_args(sc, OP_IF1, cdr(sc->code)); - sc->code = car(sc->code); + push_stack_no_args(sc, OP_IF1, cddr(sc->code)); + sc->code = cadr(sc->code); goto EVAL; case OP_IF1: @@ -82113,45 +82187,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto START; /* -------------------------------- when, unless -------------------------------- */ - case OP_WHEN: - check_when(sc); - goto EVAL; - - case OP_WHEN_S: - if (op_when_s(sc)) goto START; - goto EVAL; - - case OP_WHEN_A: - if (op_when_a(sc)) goto START; - goto EVAL; - - case OP_WHEN_P: - op_when_p(sc); - goto EVAL; - - case OP_WHEN_PP: - if (op_when_pp(sc)) goto START; - goto EVAL; - - case OP_UNLESS: - check_unless(sc); - goto EVAL; + case OP_WHEN: check_when(sc); goto EVAL; + case OP_WHEN_S: if (op_when_s(sc)) goto START; goto EVAL; + case OP_WHEN_A: if (op_when_a(sc)) goto START; goto EVAL; + case OP_WHEN_P: op_when_p(sc); goto EVAL; + case OP_WHEN_PP: if (op_when_pp(sc)) goto START; goto EVAL; - case OP_UNLESS_S: - if (op_unless_s(sc)) goto START; - goto EVAL; - - case OP_UNLESS_A: - if (op_unless_a(sc)) goto START; - goto EVAL; - - case OP_UNLESS_P: - op_unless_p(sc); - goto EVAL; - - case OP_UNLESS_PP: - if (op_unless_pp(sc)) goto START; - goto EVAL; + case OP_UNLESS: check_unless(sc); goto EVAL; + case OP_UNLESS_S: if (op_unless_s(sc)) goto START; goto EVAL; + case OP_UNLESS_A: if (op_unless_a(sc)) goto START; goto EVAL; + case OP_UNLESS_P: op_unless_p(sc); goto EVAL; + case OP_UNLESS_PP: if (op_unless_pp(sc)) goto START; goto EVAL; /* -------------------------------- let -------------------------------- */ @@ -82203,20 +82249,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (op_let1(sc)) goto BEGIN; goto EVAL; - /* now for gcc's benefit... (799/407 still matters) */ - case OP_D1: - fprintf(stderr, "oops\n"); - break; - case OP_D2: - fprintf(stderr, "oops\n"); - break; - case OP_D3: - fprintf(stderr, "oops\n"); - break; - case OP_D4: - fprintf(stderr, "oops\n"); - break; - case OP_LET_STAR_FX: op_let_star_fx(sc); goto BEGIN; case OP_NAMED_LET_STAR: op_named_let_star(sc); goto EVAL; case OP_LET_STAR2: op_let_star2(sc); goto EVAL; @@ -82231,6 +82263,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LETREC_STAR_UNCHECKED: if (op_letrec_star_unchecked(sc)) goto EVAL; goto BEGIN; case OP_LETREC_STAR1: if (op_letrec_star1(sc)) goto EVAL; goto BEGIN; + /* now for gcc's benefit... (799/407 still matters) */ + case OP_D1: fprintf(stderr, "oops\n"); break; + case OP_D2: fprintf(stderr, "oops\n"); break; + case OP_D3: fprintf(stderr, "oops\n"); break; + case OP_D4: fprintf(stderr, "oops\n"); break; + /* -------------------------------- let-temporarily -------------------------------- */ case OP_LET_TEMPORARILY: @@ -82250,7 +82288,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) s7_pointer val; val = op_let_temp_init2(sc); if (!val) goto EVAL; - if (val == sc->gc_nil) goto BEGIN; + if (val == sc->unused) goto BEGIN; } case OP_LET_TEMP_DONE: @@ -82375,8 +82413,40 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto START; goto AND_P; + case OP_AND_SAFE_P1: /* sc->code: (and (func...) (fx...)...) */ + sc->code = cdr(sc->code); + push_stack_no_args(sc, OP_AND_SAFE_P_REST, cdr(sc->code)); + sc->code = car(sc->code); + goto EVAL; + + case OP_AND_SAFE_P2: + sc->code = cdr(sc->code); + sc->value = fx_call(sc, sc->code); + if (is_false(sc, sc->value)) goto START; + sc->code = cdr(sc->code); + push_stack_no_args(sc, OP_AND_SAFE_P_REST, cdr(sc->code)); + sc->code = car(sc->code); + goto EVAL; + + case OP_AND_SAFE_P3: + sc->code = cdr(sc->code); + sc->value = fx_call(sc, sc->code); + if (is_false(sc, sc->value)) goto START; + sc->code = cdr(sc->code); + sc->value = fx_call(sc, sc->code); + if (is_false(sc, sc->value)) goto START; + sc->code = cadr(sc->code); + goto EVAL; + + case OP_AND_SAFE_P_REST: /* cdr(sc->code) is known to be a pair (and was pushed => sc->code) */ + if (is_false(sc, sc->value)) + goto START; + op_and_safe_p(sc); + goto START; + case OP_AND_SAFE_P: - op_safe_and_p(sc); + sc->code = cdr(sc->code); + op_and_safe_p(sc); goto START; case OP_AND_AP: @@ -82421,7 +82491,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto START; goto OR_P; - case OP_OR_SAFE_P: + case OP_OR_SAFE_P: /* op_or_safe_p* did not make much difference (unlike op_and_safe_p*) */ op_or_safe_p(sc); goto START; @@ -82708,8 +82778,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) * * the extra set! to pull in args, or fixup the outlet is annoying, but * but with-let is hard to do right -- what if env is chained as in class/objects? - * also, currently a mock-let is an error -- perhaps add the method checks? - * but unless 'values, that would require a 'with-let method (it's not a function) */ case OP_WITH_LET_S: op_with_let_s(sc); @@ -82774,7 +82842,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } goto START; - /* (read p) from scheme * "p" becomes current input port for eval's duration, then pops back before returning value into calling expr */ @@ -82877,7 +82944,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) default: { s7_pointer x; - sc->strbuf[0] = c; + sc->strbuf[0] = (unsigned char)c; push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args); check_stack_size(sc); sc->value = port_read_name(pt)(sc, pt); @@ -82982,7 +83049,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) return(missing_close_paren_error(sc)); default: - sc->strbuf[0] = c; + sc->strbuf[0] = (unsigned char)c; sc->value = port_read_name(pt)(sc, pt); goto READ_LIST; } @@ -82996,10 +83063,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->value = safe_reverse_in_place(sc, sc->args); if (is_symbol(car(sc->value))) { - pair_set_line(sc->value, port_line_number(sc->input_port)); - pair_set_file(sc->value, port_file_number(sc->input_port)); - set_has_line_number(sc->value); /* sc->input_port above can't be nil(?) -- it falls back on stdin now */ - + if (sc->input_port != sc->standard_input) /* (port_file_number(sc->input_port) > 1) -- maybe 0 is legit? */ + { + pair_set_line(sc->value, port_line_number(sc->input_port)); + pair_set_file(sc->value, port_file_number(sc->input_port)); + set_has_line_number(sc->value); /* sc->input_port above can't be nil(?) -- it falls back on stdin now */ + } if ((is_expansion(car(sc->value))) && (expansion_ex(sc) == goto_APPLY)) { @@ -83073,18 +83142,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) read_error(sc, "stray dot?"); /* (+ 1 . 2 3) or (list . ) */ } /* args = previously read stuff, value = thing just after the dot and before the ')': - * (list 1 2 . 3) - * value: 3, args: (2 1 list) - * '(1 . 2) - * value: 2, args: (1) - * + * (list 1 2 . 3) -> value: 3, args: (2 1 list) + * '(1 . 2) -> value: 2, args: (1) * but we also get here in a lambda arg list: - * (lambda (a b . c) #f) - * value: c, args: (b a) - * + * (lambda (a b . c) #f) -> value: c, args: (b a) * so we have to leave any error checks until later, I guess - * -- in eval_args1, if we end with non-pair-not-nil then - * something is fishy + * -- in eval_args1, if we end with non-pair-not-nil then something is fishy */ sc->value = reverse_in_place(sc, sc->value, sc->args); pair_set_dotted(sc->value); @@ -83185,7 +83248,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (sc->stack_end >= sc->stack_resize_trigger) check_for_cyclic_code(sc, code); push_stack(sc, OP_EVAL_ARGS, sc->nil, code); - + if (is_syntactic_symbol(car(carc))) /* was checking for is_syntactic here but that can be confused by successive optimizer passes: * (define (hi) (((lambda () list)) 1 2 3)) etc @@ -83195,7 +83258,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) ((!is_pair(cdr(carc))) || /* ((quote . #\h) (2 . #\i)) ! */ (is_syntactic(cadr(carc))))) apply_error(sc, (is_pair(cdr(carc))) ? cadr(carc) : carc, cdr(code)); - + sc->code = carc; sc->cur_op = (opcode_t)symbol_syntax_op_checked(sc->code); pair_set_syntax_op(sc->code, sc->cur_op); @@ -83276,12 +83339,9 @@ static char *mpfr_to_string(mpfr_t val, int32_t radix) str1 = mpfr_get_str(NULL, &expptr, radix, 0, val, GMP_RNDN); /* 0 -> full precision, but it's too hard to make this look like C formatted output. - * :(format #f "~,3F" pi) - * "3.141592653589793238462643383279502884195E0" - * :(format #f "~,3F" 1.1234567890123) ; not a bignum - * "1.123" - * :(format #f "~,3F" 1.12345678901234) ; a bignum - * "1.123456789012339999999999999999999999999E0" + * (format #f "~,3F" pi)-> "3.141592653589793238462643383279502884195E0" + * (format #f "~,3F" 1.1234567890123) -> "1.123" ; not a bignum + * (format #f "~,3F" 1.12345678901234) -> "1.123456789012339999999999999999999999999E0" ; a bignum * but we don't know the exponent or the string length until after we call mpfr_get_str. */ str = str1; @@ -83709,8 +83769,7 @@ static void mpz_init_set_s7_int(mpz_t n, s7_int uval) bool need_sign; int64_t val; val = (int64_t)uval; - /* handle one special case (sigh) */ - if (val == s7_int_min) + if (val == s7_int_min) /* handle one special case (sigh) */ mpz_init_set_str(n, "-9223372036854775808", 10); else { @@ -83757,8 +83816,8 @@ static s7_int big_integer_to_s7_int(mpz_t n) high = mpz_get_ui(x); if (high > (1LL << 31)) /* most callers of this function do not take sc as an argument and are in s7.h (s7_integer for example) */ - s7_error(cur_sc, cur_sc->out_of_range_symbol, - set_elist_2(cur_sc, wrap_string(cur_sc, "big int does not fit in s7_int: ~S", 34), + s7_error(cur_sc, cur_sc->out_of_range_symbol, + set_elist_2(cur_sc, wrap_string(cur_sc, "big int does not fit in s7_int: ~S", 34), mpz_to_big_integer(cur_sc, n))); mpz_clear(x); if (need_sign) @@ -84690,7 +84749,7 @@ static s7_pointer big_divide(s7_scheme *sc, s7_pointer args) if (!s7_is_number(car(x))) { s7_pointer func; - if ((has_active_methods(sc, car(x))) && + if ((has_active_methods(sc, car(x))) && ((func = find_method(sc, find_let(sc, car(x)), sc->multiply_symbol)) != sc->undefined)) { divisor = s7_apply_function(sc, func, cons(sc, divisor, x)); @@ -84967,7 +85026,6 @@ static s7_pointer big_make_polar(s7_scheme *sc, s7_pointer args) mpfr_clear(mag); return(real_NaN); } - if ((x == 0.0) || (y == 0.0)) { mpfr_clear(ang); @@ -85040,10 +85098,8 @@ static s7_pointer big_log(s7_scheme *sc, s7_pointer args) y = mpfr_get_d(big_real(p1), GMP_RNDN); /* we can't check y here for 1.0 (check for 0.0 apparently is ok): - * :(log 100.0 (+ 1.0 (bignum "1e-16"))) - * ;log base, argument 2, 1.000000000000000100000000000000000000002E0, is out of range (can't be 0.0 or 1.0) - * :(= 1.0 (+ 1.0 (bignum "1e-16"))) - * #f + * (log 100.0 (+ 1.0 (bignum "1e-16"))) -> ;log base, argument 2, 1.000000000000000100000000000000000000002E0, is out of range (can't be 0.0 or 1.0) + * (= 1.0 (+ 1.0 (bignum "1e-16"))) -> #f */ if (is_NaN(y)) return(real_NaN); @@ -85294,7 +85350,7 @@ static s7_pointer big_trig(s7_scheme *sc, s7_pointer args, * before comparing imag-part to 0, we need to look for NaN and inf, else: * (sinh 0+0/0i) -> 0.0 and (sinh (log 0.0)) -> inf.0 */ - + ix = mpfr_get_d(mpc_imagref(n), GMP_RNDN); if (ix == 0.0) { @@ -86014,20 +86070,18 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args) { #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_real_symbol, sc->is_real_symbol, sc->is_real_symbol) + /* can return be non-rational? */ /* currently (rationalize 1/0 1e18) -> 0 * remember to pad with many trailing zeros: - * : (rationalize 0.1 0) - * 3602879701896397/36028797018963968 - * :(rationalize 0.1000000000000000 0) - * 1/10 + * (rationalize 0.1 0) -> 3602879701896397/36028797018963968 + * (rationalize 0.1000000000000000 0) -> 1/10 * perhaps gmp number reader used if gmp -- could this be the trailing zeros problem? (why is the non-gmp case ok?) * also the bignum function is faking it. * (rationalize (real-part (bignum "0.1+i")) 0) -> 3602879701896397/36028797018963968 * a confusing case: - * > (rationalize 5925563891587147521650777143.74135805596e05) - * should be 148139097289678688041269428593533951399/250000 - * but that requires more than 128 bits of bignum-precision. + * (rationalize 5925563891587147521650777143.74135805596e05) should be 148139097289678688041269428593533951399/250000 + * but that requires more than 128 bits of bignum-precision. */ s7_pointer p0, p1 = NULL, p; @@ -86084,27 +86138,27 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args) return(out_of_range(sc, sc->rationalize_symbol, small_int(1), car(args), its_infinite_string)); } - mpfr_init_set(x0, ux, GMP_RNDN); /* x0 = ux - error */ + mpfr_init_set(x0, ux, GMP_RNDN); /* x0 = ux - error */ mpfr_sub(x0, x0, error, GMP_RNDN); - mpfr_init_set(x1, ux, GMP_RNDN); /* x1 = ux + error */ + mpfr_init_set(x1, ux, GMP_RNDN); /* x1 = ux + error */ mpfr_add(x1, x1, error, GMP_RNDN); mpz_init(i); - mpfr_get_z(i, x0, GMP_RNDU); /* i = ceil(x0) */ + mpfr_get_z(i, x0, GMP_RNDU); /* i = ceil(x0) */ - if (mpfr_cmp_ui(error, 1) >= 0) /* if (error >= 1.0) */ + if (mpfr_cmp_ui(error, 1) >= 0) /* if (error >= 1.0) */ { mpz_t n; - if (mpfr_cmp_ui(x0, 0) < 0) /* if (x0 < 0) */ + if (mpfr_cmp_ui(x0, 0) < 0) /* if (x0 < 0) */ { - if (mpfr_cmp_ui(x1, 0) < 0) /* if (x1 < 0) */ + if (mpfr_cmp_ui(x1, 0) < 0) /* if (x1 < 0) */ { mpz_init(n); - mpfr_get_z(n, x1, GMP_RNDD); /* num = floor(x1) */ + mpfr_get_z(n, x1, GMP_RNDD); /* num = floor(x1) */ } - else mpz_init_set_ui(n, 0); /* else num = 0 */ + else mpz_init_set_ui(n, 0); /* else num = 0 */ } - else mpz_init_set(n, i); /* else num = i */ + else mpz_init_set(n, i); /* else num = i */ mpz_clear(i); mpfr_clear(ux); @@ -86120,12 +86174,12 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args) { mpz_t n; - if (mpz_cmp_ui(i, 0) >= 0) /* if (i >= 0) */ - mpz_init_set(n, i); /* num = i */ + if (mpz_cmp_ui(i, 0) >= 0) /* if (i >= 0) */ + mpz_init_set(n, i); /* num = i */ else { mpz_init(n); - mpfr_get_z(n, x1, GMP_RNDD); /* else num = floor(x1) */ + mpfr_get_z(n, x1, GMP_RNDD); /* else num = floor(x1) */ } mpz_clear(i); @@ -86414,7 +86468,7 @@ static s7_pointer big_round(s7_scheme *sc, s7_pointer args) { if (mpz_even_p(fl)) mpz_init_set(n, fl); /* if (mod(fl, 2) == 0) return(fl) */ - else mpz_init_set(n, ce); + else mpz_init_set(n, ce); } } mpz_clear(fl); @@ -87268,6 +87322,24 @@ static void s7_gmp_init(s7_scheme *sc) /* -------------------------------- *s7* environment -------------------------------- */ +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); +} + +s7_int s7_float_format_precision(s7_scheme *sc) {return(sc->float_format_precision);} +s7_int s7_set_float_format_precision(s7_scheme *sc, s7_int new_len) +{ + s7_int old_len; + old_len = sc->float_format_precision; + sc->float_format_precision = new_len; + return(old_len); +} + static s7_pointer s7_let_field(s7_scheme *sc, const char *name) { s7_pointer sym; @@ -87285,7 +87357,7 @@ static void init_s7_let(s7_scheme *sc) sc->free_heap_size_symbol = s7_let_field(sc, "free-heap-size"); sc->gc_freed_symbol = s7_let_field(sc, "gc-freed"); sc->gc_protected_objects_symbol = s7_let_field(sc, "gc-protected-objects"); - set_immutable(sc->gc_protected_objects_symbol); + /* set_immutable(sc->gc_protected_objects_symbol); */ /* removed 30-Mar-19 */ sc->file_names_symbol = s7_let_field(sc, "file-names"); sc->rootlet_size_symbol = s7_let_field(sc, "rootlet-size"); sc->c_types_symbol = s7_let_field(sc, "c-types"); @@ -87307,7 +87379,7 @@ static void init_s7_let(s7_scheme *sc) sc->initial_string_port_length_symbol = s7_let_field(sc, "initial-string-port-length"); sc->default_rationalize_error_symbol = s7_let_field(sc, "default-rationalize-error"); sc->default_random_state_symbol = s7_let_field(sc, "default-random-state"); - sc->equivalent_float_epsilon_symbol = s7_let_field(sc, "equivalent-float-epsilon"); + sc->equivalent_float_epsilon_symbol = s7_let_field(sc, "equivalent-float-epsilon"); sc->hash_table_float_epsilon_symbol = s7_let_field(sc, "hash-table-float-epsilon"); sc->print_length_symbol = s7_let_field(sc, "print-length"); sc->bignum_precision_symbol = s7_let_field(sc, "bignum-precision"); @@ -87368,18 +87440,18 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda make_slot_1(sc, mu_let, make_symbol(sc, "IO"), cons(sc, make_integer(sc, info.ru_inblock), make_integer(sc, info.ru_oublock))); #endif #if (!S7_DEBUGGING) - make_slot_1(sc, mu_let, - make_symbol(sc, "permanent-cells"), + make_slot_1(sc, mu_let, + make_symbol(sc, "permanent-cells"), cons(sc, make_integer(sc, sc->permanent_cells), kmg(sc, sc->permanent_cells * sizeof(s7_cell)))); #else - make_slot_1(sc, mu_let, make_symbol(sc, "permanent-cells"), - s7_list(sc, 14, + make_slot_1(sc, mu_let, make_symbol(sc, "permanent-cells"), + s7_list(sc, 14, make_integer(sc, sc->permanent_cells), kmg(sc, sc->permanent_cells * sizeof(s7_cell)), /* big allocs here, so this is slightly inaccurate */ - make_symbol(sc, "unheap"), make_integer(sc, petrified_pointers), - make_symbol(sc, "slot"), make_integer(sc, permanent_slots), - make_symbol(sc, "port"), make_integer(sc, permanent_ports), - make_symbol(sc, "string"), make_integer(sc, permanent_strings), - make_symbol(sc, "cons"), make_integer(sc, permanent_conses), + make_symbol(sc, "unheap"), make_integer(sc, petrified_pointers), + make_symbol(sc, "slot"), make_integer(sc, permanent_slots), + make_symbol(sc, "port"), make_integer(sc, permanent_ports), + make_symbol(sc, "string"), make_integer(sc, permanent_strings), + make_symbol(sc, "cons"), make_integer(sc, permanent_conses), make_symbol(sc, "func"), make_integer(sc, permanent_functions))); make_slot_1(sc, mu_let, make_symbol(sc, "permanent-strings"), kmg(sc, permanent_string_len)); #endif @@ -87402,7 +87474,7 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda sc->w = sc->nil; make_slot_1(sc, mu_let, make_symbol(sc, "gc-protected-objects"), - cons(sc, make_integer(sc, sc->protected_objects_size - sc->gpofl_loc), + cons(sc, make_integer(sc, sc->protected_objects_size - sc->gpofl_loc), make_integer(sc, sc->protected_objects_size))); make_slot_1(sc, mu_let, make_symbol(sc, "setters"), make_integer(sc, sc->protected_setters_loc)); @@ -87420,10 +87492,10 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda } make_slot_1(sc, mu_let, make_symbol(sc, "symbol-table"), s7_list(sc, 9, - make_integer(sc, SYMBOL_TABLE_SIZE), + make_integer(sc, SYMBOL_TABLE_SIZE), make_symbol(sc, "max-bin"), make_integer(sc, mx_list), make_symbol(sc, "symbols"), cons(sc, make_integer(sc, syms), make_integer(sc, syms - gens - keys)), - make_symbol(sc, "gensyms"), make_integer(sc, gens), + make_symbol(sc, "gensyms"), make_integer(sc, gens), make_symbol(sc, "keys"), make_integer(sc, keys))); } make_slot_1(sc, mu_let, make_symbol(sc, "stack"), cons(sc, make_integer(sc, s7_stack_top(sc)), make_integer(sc, sc->stack_size))); @@ -87460,9 +87532,9 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda make_slot_1(sc, mu_let, make_symbol(sc, "vectors"), s7_list(sc, 9, make_integer(sc, sc->vectors->loc + sc->multivectors->loc), - make_symbol(sc, "vlen"), make_integer(sc, vlen), - make_symbol(sc, "fvlen"), make_integer(sc, flen), - make_symbol(sc, "ivlen"), make_integer(sc, ilen), + make_symbol(sc, "vlen"), make_integer(sc, vlen), + make_symbol(sc, "fvlen"), make_integer(sc, flen), + make_symbol(sc, "ivlen"), make_integer(sc, ilen), make_symbol(sc, "bvlen"), make_integer(sc, blen))); } @@ -87474,7 +87546,7 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda if (port_data(v)) len += port_data_size(v); } make_slot_1(sc, mu_let, make_symbol(sc, "input-ports"), cons(sc, make_integer(sc, sc->input_ports->loc), make_integer(sc, len))); - + gp = sc->output_ports; for (i = 0, len = 0; i < gp->loc; i++) { @@ -87483,7 +87555,7 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda if (port_data(v)) len += port_data_size(v); } make_slot_1(sc, mu_let, make_symbol(sc, "output-ports"), cons(sc, make_integer(sc, sc->output_ports->loc), make_integer(sc, len))); - + gp = sc->continuations; for (i = 0, len = 0; i < gp->loc; i++) if (is_continuation(gp->list[i])) @@ -87492,8 +87564,8 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda make_slot_1(sc, mu_let, make_symbol(sc, "c-objects"), make_integer(sc, sc->c_objects->loc)); #if WITH_GMP - make_slot_1(sc, mu_let, make_symbol(sc, "bignums"), - s7_list(sc, 5, make_integer(sc, sc->big_integers->loc), make_integer(sc, sc->big_ratios->loc), + make_slot_1(sc, mu_let, make_symbol(sc, "bignums"), + s7_list(sc, 5, make_integer(sc, sc->big_integers->loc), make_integer(sc, sc->big_ratios->loc), make_integer(sc, sc->big_reals->loc), make_integer(sc, sc->big_complexes->loc), make_integer(sc, sc->big_random_states->loc))); #endif @@ -87509,7 +87581,7 @@ static s7_pointer memory_usage(s7_scheme *sc) /* (for-each (lambda for (b = sc->block_lists[TOP_BLOCK_LIST], k = 0; b; b = block_next(b), k++) len += (sizeof(block_t) + block_size(b)); sc->w = cons(sc, make_integer(sc, k), sc->w); - make_slot_1(sc, mu_let, make_symbol(sc, "free-lists"), + make_slot_1(sc, mu_let, make_symbol(sc, "free-lists"), list_2(sc, cons(sc, make_symbol(sc, "bytes"), kmg(sc, len)), cons(sc, make_symbol(sc, "bins"), safe_reverse_in_place(sc, sc->w)))); sc->w = sc->nil; @@ -87539,10 +87611,10 @@ static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args) return(s7_make_integer(sc, sc->stack_size)); if (sym == sc->max_stack_size_symbol) /* max-stack-size */ return(s7_make_integer(sc, sc->max_stack_size)); - if (sym == sc->stacktrace_defaults_symbol) /* stacktrace-defaults (used to be *stacktrace*) */ + if (sym == sc->stacktrace_defaults_symbol) /* stacktrace-defaults */ return(sc->stacktrace_defaults); - if (sym == sc->rootlet_size_symbol) /* rootlet-size (actually sc->rootlet_entries) */ + if (sym == sc->rootlet_size_symbol) /* rootlet-size */ return(s7_make_integer(sc, sc->rootlet_entries)); if (sym == sc->safety_symbol) /* safety */ return(s7_make_integer(sc, sc->safety)); @@ -87629,9 +87701,9 @@ static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args) s7_pointer res; int32_t i; sc->w = sc->nil; - for (i = 0; i < sc->num_c_object_types; i++) /* c-object type (tag) is i */ + for (i = 0; i < sc->num_c_object_types; i++) /* c-object type (tag) is i */ sc->w = cons(sc, sc->c_object_types[i]->scheme_name, sc->w); - res = safe_reverse_in_place(sc, sc->w); /* so car(types) has tag 0 */ + res = safe_reverse_in_place(sc, sc->w); /* so car(types) has tag 0 */ sc->w = sc->nil; return(res); } @@ -87933,7 +88005,7 @@ static const char *decoded_name(s7_scheme *sc, s7_pointer p) if (p == sc->undefined) return("undefined"); if (p == sc->unspecified) return("unspecified"); if (p == sc->no_value) return("no_value"); - if (p == sc->gc_nil) return("gc_nil"); + if (p == sc->unused) return("#<unused>"); if (p == sc->symbol_table) return("symbol_table"); if (p == sc->rootlet) return("rootlet"); if (p == sc->unlet) return("unlet"); @@ -88302,24 +88374,21 @@ s7_scheme *s7_init(void) sc->last_error_line = -1; sc->nil = make_unique(sc, "()", T_NIL); - sc->gc_nil = make_unique(sc, "#<gc-nil>", T_NIL); /* ?? perhaps a unique type for this? */ + sc->unused = make_unique(sc, "#<unused>", T_UNUSED); sc->T = make_unique(sc, "#t", T_BOOLEAN); sc->F = make_unique(sc, "#f", T_BOOLEAN); sc->undefined = make_unique(sc, "#<undefined>", T_UNDEFINED); sc->unspecified = make_unique(sc, "#<unspecified>", T_UNSPECIFIED); #if S7_DEBUGGING - sc->no_value = make_unique(sc, "#<no-value>", T_UNSPECIFIED); + sc->no_value = make_unique(sc, "#<values>", T_UNSPECIFIED); #else sc->no_value = make_unique(sc, "#<unspecified>", T_UNSPECIFIED); #endif 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 - * built-in, I'll append unique_name and unique_name_length fields to - * the envr struct. + /* 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 built-in, I'll append unique_name and unique_name_length fields to the envr struct. */ let_id(sc->nil) = -1; unique_cdr(sc->unspecified) = sc->unspecified; @@ -88394,12 +88463,12 @@ s7_scheme *s7_init(void) sc->temp2 = sc->nil; sc->temp3 = sc->nil; sc->temp4 = sc->nil; + sc->temp5 = sc->nil; sc->temp6 = sc->nil; sc->temp7 = sc->nil; sc->temp8 = sc->nil; sc->temp9 = sc->nil; sc->temp10 = sc->nil; - sc->temp11 = sc->nil; for (i = 0; i < T_TEMPS_SIZE; i++) sc->t_temps[i] = sc->nil; sc->t_temp_ctr = 0; @@ -88451,9 +88520,9 @@ s7_scheme *s7_init(void) sc->protected_objects = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE); for (i = 0; i < INITIAL_PROTECTED_OBJECTS_SIZE; i++) { - vector_element(sc->protected_objects, i) = sc->gc_nil; - vector_element(sc->protected_setters, i) = sc->gc_nil; - vector_element(sc->protected_setter_symbols, i) = sc->gc_nil; + vector_element(sc->protected_objects, i) = sc->unused; + vector_element(sc->protected_setters, i) = sc->unused; + vector_element(sc->protected_setter_symbols, i) = sc->unused; sc->gpofl[i] = i; } @@ -88595,76 +88664,76 @@ s7_scheme *s7_init(void) init_wrappers(sc); make_standard_ports(sc); - #define quote_help "(quote obj) returns obj unevaluated. 'obj is an abbreviation for (quote obj)." - #define if_help "(if expr true-stuff optional-false-stuff) evaluates expr, then if it is true, evaluates true-stuff; otherwise, \ + #define H_quote "(quote obj) returns obj unevaluated. 'obj is an abbreviation for (quote obj)." + #define H_if "(if expr true-stuff optional-false-stuff) evaluates expr, then if it is true, evaluates true-stuff; otherwise, \ if optional-false-stuff exists, it is evaluated." - #define when_help "(when expr ...) evaluates expr, and if it is true, evaluates each form in its body, returning the value of the last" - #define unless_help "(unless expr ...) evaluates expr, and if it is false, evaluates each form in its body, returning the value of the last" - #define begin_help "(begin ...) evaluates each form in its body, returning the value of the last one" - #define set_help "(set! variable value) sets the value of variable to value." - #define let_help "(let ((var val)...) ...) binds each variable to its initial value, then evaluates its body,\ + #define H_when "(when expr ...) evaluates expr, and if it is true, evaluates each form in its body, returning the value of the last" + #define H_unless "(unless expr ...) evaluates expr, and if it is false, evaluates each form in its body, returning the value of the last" + #define H_begin "(begin ...) evaluates each form in its body, returning the value of the last one" + #define H_set "(set! variable value) sets the value of variable to value." + #define H_let "(let ((var val)...) ...) binds each variable to its initial value, then evaluates its body,\ returning the value of the last form. The let variables are local to it, and \ are not available for use until all have been initialized." - #define let_star_help "(let* ((var val)...) ...) binds each variable to its initial value, then evaluates its body, \ + #define H_let_star "(let* ((var val)...) ...) binds each variable to its initial value, then evaluates its body, \ returning the value of the last form. The let* variables are local to it, and are available immediately." - #define letrec_help "(letrec ((var (lambda ...)))...) is like let, but var can refer to itself in its value \ + #define H_letrec "(letrec ((var (lambda ...)))...) is like let, but var can refer to itself in its value \ (i.e. you can define local recursive functions)" - #define letrec_star_help "(letrec* ((var val))...) is like letrec, but successive bindings are handled as in let*" - #define cond_help "(cond (expr clause...)...) is like if..then. Each expr is evaluated in order, and if one is not #f, \ + #define H_letrec_star "(letrec* ((var val))...) is like letrec, but successive bindings are handled as in let*" + #define H_cond "(cond (expr clause...)...) is like if..then. Each expr is evaluated in order, and if one is not #f, \ the associated clauses are evaluated, whereupon cond returns." - #define and_help "(and expr expr ...) evaluates each of its arguments in order, quitting (and returning #f) \ + #define H_and "(and expr expr ...) evaluates each of its arguments in order, quitting (and returning #f) \ as soon as one of them returns #f. If all are non-#f, it returns the last value." - #define or_help "(or expr expr ...) evaluates each of its argments in order, quitting as soon as one of them is not #f. \ + #define H_or "(or expr expr ...) evaluates each of its argments in order, quitting as soon as one of them is not #f. \ If all are #f, or returns #f." - #define case_help "(case val ((key...) clause...)...) looks for val in the various lists of keys, and if a \ + #define H_case "(case val ((key...) clause...)...) looks for val in the various lists of keys, and if a \ match is found (via eqv?), the associated clauses are evaluated, and case returns." - #define do_help "(do (vars...) (loop control and return value) ...) is a do-loop." - #define lambda_help "(lambda args ...) returns a function." - #define lambda_star_help "(lambda* args ...) returns a function; the args list can have default values, \ + #define H_do "(do (vars...) (loop control and return value) ...) is a do-loop." + #define H_lambda "(lambda args ...) returns a function." + #define H_lambda_star "(lambda* args ...) returns a function; the args list can have default values, \ the parameters themselves can be accessed via keywords." - #define define_help "(define var val) assigns val to the variable (symbol) var. (define (func args) ...) is \ + #define H_define "(define var val) assigns val to the variable (symbol) var. (define (func args) ...) is \ shorthand for (define func (lambda args ...))" - #define define_star_help "(define* (func args) ...) defines a function with optional/keyword arguments." - #define define_constant_help "(define-constant var val) defines var to be a constant (it can't be set or bound), with the value val." - #define define_macro_help "(define-macro (mac args) ...) defines mac to be a macro." - #define define_macro_star_help "(define-macro* (mac args) ...) defines mac to be a macro with optional/keyword arguments." - #define define_expansion_help "(define-expansion (mac args) ...) defines mac to be a read-time macro." - #define define_bacro_help "(define-bacro (mac args) ...) defines mac to be a bacro." - #define define_bacro_star_help "(define-bacro* (mac args) ...) defines mac to be a bacro with optional/keyword arguments." - #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 = syntax(sc, "quote", OP_QUOTE, small_int(1), small_int(1), quote_help); - sc->if_symbol = syntax(sc, "if", OP_IF, small_int(2), small_int(3), if_help); - sc->when_symbol = syntax(sc, "when", OP_WHEN, small_int(2), max_arity, when_help); - sc->unless_symbol = syntax(sc, "unless", OP_UNLESS, small_int(2), max_arity, unless_help); - sc->begin_symbol = syntax(sc, "begin", OP_BEGIN, small_int(0), max_arity, begin_help); - sc->set_symbol = syntax(sc, "set!", OP_SET, small_int(2), small_int(2), set_help); - sc->cond_symbol = syntax(sc, "cond", OP_COND, small_int(1), max_arity, cond_help); - sc->and_symbol = syntax(sc, "and", OP_AND, small_int(0), max_arity, and_help); - sc->or_symbol = syntax(sc, "or", OP_OR, small_int(0), max_arity, or_help); - sc->case_symbol = syntax(sc, "case", OP_CASE, small_int(2), max_arity, case_help); - sc->with_baffle_symbol = syntax(sc, "with-baffle", OP_WITH_BAFFLE, small_int(0), max_arity, with_baffle_help); /* (with-baffle) is () */ - sc->macroexpand_symbol = syntax(sc, "macroexpand", OP_MACROEXPAND, small_int(1), small_int(1), macroexpand_help); - sc->define_symbol = definer_syntax(sc, "define", OP_DEFINE, small_int(2), max_arity, define_help); - sc->define_star_symbol = definer_syntax(sc, "define*", OP_DEFINE_STAR, small_int(2), max_arity, define_star_help); - sc->define_constant_symbol = definer_syntax(sc, "define-constant", OP_DEFINE_CONSTANT, small_int(2), max_arity, define_constant_help); - sc->define_macro_symbol = definer_syntax(sc, "define-macro", OP_DEFINE_MACRO, small_int(2), max_arity, define_macro_help); - sc->define_macro_star_symbol = definer_syntax(sc, "define-macro*", OP_DEFINE_MACRO_STAR, small_int(2), max_arity, define_macro_star_help); - sc->define_expansion_symbol = definer_syntax(sc, "define-expansion",OP_DEFINE_EXPANSION, small_int(2), max_arity, define_expansion_help); - sc->define_bacro_symbol = definer_syntax(sc, "define-bacro", OP_DEFINE_BACRO, small_int(2), max_arity, define_bacro_help); - sc->define_bacro_star_symbol = definer_syntax(sc, "define-bacro*", OP_DEFINE_BACRO_STAR, small_int(2), max_arity, define_bacro_star_help); - sc->let_symbol = binder_syntax(sc, "let", OP_LET, small_int(2), max_arity, let_help); - sc->let_star_symbol = binder_syntax(sc, "let*", OP_LET_STAR, small_int(2), max_arity, let_star_help); - sc->letrec_symbol = binder_syntax(sc, "letrec", OP_LETREC, small_int(2), max_arity, letrec_help); - sc->letrec_star_symbol = binder_syntax(sc, "letrec*", OP_LETREC_STAR, small_int(2), max_arity, letrec_star_help); - sc->do_symbol = binder_syntax(sc, "do", OP_DO, small_int(2), max_arity, do_help); /* 2 because body can be null */ - sc->lambda_symbol = binder_syntax(sc, "lambda", OP_LAMBDA, small_int(2), max_arity, lambda_help); - sc->lambda_star_symbol = binder_syntax(sc, "lambda*", OP_LAMBDA_STAR, small_int(2), max_arity, lambda_star_help); - sc->let_temporarily_symbol = binder_syntax(sc, "let-temporarily", OP_LET_TEMPORARILY, small_int(2), max_arity, let_temporarily_help); - sc->with_let_symbol = binder_syntax(sc, "with-let", OP_WITH_LET, small_int(1), max_arity, with_let_help); + #define H_define_star "(define* (func args) ...) defines a function with optional/keyword arguments." + #define H_define_constant "(define-constant var val) defines var to be a constant (it can't be set or bound), with the value val." + #define H_define_macro "(define-macro (mac args) ...) defines mac to be a macro." + #define H_define_macro_star "(define-macro* (mac args) ...) defines mac to be a macro with optional/keyword arguments." + #define H_define_expansion "(define-expansion (mac args) ...) defines mac to be a read-time macro." + #define H_define_bacro "(define-bacro (mac args) ...) defines mac to be a bacro." + #define H_define_bacro_star "(define-bacro* (mac args) ...) defines mac to be a bacro with optional/keyword arguments." + #define H_with_baffle "(with-baffle ...) evaluates its body in a context that is safe from outside interference." + #define H_macroexpand "(macroexpand macro-call) returns the result of the expansion phase of evaluating the macro call." + #define H_with_let "(with-let env ...) evaluates its body in the environment env." + #define H_let_temporarily "(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 = syntax(sc, "quote", OP_QUOTE, small_int(1), small_int(1), H_quote); + sc->if_symbol = syntax(sc, "if", OP_IF, small_int(2), small_int(3), H_if); + sc->when_symbol = syntax(sc, "when", OP_WHEN, small_int(2), max_arity, H_when); + sc->unless_symbol = syntax(sc, "unless", OP_UNLESS, small_int(2), max_arity, H_unless); + sc->begin_symbol = syntax(sc, "begin", OP_BEGIN, small_int(0), max_arity, H_begin); /* (begin) is () */ + sc->set_symbol = syntax(sc, "set!", OP_SET, small_int(2), small_int(2), H_set); + sc->cond_symbol = syntax(sc, "cond", OP_COND, small_int(1), max_arity, H_cond); + sc->and_symbol = syntax(sc, "and", OP_AND, small_int(0), max_arity, H_and); + sc->or_symbol = syntax(sc, "or", OP_OR, small_int(0), max_arity, H_or); + sc->case_symbol = syntax(sc, "case", OP_CASE, small_int(2), max_arity, H_case); + sc->with_baffle_symbol = syntax(sc, "with-baffle", OP_WITH_BAFFLE, small_int(0), max_arity, H_with_baffle); /* (with-baffle) is () */ + sc->macroexpand_symbol = syntax(sc, "macroexpand", OP_MACROEXPAND, small_int(1), small_int(1), H_macroexpand); + sc->define_symbol = definer_syntax(sc, "define", OP_DEFINE, small_int(2), max_arity, H_define); + sc->define_star_symbol = definer_syntax(sc, "define*", OP_DEFINE_STAR, small_int(2), max_arity, H_define_star); + sc->define_constant_symbol = definer_syntax(sc, "define-constant", OP_DEFINE_CONSTANT, small_int(2), max_arity, H_define_constant); + sc->define_macro_symbol = definer_syntax(sc, "define-macro", OP_DEFINE_MACRO, small_int(2), max_arity, H_define_macro); + sc->define_macro_star_symbol = definer_syntax(sc, "define-macro*", OP_DEFINE_MACRO_STAR, small_int(2), max_arity, H_define_macro_star); + sc->define_expansion_symbol = definer_syntax(sc, "define-expansion",OP_DEFINE_EXPANSION, small_int(2), max_arity, H_define_expansion); + sc->define_bacro_symbol = definer_syntax(sc, "define-bacro", OP_DEFINE_BACRO, small_int(2), max_arity, H_define_bacro); + sc->define_bacro_star_symbol = definer_syntax(sc, "define-bacro*", OP_DEFINE_BACRO_STAR, small_int(2), max_arity, H_define_bacro_star); + sc->let_symbol = binder_syntax(sc, "let", OP_LET, small_int(2), max_arity, H_let); + sc->let_star_symbol = binder_syntax(sc, "let*", OP_LET_STAR, small_int(2), max_arity, H_let_star); + sc->letrec_symbol = binder_syntax(sc, "letrec", OP_LETREC, small_int(2), max_arity, H_letrec); + sc->letrec_star_symbol = binder_syntax(sc, "letrec*", OP_LETREC_STAR, small_int(2), max_arity, H_letrec_star); + sc->do_symbol = binder_syntax(sc, "do", OP_DO, small_int(2), max_arity, H_do); /* 2 because body can be null */ + sc->lambda_symbol = binder_syntax(sc, "lambda", OP_LAMBDA, small_int(2), max_arity, H_lambda); + sc->lambda_star_symbol = binder_syntax(sc, "lambda*", OP_LAMBDA_STAR, small_int(2), max_arity, H_lambda_star); + sc->let_temporarily_symbol = binder_syntax(sc, "let-temporarily", OP_LET_TEMPORARILY, small_int(2), max_arity, H_let_temporarily); + sc->with_let_symbol = binder_syntax(sc, "with-let", OP_WITH_LET, small_int(1), max_arity, H_with_let); set_local_slot(sc->with_let_symbol, global_slot(sc->with_let_symbol)); /* for set_locals */ set_immutable(sc->with_let_symbol); sc->setter_symbol = make_symbol(sc, "setter"); @@ -88864,6 +88933,8 @@ s7_scheme *s7_init(void) sc->c_pointer_weak2_symbol = defun("c-pointer-weak2", c_pointer_weak2, 1, 0, false); sc->c_pointer_to_list_symbol = defun("c-pointer->list", c_pointer_to_list, 1, 0, false); + sc->port_file_symbol = defun("port-file", port_file, 1, 0, false); + sc->port_position_symbol = defun("port-position", port_position, 1, 0, false); sc->port_line_number_symbol = defun("port-line-number", port_line_number, 0, 1, false); 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); @@ -89193,6 +89264,10 @@ s7_scheme *s7_init(void) sc->apply_symbol = unsafe_defun("apply", apply, 1, 0, true); { s7_pointer p; + set_is_definer(sc->apply_symbol); + /* yow... (apply (inlet) (f)) in do body where (f) returns '(define...) -- see s7test.scm under apply + * perhaps better: if closure returns a definer in some way set its name as a definer? even this is not fool-proof + */ p = slot_value(global_slot(sc->apply_symbol)); set_type(p, type(p) | T_COPY_ARGS | T_UNHEAP); /* (let ((x '((1 2) 3 4))) (catch #t (lambda () (apply apply apply x)) (lambda args 'error)) x) should not mess up x! */ @@ -89219,14 +89294,13 @@ s7_scheme *s7_init(void) sc->funclet_symbol = defun("funclet", funclet, 1, 0, false); sc->dilambda_symbol = defun("dilambda", dilambda, 2, 0, false); s7_typed_dilambda(sc, "setter", g_setter, 1, 1, g_set_setter, 2, 1, H_setter, Q_setter, NULL); - sc->arity_symbol = defun("arity", arity, 1, 0, false); sc->is_aritable_symbol = defun("aritable?", is_aritable, 2, 0, false); sc->is_eq_symbol = defun("eq?", is_eq, 2, 0, false); sc->is_eqv_symbol = defun("eqv?", is_eqv, 2, 0, false); sc->is_equal_symbol = defun("equal?", is_equal, 2, 0, false); - sc->is_equivalent_symbol = defun("equivalent?", is_equivalent, 2, 0, false); + sc->is_equivalent_symbol = defun("equivalent?", is_equivalent, 2, 0, false); sc->type_of_symbol = defun("type-of", type_of, 1, 0, false); sc->gc_symbol = unsafe_defun("gc", gc, 0, 1, false); @@ -89239,7 +89313,7 @@ s7_scheme *s7_init(void) #endif s7_define_function(sc, "s7-optimize", g_optimize, 1, 0, false, "short-term debugging aid"); - sc->c_object_set_function = s7_make_function(sc, "(c-object setter)", g_c_object_set, 1, 0, true, "c-object setter"); + sc->c_object_set_function = s7_make_function(sc, "#<c-object-setter>", g_c_object_set, 1, 0, true, "c-object setter"); /* c_function_signature(sc->c_object_set_function) = s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_c_object_symbol, sc->T); */ set_scope_safe(slot_value(global_slot(sc->call_with_input_string_symbol))); @@ -89276,12 +89350,12 @@ s7_scheme *s7_init(void) /* -------- *features* -------- */ sc->features_symbol = s7_define_variable_with_documentation(sc, "*features*", sc->nil, "list of currently available features ('complex-numbers, etc)"); - s7_set_setter(sc, sc->features_symbol, s7_make_function(sc, "(set *features*)", g_features_set, 2, 0, false, "*features* setter")); + s7_set_setter(sc, sc->features_symbol, s7_make_function(sc, "#<set-*features*>", g_features_set, 2, 0, false, "*features* setter")); /* -------- *load-path* -------- */ sc->load_path_symbol = s7_define_variable_with_documentation(sc, "*load-path*", sc->nil, "*load-path* is a list of directories (strings) that the load function searches if it is passed an incomplete file name"); - s7_set_setter(sc, sc->load_path_symbol, s7_make_function(sc, "(set *load-path*)", g_load_path_set, 2, 0, false, "*load-path* setter")); + s7_set_setter(sc, sc->load_path_symbol, s7_make_function(sc, "#<set-*load-path*>", g_load_path_set, 2, 0, false, "*load-path* setter")); #ifdef CLOAD_DIR sc->cload_directory_symbol = s7_define_variable(sc, "*cload-directory*", s7_make_string(sc, (char *)CLOAD_DIR)); @@ -89289,7 +89363,7 @@ s7_scheme *s7_init(void) #else sc->cload_directory_symbol = s7_define_variable(sc, "*cload-directory*", make_empty_string(sc, 0, 0)); #endif - s7_set_setter(sc, sc->cload_directory_symbol, s7_make_function(sc, "(set! *cload-directory*)", g_cload_directory_set, 2, 0, false, "*cload-directory* setter")); + s7_set_setter(sc, sc->cload_directory_symbol, s7_make_function(sc, "#<set-*cload-directory*>", g_cload_directory_set, 2, 0, false, "*cload-directory* setter")); /* -------- *autoload* -------- * this pretends to be a hash-table or environment, but it's actually a function @@ -89297,8 +89371,8 @@ s7_scheme *s7_init(void) sc->autoloader_symbol = s7_define_typed_function(sc, "*autoload*", g_autoloader, 1, 0, false, H_autoloader, Q_autoloader); c_function_set_setter(slot_value(global_slot(sc->autoloader_symbol)), slot_value(global_slot(sc->autoload_symbol))); /* (set! (*autoload* x) y) */ - sym = s7_define_variable_with_documentation(sc, "*libraries*", sc->nil, "list of currently loaded libraries (libc.scm, etc)"); - sc->libraries = global_slot(sym); + sc->libraries_symbol = s7_define_variable_with_documentation(sc, "*libraries*", sc->nil, "list of currently loaded libraries (libc.scm, etc)"); + s7_set_setter(sc, sc->libraries_symbol, s7_make_function(sc, "#<set-*libraries*>", g_libraries_set, 2, 0, false, "*libraries* setter")); s7_autoload(sc, make_symbol(sc, "cload.scm"), s7_make_permanent_string(sc, "cload.scm")); s7_autoload(sc, make_symbol(sc, "lint.scm"), s7_make_permanent_string(sc, "lint.scm")); @@ -89308,6 +89382,7 @@ s7_scheme *s7_init(void) s7_autoload(sc, make_symbol(sc, "reactive.scm"), s7_make_permanent_string(sc, "reactive.scm")); s7_autoload(sc, make_symbol(sc, "repl.scm"), s7_make_permanent_string(sc, "repl.scm")); s7_autoload(sc, make_symbol(sc, "r7rs.scm"), s7_make_permanent_string(sc, "r7rs.scm")); + s7_autoload(sc, make_symbol(sc, "profile.scm"), s7_make_permanent_string(sc, "profile.scm")); s7_autoload(sc, make_symbol(sc, "libc.scm"), s7_make_permanent_string(sc, "libc.scm")); s7_autoload(sc, make_symbol(sc, "libm.scm"), s7_make_permanent_string(sc, "libm.scm")); @@ -89322,7 +89397,7 @@ s7_scheme *s7_init(void) /* -------- *#readers* -------- */ sym = s7_define_variable_with_documentation(sc, "*#readers*", sc->nil, "list of current reader macros"); sc->sharp_readers = global_slot(sym); - s7_set_setter(sc, sym, s7_make_function(sc, "(set! *#readers*)", g_sharp_readers_set, 2, 0, false, "*#readers* setter")); + s7_set_setter(sc, sym, s7_make_function(sc, "#<set-*#readers*>", g_sharp_readers_set, 2, 0, false, "*#readers* setter")); /* *features* */ s7_provide(sc, "s7"); @@ -89405,11 +89480,18 @@ s7_scheme *s7_init(void) #if defined(__sun) && defined(__SVR4) s7_provide(sc, "solaris"); #endif +#ifdef __MINGW32__ + s7_provide(sc, "mingw"); +#endif + #ifdef __SUNPRO_C s7_provide(sc, "sunpro_c"); #endif -#ifdef __MINGW32__ - s7_provide(sc, "mingw"); +#if (defined(__clang__)) + s7_provide(sc, "clang"); +#endif +#if (defined(__GNUC__)) + s7_provide(sc, "gcc"); #endif sc->vector_set_function = slot_value(global_slot(sc->vector_set_symbol)); @@ -89437,9 +89519,9 @@ s7_scheme *s7_init(void) #if (WITH_PURE_S7) /* we need to be able at least to set (current-output-port) to #f */ c_function_set_setter(slot_value(global_slot(sc->current_input_port_symbol)), - s7_make_function(sc, "(set *stdin*)", g_set_current_input_port, 1, 0, false, "*stdin* setter")); + s7_make_function(sc, "#<set-*stdin*>", g_set_current_input_port, 1, 0, false, "*stdin* setter")); c_function_set_setter(slot_value(global_slot(sc->current_output_port_symbol)), - s7_make_function(sc, "(set *stdout*)", g_set_current_output_port, 1, 0, false, "*stdout* setter")); + s7_make_function(sc, "#<set-*stdout*>", g_set_current_output_port, 1, 0, false, "*stdout* setter")); #else set_setter(sc->set_current_input_port_symbol); set_setter(sc->set_current_output_port_symbol); @@ -89467,9 +89549,11 @@ s7_scheme *s7_init(void) s7_function_set_setter(sc, "let-ref", "let-set!"); s7_function_set_setter(sc, "string-ref", "string-set!"); c_function_set_setter(slot_value(global_slot(sc->outlet_symbol)), - s7_make_function(sc, "(set! outlet)", g_set_outlet, 2, 0, false, "outlet setter")); + s7_make_function(sc, "#<set-outlet>", g_set_outlet, 2, 0, false, "outlet setter")); c_function_set_setter(slot_value(global_slot(sc->port_line_number_symbol)), - s7_make_function(sc, "(set! port-line-number)", g_set_port_line_number, 1, 1, false, "port line setter")); + s7_make_function(sc, "#<set-port-line-number>", g_set_port_line_number, 1, 1, false, "port line setter")); + c_function_set_setter(slot_value(global_slot(sc->port_position_symbol)), + s7_make_function(sc, "#<set-port-position>", g_set_port_position, 2, 0, false, "port position setter")); s7_define_constant(sc, "most-positive-fixnum", mostfix); s7_define_constant(sc, "most-negative-fixnum", leastfix); @@ -89493,17 +89577,17 @@ s7_scheme *s7_init(void) random_carry(p) = 1675393560; #endif sc->default_rng = p; - - for (i = 0; i < 10; i++) sc->singletons[(uint8_t)'0' + i] = small_int(i); - sc->singletons[(uint8_t)'+'] = sc->add_symbol; - sc->singletons[(uint8_t)'-'] = sc->subtract_symbol; - sc->singletons[(uint8_t)'*'] = sc->multiply_symbol; - sc->singletons[(uint8_t)'/'] = sc->divide_symbol; - sc->singletons[(uint8_t)'<'] = sc->lt_symbol; - sc->singletons[(uint8_t)'>'] = sc->gt_symbol; - sc->singletons[(uint8_t)'='] = sc->eq_symbol; } + for (i = 0; i < 10; i++) sc->singletons[(uint8_t)'0' + i] = small_int(i); + sc->singletons[(uint8_t)'+'] = sc->add_symbol; + sc->singletons[(uint8_t)'-'] = sc->subtract_symbol; + sc->singletons[(uint8_t)'*'] = sc->multiply_symbol; + sc->singletons[(uint8_t)'/'] = sc->divide_symbol; + sc->singletons[(uint8_t)'<'] = sc->lt_symbol; + sc->singletons[(uint8_t)'>'] = sc->gt_symbol; + sc->singletons[(uint8_t)'='] = sc->eq_symbol; + #if WITH_GMP s7_gmp_init(sc); #endif @@ -90019,13 +90103,18 @@ s7_scheme *s7_init(void) sc->let_set_fallback_symbol, s7_make_function(sc, "s7-let-set", g_s7_let_set_fallback, 3, 0, false, "*s7* writer"))); s7_define_constant(sc, "*s7*", s7_openlet(sc, sc->s7_let)); - s7_eval_c_string(sc, "(define morally-equal? equivalent?)"); + { /* make the two *s7* accessor fields immutable */ + s7_pointer slot; + slot = let_slots(sc->s7_let); + set_immutable(slot); + set_immutable(next_slot(slot)); + } + #if (!DISABLE_DEPRECATED) s7_eval_c_string(sc, "(begin \n\ (define global-environment rootlet) \n\ (define current-environment curlet) \n\ - (define hash-table* hash-table) \n\ - ;(define morally-equal? equivalent?) \n\ + (define morally-equal? equivalent?) \n\ (define make-keyword string->keyword))"); /* make-keyword is used in CM's scm/s7.scm */ #endif @@ -90033,7 +90122,7 @@ s7_scheme *s7_init(void) if (strcmp(op_names[HOP_SAFE_C_PP], "h_safe_c_pp") != 0) fprintf(stderr, "op_name: %s\n", op_names[HOP_SAFE_C_PP]); 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]); if (strcmp(op_names[OP_SAFE_CLOSURE_A_A], "safe_closure_a_a") != 0) fprintf(stderr, "op_name: %s\n", op_names[OP_SAFE_CLOSURE_A_A]); - if ((OP_MAX_DEFINED != 799) || (OPT_MAX_DEFINED != 407)) + if ((OP_MAX_DEFINED != 803) || (OPT_MAX_DEFINED != 407)) fprintf(stderr, "size: cell: %d, block: %d, max op: %d, opt: %d\n", (int)sizeof(s7_cell), (int)sizeof(block_t), OP_MAX_DEFINED, OPT_MAX_DEFINED); /* 64 bit machine: cell size: 48, 80 if gmp, 104 if debugging, block size: 40 */ #endif @@ -90093,7 +90182,7 @@ int main(int argc, char **argv) /* in Linux: gcc s7.c -o repl -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g -ldl -lm -Wl,-export-dynamic * in *BSD: gcc s7.c -o repl -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g -lm -Wl,-export-dynamic * in OSX: gcc s7.c -o repl -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g -lm - * (clang also needs LDFLAGS="-Wl,-export-dynamic" in Linux and maybe "-fPIC") + * (clang also needs LDFLAGS="-Wl,-export-dynamic" in Linux and "-fPIC") */ #endif @@ -90101,39 +90190,46 @@ int main(int argc, char **argv) * * new snd version: snd.h configure.ac HISTORY.Snd NEWS barchive, /usr/ccrma/web/html/software/snd/index.html * - * ---------------------------------------------------------------------------------- - * 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19.0 19.1 19.2 19.3 - * ---------------------------------------------------------------------------------- - * tpeak | | | | 391 | 377 | 199 | 199 160 160 - * tmac | | | | 9052 | 264 | 236 | 236 236 236 - * tshoot | | | | | | 373 | 356 357 357 - * tauto | | | 1752 | 1689 | 1700 | 835 | 594 594 593 - * tref | | | 2372 | 2125 | 1036 | 983 | 971 966 950 - * index 44.3 | 3291 | 1725 | 1276 | 1255 | 1168 | 1022 | 1018 993 976 - * teq | | | 6612 | 2777 | 1931 | 1539 | 1540 1518 1520 - * s7test 1721 | 1358 | 995 | 1194 | 2926 | 2110 | 1726 | 1719 1715 1720 - * lint | | | | 4041 | 2702 | 2120 | 2092 2087 2087 - * tcopy | | | 13.6 | 3183 | 2974 | 2320 | 2264 2249 2249 - * tform | | | 6816 | 3714 | 2762 | 2362 | 2358 2268 2325 - * tread | | | | | 2357 | 2336 | 2338 2335 2332 - * tfft | | 15.5 | 16.4 | 17.3 | 3966 | 2493 | 2502 2467 2467 - * tvect | | | | | | 5616 | 2650 2520 2520 - * tlet | | | | | 4717 | 2959 | 2946 2678 2671 - * tclo | | 4391 | 4666 | 4651 | 4682 | 3084 | 3061 2832 2850 - * tmap | | | 9.3 | 5279 | 3445 | 3015 | 3009 3085 3086 - * dup | | | | | 20.8 | 5711 | 4137 3469 3032 - * tsort | | | | 8584 | 4111 | 3327 | 3317 3318 3318 - * titer | | | | 5971 | 4646 | 3587 | 3564 3559 3551 - * thash | | | 50.7 | 8778 | 7697 | 5309 | 5254 5181 5180 - * tset | | | | | 10.0 | 6432 | 6317 6390 6432 - * trec 25.0 | 19.2 | 15.8 | 16.4 | 16.4 | 16.4 | 11.0 | 11.0 10.9 10.9 - * tgen | 71.0 | 70.6 | 38.0 | 12.6 | 11.9 | 11.2 | 11.1 11.1 11.1 - * tall 90.0 | 43.0 | 14.5 | 12.7 | 17.9 | 18.8 | 17.1 | 17.1 17.2 17.2 - * calls 359.0 |275.0 | 54.0 | 34.7 | 43.7 | 40.4 | 38.4 | 38.4 38.4 38.5 - * sg | | | |139.0 | 85.9 | 78.0 | 78.0 72.9 73.0 - * lg | | | |211.0 |133.0 |112.7 |110.6 110.2 110.3 - * tbig | | | | |246.9 |230.6 |213.3 187.3 187.2 - * ---------------------------------------------------------------------------------- + * ------------------------------------------------------------------------------------------ + * 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19.0 19.1 19.2 19.3 19.4 + * ------------------------------------------------------------------------------------------ + * tpeak | | | | 391 | 377 | 199 | 199 160 160 161 + * tmac | | | | 9052 | 264 | 236 | 236 236 236 236 + * tauto | | | 1752 | 1689 | 1700 | 835 | 594 594 593 595 + * tshoot | | | | | | 710 | 636 + * tref | | | 2372 | 2125 | 1036 | 983 | 971 966 950 954 + * index 44.3 | 3291 | 1725 | 1276 | 1255 | 1168 | 1022 | 1018 993 976 974 + * teq | | | 6612 | 2777 | 1931 | 1539 | 1540 1518 1520 1513 + * s7test 1721 | 1358 | 995 | 1194 | 2926 | 2110 | 1726 | 1719 1715 1720 1692 + * lint | | | | 4041 | 2702 | 2120 | 2092 2087 2087 2099 + * tcopy | | | 13.6 | 3183 | 2974 | 2320 | 2264 2249 2249 2260 + * tform | | | 6816 | 3714 | 2762 | 2362 | 2358 2268 2325 2320 + * tread | | | | | 2357 | 2336 | 2338 2335 2332 2332 + * tfft | | 15.5 | 16.4 | 17.3 | 3966 | 2493 | 2502 2467 2467 2467 + * tvect | | | | | | 5616 | 2650 2520 2520 2471 + * tlet | | | | | 4717 | 2959 | 2946 2678 2671 2685 + * tclo | | 4391 | 4666 | 4651 | 4682 | 3084 | 3061 2832 2850 2855 + * dup | | | | | 20.8 | 5711 | 4137 3469 3032 2993 + * tmap | | | 9.3 | 5279 | 3445 | 3015 | 3009 3085 3086 3085 + * tsort | | | | 8584 | 4111 | 3327 | 3317 3318 3318 3318 + * tset | | | | | 10.0 | 6432 | 6317 6390 6432 3464 + * titer | | | | 5971 | 4646 | 3587 | 3564 3559 3551 3551 + * thash | | | 50.7 | 8778 | 7697 | 5309 | 5254 5181 5180 5150 + * trec 25.0 | 19.2 | 15.8 | 16.4 | 16.4 | 16.4 | 11.0 | 11.0 10.9 10.9 10.9 + * tgen | 71.0 | 70.6 | 38.0 | 12.6 | 11.9 | 11.2 | 11.1 11.1 11.1 11.2 + * tall 90.0 | 43.0 | 14.5 | 12.7 | 17.9 | 18.8 | 17.1 | 17.1 17.2 17.2 16.9 + * calls 359.0 |275.0 | 54.0 | 34.7 | 43.7 | 40.4 | 38.4 | 38.4 38.4 38.5 38.4 + * sg | | | |139.0 | 85.9 | 78.0 | 78.0 72.9 73.0 73.0 + * lg | | | |211.0 |133.0 |112.7 |110.6 110.2 110.3 110.1 + * tbig | | | | |246.9 |230.6 |213.3 187.3 187.2 185.1 + * ------------------------------------------------------------------------------------------ + * + * push pop s7 stack entry and abort on stack overflow [args/code as strings] * - * new infinite recursion catch: push pop s7 stack entry and abort on stack overflow [args/code as strings] + * get rid of op_c_d (ca 50 cases) or add c_func field c_d->fx_* + * in fx_choose is the is_global check needed in all such cases? (how else HOP_SAFE??) [has_fx too op_safe_c_fp trec = is_pair+has_fx op_and_p--divide this?] + * t978 needs fx_let, int sig remainder et al, why is closure so much slower? + * lint needs to treat subvector? as compatible with vector? (signatures vector-ref etc) + * is wrong about moving make-index.scm 251 let+c -> do step (len check) + * check all-lg */ @@ -1,8 +1,8 @@ #ifndef S7_H #define S7_H -#define S7_VERSION "8.1" -#define S7_DATE "4-Jan-19" +#define S7_VERSION "8.2" +#define S7_DATE "22-Mar-19" #include <stdint.h> /* for int64_t */ @@ -291,11 +291,6 @@ s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill); void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj); /* (vector-fill! vec obj) */ s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect); s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect); /* (vector->list vec) */ - - -s7_int s7_print_length(s7_scheme *sc); /* value of (*s7* 'print-length) */ -s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len); /* sets (*s7* 'print-length), returns old value */ - /* * (vect i) is the same as (vector-ref vect i) * (set! (vect i) x) is the same as (vector-set! vect i x) @@ -303,8 +298,7 @@ s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len); * (set! (vect i j k) x) sets that element (vector-ref and vector-set! can also be used) * (make-vector (list 2 3 4)) returns a 3-dimensional vector with the given dimension sizes * (make-vector '(2 3) 1.0) returns a 2-dim vector with all elements set to 1.0 - */ - + */ bool s7_is_hash_table(s7_pointer p); /* (hash-table? p) */ s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size); /* (make-hash-table size) */ @@ -572,6 +566,12 @@ s7_pointer s7_fill(s7_scheme *sc, s7_pointer args); /* (fill! ...) */ s7_pointer s7_type_of(s7_scheme *sc, s7_pointer arg); /* (type-of arg) */ +s7_int s7_print_length(s7_scheme *sc); /* value of (*s7* 'print-length) */ +s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len); /* sets (*s7* 'print-length), returns old value */ +s7_int s7_float_format_precision(s7_scheme *sc); /* value of (*s7* 'float-format-precision) */ +s7_int s7_set_float_format_precision(s7_scheme *sc, s7_int new_len); /* sets (*s7* 'float-format-precision), returns old value */ + + /* -------------------------------------------------------------------------------- */ /* c types/objects */ @@ -854,6 +854,7 @@ void s7_gc_unprotect(s7_scheme *sc, s7_pointer x); /* used in CM */ * * s7 changes * + * 22-Mar: s7_float_format_precision. port-position. port-file. * 4-Jan-19: morally-equal? -> equivalent? * -------- * 29-Dec: s7_c_type_set_getter|setter (implicit c-object access). @@ -384,7 +384,7 @@ The following constants are predefined: pi, most-positive-fixnum, most-negative- Other math-related differences between s7 and r5rs: </p> -<ul> +<ul style="list-style-type:disc;"> <li>rational? and exact mean integer or ratio (i.e. not floating point), inexact means not exact. <li>floor, ceiling, truncate, and round return (exact) integer results. <li>"#" does not stand for an unknown digit. @@ -2393,17 +2393,17 @@ of the table sizes, or the order in which the key/value pairs were added. </div> <div class="indented"> -<p>The third argument to make-hash-table (eq-func) is slightly complicated. If it is omitted, +<p>The second argument to make-hash-table (eq-func) is slightly complicated. If it is omitted, s7 chooses the hashing equality and mapping functions based on the keys in the hash-table. There are times when you know in advance what equality function you want. If it's one of the built-in s7 equality functions, eq?, eqv?, equal?, equivalent?, =, string=?, string-ci=?, char=?, or char-ci=?, -you can pass that function as the third argument. In any other case, you need to +you can pass that function as the second argument. In any other case, you need to give s7 both the equality function and the mapping function. The latter takes any object and returns the hash-table location for it (an integer). The problem here is that for the arbitrary equality function to work, objects that are equal according to that function have to be mapped to the same hash-table location. There's no way for s7 to intuit -what this mapping should be except in the built-in cases. So to specify some arbitrary function, the third +what this mapping should be except in the built-in cases. So to specify some arbitrary function, the second argument is a cons: '(equality-checker mapper). </p> @@ -2453,9 +2453,10 @@ Otherwise, for example, you could use NaN as a key, but then never be able to ac '(27 . 196418) '(28 . 317811) '(29 . 514229) '(30 . 832040) '(31 . 1346269) '(32 . 2178309) '(33 . 3524578) '(34 . 5702887)))</em> </pre> +<p>but the tail recursive version of fib is simpler and almost as fast as the memoized version.</p> </div> -<p>The fourth argument, typers, sets type checkers for the keys and values in the table. +<p>The third argument, typers, sets type checkers for the keys and values in the table. It is a cons of the type functions (currently built-in functions only, as in vectors): <code>(cons symbol? integer?)</code> for example. This says that all the keys must be symbols and all the values integers. @@ -4019,11 +4020,29 @@ Other functions: </p> <ul> -<li>read-byte and write-byte: binary IO. -<li>read-line: line-at-a-time reads, optional third argument #t to include the newline. +<li>read-byte and write-byte: binary IO +<li>read-line: line-at-a-time reads, optional third argument #t to include the newline +<li>read-string (r7rs) <li>current-error-port, set-current-error-port +<li><em class=def id="portfilename">port-filename</em> and + <em class=def id="portlinenumber">port-line-number</em> (input ports) +<li><em class=def id="portposition">port-position</em> (input port, settable) +<li><em class=def id="portfile">port-file</em> </ul> +<p>Use length to get the length in bytes of an input port's file or string. +port-line-number is settable (for fancy *#readers*). +<b>port-position</b> is the position in bytes of the reader in the port. It is settable. +<b>port-file</b> is intended for use with the *libc* library. It returns a c-pointer +containing the FILE* pointer associated with the file port (except in Windows): +</p> +<pre class="indented"> +(call-with-input-file "s7test.scm" + (lambda (p) + (with-let (sublet *libc* :file (<em class=red>port-file</em> p)) + (fseek file 1000 SEEK_SET)))) +</pre> + <p>The variable (*s7* 'print-length) sets the upper limit on how many elements of a sequence are printed by object->string and format. When running s7 behind a GUI, you often want input to come from and output to go to @@ -4685,10 +4704,10 @@ the initial value: <b><em class=def id="loadpath">*load-path*</em></b> is a list of directories to search when loading a file. <b><em class=def id="loadhook">*load-hook*</em></b> is a hook whose functions are called just before a file is loaded. The hook function argument, named 'name, is the filename. -While loading, the <em class=def id="portfilename">port-filename</em> and -<em class=def id="portlinenumber">port-line-number</em> of the current-input-port can tell you -where you are in the file. This data is available after loading via <em class=def id="pairlinenumber">pair-line-number</em> -and <em class=def id="pairfilename">pair-filename</em>. port-line-number is settable (for fancy *#readers*). +While loading, port-filename and +port-line-number of the current-input-port can tell you +where you are in the file. This data is also available after loading via <em class=def id="pairlinenumber">pair-line-number</em> +and <em class=def id="pairfilename">pair-filename</em>. </p> <pre class="indented"> @@ -4734,8 +4753,8 @@ at startup *features* is: <pre class="indented"> > *features* -<em class="gray">(snd-18.0 snd17 snd audio snd-s7 snd-gtk gsl alsa gtk2 xg clm6 clm sndlib linux - dlopen complex-numbers system-extras ratio s7-4.14 s7) </em> +<em class="gray">(snd-19.3 snd19 snd audio snd-s7 snd-motif gsl alsa xm clm6 clm sndlib linux +autoload dlopen history complex-numbers system-extras overflow-checks ratio s7-8.2 s7)</em> > (provided? 'gsl) <em class="gray">#t</em> </pre> @@ -4993,10 +5012,14 @@ Here we scan the symbol table looking for any function that doesn't have documen (<em class=red>symbol-table</em>)) </pre> +<p>Or get a list of gensyms:</p> +<pre> +(map (lambda (sym) (if (gensym? sym) sym (values))) (<em class=red>symbol-table</em>)) +</pre> <div class="indented"> -<p>Here's a better example, an automatic software tester. +<p>An automatic software tester (see tauto.scm and auto-tester.scm in snd tools for extensions): </p> <pre class="indented"> @@ -5084,9 +5107,9 @@ some other thing, they satisfy the function equivalent?. </p> <pre class="indented"> -> (equivalent? 2 2.0) ; would "equal!?" be a better name? +> (equivalent? 2 2.0) <em class="gray">#t</em> -> (equivalent? 1/0 1/0) ; NaN +> (equivalent? 1/0 1/0) ; NaN <em class="gray">#t</em> > (equivalent? .1 1/10) <em class="gray">#t</em> ; floating-point epsilon here is 1.0e-15 or thereabouts @@ -5101,7 +5124,7 @@ some other thing, they satisfy the function equivalent?. <p>The *s7* field equivalent-float-epsilon sets the floating-point fudge factor. I can't decide how bignums should interact with equivalent?. Currently, if a bignum is involved, either here or in a hash-table, s7 uses equal?. -Finally, if either argument is an environment with a 'equivalent? method, +Finally, if either argument is an environment with an 'equivalent? method, that method is invoked. </p> @@ -5374,7 +5397,9 @@ the generic functions mechanism, much like a c-object: <p>c-pointer->list returns (list pointer-as-int type info). The "weak1" and "weak2" fields are intended for custom "weak" references. The weak fields values are not marked during the GC sweep, much like a key in a weak-hash-table. -If either value is GC'd, that field is set to #f by the GC. +If either value is GC'd, that field is set to #f by the GC. The weak fields are +ignored by equal? and equivalent? when comparing c-pointers, and by object->string +of a c-pointer even if :readable is specified. </p> @@ -5462,7 +5487,7 @@ int main(int argc, char **argv) <p id="s7vsr5rs">Some other differences from r5rs: </p> -<ul> +<ul style="list-style-type:disc;"> <li>no force or delay (see <a href="#r7rs">below</a>). <li>no syntax-rules or any of its friends. <li>no scheme-report-environment, null-environment, or interaction-environment (use curlet). @@ -5511,7 +5536,7 @@ definition, and a later redefinition does not affect earlier uses. <p>Here are some changes I'd make to s7 if I didn't care about compatibility with other Schemes: </p> -<ul> +<ul style="list-style-type:disc;"> <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? @@ -5526,7 +5551,7 @@ definition, and a later redefinition does not affect earlier uses. <p>(most of these are removed if you set the compiler flag WITH_PURE_S7), and perhaps: </p> -<ul> +<ul style="list-style-type:disc;"> <li>remove even? and odd?, gcd and lcm. <li>remove string-length and vector-length. <li>remove list-ref|set!, string-ref|set!, vector-ref|set!, hash-table-ref|set!, set-car!|cdr!, and set-current-output|input|error-port. @@ -5607,7 +5632,7 @@ Better ideas are always welcome! <p>And the built-in constants: </p> -<ul> +<ul style="list-style-type:disc;"> <li>pi <li>*stdin* *stdout* *stderr* <li>*s7* @@ -5627,7 +5652,7 @@ Better ideas are always welcome! <p>Currently WITH_PURE_S7: </p> -<ul> +<ul style="list-style-type:disc;"> <li>places 'pure-s7 in *features* <li>omits char-ready, char-ci*, string-ci* <li>omits string-copy, string-fill!, vector-fill!, vector-append @@ -8371,7 +8396,7 @@ int main (int argc, char **argv) <div class="header" id="gdb"><h4>gdb</h4></div> <p> -gdbinit has some debugging commands, intended your ~/.gdbinit file. +gdbinit has some debugging commands, intended for your ~/.gdbinit file. </p> <pre class="indented"> @@ -8938,6 +8963,7 @@ variables at the start of lint.scm to control additional output: *report-boolean-functions-misbehaving* *report-repeated-code-fragments* *report-quasiquote-rewrites* +*report-combinable-lets* </pre> <p>See lint.scm for more about these switches. You can also extend lint by adding your own code, @@ -20,16 +20,18 @@ ;;; N Higham, "Accuracy and Stability of Numerical Algorithms" ;;; various mailing lists and websites (see individual cases below) + (define full-test #f) ; this includes some time-consuming stuff (define with-bignums (provided? 'gmp)) ; scheme number has any number of bits - ; we assume s7_double is double, and s7_int is long long int + ; we assume s7_double is double, and s7_int is int64_t ; a few of the bignum tests assume the default bignum-precision is 128 (define with-complex (provided? 'complex-numbers)) (define with-windows (provided? 'windows)) -(if (not (defined? 's7test-exits)) (define s7test-exits #t)) +(unless (defined? 's7test-exits) (define s7test-exits #t)) (define asan-flags "") ;" -fsanitize=address -fsanitize=bounds ") + ;;; ---------------- pure-s7 ---------------- (define pure-s7 (provided? 'pure-s7)) (when pure-s7 @@ -422,6 +424,7 @@ #include <stdlib.h> #include <stdio.h> #include <string.h> +#include <math.h> #include \"s7.h\" static s7_scheme *s7; @@ -570,6 +573,7 @@ static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args) gb = (g_block *)s7_c_object_value(b); for (i = 0, p = args; i < len; i++, p = s7_cdr(p)) gb->data[i] = s7_number_to_real(sc, s7_car(p)); + /* if (s7_is_openlet(s7_car(p))) gb->data[i] = s7_number_to_real(sc, s7_let_ref(sc, p, s7_make_symbol(sc, \"value\"))) */ return(b); } @@ -587,12 +591,21 @@ static s7_pointer block_p_d(s7_scheme *sc, s7_double x) return(new_g); } +static bool is_NaN(s7_double x) {return(x != x);} +#if __cplusplus + #define is_inf(x) std::isinf(x) +#else + #define is_inf(x) isinf(x) +#endif + static char *g_block_display(s7_scheme *sc, void *value) { g_block *b = (g_block *)value; - s7_int i, len; + s7_int i, len, prec; char *buf; char flt[64]; + prec = s7_float_format_precision(sc); + if (prec >= 16) prec = 3; len = b->size; if (len > s7_print_length(sc)) len = s7_print_length(sc); buf = (char *)calloc((len + 1) * 64, sizeof(char)); @@ -600,7 +613,14 @@ static char *g_block_display(s7_scheme *sc, void *value) snprintf(buf, (len + 1) * 64, \"(block\"); for (i = 0; i < len; i++) { - snprintf(flt, 64, \" %.3f\", b->data[i]); + if (is_NaN(b->data[i])) + snprintf(flt, 64, \" +nan.0\"); + else + { + if (is_inf(b->data[i])) + snprintf(flt, 64, \" %cinf.0\", (b->data[i] >= 0.0) ? '+' : '-'); + else snprintf(flt, 64, \" %.*f\", (int)prec, b->data[i]); + } strcat(buf, flt); } if (b->size > s7_print_length(sc)) @@ -620,7 +640,14 @@ static char *g_block_display_readably(s7_scheme *sc, void *value) snprintf(buf, (len + 1) * 64, \"(block\"); for (i = 0; i < len; i++) { - snprintf(flt, 64, \" %.16g\", b->data[i]); + if (is_NaN(b->data[i])) + snprintf(flt, 64, \" +nan.0\"); + else + { + if (is_inf(b->data[i])) + snprintf(flt, 64, \" %cinf.0\", (b->data[i] >= 0.0) ? '+' : '-'); + else snprintf(flt, 64, \" %.16g\", b->data[i]); + } strcat(buf, flt); } strcat(buf, \")\"); @@ -1104,6 +1131,8 @@ static s7_pointer fin_open(s7_scheme *sc, s7_pointer args) s7_pointer str; fin_loc = 0; str = s7_car(args); + if (!s7_is_string(str)) + return(s7_wrong_type_arg_error(sc, \"fin_open\", 1, s7_car(args), \"a string\")); fin = s7_string(str); /* assume caller will GC protect the string */ fin_size = s7_string_length(str); return(s7_open_input_function(sc, finput)); @@ -1337,25 +1366,10 @@ void block_init(s7_scheme *sc) (not (file-exists? "ffitest.c")) (file-exists? "tools/ffitest.c")) (system "cp tools/ffitest.c .")) - (system (string-append "gcc -o ffitest ffitest.c -g3 -Wall s7.o " asan-flags " -lm -I. -ldl")) + (system (string-append (if (provided? 'clang) "clang" "gcc") " -o ffitest ffitest.c -g3 -Wall -fPIC s7.o " asan-flags " -lm -I. -ldl")) (system "ffitest")) #| -(when with-block -;(define eval seval) ; finished ok -;(define dynamic-wind swind) ; finished ok -;(define read sread) ; ok until (unsupported) let-as-port 80480, also read-error in sevalstr does not unwind C stack -;(define load sload) ; ok until (unsupported) cload -;(define-macro (test tst expected) `(ok? ',tst (lambda () (define (_s7_ _a_) ,tst) (scall _s7_ (list 0))) ,expected)) ; finished ok! -;(define eval-string sevalstr) ; ok except various local exiters, eval-string as method, multiple statements etc, gloms up C stack -(test (sevalstr "(+ 1 2)") 3) -(test (sevalstr "(+ 1 #())") 'error) -(test (let ((x 1) (y 2)) (sevalstr "(begin (set! x 3) (set! y 4))") (list x y)) '(3 4)) -(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*)) (set! (hook-functions *error-hook*) @@ -1647,6 +1661,17 @@ void block_init(s7_scheme *sc) (test (b 'a) #<undefined>) ; hmmm -- it's thinking of methods (test ((block) 'a) #<undefined>)) + (test (object->string (block +nan.0)) "(block +nan.0)") + (test (object->string (block +inf.0)) "(block +inf.0)") + (test (object->string (block -inf.0)) "(block -inf.0)") + (test (object->string (block pi)) "(block 3.142)") + (test (object->string (block +nan.0) :readable) "(block +nan.0)") + (test (object->string (block +inf.0) :readable) "(block +inf.0)") + (test (object->string (block -inf.0) :readable) "(block -inf.0)") + (test (object->string (block pi) :readable) "(block 3.141592653589793)") ; (block pi) would be better + (let-temporarily (((*s7* 'float-format-precision) 8)) + (test (object->string (block pi)) "(block 3.14159265)")) + (let ((v (make-vector 2 (block 1.0) block?))) (test (block? (v 0)) #t) (vector-set! v 0 (block 2.0)) @@ -1681,7 +1706,9 @@ void block_init(s7_scheme *sc) (test (make-hash-table 8 #f (cons #t #f)) 'error) (test (make-hash-table 8 #f ()) 'error) - (test (signature (make-hash-table 8 #f (cons #t #t))) '(#t hash-table? #t)) ; same as (signature (make-hash-table 8 #f [#f])) + (let ((sig (list #t 'hash-table? #t))) + (set-cdr! (cddr sig) (cddr sig)) + (test (signature (make-hash-table 8 #f (cons #t #t))) sig)) ; same as (signature (make-hash-table 8 #f [#f])) (test (blocks) (list 4 1)) (test (blocks :frequency 2) (list 2 1)) @@ -1932,6 +1959,9 @@ void block_init(s7_scheme *sc) (test (c-pointer->list (c-pointer 0)) '(0 #f #f)) (test (c-pointer->list (c-pointer 123 'null?)) '(123 null? #f)) +(test (c-pointer-info (copy (c-pointer 1 2 3 4 5))) 3) +(test (c-pointer-weak1 (copy (c-pointer 1 2 3 4 5))) 4) +(test (c-pointer-weak2 (copy (c-pointer 1 2 3 4 5))) 5) (test (equal? (c-pointer 1) 1) #f) (test (equal? (c-pointer 1) (c-pointer 1)) #t) @@ -1954,6 +1984,7 @@ void block_init(s7_scheme *sc) (test (object->string (c-pointer 1 (vector)) :readable) "(c-pointer 1 #() #f)") (test (object->string (c-pointer 1 (vector))) "#<c_pointer 0x1>") ; ?? +(test (object->string (copy (c-pointer 1 2 3 4 5)) :readable) "(c-pointer 1 2 3)") ; see s7.html, same for equal? and equivalent? (test (c-pointer-info) 'error) (test (c-pointer-info #f) 'error) @@ -2357,6 +2388,7 @@ void block_init(s7_scheme *sc) (test (equal? (list +nan.0) (list +nan.0)) #f) (test (equal? (vector +nan.0) (vector +nan.0)) #f) (test (equal? #(1/0) #(1/0)) #f) +(test (equal? #r(0.0) #r(-0.0)) #t) (test (let ((x 3.141)) (equal? x x)) #t) (test (equal? 3 3) #t) @@ -3748,26 +3780,38 @@ void block_init(s7_scheme *sc) (test (type-of 1.0) 'float?) (test (type-of 1+i) 'complex?) (test (type-of #<unspecified>) 'unspecified?) +(test (type-of (values)) 'unspecified?) (test (type-of #<undefined>) 'undefined?) (test (type-of _undef_) 'undefined?) (test (type-of #<eof>) 'eof-object?) (test (type-of (hash-table)) 'hash-table?) +(test (type-of (weak-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 (byte-vector 1 2)) 'byte-vector?) (test (type-of "") 'string?) (test (type-of #\a) 'char?) (test (type-of 'a) 'symbol?) (test (type-of :a) 'symbol?) +(test (type-of (gensym)) '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 (lambda () 1)) 'procedure?) +(test (type-of (lambda* ((a 1)) a)) 'procedure?) +(test (type-of quasiquote) 'macro?) +(test (type-of (define-bacro (_b_ x) `(+ ,x 1))) 'macro?) ; bacro? undefined (test (type-of (c-pointer 0)) 'c-pointer?) (test (type-of (random-state 123)) 'random-state?) (test (type-of lambda) 'syntax?) -(test (type-of (byte-vector 1 2)) 'byte-vector?) +(test (type-of (call-with-exit (lambda (g) g))) #f) +(test (type-of (call/cc (lambda (g) g))) 'continuation?) +(test (type-of (make-iterator '(1 2))) 'iterator?) +(when with-block + (test (type-of (block)) 'c-object?)) (let () (define (remove obj seq) ; remove-all? @@ -7843,6 +7887,22 @@ i" (lambda (p) (eval (read p)))) pi) (test (length '((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 1) +(test (let ((f (lambda (a) (values a (+ a 1))))) + (define (f1 x) + (hash-table-entries (and (< (length x) 100) x))) + (f1 f)) + 'error) +(test (let ((f (lambda (a) (values a (+ a 1))))) + (define (f1 x) + (hash-table-entries (and (= (length x) 100) x))) + (f1 f)) + 'error) + +(test (call-with-input-string "01234" (lambda (p) (length p))) 5) +(test (call-with-input-file "s7test.scm" (lambda (p) (> (length p) 5000000))) #t) +(unless pure-s7 + (test (length (call-with-input-file "s7test.scm" (dilambda (lambda* (a b) a) (lambda* (a b c) c)))) #f)) ; (length <closed-port>) +(test (let ((len 0)) (call-with-output-string (lambda (p) (display "0123" p) (set! len (length p)))) len) 4) ;;; -------------------------------------------------------------------------------- @@ -8330,6 +8390,40 @@ i" (lambda (p) (eval (read p)))) pi) (test (reverse! `((1) . x)) 'error) (if with-block (test (reverse! (immutable! (block 0 0))) 'error)) +(when full-test + (let () + (define (revstr size) + (let ((str (make-string size))) + (do ((i 0 (+ i 1))) + ((= i size)) + (string-set! str i (integer->char (+ i 20)))) + (let ((rstr (reverse! str))) + (do ((i 0 (+ i 1)) + (j (- size 1) (- j 1))) + ((= i size)) + (unless (char=? (string-ref str j) (integer->char (+ i 20))) + (format *stderr* "revstr ~D: ~A ~A~%" i (string-ref str j) (integer->char (+ i 20)))))))) + + (do ((i 1 (+ i 1))) + ((= i 8)) + (revstr (expt 2 i))) + + (define (revint size) + (let ((str (make-int-vector size))) + (do ((i 0 (+ i 1))) + ((= i size)) + (int-vector-set! str i i)) + (let ((rstr (reverse! str))) + (do ((i 0 (+ i 1)) + (j (- size 1) (- j 1))) + ((= i size)) + (unless (= (int-vector-ref str j) i) + (format *stderr* "revint ~D: ~A ~A~%" i (int-vector-ref str j) i)))))) + + (do ((i 3 (+ i 1))) + ((= i 10)) + (revint (expt 2 i))) + )) ;;; -------------------------------------------------------------------------------- @@ -10131,6 +10225,13 @@ i" (lambda (p) (eval (read p)))) pi) (test (member 1 (list 2 3) (lambda (a b) `(x ,(let ((lst (list 1))) (set-cdr! lst lst))) #f)) #f) (test (member 1 (list 3 2) (lambda (a b) (set-cdr! '(x) (let ((lst (list 1))) (set-cdr! lst lst))) (or))) #f)) +(let-temporarily (((*s7* 'safety) 1)) + (let ((lst (list 1 2))) + (set-cdr! (cdr lst) lst) + (test (tree-leaves lst) 'error) + (test (tree-memq 'a lst) 'error) + (test (tree-set-memq '(a b c) lst) 'error) + (test (tree-count 'a lst) 'error))) @@ -11100,7 +11201,7 @@ i" (lambda (p) (eval (read p)))) pi) (test (vector->list #(1 2 3 4) 5) 'error) (test (vector->list #(1 2 3 4) 1 5) 'error) (test (vector->list #(1 2 3 4) 1 2 3) 'error) -(test (vector->list #(1 2 3 4) 1 #f) 'error) +(unless pure-s7 (test (vector->list #(1 2 3 4) 1 #f) 'error)) (test (vector->list #(1 2 3 4) #f) 'error) (test (vector->list #(1 2 3 4) #f 1) 'error) @@ -11677,7 +11778,7 @@ i" (lambda (p) (eval (read p)))) pi) (test (vector->list (vector-append (make-float-vector 1 0.0) (make-float-vector 2 1.0))) '(0.0 1.0 1.0)) (test (vector-append (byte-vector 0) (vector 1)) #u(0 1)) -(test (vector-append (vector 1) (openlet (inlet 'vector-append (lambda args (#_vector-append (car args) #(2 3)))))) #(1 2 3)) +(unless pure-s7 (test (vector-append (vector 1) (openlet (inlet 'vector-append (lambda args (#_vector-append (car args) #(2 3)))))) #(1 2 3))) (unless pure-s7 (for-each @@ -13339,6 +13440,13 @@ i" (lambda (p) (eval (read p)))) pi) (set! (prev head) cur) (test (object->string head) "#1=(#31=(#30=(#29=(#28=(#27=(#26=(#25=(#24=(#23=(#22=(#21=(#20=(#19=(#18=(#17=(#16=(#15=(#14=(#13=(#12=(#11=(#10=(#9=(#8=(#7=(#6=(#5=(#4=(#3=(#2=(#32=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #8#) 8 #9#) 9 #10#) 10 #11#) 11 #12#) 12 #13#) 13 #14#) 14 #15#) 15 #16#) 16 #17#) 17 #18#) 18 #19#) 19 #20#) 20 #21#) 21 #22#) 22 #23#) 23 #24#) 24 #25#) 25 #26#) 26 #27#) 27 #28#) 28 #29#) 29 #30#) 30 #31#) 31 #1#) 0 #32#)"))) +(let ((x (list '+ 1))) + (set-cdr! (cdr x) x) + (do ((i 0 (+ i 1))) + ((= i 6)) + (set! x (cons x x))) + (test (object->string x) "(#6=(#5=(#4=(#3=(#2=(#1=(+ 1 . #1#) . #1#) . #2#) . #3#) . #4#) . #5#) . #6#)")) + (test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (append lst lst ())) 'error) (test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (object->string (append (list lst) (list lst) ()))) "(#1=(1 2 3 . #1#) #1#)") @@ -13502,9 +13610,7 @@ i" (lambda (p) (eval (read p)))) pi) (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle (pinner () vals len) (set-cdr! (list-tail vals (- len 1)) ()))) ; restore its original shape -|# -#| ;; 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" @@ -13600,6 +13706,24 @@ i" (lambda (p) (eval (read p)))) pi) (pinner vals len) (set-cdr! (list-tail vals (- len 1)) ()))))))) ; restore its original shape +#| +;; much slower: +(define (for-each-permutation func vals) + (define (heap-permutation size n) + (if (= size 1) + (apply func vals) + (do ((i 0 (+ i 1))) + ((= i size)) + (heap-permutation (- size 1) n) + (if (odd? size) + (let ((temp (vals 0))) + (set! (vals 0) (vals (- size 1))) + (set! (vals (- size 1)) temp)) + (let ((temp (vals i))) + (set! (vals i) (vals (- size 1))) + (set! (vals (- size 1)) temp)))))) + (heap-permutation (length vals) (length vals))) +|# (when full-test (let() @@ -14132,7 +14256,9 @@ i" (lambda (p) (eval (read p)))) pi) ;;; HASH-TABLES ;;; -------------------------------------------------------------------------------- ;;; make-hash-table +;;; make-weak-hash-table ;;; hash-table +;;; weak-hash-table ;;; hash-table? ;;; weak-hash-table? ;;; hash-table-entries @@ -14296,6 +14422,8 @@ i" (lambda (p) (eval (read p)))) pi) (define (hi) (func)) (hi)) 'error) +(test (let ((h (hash-table 'a (hash-table 'b 2)))) (h 'a 'b)) 2) + (for-each (lambda (arg) (test (make-hash-table arg) 'error)) @@ -14477,6 +14605,11 @@ i" (lambda (p) (eval (read p)))) pi) (if (not with-windows) (test (object->string ht1) "(hash-table +nan.0 0)")))) +(let ((h1 (make-hash-table 8 equivalent?)) + (h2 (make-hash-table 8 equivalent?))) + (hash-table-set! h2 (let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>) 1) + (test (object->string (append h1 h2)) "(hash-table #1=#(#1#) 1)")) + (unless with-bignums (let ((ht1 (make-hash-table))) (set! (ht1 1) "1") @@ -14936,6 +15069,9 @@ i" (lambda (p) (eval (read p)))) pi) (test (weak-hash-table? (make-weak-hash-table)) #t) (test (let ((h (make-weak-hash-table))) (set! (h 'a) 1) (object->string h :readable)) "(weak-hash-table 'a 1)") (test (equal? (weak-hash-table 'a 1) (weak-hash-table 'a 1)) #t) +(test (object->string (weak-hash-table)) "(weak-hash-table)") +(test (object->string (make-iterator (weak-hash-table 'a 1))) "#<iterator: weak-hash-table>") +(test (object->string (make-iterator (weak-hash-table 'a 1)) :readable) "(make-iterator (weak-hash-table 'a 1))") (when full-test (do ((z 0 (+ z 1))) @@ -14959,8 +15095,18 @@ i" (lambda (p) (eval (read p)))) pi) (when (zero? (hash-table-entries wht)) (do ((k 0 (+ k 1))) ((= k 100)) - (set! (wht (keys k)) k))))))) - + (set! (wht (keys k)) k)))))) + (let ((wht (make-weak-hash-table))) + (do ((i 0 (+ i 1))) + ((= i 1000)) + (set! (wht (list i)) i)) + (do ((i 0 (+ i 1))) + ((= i 1000)) + (for-each + (lambda (p) + (unless (pair? p) + (format *stderr* "p: ~S~%" p))) + wht)))) (test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1) (set! (h2 'b) 2.0) (equivalent? h1 h2)) #t) (test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1.0) (set! (h2 'b) 2) (equivalent? (list h1) (list h2))) #t) @@ -16487,16 +16633,19 @@ i" (lambda (p) (eval (read p)))) pi) (test (write "a" p) 'error) (test (display "a" p) 'error) (test (format p "~a" 2) 'error)) - (list *stdin* (current-input-port))) + (list *stdin* (current-input-port) + (call-with-output-string (lambda (p) p)))) (for-each (lambda (p) (test (read-char p) 'error) (test (read-byte p) 'error) (test (read-line p) 'error) - (test (read-string p) 'error) + (test (read-string 5 p) 'error) (test (read p) 'error)) - (list *stdout* #f (current-output-port))) + (list *stdout* #f (current-output-port) + (call-with-input-file "s7test.scm" (lambda (p) p)) + (call-with-input-string "0123456" (lambda (p) p)))) (test (write #\1 *stdin*) 'error) (test (write-char #\1 *stdin*) 'error) @@ -16575,6 +16724,13 @@ i" (lambda (p) (eval (read p)))) pi) (test (port-closed? (current-input-port) (current-output-port)) 'error) (test (let-temporarily (((current-output-port) #f)) (port-closed? (current-output-port))) #f) +(test (call-with-input-string "0123456789" (lambda (p) (set! (port-position p) 3) (list (read-char p) (port-position p)))) '(#\3 4)) +(test (call-with-input-file "s7test.scm" (lambda (p) (set! (port-position p) 88) (list (read-string 10 p) (port-position p)))) '(";;; Paul", 98)) +(test (call-with-input-string "0123456789" (lambda (p) (set! (port-position p) -3))) 'error) +(test (port-position (call-with-input-file (string #\c #\null #\b) quasiquote)) 'error) ; closed port + +(test (call-with-input-file "s7test.scm" (lambda (p) (c-pointer? (port-file p)))) #t) + (call-with-output-file tmp-output-file (lambda (p) (display "3.14" p))) (test (call-with-input-file tmp-output-file (lambda (p) (read p) (let ((val (read p))) (eof-object? val)))) #t) @@ -19816,6 +19972,7 @@ a2" 3) "132") (newline p) (let ((val (function-get-output p))) (function-close-output p) + (close-output-port p) (if (not (string=? val "1234567890\n")) (format *stderr* ";function port outputs: ~S (~D, ~A)~%" val (length val) (string->vector val))))) @@ -20997,8 +21154,8 @@ c" (test (string? str) #t)) ;;; these are not readable: -(test (object->string (inlet 'a (call-with-exit (lambda (return) return))) :readable) "(inlet :a goto)") -(test (object->string (inlet 'a (call/cc (lambda (return) return))) :readable) "(inlet :a continuation)") +(test (object->string (inlet 'a (call-with-exit (lambda (return) return))) :readable) "(inlet :a #<goto>)") +(test (object->string (inlet 'a (call/cc (lambda (return) return))) :readable) "(inlet :a #<continuation>)") ;;; these are incorrect: ;(test (object->string (let () (define-constant a 32) (curlet)) :readable) "(inlet :a 32)") @@ -21172,10 +21329,34 @@ c" (test (object->string (list (sublet (openlet (inlet 'abs (lambda (x) (- x)))) :allow-other-keys 1)) :readable) "(list (openlet (sublet (openlet (inlet :abs (lambda (x) (- x)))) :allow-other-keys 1)))") -(test (object->string (quasiquote '2) :readable) "''2") -(test (object->string (quasiquote ''2) :readable) "'''2") -(test (object->string (quasiquote (symbol->string 'x)) :readable) "(list 'symbol->string ''x)") -(test (object->string (quasiquote (openlet? (list-ref -123 '#() (expt 2 32)))) :readable) "(list 'openlet? (list 'list-ref -123 ''#() (list 'expt 2 32)))") +(test (object->string (quasiquote '2) :readable) "(list 'quote 2)") +(test (object->string (quasiquote ''2) :readable) "(list 'quote (list 'quote 2))") +(test (object->string (quasiquote (symbol->string 'x)) :readable) "(list 'symbol->string (list 'quote 'x))") +(test (object->string (quasiquote (openlet? (list-ref -123 '#() (expt 2 32)))) :readable) + "(list 'openlet? (list 'list-ref -123 (list 'quote #()) (list 'expt 2 32)))") + +(test (format #f "~W" (map (lambda (a b) (vector a b)) (quote (quote)) (inlet 'integer? (lambda (f) #f)))) + "(list (vector 'quote (cons 'integer? (lambda (f) #f))))") +(test (format #f "~W" (list (list 'quote (cons 'integer? (lambda (y) #f))))) "(list (list 'quote (cons 'integer? (lambda (y) #f))))") +(test (format #f "~W" (list (list 'quote 2))) "(list (list 'quote 2))") +(test (format #f "~W" (list 'quote 2)) "(list 'quote 2)") +(test (format #f "~S" (list 'quote 2)) "'2") +(test (format #f "~{~A ~}" (list 'quote 2)) "quote 2 ") +(test (let ((lst (list (lambda (y) #f)))) (format #f "~W" (list 'quote lst))) "(list 'quote (list (lambda (y) #f)))") +(test (let ((lst (list (lambda (y) #f)))) (format #f "~S" (list 'quote lst))) "'(#<lambda (y)>)") +(test (format #f "~W" (list 'quote (lambda () #f))) "(list 'quote (lambda () #f))") +(test (format #f "~W" (list 'quote 1 (lambda () #f))) "(list 'quote 1 (lambda () #f))") +(test (equal? ''2 (list 'quote 2)) #t) +(test (equivalent? ''(vector #f) (list 'quote (vector #f))) #f) +(test (equivalent? ''(lambda () #f) (list 'quote (lambda () #f))) #f) +(test (let ((lst (list 'quote (vector #f)))) + (let ((nlst (eval-string (object->string lst :readable)))) + (equivalent? lst nlst))) + #t) +(test (let ((lst (list 'quote (lambda () #f)))) + (let ((nlst (eval-string (object->string lst :readable)))) + (equivalent? lst nlst))) + #t) (test (object->string (symbol "12") :readable) "(symbol \"12\")") (test (object->string (symbol "-1") :readable) "(symbol \"-1\")") @@ -21463,12 +21644,12 @@ c" <1>)") (test-wi (object->string (let ((i 0)) (set! (setter 'i) integer?) (curlet)) :readable) - "(let ((i 0)) (set! (setter 'i) integer?) (curlet))") ; why not #_integer? here and below? + "(let ((i 0)) (set! (setter 'i) #_integer?) (curlet))") (let ((lt (let ((i 0) (inner #f)) (set! (setter 'i) integer?) (curlet)))) (set! (lt 'inner) lt) (test-wi (object->string lt :readable) - "(let ((<1> (let ((i 0) (inner #f)) (set! (setter 'i) integer?) (curlet)))) + "(let ((<1> (let ((i 0) (inner #f)) (set! (setter 'i) #_integer?) (curlet)))) (set! (<1> :inner) <1>) <1>)")) @@ -21658,8 +21839,6 @@ c" "(make-iterator (let ((a 0)) (lambda () (set! a (+ a 1)))))" -;;; what about equivalent? here and eval-string - <2> (object->string (let ((a 0) (b 1)) (lambda (c) (+ a b c))) :readable) "(let ((b 1) (a 0)) (lambda (c) (+ a b c)))" @@ -23167,6 +23346,7 @@ similarly: (test (apply append (map list '((a . 1) (b . 2) #<eof>))) '((a . 1) (b . 2) #<eof>)) (test (apply append (map list '(a b #<eof> d))) '(a b #<eof> d)) (test (map values (vector 1 2 #<eof> 3)) '(1 2 #<eof> 3)) +(test (map (lambda (x) (values)) '(1 2 3)) ()) ; :) (test (map (lambda (x) (set! x (* 2 x)) 2) '(1 2 3)) '(2 2 2)) (test (map (lambda (x) x (set! x (* 2 x)) x) '(1 2 3)) '(2 4 6)) @@ -23867,6 +24047,8 @@ in s7: (test (make-iterator (hash-table 'a 1) (immutable! (cons 0 0))) 'error) (test (make-iterator (inlet 'a 1) (immutable! (cons 0 0))) 'error) (test (make-iterator '(1 2 3) #(0)) 'error) +(test (make-iterator (let ((+iterator+ #t)) (lambda (iter) 1))) 'error) +(test (iterator? (make-iterator (let ((+iterator+ #t)) (lambda iter 1)))) #t) (for-each (lambda (arg) @@ -24118,6 +24300,35 @@ in s7: res) #<eof>))))) "[a 1][b 2][c 2]") +(test (object->string (make-iterator (let ((lst '((a . 1) (b . 2) (c . 2))) + (+iterator+ #t)) + (lambda () + (if (pair? lst) + (let ((res (list (caar lst) (cdar lst)))) + (set! lst (cdr lst)) res) + #<eof>))))) + "#<iterator: function>") +(test (object->string (make-iterator (let ((lst '((a . 1) (b . 2) (c . 2))) + (+iterator+ #t)) + (lambda () + (if (pair? lst) + (let ((res (list (caar lst) (cdar lst)))) + (set! lst (cdr lst)) res) + #<eof>)))) :readable) + "(make-iterator (let ((+iterator+ #t) ) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>))))") +(let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2))) + (+iterator+ #t)) + (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>))))) + (test (equivalent? (make-iterator iterf) (make-iterator iterf)) #t)) + +(let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2)))) + (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>))))) + (test (make-iterator iterf) 'error)) + +(let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2))) + (+iterator+ #f)) + (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>))))) + (test (make-iterator iterf) 'error)) (let () (define (make-diagonal-iterator matrix) @@ -24821,6 +25032,7 @@ in s7: (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) ((0 1) ()))) (f)) 'error) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1) (test (let () (define (f) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1) +(test (let () (define (f) (do ((i 0 (+ i 1)) (x (provide ':allow-other-keys) (provide ':allow-other-keys))) ((= i 1) x))) (f)) :allow-other-keys) (test (define-constant) 'error) (test (define-constant _asdf_ 2 3) 'error) @@ -25946,8 +26158,8 @@ in s7: (test (case () (('()) 2) (else 1)) 1) ; car: (quote ()), value: (), eqv: 0, null: 0 1 (test (case () ((()) 2) (else 1)) 2) ; car: (), value: (), eqv: 1, null: 1 1 -;;; this is a difference between () and () ? -;;; (eqv? () ()) -> #t and (eqv? () ()) is #t so it's the lack of evaluation in the search case whereas the index is evaluated +;;; this is a difference between () and '() ? +;;; (eqv? () ()) -> #t and (eqv? () '()) is #t so it's the lack of evaluation in the search case whereas the index is evaluated ;;; equivalent to: (test (case 2 (('2) 3) (else 1)) 1) ; car: (quote 2), value: 2, eqv: 0, null: 0 0 @@ -26165,7 +26377,6 @@ in s7: (when with-block (test (let ((i 0)) (let ((_f_ (lambda () (case (append (block) (block)) ((null? i) i))))) (_f_) (_f_))) #<unspecified>)) ; case p_e_g (test (let () (define (func) (let ((i 0)) ((lambda () (case (lambda sym-args sym-args) ((null? i) i)))))) (define (hi) (func) (func)) (hi) (hi)) #<unspecified>) - ;; newly optimized case (let ((lt (inlet 'a 1 'b 2))) (define (c1 s) (case (let-ref lt s) ((#<undefined>) 3) (else))) @@ -26268,6 +26479,17 @@ in s7: (test (big-cond 541) 541) (test (big-case 541) 541)) +(let-temporarily (((*s7* 'safety) 1)) + (test (apply case `(x . 1) + (let ((<1> (list #f)) + (<2> (list #f #f))) + (set-car! <1> <1>) + (set-cdr! <1> <2>) + (set-cdr! (cdr <2>) <2>) + <1>) + `((x . 1))) + 'error)) + ;;; -------------------------------------------------------------------------------- @@ -26366,7 +26588,8 @@ in s7: (test ((lambda (x) (+ x ((lambda (x) (+ x 1)) 2))) 3) 6) (test ((lambda (x) (define y 1) (+ x y)) 2) 3) (test ((lambda (a) "this is a doc string" a) 1) 1) -;;; ideally ((lambda (a) "hiho" (define x 1) x) 1) -> 1 but I'm not sure it's r5rs-ish +(test ((lambda (a) "hiho" (define x 1) x) 2) 1) +(test ((lambda (a) "hiho" (define x a) x) 2) 2) (test (let ((g (lambda () '3))) (= (g) 3)) #t) (test ((((lambda () lambda)) () 1)) 1) @@ -26622,6 +26845,12 @@ in s7: (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 () (define x (lambda (arg)))) 'error) +(test (let () (define (x (arg)))) 'error) + +(let-temporarily (((*s7* 'safety) 1)) ; not sure about these two -- cyclic bodies + (test (let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda () lst ())) 'error) + (test (let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda* () lst ())) 'error)) (test (let ((hi (lambda (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error) (test (object->string @@ -26947,6 +27176,12 @@ in s7: (test (apply + '(1 2 . 3)) 'error) (test (apply + '(1 2) (list 3 4)) 'error) (test (let () (define (mrec a b) (if (<= b 0) (list a) (apply mrec (list a) (list (- b 1))))) (mrec (list 1 2) 5)) '(((((((1 2)))))))) +(test (apply (inlet) '(define y 32)) 32) +(test (let () + (define (rfunc) '(define y 32)) + (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (apply (inlet) (rfunc))))) + (func)) + 32) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) @@ -28046,6 +28281,9 @@ in s7: (test (list? (values 1 2 3)) 'error) (test (list? (values 1)) #f) (test (list? (values (list 1 2 3))) #t) +(test (let () (define (f) (and () (values #f 1 2) (vector 0))) (f) (f)) #f) ; and_safe_p2->and_safe_p_rest +(test (let () (define (f) (and (values #f 1 2) 1 (vector 0))) (f) (f)) #f) ; same p1 +(test (let () (define (f) (and (values #f 1 2) 1 (subvector (vector 0) 0))) (f) (f)) #f) (test (+ (call-with-exit (lambda (ret) (values 1 2 3)))) 6) (test (+ 4 (call-with-exit (lambda (ret) (values 1 2 3))) 5) 15) @@ -28066,7 +28304,7 @@ in s7: (let () (test (let ((x 1)) (set! x (apply values (signature (hash-table))))) 'error) - (test (signature (hash-table)) '(#t hash-table? #t))) + (test (signature (hash-table)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig))) (test (let ((x 1)) (set! x (values)) x) #<unspecified>) (test ((lambda () (let ((x 1)) (set! x (boolean? (values)))))) #f) @@ -28420,7 +28658,7 @@ in s7: (test (cons (values 1 2)) '(1 . 2)) (test (number->string (values 1 2)) "1") -(test (object->string (values)) (if (provided? 'debugging) "#<no-value>" "#<unspecified>")) +(test (object->string (values)) (if (provided? 'debugging) "#<values>" "#<unspecified>")) (test (equal? (values) #<unspecified>) #t) (test (equal? (begin) (begin (values))) #f) ; () but #<unspecified> (test (map (lambda (x) (if #f x #<unspecified>)) (list 1 2)) '(#<unspecified> #<unspecified>)) @@ -28445,6 +28683,18 @@ in s7: (test ((lambda (x) (cyclic-sequences (x 1) )) list-values) ()) (test (let ((x list-values)) (cyclic-sequences (x 1))) ()) +(test (let ((lst (list (values)))) (map values lst)) (list-values (values))) +(test (let ((lst (list 1 (values) 2))) (map values lst)) (list-values 1 (values) 2)) +(test (map values (list (values (values (values))))) (list-values (values (values (values))))) +(let ((seq (list 1 2 (values) 3))) + (test (let ((erg (apply list-values seq))) + (let ((iter (if (iterator? erg) erg (make-iterator erg))) + (result ())) + (do ((x (iter) (iter))) + ((iterator-at-end? iter) (reverse result)) + (set! result (cons x result))))) + (map values seq))) + (test (let ((lst (list 0))) (set-cdr! lst lst) (format (values #f "~A" lst))) @@ -29276,6 +29526,19 @@ in s7: (test (let () (define (f5) (let loop ((i 0)) (set! loop (lambda () 2)) (loop))) (f5)) 2) (test (let () (define (f6) (let loop ((i 0)) (define (loop) 2) (loop))) (f6)) 2) +(test (let ((f1 (lambda () (x)))) (define (x) 2) (f1)) 'error) +(test (let ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 'error) +(test (let () (define (f1) (x)) (define (x) 2) (f1)) 2) +(test (let () (define (f1) x) (define x 2) (f1)) 2) +(test (letrec ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 2) +(test (letrec ((f1 (lambda () x)) (x 2)) (f1)) 2) +(test (letrec* ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 2) +(test (letrec* ((f1 (lambda () x)) (x 2)) (f1)) 2) +(test (letrec ((f1 (lambda () (x)))) (define (x) 2) (f1)) 2) ; Guile: x unbound +(test (letrec* ((f1 (lambda () (x)))) (define (x) 2) (f1)) 2) ; same +(test (letrec ((f1 (lambda () x))) (define x 2) (f1)) 2) ; same +(test (letrec* ((f1 (lambda () x))) (define x 2) (f1)) 2) ; same + (let ((enter 0) (exit 0) (inner 0)) @@ -30489,6 +30752,11 @@ in s7: (test (+ 2 (values 3 (call-with-exit (lambda (k1) (k1 4))) 5)) 14) (test (+ 2 (call-with-exit (lambda (k1) (values 3 (k1 4) 5))) 8) 14) (test (+ 2 (call-with-exit (lambda (k1) (values 3 (k1 4 -3) 5))) 8) 11) +(test (call-with-exit (lambda (pi) 1)) 'error) +(test (let () (define (func) (call-with-exit (lambda (pi) 1))) (define (hi) (func) (func)) (hi) (hi)) 'error) +(test (let () (define (func) (call-with-exit (lambda (with-let) 1.0))) (func)) 'error) +(test (let () (define (func) (catch #t (lambda () 1) (lambda (with-let info) 1.0))) (func)) 'error) +(test (let () (define (func) (call/cc (lambda (with-let) 1.0))) (func)) 'error) (test (call-with-exit (let () (lambda (k1) (k1 2)))) 2) (test (+ 2 (call/cc (let () (call/cc (lambda (k1) (k1 (lambda (k2) (k2 3)))))))) 5) @@ -30502,6 +30770,7 @@ in s7: (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) +(test (let ((x 1)) (set! x (- (call-with-exit (lambda (go) (catch #t (lambda () (abs "hi") 3) (lambda (t i) (go 4 4) 6)) 5))))) 0) (test (call-with-exit (lambda (a . b) (a 1))) 1) (test (call/cc (lambda (a . b) (a 1))) 1) @@ -31403,6 +31672,8 @@ who says the continuation has to restart the map from the top? (test (+ 1 (with-baffle (values 2 3)) 4) 10) (test (with-baffle . 1) 'error) (test (with-baffle 1 2 . 3) 'error) +(let ((str (with-baffle (object->string (curlet))))) + (test "(inlet (symbol \"(baffle)\") #<baffle:" (substring str 0 36))) (test (with-baffle (let ((x 0) @@ -32462,8 +32733,9 @@ who says the continuation has to restart the map from the top? (if (not (provided? 'immutable-unquote)) (test (equal? (let ((b, 32)) '(a, , b, c,)) '(a, (unquote b,) c,)) #t)) ; comma by itself (no symbol) is an error (if (not (provided? 'immutable-unquote)) (test (equal? (let ((b, 32)) '(a, , , b, c,)) '(a, (unquote (unquote b,)) c,)) #t)) ;(test (equal? (let ((b 32)) (let ((b, b)) ``(a, , , b, c,))) '(list-values 'a, 32 'c,)) #t) -(if (not pure-s7) - (test (let ((func abs)) (quasiquote (sym . (unquote func)))) (cons 'sym abs))) ; guile mailing list +(unless pure-s7 + (test (let ((func abs)) (quasiquote (sym . (unquote func)))) (cons 'sym abs)) ; guile mailing list + (test (eval-string "`(+ (unquote 2 3))") 'error)) (test (eval ``(,@,@())) ()) (test (list (let ((x '(1 2))) `,@x)) '(1 2)) (test (let ((x '(1))) `,@x) 1) @@ -32488,7 +32760,6 @@ who says the continuation has to restart the map from the top? (test (let (,@ ()) ,2) 2) (test (let (' 1) quote) 1) )) -(test (eval-string "`(+ (unquote 2 3))") 'error) ;; mostly from gauche (let ((quasi0 99) @@ -33202,9 +33473,26 @@ who says the continuation has to restart the map from the top? (test (set! *load-path* arg) 'error) (test (set! *#readers* arg) 'error)) (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi #t #f #(()))) -;(test (let ((*features* 123)) *features*) 'error) -;(test (let (((*s7* 'safety) '(1 2 3))) (*s7* 'safety)) 'error) -;(test (let (((*s7* 'safety) 1)) 2) 'error) + +(test (let ((*features* 123)) *features*) 123) +(test (set! *features* '(1 2 3)) 'error) +(test (set! *features* '(a b . c)) 'error) +(test (let-temporarily ((*features* #f)) *features*) 'error) + +(test (fill! *features* #f) 'error) +(when (pair? *libraries*) + (test (fill! *libraries* #f) 'error)) +(test (set! *libraries* #f) 'error) +(test (set! *libraries* (list 1 2)) 'error) +;(test (copy '(1 2 3) *features*) 'error) + +(test (set! pi 3) 'error) +(test (let-temporarily ((pi 3)) pi) 'error) +(test (set! ((rootlet) 'pi) 3) 'error) +(test (let-set! (rootlet) 'pi 3) 'error) +(test (copy '((pi . 3)) (rootlet)) 'error) +(test ((lambda (pi) pi) 3) 'error) + (test (set! *load-path* (list 1 2 3)) 'error) (test (set! *#readers* (list 32)) 'error) (test (set! *#readers* (list (list #\a 32))) 'error) @@ -33949,6 +34237,8 @@ who says the continuation has to restart the map from the top? (test (catch #t (lambda () (error 1 2 3)) (lambda* ((a 2) (b 3) (c 4)) (list a b c))) '(1 (2 3) 4)) (test (catch #t (lambda () (error 'oops)) require) 'error) (test (let ((x (list 1 2))) (catch #t (lambda () (catch x (lambda () (throw x)) (lambda args x))) (lambda () 'oops))) '(1 2)) +(test (let () (define (f) (catch #t (lambda () 1) (lambda (pi pj) #f))) (f)) 'error) +(test (let () (define (f) (catch #t (lambda () 1) (lambda (pj pi) #f))) (f)) 'error) (let () (define (f) @@ -34674,6 +34964,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test ((lambda* ((a (quote . -1))) quote)) 'error) (test ((lambda* ((a (quote 1 1))) a)) 'error) (test ((lambda* ((a (quote))) a)) 'error) +(test ((lambda* ((e #<undefined>)) 1)) 1) +(test ((lambda* ((d 1) (e #<undefined>)) 1)) 1) (let () (define* (f2 (a 0) (b 1)) (list a b)) @@ -34833,6 +35125,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3 :b 2)) 3) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) 3) (test (let () (define* (hi :rest a :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) '(:c 1 :a 3 :b 2)) +(test ((lambda* (a :allow-other-keys) a) 1 :a 2) 'error) +(test ((lambda* (a :allow-other-keys) a) 1 :b 2) 1) (test (let () (define* (hi (a 1) (b 2) :allow-other-keys :allow-other-keys) a)) 'error) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) 'error) @@ -35215,7 +35509,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test ((lambda* (:allow-other-keys) #f) :c 1) 'error) (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) :a 1 :a 2) 'error) (test ((lambda* (a :allow-other-keys) a) :c :c :c :c) #f) (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)) @@ -35224,8 +35518,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test ((lambda* (:rest b (a 1)) (list a b))) '(1 ())) (test ((lambda* (:rest a b c) (list a b c)) 1 2 3 4) '((1 2 3 4) 2 3)) -;(test (let ((x 3)) (define* (f (x x)) x) (let ((x 32)) (f))) 3) -(test (let ((x 3)) (define-macro* (f (x x)) `,x) (let ((x 32)) (f))) 32) ; ?? inconsistent with define* perhaps? +(test (let ((x 3)) (define* (f (x x)) x) (let ((x 32)) (f))) 3) +(test (let ((x 3)) (define-macro* (f (x x)) `,x) (let ((x 32)) (f))) 32) (test (let () (define (x x) x) (x 1)) 1) (test (procedure? (let () (define* (x (x #t)) x) (x x))) #t) @@ -36222,6 +36516,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (arity define-bacro) (cons 2 *max-arity*)) (test (arity string-append) (cons 0 *max-arity*)) (test (arity port-line-number) '(0 . 1)) +(test (arity port-position) '(1 . 1)) +(test (arity port-file) '(1 . 1)) (test (arity dilambda) '(2 . 2)) (test (arity letrec*) (cons 2 *max-arity*)) (test (arity make-iterator) '(1 . 2)) @@ -36356,6 +36652,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (arity subvector?) '(1 . 1)) (test (arity subvector-position) '(1 . 1)) (test (arity subvector-vector) '(1 . 1)) +(test (arity openlets) '(0 . 0)) +(test (arity coverlets) '(0 . 0)) (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*)) @@ -36924,7 +37222,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (let ((a (make-vector 3 'a symbol?))) (let ((b (copy a))) (vector-set! b 0 32))) 'error) (test (let ((a (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (let ((b (copy a))) (set! (b 'i) #\a))) 'error) -(test (let ((a (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (object->string (copy a) :readable)) "(let ((i 0)) (set! (setter 'i) integer?) (curlet))") +(test (let ((a (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (object->string (copy a) :readable)) "(let ((i 0)) (set! (setter 'i) #_integer?) (curlet))") (let ((x 1)) (set! (setter 'x) integer?) @@ -36942,6 +37240,14 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test x 'a) (test (set! x 3.14) 'error) (test x 'a)) (test x 1) (set! x 32) (test (set! x 3.14) 'error) (test x 32)) +(test (set! (setter setter) car) 'error) + +(let ((lst (list 1 2))) + (set! (setter (setter car)) (lambda (s v1 v2) (list v1 v2))) + (test (set! (set-car! lst 32) 4) '(32 4)) + (test lst '(1 2)) + (set! (setter (setter car)) #f)) + ;;; -------------------------------------------------------------------------------- ;;; documentation @@ -37019,8 +37325,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (func 2))) 5) -(let ((e (openlet (inlet 'help (lambda (obj) "this is helpful"))))) - (test-wi ((if (provided? 'snd) s7-help help) e) "this is helpful")) +(unless (provided? 'snd) + (let ((e (openlet (inlet 'help (lambda (obj) "this is helpful"))))) + (test-wi (help e) "this is helpful"))) (let () (define fdoc (let ((+documentation+ "this is fdoc's doc")) (lambda (x) (+ x 1)))) @@ -37070,19 +37377,19 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature (make-iterator (inlet 'a 1))) '(pair?)) (test (signature (make-iterator (hash-table 'a 1))) '(pair?)) (test (signature (make-iterator "hi")) '(char?)) -(test (signature (make-iterator (let ((+signature+ '(integer? integer?)) (+iterator+ #t)) (lambda (iter) 1)))) '(integer?)) +(test (signature (make-iterator (let ((+signature+ '(integer? integer?)) (+iterator+ #t)) (lambda () 1)))) '(integer?)) (test (signature (make-iterator (let ((+iterator+ #t)) (lambda () 1)))) '(#t)) (test (signature "hi") '(char? string? integer?)) (test (signature (c-pointer 0)) #f) -(test (signature (hash-table 'a 1)) '(#t hash-table? #t)) +(test (signature (hash-table 'a 1)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig)) (test (equal? (let ((L (list 1 2 3))) (set-cdr! (cddr L) (cddr L)) L) (cons 1 (cons 2 (let ((L (list 3))) (set-cdr! L L))))) #t) (test (signature (list 1 2)) (cons #t (cons 'pair? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (vector 1 2)) (cons #t (cons 'vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (float-vector 1 2)) (cons 'float? (cons 'float-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (int-vector 1 2)) (cons 'integer? (cons 'int-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (byte-vector 1 2)) (cons 'byte? (cons 'byte-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) -(test (signature (inlet 'a 1)) '(#t let? #t)) +(test (signature (inlet 'a 1)) (let ((sig (list #t 'let? 'symbol?))) (set-cdr! (cddr sig) (cddr sig)) sig)) (test (signature #()) #f) (test (signature #i()) #f) (test (signature #r()) #f) @@ -37267,6 +37574,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature cos) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature cosh) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature coverlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L)) +(test (signature coverlets) '(boolean?)) (test (signature curlet) '(let?)) (test (signature current-error-port) '((output-port? not))) (test (signature current-input-port) '(input-port?)) @@ -37388,6 +37696,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature open-output-file) '(output-port? string? string?)) (test (signature open-output-string) '(output-port?)) (test (signature openlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L)) +(test (signature openlets) '(boolean?)) (test (signature openlet?) '(boolean? #t)) (test (signature outlet) '(let? let?)) (test (signature output-port?) '(boolean? #t)) @@ -37397,8 +37706,10 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature pair?) '(boolean? #t)) (test (signature peek-char) '((char? eof-object?) input-port?)) (test (signature port-closed?) '(boolean? (input-port? output-port? not))) +(test (signature port-file) '(c-pointer? (input-port? output-port?))) (test (signature port-filename) '(string? (input-port? output-port?))) (test (signature port-line-number) '(integer? input-port?)) +(test (signature port-position) '(integer? input-port?)) (test (signature positive?) '(boolean? real?)) (test (signature documentation) '(string? #t)) (test (signature procedure-source) '(list? (procedure? macro?))) @@ -37413,7 +37724,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature random-state->list) '(pair? random-state?)) (test (signature random-state?) '(boolean? #t)) (test (signature rational?) '(boolean? #t)) -(test (signature rationalize) '(real? real? real?)) +(test (signature rationalize) '(rational? real? real?)) ; maybe return type: (real? boolean?) but I can't find a case for either (test (signature read) '(#t input-port?)) (test (signature read-byte) '((byte? eof-object?) input-port?)) (test (signature read-char) '((char? eof-object?) input-port?)) @@ -37506,8 +37817,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature #u(1 2)) (cons 'byte? (cons 'byte-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature "12") '(char? string? integer?)) (test (signature '(1 2)) (let ((lst (list #t 'pair? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst)) -(test (signature (hash-table 'a 1)) '(#t hash-table? #t)) -(test (signature (inlet 'a 1)) '(#t let? #t)) +(test (signature (hash-table 'a 1)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig)) +(test (signature (inlet 'a 1)) (let ((sig (list #t 'let? 'symbol?))) (set-cdr! (cddr sig) (cddr sig)) sig)) (test (signature (openlet (inlet 'a 1 'signature (lambda (obj) (list 'integer? 'let? 'symbol?))))) '(integer? let? symbol?)) (test (signature (make-hash-table 8 #f (cons symbol? integer?))) '(integer? hash-table? symbol?)) @@ -39484,7 +39795,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (label 'the-end) 0) (let-temporarily (((*s7* 'safety) 1)) - (test (object->string ho :readable) 'error) + (test (object->string ho :readable) "#<write_closure: body is cyclic>") ; changed 12-Mar-19 (test (equivalent? ho hi) #f)) (test (ho 2) 0)) @@ -40734,6 +41045,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta ;;; which is consistent, so to speak, with the (set! gcd +) example mentioned in s7.html (test (((let ((x (lambda (y) (+ y 1)))) (curlet)) 'x) 2) 3) +(test (let ((h (inlet 'a (inlet 'b 2)))) (h 'a 'b)) 2) (test (equal? (inlet 'a 1) (inlet 'a 1)) #t) (test (equivalent? (inlet 'a 1) (inlet 'a 1)) #t) @@ -40884,6 +41196,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (let ((a 21)) (let ((e (inlet (curlet)))) (set! a 32) (with-let e a))) 21) (test (let ((a 21)) (let ((e (sublet (curlet)))) (set! a 32) (with-let e a))) 32) +(test (with-let (block 1 2 3) ((curlet) 0)) 'error) +(test (with-let (c-pointer 0) (curlet)) 'error) (catch #t (lambda () @@ -40929,6 +41243,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (this-is-not-global 2) 'error) +(test (let ((b 2)) (varlet (curlet) 'a 1) (+ a b)) 3) (let () (apply varlet (curlet) @@ -42731,7 +43046,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (when with-block (test (object->string (object->let (block))) - "(inlet 'value (block) 'type c-object? 'c-object-type 0 'c-object-let (inlet 'float-vector? #<lambda (p)> 'signature #<lambda (p)> 'type block? 'arity #<lambda (p)> 'aritable? #<lambda (p args)> 'vector-dimensions #<lambda (p)> 'empty #<lambda (p)> 'subsequence subblock 'append block-append 'equivalent? blocks-are-equivalent 'reverse! block-reverse!) 'class (inlet 'name \"<block>\" 'setter (c-object setter)) 'c-object-length <unnamed c_function> 'c-object-ref <unnamed c_function> 'c-object-set! <unnamed c_function> 'c-object-copy <unnamed c_function> 'c-object-fill! <unnamed c_function> 'c-object-reverse <unnamed c_function> 'c-object->string <unnamed c_function>)")) + "(inlet 'value (block) 'type c-object? 'c-object-type 0 'c-object-let (inlet 'float-vector? #<lambda (p)> 'signature #<lambda (p)> 'type block? 'arity #<lambda (p)> 'aritable? #<lambda (p args)> 'vector-dimensions #<lambda (p)> 'empty #<lambda (p)> 'subsequence subblock 'append block-append 'equivalent? blocks-are-equivalent 'reverse! block-reverse!) 'class (inlet 'name \"<block>\" 'setter #<c-object-setter>) 'c-object-length #<unnamed-c-function> 'c-object-ref #<unnamed-c-function> 'c-object-set! #<unnamed-c-function> 'c-object-copy #<unnamed-c-function> 'c-object-fill! #<unnamed-c-function> 'c-object-reverse #<unnamed-c-function> 'c-object->string #<unnamed-c-function>)")) ;(test (let? (eval-string (object->string (object->let (rootlet)) :readable))) #t) (test (let ((x '2)) (set! (setter 'x) integer?) (object->string (object->let 'x))) "(inlet 'value x 'type symbol? 'current-value 2 'setter integer? 'immutable? #f)") @@ -42766,6 +43081,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (f2) '(3 2))) (test (f2) '(0 1))) +(test (let ((x 3) (y 4)) (let-temporarily ((x (+ y (let-temporarily ((y 5)) (+ x y))))) (+ x y))) 16) + (let () (define f3 (let ((x 'z)) (dilambda (lambda () x) @@ -42929,6 +43246,50 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (setter '___x___) #f)) (test (eq? (setter '___x___) f) #t)) +(let () + (define (flet x) x) + (let-temporarily ((flet (lambda (x) (+ x 1)))) + (test (flet 1) 2)) + (test (flet 1) 1)) + +(when with-block + (let ((obj (block 1 2 3))) + (let-temporarily (((obj 1) 32)) + (test obj (block 1 32 3))) + (test obj (block 1 2 3)))) + +(test (with-output-to-string + (lambda () + (call-with-exit + (lambda (quit) + (let ((x #f) + (cc #f)) + (let-temporarily ((x 1)) + (set! x 2) + (call/cc + (lambda (return) + (set! cc return))) + (display x) + (unless (= x 2) (quit)) + (set! x 3) + (cc))))))) + (with-output-to-string + (lambda () + (call-with-exit + (lambda (quit) + (let ((x #f) + (cc #f) + (returned #f)) + (let-temporarily ((x 1)) + (set! x 2) + (call/cc + (lambda (return) + (set! cc return))) + (display x) + (when returned (quit)) + (set! returned #t)) + (set! x 3) + (cc))))))) ;;; -------------------------------------------------------------------------------- @@ -46326,7 +46687,7 @@ hi6: (string-app... (define-macro (prog1 first . body) (let ((result (gensym))) `(let ((,result ,first)) ,@body ,result))) (define-macro (prog2 first second . body) `(prog1 (progn ,first ,second) ,@body)) - (define-macro (the type form) form) + (define-macro (the type form) form) ; see function the in stuff.scm (define-macro (defvar var . args) `(define ,var (or ,(and (not (null? args)) (car args)) #f))) (define-macro* (incf sym (inc 1)) @@ -63163,6 +63524,15 @@ hi6: (string-app... (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>)) +(let () + (define (func) + (call-with-output-string + (lambda (p) + (do ((i 0 (+ i 1))) + ((= i 1) (get-output-string p)) + (display (rationalize most-positive-fixnum) p))))) + (test (func) "9223372036854775807")) + (for-each (lambda (arg) (test (rationalize arg +nan.0) 'error) @@ -81087,8 +81457,8 @@ hi6: (string-app... (lambda (ok) (for-each-permutation (lambda args - (when (not (equivalent? (apply - args) (- (car args) (apply + (cdr args))))) - (format #t "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args)))) + (unless (= (apply - args) (- (car args) (apply + (cdr args)))) + (format *stderr* "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args)))) (ok))) '(1 1/2 0.5 1+i)))) @@ -81096,8 +81466,8 @@ hi6: (string-app... (lambda (ok) (for-each-permutation (lambda args - (when (not (equivalent? (apply - args) (+ (car args) (- (apply + (cdr args)))))) - (format #t "~A: (- ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply - args)) + (unless (= (apply - args) (+ (car args) (- (apply + (cdr args))))) + (format *stderr* "~A: (- ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply - args)) (ok))) '(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i)))) @@ -84195,15 +84565,8 @@ etc.... (num-test 0 #b0/1000000000) (num-test 0 #b0/100000000000000000000000000000000000000) (num-test 0 #b0/100000000000000000000000000000000000000000000000000000000000000) -(if with-bignums - (begin - (num-test (string->number "#b0/100000000000000000000000000000000000000000000000000000000000000000000") 0) - (num-test (string->number "#b-0/100000000000000000000000000000000000000000000000000000000000000000000") 0))) -;;; there's a problem here -- the reader tries to make sense of every form even if it can't actually -;;; be evaluated, so in the block above in the non-bignum case, if the #b... is not in double quotes, it tries to read -;;; the value as a number. make_atom however returns NaN because it can't represent the integer in 64 bits, and -;;; the #... code interprets that as #b<not-a-number> and it raises a read error! Ideally, we'd distinguish -;;; between #b... that can't possibly be right and the same that might be ok if the bits are available. +(num-test (string->number "#b0/100000000000000000000000000000000000000000000000000000000000000000000") 0) +(num-test (string->number "#b-0/100000000000000000000000000000000000000000000000000000000000000000000") 0) (test (equal? 0.0 #b0.0e10) #t) (test (equal? 0.0 #b0e100) #t) @@ -86530,7 +86893,7 @@ etc (lambda (p) (do ((i 0 (+ i 1))) ((= i 4)) - (write (* i 2) p) ; ("do" does not rebind in s7) + (write (* i 2) p) (display (* i 4) p) (format p "~A" i)))) #(0 0 "0" 2 4 "1" 4 8 "2" 6 12 "3")) @@ -86548,35 +86911,6 @@ etc (test (apply subsequence e ()) #(1 2 3 4)) (test (subsequence e) #(1 2 3 4))) - (let-temporarily (((*s7* 'print-length) 3)) - (test (sequence->string '(0 1 2)) "(0 1 2)") - (test (sequence->string '()) "()") - (test (sequence->string '(0 1 2 3)) "(0 1 2 ...)") - (test (sequence->string #(0 1 2)) "#(0 1 2)") - (test (sequence->string #()) "#()") - (test (sequence->string #(0 1 2 3)) "#(0 1 2 ...)") - (test (sequence->string (hash-table)) "(hash-table)") - (test (string? (sequence->string (hash-table 'a 1 'b 2 'c 3))) #t) - (test (string? (sequence->string (hash-table 'a 1 'b 2 'c 3 'd 4))) #t) - (test (sequence->string (inlet)) "(inlet)") - (test (sequence->string (inlet 'a 1 'b 2 'c 3)) "(inlet '(a . 1) '(b . 2) '(c . 3))") - (test (sequence->string (inlet 'a 1 'b 2 'c 3 'd 4)) "(inlet '(a . 1) '(b . 2) '(c . 3) ...)") - (test (sequence->string "") "\"\"") - (test (sequence->string "abc") "\"abc\"") - (test (sequence->string "abcd") "\"abc ...\"") - (test (sequence->string #u()) "#u()") - (test (sequence->string (string->byte-vector "abc")) "#u(97 98 99)") - (test (sequence->string (byte-vector 0 1 2 3)) "#u(0 1 2 ...)") - (test (sequence->string (float-vector)) "#r()") - (test (sequence->string (float-vector 0 1 2 3)) "#r(0.0 1.0 2.0 ...)") - (test (sequence->string (float-vector 0 1 2)) "#r(0.0 1.0 2.0)") - (when with-block (test (sequence->string (block)) "(block)")) - (when with-block (test (sequence->string (block 0 1 2)) "#r(0.0 1.0 2.0)")) - (when with-block (test (sequence->string (block 0 1 2 3)) "#r(0.0 1.0 2.0 ...)") ) - (set! (*s7* 'print-length) 8) - (test (string? (sequence->string (hash-table 'a 1 'b 2 'c 3 'd 4))) #t) - (test (sequence->string (inlet 'a 1 'b 2 'c 3 'd 4)) "(inlet '(a . 1) '(b . 2) '(c . 3) '(d . 4))")) - (test (pair? (member :heap-size (*s7*->list))) #t) ;; sandbox @@ -86622,428 +86956,7 @@ etc (test (adjoin 'a ()) '(a)) (test (adjoin 'a '(a)) '(a)) (test (adjoin 'a '(b a c)) '(b a c)) - (test (adjoin 'a '(b c)) '(a b c)) - - (define (Display-test) - - (define-macro (with-Display . body) - `(call-with-output-string - (lambda (p) - (let ((oldp (Display-port))) - (set! (Display-port) p) - ,@body - (set! (Display-port) oldp))))) - - (define (strip-comments s) - (let* ((len (length s)) - (new-s (make-string len #\null))) - (do ((i 0 (+ i 1)) - (j 0) - (k 1)) - ((= i len) (substring new-s 0 j)) - (case (s i) - ((#\;) - (set! k 0) - (set! j (- j 1))) - ((#\newline) - (set! k 1) - (set! (new-s j) #\newline)) - (else (set! (new-s j) (s i)))) - (set! j (+ j k))))) - - (define (Display-string=? s1 s2) - (or (string=? s1 s2) - (string=? (strip-comments s1) s2))) - (Display (define (hi x) (+ x 1))) - (let ((str (with-Display (hi 1)))) - (if (not (Display-string=? str "(hi :x 1)\n -> 2\n")) - (format *stderr* "Display 0: (hi 1) -> ~S~%" (strip-comments str)))) - - (define (ho y) (let ((z (+ y 1))) (hi z))) - (let ((str (with-Display (ho 1)))) - (if (not (Display-string=? str "(hi :x 2)\n -> 3\n")) - (format *stderr* "Display 1: (ho 1) -> ~S~%" (strip-comments str)))) - - (Display (define (ho y) (let ((z (+ y 1))) (hi z)))) - (let ((str (with-Display (ho 1)))) - (if (not (Display-string=? str "(ho :y 1)\n (let ((z . 2))\n (hi :x 2)\n -> 3\n (hi z)) -> 3\n -> 3\n")) - (format *stderr* "Display 1a: (ho 1) -> ~S~%" (strip-comments str)))) - - (Display (define (hi x) (if (> x 0) (hi (- x 1)) 0))) - (let ((str (with-Display (hi 1)))) - (if (not (Display-string=? str "(hi :x 1)\n (hi :x 0)\n -> 0\n -> 0\n")) - (format *stderr* "Display 2: (hi 1) -> ~S~%" (strip-comments str)))) - - (Display (define (hi a b) (+ a b))) - (let ((str (with-Display (hi 1 2)))) - (if (and (not (Display-string=? str "(hi :a 1 :b 2)\n -> 3\n")) - (not (Display-string=? str "(hi :b 2 :a 1)\n -> 3\n"))) - (format *stderr* "Display 3: (hi 1 2) -> ~S~%" (strip-comments str)))) - - (Display (define (hi x) (let ((a 1) (b 2)) (+ x a b)))) - (let ((str (with-Display (hi 1)))) - (if (not (Display-string=? str "(hi :x 1)\n (let ((a . 1) (b . 2))\n (+ x a b)) -> 4\n -> 4\n")) - (format *stderr* "Display 4: (hi 1) -> ~S~%" (strip-comments str)))) - - (Display (define (hi x) (let ((a 1) (b 2) (c 3) (d 4) (e 5) (f 6) (g 7)) (+ x e)))) - (let ((str (with-Display (hi 1)))) - (if (not (Display-string=? str "(hi :x 1)\n (let ((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6) ...)\n (+ x e)) -> 6\n -> 6\n")) - (format *stderr* "Display 5: (hi 1) -> ~S~%" (strip-comments str)))) - - (Display (define (hi x) (x 0))) - (let ((str (with-Display (hi '(0 1 2 3 4 5 6))))) - (if (not (Display-string=? str "(hi :x (0 1 2 3 4 5 ...))\n -> 0\n")) - (format *stderr* "Display 5: (hi '(0 1 2 3 4 5 6)) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (hi #(0 1 2 3 4 5 6))))) - (if (not (Display-string=? str "(hi :x #(0 1 2 3 4 5 ...))\n -> 0\n")) - (format *stderr* "Display 5: (hi #(0 1 2 3 4 5 6)) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (hi #u(0 1 2 3 4 5 6))))) - (if (not (Display-string=? str "(hi :x #u(0 1 2 3 4 5 ...))\n -> 0\n")) - (format *stderr* "Display 5: (hi #u(0 1 2 3 4 5 6)) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (hi "01234567")))) - (if (not (Display-string=? str "(hi :x \"012345 ...\")\n -> #\\0\n")) - (format *stderr* "Display 5: (hi \"01234567\") -> ~S~%" (strip-comments str)))) - - (Display (define (hi x) (x 'a))) - (let ((str (with-Display (hi (hash-table 'a 1))))) - (if (not (Display-string=? str "(hi :x (hash-table 'a 1))\n -> 1\n")) - (format *stderr* "Display 5: (hi (hash-table 'a 1)) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (hi (inlet 'a 1))))) - (if (not (Display-string=? str "(hi :x (inlet '(a . 1)))\n -> 1\n")) - (format *stderr* "Display 5: (hi (inlet 'a 1)) -> ~S~%" (strip-comments str)))) - - (Display (define* (hi (x 1)) (* x 2))) - (let ((str (with-Display (hi)))) - (if (not (Display-string=? str "(hi :x 1)\n -> 2\n")) - (format *stderr* "Display 6: (hi) -> ~S~%" (strip-comments str)))) - - (let ((y 5)) - (Display (define* (hi (x (* y 2))) (* x 3))) - (let ((str (with-Display (hi)))) - (if (not (Display-string=? str "(hi :x 10)\n -> 30\n")) - (format *stderr* "Display 7: (hi) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (hi 3)))) - (if (not (Display-string=? str "(hi :x 3)\n -> 9\n")) - (format *stderr* "Display 8: (hi) -> ~S~%" (strip-comments str))))) - - (Display - (define (f1 x) - (or (> x 1) - (< x -1) - (= x 0)))) - - (let ((str (with-Display (f1 1)))) - (if (not (Display-string=? str "(f1 :x 1)\n -> #f\n")) - (format *stderr* "Display 9: (f1 1) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f1 -2)))) - (if (not (Display-string=? str "(f1 :x -2)\n (or ... (< x -1) ... ) -> #t\n -> #t\n")) - (format *stderr* "Display 9: (f1 -2) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f1 2)))) - (if (not (Display-string=? str "(f1 :x 2)\n (or (> x 1) ... ) -> #t\n -> #t\n")) - (format *stderr* "Display 9: (f1 2) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f1 0)))) - (if (not (Display-string=? str "(f1 :x 0)\n (or ... (= x 0)) -> #t\n -> #t\n")) - (format *stderr* "Display 9: (f1 0) -> ~S~%" (strip-comments str)))) - - (Display - (define (f2 x) - (and (> x 1) - (not (= x 3)) - (integer? x)))) - - (let ((str (with-Display (f2 0)))) - (if (not (Display-string=? str "(f2 :x 0)\n (and (> x 1) ... ) -> #f\n -> #f\n")) - (format *stderr* "Display 10: (f2 0) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f2 2)))) - (if (not (Display-string=? str "(f2 :x 2)\n -> #t\n")) - (format *stderr* "Display 10: (f2 2) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f2 3)))) - (if (not (Display-string=? str "(f2 :x 3)\n (and ... (not (= x 3)) ... ) -> #f\n -> #f\n")) - (format *stderr* "Display 10: (f2 3) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f2 3.5)))) - (if (not (Display-string=? str "(f2 :x 3.5)\n (and ... (integer? x)) -> #f\n -> #f\n")) - (format *stderr* "Display 10: (f2 3.5) -> ~S~%" (strip-comments str)))) - - (Display - (define (f3 x) - (let ((y (* x 2))) - (and (> y 1) - (not (= y 6)) - (integer? x))))) - - (let ((str (with-Display (f3 3.5)))) - (if (not (Display-string=? str "(f3 :x 3.5)\n (let ((y . 7.0))\n (and (> y 1) (not (= y 6)) (integer? x))) -> #f\n -> #f\n")) - (format *stderr* "Display 11: (f3 3.5) -> ~S~%" (strip-comments str)))) - - (Display - (define (f4 x) - (display x (Display-port)) - (newline (Display-port)) - (* x 2))) - - (let ((str (with-Display (f4 1)))) - (if (not (Display-string=? str "(f4 :x 1)\n1\n -> 2\n")) - (format *stderr* "Display 12: (f4 1) -> ~S~%" (strip-comments str)))) - - (Display - (define (f5 x) - (when (> x 1) - (display x (Display-port)) - (newline (Display-port)) - (* x 2)))) - - (let ((str (with-Display (f5 3)))) - (if (not (Display-string=? str "(f5 :x 3)\n3\n(when ... (* x 2)) -> 6\n -> 6\n")) - (format *stderr* "Display 13: (f5 3) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f5 0)))) - (if (not (Display-string=? str "(f5 :x 0)\n(when (> x 1) -> #f ...)\n -> #<unspecified>\n")) - (format *stderr* "Display 13: (f5 0) -> ~S~%" (strip-comments str)))) - - (Display - (define (f5a x) - (unless (> x 1) - (display x (Display-port)) - (newline (Display-port)) - (* x 2)))) - - (let ((str (with-Display (f5a 3)))) - (if (not (Display-string=? str "(f5a :x 3)\n(unless (> x 1) -> #t ...)\n -> #<unspecified>\n")) - (format *stderr* "Display 14: (f5a 3) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f5a 0)))) - (if (not (Display-string=? str "(f5a :x 0)\n0\n(unless ... (* x 2)) -> 0\n -> 0\n")) - (format *stderr* "Display 14: (f5a 0) -> ~S~%" (strip-comments str)))) - - (Display - (define (f6 x) - (begin - (display x (Display-port)) - (newline (Display-port)) - (* x 2)))) - - (let ((str (with-Display (f6 3)))) - (if (not (Display-string=? str "(f6 :x 3)\n3\n(begin ... (* x 2)) -> 6\n -> 6\n")) - (format *stderr* "Display 15: (f6 3) -> ~S~%" (strip-comments str)))) - - (Display - (define (f7 x) - (cond ((= x 0) 123) - ((> x 1) (display x (Display-port)) (newline (Display-port)) (* x 2)) - (#t x)))) - - (let ((str (with-Display (f7 3)))) - (if (not (Display-string=? str "(f7 :x 3)\n3\n (cond ... ((> x 1) (display x (Display-port)) (newline (Display-port)) (* x 2)) ... ) -> 6\n -> 6\n")) - (format *stderr* "Display 16: (f7 3) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f7 0)))) - (if (not (Display-string=? str "(f7 :x 0)\n (cond ((= x 0) 123) ... ) -> 123\n -> 123\n")) - (format *stderr* "Display 16: (f7 0) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f7 1)))) - (if (not (Display-string=? str "(f7 :x 1)\n (cond ... (#t x)) -> 1\n -> 1\n")) - (format *stderr* "Display 16: (f7 1) -> ~S~%" (strip-comments str)))) - - (Display - (define (f8 x) - (case (+ x 1) - ((0) 123) - ((1 2 3) 0) - (else 4)))) - - (let ((str (with-Display (f8 3)))) - (if (not (Display-string=? str "(f8 :x 3)\n (case [4] ... (else 4)) -> 4\n -> 4\n")) - (format *stderr* "Display 17: (f8 3) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f8 -1)))) - (if (not (Display-string=? str "(f8 :x -1)\n (case [0] ((0) 123) ... ) -> 123\n -> 123\n")) - (format *stderr* "Display 17: (f8 -1) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f8 1)))) - (if (not (Display-string=? str "(f8 :x 1)\n (case [2] ... ((1 2 3) 0) ... ) -> 0\n -> 0\n")) - (format *stderr* "Display 17: (f8 1) -> ~S~%" (strip-comments str)))) - - (Display - (define (f9 x) - (if (< x 0) (* x 2) (* x 3)))) - - (let ((str (with-Display (f9 3)))) - (if (not (Display-string=? str "(f9 :x 3)\n -> 9\n")) - (format *stderr* "Display 18: (f9 3) -> ~S~%" (strip-comments str)))) - - (Display - (define (f10 x) - (dynamic-wind - (lambda () - (set! x (* x 2))) - (lambda () - (display x (Display-port)) - (newline (Display-port)) - (* x 2)) - (lambda () - (set! x 0))))) - - (let ((str (with-Display (f10 1)))) - (if (not (Display-string=? str "(f10 :x 1)\n2\n(dynamic-wind ... (* x 2)) -> 4\n -> 4\n")) - (format *stderr* "Display 19: (f10 1) -> ~S~%" (strip-comments str)))) - - (Display - (define (f11 x) - (cond (x => abs)))) - - (let ((str (with-Display (f11 -1)))) - (if (not (Display-string=? str "(f11 :x -1)\n (cond (x => abs)) -> 1\n -> 1\n")) - (format *stderr* "Display 20: (f11 -1) -> ~S~%" (strip-comments str)))) - - (Display - (define (f12 x) - (cond ((+ x 1) => (lambda (y) (* y 2)))))) - - (let ((str (with-Display (f12 2)))) - (if (not (Display-string=? str "(f12 :x 2)\n (cond ((+ x 1) => (lambda (y) (* y 2)))) -> 6\n -> 6\n")) - (format *stderr* "Display 21: (f12 2) -> ~S~%" (strip-comments str)))) - - (Display - (define (f13 x) - (case x - ((a) => (lambda (y) y)) - (else => symbol?)))) - - (let ((str (with-Display (f13 'a)))) - (if (not (Display-string=? str "(f13 :x a)\n (case [a] ((a) => (lambda (y) y)) ... ) -> a\n -> a\n")) - (format *stderr* "Display 22: (f13 'a) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f13 1)))) - (if (not (Display-string=? str "(f13 :x 1)\n (case [1] ... (else => symbol?)) -> #f\n -> #f\n")) - (format *stderr* "Display 22: (f13 1) -> ~S~%" (strip-comments str)))) - - (Display - (define (f14 . x) - (display x (Display-port)) - (newline (Display-port)) - (apply + x))) - - (let ((str (with-Display (f14)))) - (if (not (Display-string=? str "(f14 :x ())\n()\n -> 0\n")) - (format *stderr* "Display 23a: (f14) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f14 1)))) - (if (not (Display-string=? str "(f14 :x (1))\n(1)\n -> 1\n")) - (format *stderr* "Display 23b: (f14 1) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f14 1 2)))) - (if (not (Display-string=? str "(f14 :x (1 2))\n(1 2)\n -> 3\n")) - (format *stderr* "Display 23c: (f14 1 2) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (let ((a 1) (b 2)) (f14 a b))))) - (if (not (Display-string=? str "(f14 :x (1 2))\n(1 2)\n -> 3\n")) - (format *stderr* "Display 23d: (f14 a b) -> ~S~%" (strip-comments str)))) - - (Display - (define (f15) - (+ 1 2))) - - (let ((str (with-Display (f15)))) - (if (not (Display-string=? str "(f15)\n -> 3\n")) - (format *stderr* "Display 23e: (f15) -> ~S~%" (strip-comments str)))) - - (Display - (define (f16 x) - (case (+ x 1) - ((0) 123) - ((1 2 3) 0)))) - - (let ((str (with-Display (f16 4)))) - (if (not (Display-string=? str "(f16 :x 4)\n (case [5] falls through\n -> #<unspecified>\n")) - (format *stderr* "Display 24: (f16 4) -> ~S~%" (strip-comments str)))) - - (Display - (define (f17 x . y) - (display y (Display-port)) - (newline (Display-port)) - (apply + x y))) - - (let ((str (with-Display (f17 1)))) - (if (and (not (Display-string=? str "(f17 :x 1 :y ())\n()\n -> 1\n")) - (not (Display-string=? str "(f17 :y () :x 1)\n()\n -> 1\n"))) - (format *stderr* "Display 25a: (f17 1) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f17 1 2)))) - (if (and (not (Display-string=? str "(f17 :x 1 :y (2))\n(2)\n -> 3\n")) - (not (Display-string=? str "(f17 :y (2) :x 1)\n(2)\n -> 3\n"))) - (format *stderr* "Display 25b: (f17 1 2) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (let ((a 1) (b 2)) (f17 a b))))) - (if (and (not (Display-string=? str "(f17 :x 1 :y (2))\n(2)\n -> 3\n")) - (not (Display-string=? str "(f17 :y (2) :x 1)\n(2)\n -> 3\n"))) - (format *stderr* "Display 25c: (f17 a b) -> ~S~%" (strip-comments str)))) - - (Display - (define* (f18 (x 1) (y 2)) - (display y (Display-port)) - (newline (Display-port)) - (+ x y))) - - (let ((str (with-Display (f18)))) - (if (and (not (Display-string=? str "(f18 :x 1 :y 2)\n2\n -> 3\n")) - (not (Display-string=? str "(f18 :y 2 :x 1)\n2\n -> 3\n"))) - (format *stderr* "Display 26: (f18) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f18 3)))) - (if (and (not (Display-string=? str "(f18 :x 3 :y 2)\n2\n -> 5\n")) - (not (Display-string=? str "(f18 :y 2 :x 3)\n2\n -> 5\n"))) - (format *stderr* "Display 26: (f18 3) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f18 :y 32)))) - (if (and (not (Display-string=? str "(f18 :x 1 :y 32)\n32\n -> 33\n")) - (not (Display-string=? str "(f18 :y 32 :x 1)\n32\n -> 33\n"))) - (format *stderr* "Display 26: (f18 :y 32) -> ~S~%" (strip-comments str)))) - (let ((str (with-Display (f18 :y 32 :x 12)))) - (if (and (not (Display-string=? str "(f18 :x 12 :y 32)\n32\n -> 44\n")) - (not (Display-string=? str "(f18 :y 32 :x 12)\n32\n -> 44\n"))) - (format *stderr* "Display 26: (f18 :y 32 :x 12) -> ~S~%" (strip-comments str)))) - - (Display - (define* (f19 (x 1) y) - (display y (Display-port)) - (newline (Display-port)) - (list x y))) - - (let ((str (with-Display (f19)))) - (if (and (not (Display-string=? str "(f19 :x 1 :y #f)\n#f\n -> (1 #f)\n")) - (not (Display-string=? str "(f19 :y #f :x 1)\n#f\n -> (1 #f)\n"))) - (format *stderr* "Display 27: (f19) -> ~S~%" (strip-comments str)))) - - (Display - (define* (f20 x :rest y) - (display y (Display-port)) - (newline (Display-port)) - (list x y))) - - (let ((str (with-Display (f20)))) - (if (and (not (Display-string=? str "(f20 :x #f :y ())\n()\n -> (#f ())\n")) - (not (Display-string=? str "(f20 :y () :x #f)\n()\n -> (#f ())\n"))) - (format *stderr* "Display 28: (f20) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (let ((x 1)) (Display (or (< x 1) (= x 1))))))) - (if (not (Display-string=? str " (or ... (= x 1)) -> #t\n")) - (format *stderr* "Display 29: (or...) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (let ((x 1)) (Display (when (> x 0) (+ x 1))))))) - (if (not (Display-string=? str "(when ... (+ x 1)) -> 2\n")) - (format *stderr* "Display 30: (when...) -> ~S~%" (strip-comments str)))) - - (let ((str (with-Display (Display (let ((x 1)) (+ x 1)))))) - (if (not (Display-string=? str "(let ((x . 1))\n (+ x 1)) -> 2\n")) - (format *stderr* "Display 30: (let...) -> ~S~%" (strip-comments str)))) - - (set! ((funclet Display) '*display-spacing*) 4) - (Display (define (f21 x) (if (> x 0) (f21 (- x 1)) 0))) - (let ((str (with-Display (f21 2)))) - (if (not (Display-string=? str "(f21 :x 2)\n (f21 :x 1)\n (f21 :x 0)\n -> 0\n -> 0\n -> 0\n")) - (format *stderr* "Display 31: (f21 2) -> ~S~%" (strip-comments str)))) - - (set! ((funclet Display) '*display-spacing*) 1) - (Display (define (f21 x) (if (> x 0) (f21 (- x 1)) 0))) - (let ((str (with-Display (f21 2)))) - (if (not (Display-string=? str "(f21 :x 2)\n (f21 :x 1)\n (f21 :x 0)\n -> 0\n -> 0\n -> 0\n")) - (format *stderr* "Display 31a: (f21 2) -> ~S~%" (strip-comments str)))) - - (set! ((funclet Display) '*display-spacing*) 2) - ) - (Display-test) - ) + (test (adjoin 'a '(b c)) '(a b c))) (let () (require write.scm) @@ -88390,8 +88303,18 @@ etc (test (string-fill! str num) 'error) (test (string-fill! num #\a) 'error) (test (string-fill! num chr) 'error) - (test (string-fill! "123" #\a num) #\a) - (test (string-fill! "123" #\a 0 num) #\a)) + (unless pure-s7 + (test (string-fill! "123" #\a num) #\a) + (test (string-fill! "123" #\a 0 num) #\a))) + + (test (object->string ((*mock-number* 'mock-number) 1) :readable) + "(openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?)))") + (test (object->string (sublet ((*mock-number* 'mock-number) 1) :asdf 2) :readable) + "(openlet (sublet *mock-number* :asdf 2))") + (test (object->string (sublet (inlet :asdf 3) :mn ((*mock-number* 'mock-number) 1)) :readable) + "(sublet (inlet :asdf 3) :mn (openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?))))") + (test (format #f "~W" ((*mock-number* 'mock-number) 1)) + "(openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?)))") (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I)) #t) (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\k)) #f) @@ -88548,7 +88471,7 @@ etc (test (s 0) #\A) (test (set! (s 1) #\B) #\B) (test (s 1) #\B) - (test (string->list s) '(#\A #\B #\c)) + (unless pure-s7 (test (string->list s) '(#\A #\B #\c))) (test (string-append s "d") "ABcd") (test (string-append "d" s "e") "dABce") (test (string-append "d" "f" s) "dfABc") @@ -88798,15 +88721,16 @@ etc (test (p index) 2) (test (v index) 2) (test (subvector #(0 1 2 3) '(3) (mock-number 1)) #(1 2 3)) - (test (vector->list #(0 1 2 3 4) (mock-number 1) (mock-number 3)) '(1 2)) + (unless pure-s7 + (test (vector->list #(0 1 2 3 4) (mock-number 1) (mock-number 3)) '(1 2)) + (test (vector->list #(0 1 2 3 4) index) '(2 3 4)) + (test (vector->list #(0 1 2 3 4) index index) ()) + (test (string->list "01234" index) '(#\2 #\3 #\4)) + (test (string->list "01234" 0 index) '(#\0 #\1))) (test (list-tail p index) '(2 3 4)) (test (substring "01234" index) "234") (test (substring "01234" 0 index) "01") (test (substring "01234" index (mock-number 3)) "2") - (test (vector->list #(0 1 2 3 4) index) '(2 3 4)) - (test (vector->list #(0 1 2 3 4) index index) ()) - (test (string->list "01234" index) '(#\2 #\3 #\4)) - (test (string->list "01234" 0 index) '(#\0 #\1)) (test (let ((dest (make-string 3))) (copy "01234" dest index) dest) "234") (test (let ((dest (make-string 2))) (copy "01234" dest 0 index) dest) "01") (unless pure-s7 (test (let ((str "01234")) (string-fill! str #\a index) str) "01aaa")) @@ -88823,6 +88747,14 @@ etc (test (let ((vec ((*mock-vector* 'mock-vector) 10 11 12))) (vec ((*mock-number* 'mock-number) 1))) 11) (test (let () (define (func) (copy ((*mock-string* 'mock-string) #\h #\o #\h #\o) #i(1 2))) (func)) #i(104 111)) + (let () + (define-constant fv #(1 2 3)) + (define (func) + (do ((i 0 (+ i 1))) + ((= i 1) + (vector-ref fv (mock-number 0))))) + (test (func) 1)) + (test-wi (object->string (vector (let ((<1> #f) (<2> (vector #f))) @@ -88835,7 +88767,7 @@ etc (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<3> 0) <1>) - (set! (<3> 1) (hash-table 'b 2)) + (set! (<3> 1) (openlet (sublet *mock-hash-table* :value (hash-table 'b 2) :mock-type 'mock-hash-table?))) (set! (<2> 0) <1>) <3>)") (test-wi (object->string @@ -88850,7 +88782,7 @@ etc (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<3> 0) <1>) - (set! (<3> 1) (list 1 2)) + (set! (<3> 1) (openlet (sublet *mock-pair* :value (list 1 2) :mock-type 'mock-pair?))) (set! (<2> 0) <1>) <3>)") @@ -89188,8 +89120,9 @@ etc (test (format #f (mock-symbol 'b) (mock-symbol 'a)) 'error) (test (write-byte (mock-port *stdout*)) 'error) (test (call-with-output-string (lambda (p) (write-byte (mock-number 123) (mock-port p)))) (string (integer->char 123))) - (test (let ((str "123")) (string-fill! str (mock-string #\a))) 'error) - (test (let ((str "123")) (string-fill! str #\b (mock-string #\a))) 'error) + (unless pure-s7 + (test (let ((str "123")) (string-fill! str (mock-string #\a))) 'error) + (test (let ((str "123")) (string-fill! str #\b (mock-string #\a))) 'error)) (test (with-let (mock-number 2.0) (make-hash-table)) (make-hash-table)) (test (make-hash-table (mock-number 2) (mock-number 8)) 'error) (test (let () (define (func) (let ((x #f)) (catch 'oops @@ -89292,7 +89225,7 @@ etc (test (format #f "~O" (mock-number 17)) "21") (test (format #f "~A" (mock-number 17)) "17") (test (format #f "~S" (mock-number 17)) "17") - (test (format #f "~W" (mock-number 17)) "17") ;was "(immutable! (sublet *mock-number* :value 17))") + (test (format #f "~W" (mock-number 17)) "(openlet (immutable! (sublet *mock-number* :value 17 :mock-type 'mock-number?)))") (test (format #f "~F" (mock-number 1.5)) "1.500000") (test (format #f "~G" (mock-number 1.5)) "1.5") (test (format #f "~E" (mock-number 1.5)) "1.500000e+00") @@ -89308,7 +89241,7 @@ etc (test (format #f (mock-string "~A ~A") 1 (mock-string "2")) "1 2") (test (format #f "symbol: ~S" (mock-symbol 'a)) "symbol: a") (test (format #f "~S" (mock-number 3/2)) "3/2") - (test (format #f "~W" (mock-number 3/2)) "3/2") ; was "(immutable! (sublet *mock-number* :value 3/2))") + (test (format #f "~W" (mock-number 3/2)) "(openlet (immutable! (sublet *mock-number* :value 3/2 :mock-type 'mock-number?)))") (test (format #f "~A" (mock-string #\a #\b #\c)) "abc") (test (format #f "~A" (mock-pair 1 2 3)) "(1 2 3)") (test (format #f "~A" (mock-char #\a)) "a") @@ -89905,6 +89838,30 @@ etc (test (equivalent? (*s7* 'stack) (*s7* 'stack)) #f) (test (set! (*s7* 'max-format-arg) 12) 'error) +(test (cutlet *s7* 'let-ref-fallback) 'error) +(test (varlet *s7* 'let-ref-fallback 123) 'error) +(test (cutlet *s7* 'let-set-fallback) 'error) +(test (varlet *s7* 'let-set-fallback 123) 'error) +(test (let-set! *s7* 'let-ref-fallback #t) 'error) +(test (type-of *s7*) 'let?) +(test (let-set! *s7* 'a 1) 'error) +(test (reverse! *s7*) 'error) +(test (fill! *s7* #f) 'error) +(test (procedure? ((copy (inlet 'let-ref-fallback #f) *s7*) 'let-ref-fallback)) #t) +(test (copy '((let-set-fallback . 32)) *s7*) 'error) +;; related... +(test (let ((e (let () (define-constant a 1) (curlet)))) (let-set! e 'a 2) e) 'error) +(test (let ((e (let () (define-constant a 1) (curlet)))) (set! (e 'a) 2) e) 'error) +(test (let ((e (let () (define-constant a 1) (curlet)))) (with-let e (set! a 2)) e) 'error) +(test (fill! (let ((a 1)) (set! (setter 'a) integer?) (curlet)) #f) 'error) +(test (let-set! (let ((a 1)) (set! (setter 'a) integer?) (curlet)) 'a #f) 'error) +(test (let ((a 1)) (set! (setter 'a) integer?) (let ((a #f)) a)) #f) +(test (let () (define-constant a 3) (let ((a #f)) a)) 'error) +(test (let ((e (let () (define-constant a 1) (curlet)))) (fill! e 2) e) 'error) +(test (varlet (let ((a 1)) (set! (setter 'a) integer?) (curlet)) 'a #f) (inlet 'a 1 'a #f)) +(test (cutlet (let ((a 1)) (set! (setter 'a) integer?) (curlet)) 'a) (inlet)) +(test (cutlet (varlet (let ((a 1)) (set! (setter 'a) integer?) (curlet)) 'a #f) 'a) (inlet 'a 1)) +(test (copy '((a . #f)) (let ((a 1)) (set! (setter 'a) integer?) (curlet))) 'error) (catch #t (lambda () @@ -90243,6 +90200,7 @@ etc (test (let () (define (func x) (sort! / (lambda (zero? i) (zero? i)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (string>? (string) (read-line)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! cons '() macroexpand))) (define (hi) (func #f)) (hi)) 'error) +(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-set! cons -1 ()))) (f)) 'error) (test (let () (define (func x) (call-with-values quasiquote macroexpand )) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (modulo (expt 2 32) (make-iterator (list 1 2 3))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (< (read-char (cond (boolean? lambda* (lambda (a) (values a (+ a 1))) `(+ ,a ,b) 0+0/0i))))) (define (hi) (func #f)) (hi)) 'error) @@ -92405,6 +92363,7 @@ etc (let () (require lint.scm) (set! *report-repeated-code-fragments* #f) + (set! *report-combinable-lets* #t) (set! (setter /) #f); clear stuff from above (define lint-test @@ -92726,8 +92685,8 @@ etc (lint-test "(random 0)" " random: perhaps (random 0) -> 0") (lint-test "(random 0.0)" " random: perhaps (random 0.0) -> 0.0") (lint-test "(random x)" "") - (lint-test "(random 1)" " random (line 0): perhaps (random 1) -> 0") - (lint-test "(random -1)" " random (line 0): perhaps (random -1) -> 0") + (lint-test "(random 1)" " random: perhaps (random 1) -> 0") + (lint-test "(random -1)" " random: perhaps (random -1) -> 0") (lint-test "(random 0 y)" "") (lint-test "(lognot 1)" " lognot: perhaps (lognot 1) -> -2") @@ -95165,9 +95124,9 @@ etc (lint-test "(do ((i 0 (+ i 1))) (#f i))" " do: result is unreachable: (#f i)") (lint-test "(do ((i 0 (+ i 0))) ((= i 10) i))" " do: perhaps (+ i 0) -> i") (lint-test "(do ((i 0 (+ i 1))) ((= i 0)) (display i))" - " do (line 0): do is a no-op because (= i 0) is true at the start: (do ((i 0 (+ i 1))) ((= i 0)) (display i))") + " do: do is a no-op because (= i 0) is true at the start: (do ((i 0 (+ i 1))) ((= i 0)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((>= 0 i)) (display i))" - " do (line 0): do is a no-op because (>= 0 i) is true at the start: (do ((i 0 (+ i 1))) ((>= 0 i)) (display i))") + " do: do is a no-op because (>= 0 i) is true at the start: (do ((i 0 (+ i 1))) ((>= 0 i)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((= i 1)) (display i))" " do: do is unnecessary: (do ((i 0 (+ i 1))) ((= i 1)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((= 1 i)) (display i))" " do: do is unnecessary: (do ((i 0 (+ i 1))) ((= 1 i)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((= i len)) (string-set! s i #\\a))" @@ -97496,8 +97455,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 (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))") + (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))") ;; 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)))" @@ -97525,20 +97484,23 @@ etc (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: 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: f14 is the same as f11 (line 0)") + f14: f14 is the same as f11") (lint-test "(let () (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) (define (f14 x y) (if (positive? x) (+ x y) y)) (+ (f11 1 2) (f14 1 2)))" - " let: perhaps embed f14: - (let () (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b))... -> - (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y)))) - let: the inner function f12 could be moved to f11's closure: - (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) -> - (define f11 (let () (define (f12 a b) (if (positive? a) (+ a b) b)) (lambda (a b) ...))) - let: perhaps (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) -> - (define (f11 a b) (if (positive? a) (+ a b) b)) - f14: f14 is the same as f12 (line 1)") + " let (line 3): perhaps embed f14: + (let () (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b))... -> + (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y)))) + let (line 1): the inner function f12 could be moved to f11's closure: + (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) -> + (define f11 (let () + (define (f12 a b) (if (positive? a) (+ a b) b)) + (lambda (a b)...))) + let (line 1): perhaps + (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) -> + (define (f11 a b) (if (positive? a) (+ a b) b)) + f14 (line 2): f14 is the same as f12 (line 1)") (lint-test "(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 y x) (if (positive? x) (+ x y) y)) @@ -98057,8 +98019,8 @@ etc 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") ;; 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 abs 3)" " top-level redefinition of built-in function abs: (define abs 3)") + (lint-test "(define* (abs (ab 1)) (+ ab 1))" " top-level 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)") @@ -98731,7 +98693,7 @@ etc 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 1.0+nan.0i) is already a constant, defined: (random-state->list -) + func: + in (define-macro* + (list ()) '(x 1) :hi 1.0+nan.0i) is already a constant, defined (random-state->list -) func: (define-macro* + (list ()) '(x 1) :hi 1.0+nan.0i) is messed up func: + not used, initially: (random-state->list -) from define-constant") (lint-test "(define (func x) (if (arity (apply +)) (caaadr /) (begin .. when `((x . 1)) . 0/0+0/0i)))" @@ -98876,13 +98838,16 @@ etc (let ((sl (string-length obj))) (+ (if (> sl 0) (hashfn obj) seed) (if (> sl 1) (hashfn obj) seed)))) ((else #f))))))) ...)") + (let-temporarily ((*report-combinable-lets* #f)) + (lint-test "(define (f) (let ((div 0)) (do ((i 0 (+ i 1))) ((= i div)) (display i))))" "")) + ; TODO: -; (lint-test "(and (string? x) (= (length x) 0))" "") ; " and (line 0): perhaps (assuming x is a list), (= (length x) 0) -> (null? x) which is ridiculous +; (lint-test "(and (string? x) (= (length x) 0))" "") ; " and: perhaps (assuming x is a list), (= (length x) 0) -> (null? x) which is ridiculous ; (lint-test "(and (vector? x) (zero? (length x)))" "") ; same as above, should be -> (equal? x #()) ; (lint-test "(and (list? x) (= 0 (length x)))" "") ; same as above (so the parenthetical remark is ridiculous) -; (lint-test "(and (list? x) (> (length x) 0))" "") ; " and (line 0): perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x) -; (lint-test "(or (list? x) (> (length x) 0))" "") ; " or (line 0): perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x) +; (lint-test "(and (list? x) (> (length x) 0))" "") ; " and: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x) +; (lint-test "(or (list? x) (> (length x) 0))" "") ; " or: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x) ; (lint-test "(if (integer? x) (rational? x))" "") ; -> (or (integer? x) #<unspecified>)?? #| @@ -99896,7 +99861,7 @@ but I think we get NaN's implicitly and s7_make_real does not check |# #| -;;; this hits the 32-bit wrap-around symbol_ctr bug: +;;; this hits the (old) 32-bit wrap-around symbol_ctr bug: (let ((xxxxx 1)) xxxxx) (define (f size) (do ((i 0 (+ i 1))) ((= i size)) (tree-set-memq '(y) '(1 2)))) (define (G z) (f z)) @@ -335,12 +335,11 @@ (do ((k 0 (+ k 1)) (j 1 (+ j 1))) ((= j tractlength)) - (begin - (set! tk tj) - (if (zero? (float-vector-ref radii j)) - (set! tj 1e-10) - (set! tj (* (float-vector-ref radii k) (float-vector-ref radii k)))) - (float-vector-set! coeffs j (/ (- tk tj) (+ tk tj)))))) + (set! tk tj) + (if (zero? (float-vector-ref radii j)) + (set! tj 1e-10) + (set! tj (* (float-vector-ref radii k) (float-vector-ref radii k)))) + (float-vector-set! coeffs j (/ (- tk tj) (+ tk tj))))) (set! glot-refl-gain (radii tractlength-1)) (set! lip-refl-gain (radii tractlength)) @@ -5983,19 +5983,18 @@ frequency whistles leaking through." 17827, 17837, 17839, 17851, 17863}; #endif - static mus_float_t all_mins[128] = {1.0000, 1.7600, 1.9797, 2.0390, 2.3435, 2.5493, 2.6394, 2.7946, 2.9617, 3.1023, 3.2180, 3.3887, 3.5241, 3.6122, 3.7680, 3.8738, 3.9802, 4.1438, 4.2210, 4.2890, 4.4824, 4.5866, 4.6052, 4.7280, 4.8531, 5.0050, 5.0640, 5.1573, 5.2413, 5.3623, 5.4800, 5.5259, 5.6320, 5.7167, 5.7648, 5.8770, 5.9291, 6.0764, 6.1247, 6.2388, 6.3296, 6.4351, 6.4755, 6.5454, 6.6312, 6.6921, 6.7592, 6.8630, 6.9144, 7.0054, 7.0637, 7.1368, 7.1997, 7.2564, 7.3299, 7.3515, 7.4959, 7.5862, 7.6389, 7.6004, 7.7602, 7.7988, 7.8838, 7.9463, 8.0038, 8.0641, 8.1270, 8.1759, 8.2203, 8.1858, 8.3294, 8.4352, 8.4355, 8.5093, 8.6129, 8.6292, 8.7018, 8.7310, 8.8164, 8.8399, 8.9113, 8.9487, 8.9469, 9.0279, 9.1400, 9.2143, 9.2076, 9.3188, 9.3608, 9.4148, 9.4762, 9.5310, 9.4369, 9.6238, 9.6045, 9.7150, 9.8146, 9.7808, 9.8684, 9.9374, 9.9893, 10.0292, 10.0825, 10.1311, 10.1809, 10.2348, 10.2757, 10.3212, 10.4394, 10.4438, 10.4982, 10.4710, 10.6004, 10.5194, 10.6682, 10.6756, 10.7494, 10.7909, 10.8383, 10.8805, 10.9294, 10.9655, 11.0898, 11.0638, 11.1608, 11.1455, 11.1939, 11.3092}; + static mus_float_t all_mins[128] = {1.0000, 1.7600, 1.9797, 2.0390, 2.3435, 2.5493, 2.6394, 2.7946, 2.9617, 3.1023, 3.2180, 3.3887, 3.5241, 3.6122, 3.7680, 3.8738, 3.9802, 4.1397, 4.2182, 4.2880, 4.4425, 4.5399, 4.6037, 4.7280, 4.8529, 4.9819, 5.0640, 5.1567, 5.2413, 5.3613, 5.4531, 5.5256, 5.6085, 5.7151, 5.7615, 5.8717, 5.9181, 6.0558, 6.1236, 6.2239, 6.2785, 6.3741, 6.4746, 6.5441, 6.6127, 6.6910, 6.7566, 6.8041, 6.8716, 6.9660, 6.9718, 7.1018, 7.1684, 7.2456, 7.3000, 7.3494, 7.4415, 7.4714, 7.4694, 7.5887, 7.7185, 7.7918, 7.7927, 7.8504, 7.9354, 8.0115, 8.0440, 8.1314, 8.1403, 8.1770, 8.2913, 8.3678, 8.3715, 8.4685, 8.5124, 8.5666, 8.6559, 8.7132, 8.7674, 8.8316, 8.7973, 8.8502, 8.9350, 9.0232, 9.0499, 9.1449, 9.1879, 9.2434, 9.3155, 9.3693, 9.4066, 9.4199, 9.4126, 9.5437, 9.5949, 9.6988, 9.7336, 9.7670, 9.8274, 9.8281, 9.9219, 9.9997, 9.9365, 10.0175, 10.0636, 10.1795, 10.2507, 10.3130, 10.3161, 10.3845, 10.4435, 10.4596, 10.5332, 10.5179, 10.6217, 10.6669, 10.7403, 10.7900, 10.8359, 10.8779, 10.9249, 10.9498, 11.0161, 11.0603, 11.1055, 11.1455, 11.1761, 11.2104}; - static mus_float_t odd_mins[128] = {1.0000, 1.5390, 1.7387, 2.0452, 2.3073, 2.5227, 2.6183, 2.7907, 2.8862, 3.0534, 3.1766, 3.3619, 3.4745, 3.5985, 3.7384, 3.8570, 3.9264, 4.0695, 4.1719, 4.3580, 4.4485, 4.5810, 4.6616, 4.7864, 4.8868, 5.0064, 5.0888, 5.0889, 5.2634, 5.3531, 5.4189, 5.5633, 5.6030, 5.7405, 5.8333, 5.9776, 6.0191, 6.1443, 6.1815, 6.2725, 6.3216, 6.4032, 6.4742, 6.5992, 6.6249, 6.7092, 6.7852, 6.8280, 6.9896, 6.9471, 7.0877, 7.0801, 7.2526, 7.3281, 7.3642, 7.4191, 7.4889, 7.5859, 7.6178, 7.6996, 7.7755, 7.8170, 7.9041, 7.9574, 8.0418, 8.0952, 8.1280, 8.2044, 8.2749, 8.3285, 8.4066, 8.3664, 8.5147, 8.4879, 8.6495, 8.6513, 8.7070, 8.7153, 8.8646, 8.8701, 8.9263, 8.8955, 9.0607, 9.1335, 9.1729, 9.2133, 9.3199, 9.3240, 9.3316, 9.4217, 9.4566, 9.5527, 9.6288, 9.6539, 9.7169, 9.7594, 9.8323, 9.8526, 9.9278, 9.9678, 9.9646, 10.0458, 10.1025, 10.1685, 10.1158, 10.1983, 10.2960, 10.3255, 10.4140, 10.4081, 10.5889, 10.5826, 10.5864, 10.6208, 10.6743, 10.7333, 10.7833, 10.8122, 10.9166, 10.9086, 11.0006, 11.0363, 11.1211, 11.1342, 11.1221, 11.2224, 11.2680, 11.2612}; + static mus_float_t odd_mins[128] = {1.0000, 1.5390, 1.7387, 2.0452, 2.3073, 2.5227, 2.6183, 2.7907, 2.8862, 3.0534, 3.1766, 3.3619, 3.4745, 3.5985, 3.7384, 3.8570, 3.9264, 4.0695, 4.1719, 4.3004, 4.3988, 4.5190, 4.6344, 4.7830, 4.8336, 4.9967, 5.0854, 5.0889, 5.2573, 5.3526, 5.4189, 5.5543, 5.5967, 5.7260, 5.8007, 5.9555, 5.9587, 6.0708, 6.1678, 6.2652, 6.3216, 6.4032, 6.4742, 6.5992, 6.6249, 6.7092, 6.7852, 6.8280, 6.9858, 6.9471, 7.0877, 7.0801, 7.2526, 7.3281, 7.3642, 7.4191, 7.4889, 7.5859, 7.6178, 7.6996, 7.7755, 7.8170, 7.9041, 7.9574, 8.0409, 8.0952, 8.1280, 8.2044, 8.2749, 8.3285, 8.3835, 8.3664, 8.5147, 8.4879, 8.6207, 8.6513, 8.7070, 8.7153, 8.8646, 8.8701, 8.9263, 8.8955, 9.0607, 9.1335, 9.1729, 9.2133, 9.3170, 9.3240, 9.3316, 9.4217, 9.4566, 9.5527, 9.6288, 9.6539, 9.7169, 9.7594, 9.8323, 9.8526, 9.9278, 9.9678, 9.9646, 10.0458, 10.1025, 10.1685, 10.1158, 10.1983, 10.2960, 10.3255, 10.4140, 10.4081, 10.4171, 10.5820, 10.5864, 10.6208, 10.6743, 10.7333, 10.7833, 10.8122, 10.8155, 10.9086, 10.9649, 11.0108, 11.0879, 11.1203, 11.1221, 11.2172, 11.2677, 11.2612}; - static mus_float_t prime_mins[128] = {1.0000, 1.7600, 1.9798, 2.1921, 2.4768, 2.8054, 3.0618, 3.2628, 3.3822, 3.6019, 3.7784, 3.9359, 4.1545, 4.3244, 4.4669, 4.6015, 4.7191, 4.8554, 5.0150, 5.1886, 5.3250, 5.4444, 5.5636, 5.6457, 5.8110, 6.0603, 6.1342, 6.1909, 6.3650, 6.4518, 6.7015, 6.8403, 6.8471, 6.9918, 7.1647, 7.2743, 7.2923, 7.3972, 7.4571, 7.7036, 7.8670, 7.9689, 8.0462, 8.1786, 8.1587, 8.2656, 8.4225, 8.4701, 8.6383, 8.6779, 8.6547, 8.8203, 8.9537, 9.1135, 9.1486, 9.4076, 9.5698, 9.4963, 9.4489, 9.6577, 9.8482, 9.7939, 9.7212, 9.9180, 10.2494, 10.2168, 10.3295, 10.4019, 10.4139, 10.4406, 10.5788, 10.5922, 10.7617, 10.7115, 11.0223, 11.0723, 10.8825, 11.1288, 11.2266, 11.4514, 11.5009, 11.4800, 11.5157, 11.5609, 11.6403, 11.5250, 11.9270, 11.9889, 12.2189, 12.0405, 12.1250, 12.1239, 12.3234, 12.3723, 12.5103, 12.6686, 12.6382, 12.8988, 13.0893, 13.1158, 13.0683, 13.3991, 13.4243, 13.1969, 13.1439, 13.2161, 13.5618, 13.6628, 13.6943, 13.7797, 13.7655, 13.8646, 14.0364, 14.2144, 14.1698, 14.4672, 14.6007, 14.5453, 14.3907, 14.5061, 14.5506, 14.8452, 14.6063, 14.8769, 14.7724, 14.9200, 14.9658, 14.6466}; + static mus_float_t prime_mins[128] = {1.0000, 1.7600, 1.9798, 2.1921, 2.4768, 2.8054, 3.0618, 3.2628, 3.3822, 3.6019, 3.7784, 3.9359, 4.1545, 4.3244, 4.4659, 4.6003, 4.7186, 4.8551, 4.9988, 5.1826, 5.3236, 5.4336, 5.5623, 5.6422, 5.8108, 6.0560, 6.1340, 6.1909, 6.3650, 6.4518, 6.6155, 6.7719, 6.8464, 6.9912, 7.1636, 7.1869, 7.2910, 7.3959, 7.4521, 7.5274, 7.7192, 7.8634, 7.9364, 8.0652, 8.1549, 8.2605, 8.2472, 8.4681, 8.5828, 8.6759, 8.6516, 8.8175, 8.9482, 8.9955, 9.1430, 9.1118, 9.2168, 9.4251, 9.4178, 9.5291, 9.5971, 9.6970, 9.6932, 9.9049, 10.0313, 10.0406, 10.2660, 10.2616, 10.3583, 10.3621, 10.4075, 10.4970, 10.4247, 10.6460, 10.7289, 10.7732, 10.7871, 10.9786, 10.9996, 11.1246, 11.3109, 11.3865, 11.4001, 11.4872, 11.5705, 11.4640, 11.5865, 11.7792, 11.7172, 11.9121, 12.0055, 11.8779, 11.9314, 12.0399, 12.0860, 12.1999, 12.2938, 12.3727, 12.5774, 12.5080, 12.3999, 12.5091, 12.6727, 12.8169, 12.9165, 12.7944, 12.9882, 12.9496, 13.0181, 13.0735, 13.3043, 13.4320, 13.3789, 13.4760, 13.4814, 13.6086, 13.6802, 13.8100, 13.7456, 13.7572, 13.8806, 13.9065, 13.9862, 14.1155, 14.1096, 14.1161, 14.0378, 14.2402}; - static mus_float_t even_mins[128] = {1.0000, 1.7602, 2.0215, 2.4306, 2.6048, 2.8370, 3.0470, 3.1975, 3.4540, 3.5587, 3.6561, 3.7869, 3.9726, 4.0967, 4.1921, 4.3250, 4.4630, 4.5694, 4.7415, 4.8395, 4.9197, 5.0552, 5.1479, 5.2532, 5.4032, 5.4523, 5.6204, 5.7317, 5.7663, 5.9070, 5.9878, 6.0611, 6.1626, 6.2228, 6.3623, 6.4321, 6.5805, 6.5366, 6.6832, 6.7481, 6.8810, 6.9415, 7.0552, 7.0483, 7.1652, 7.2760, 7.2926, 7.4670, 7.5877, 7.6224, 7.6548, 7.7863, 7.7505, 7.8451, 8.0075, 8.0420, 8.1156, 8.1027, 8.1945, 8.3124, 8.3566, 8.3910, 8.4139, 8.5009, 8.6650, 8.7856, 8.8244, 8.7974, 8.8704, 9.0010, 9.0999, 8.9855, 9.1604, 9.2507, 9.2084, 9.3920, 9.3628, 9.3359, 9.5324, 9.5713, 9.5437, 9.6632, 9.7525, 9.7487, 9.6937, 9.8045, 9.8747, 9.9683, 10.1103, 10.2395, 10.1678, 10.2333, 10.1208, 10.4354, 10.4453, 10.5480, 10.4547, 10.5295, 10.4140, 10.4721, 10.7995, 10.8253, 10.8315, 10.7829, 10.9236, 10.9172, 10.9844, 11.0254, 11.0804, 11.2647, 11.3526, 11.2728, 11.1978, 11.3362, 11.3367, 11.5548, 11.3673, 11.5805, 11.6248, 11.7167, 11.5799, 11.7805, 11.7526, 11.8398, 11.8194, 11.9815, 11.8908, 11.9243}; - - static mus_float_t min_8[4] = {16.2329, 17.2610, 18.0460, 23.9548}; - static mus_float_t min_9[4] = {24.1124, 24.0647, 25.2901, 38.6029}; - static mus_float_t min_10[4] = {34.3800, 35.3998, 35.8426, 65.3493}; - static mus_float_t min_11[4] = {51.4838, 50.4877, 51.3446, 95.9043}; + static mus_float_t even_mins[128] = {1.0000, 1.7602, 2.0215, 2.4306, 2.6048, 2.8370, 3.0470, 3.1975, 3.4540, 3.5587, 3.6561, 3.7869, 3.9726, 4.0967, 4.1921, 4.3250, 4.4630, 4.5694, 4.7415, 4.8395, 4.9197, 5.0552, 5.1479, 5.2532, 5.4032, 5.4523, 5.6204, 5.7317, 5.7663, 5.9070, 5.9878, 6.0611, 6.1619, 6.2228, 6.3617, 6.4316, 6.5302, 6.5360, 6.6802, 6.7476, 6.8804, 6.9400, 7.0517, 7.0391, 7.1643, 7.2740, 7.2898, 7.3923, 7.5290, 7.5471, 7.5686, 7.7050, 7.7478, 7.8429, 7.8878, 7.9747, 7.9655, 8.1007, 8.1919, 8.2950, 8.2268, 8.3868, 8.4105, 8.4885, 8.5672, 8.6324, 8.6805, 8.7377, 8.8613, 8.7383, 8.8715, 8.9661, 8.9989, 9.0897, 9.1223, 9.2670, 9.2587, 9.3283, 9.3569, 9.4514, 9.4842, 9.4971, 9.5274, 9.6148, 9.6764, 9.7580, 9.8338, 9.7183, 9.9973, 10.0054, 10.0428, 10.0938, 10.0656, 10.1228, 10.2691, 10.2410, 10.3316, 10.4691, 10.3878, 10.4419, 10.5743, 10.5388, 10.6377, 10.6556, 10.7237, 10.8126, 10.8718, 10.9019, 10.9585, 11.0599, 10.9622, 11.1279, 11.0422, 11.0983, 11.1109, 11.2778, 11.2957, 11.4305, 11.4631, 11.3135, 11.4986, 11.5297, 11.5885, 11.6136, 11.6968, 11.7032, 11.7900, 11.8302}; + static mus_float_t min_8[4] = {15.9975, 16.2419, 16.8959, 23.9548}; + static mus_float_t min_9[4] = {23.1900, 23.5159, 24.5104, 38.6029}; + static mus_float_t min_10[4] = {33.0298, 33.7318, 34.4867, 65.3493}; + static mus_float_t min_11[4] = {48.9126, 48.2271, 50.8873, 95.9043}; #define USE_CLM_RANDOM (!HAVE_SCHEME) @@ -6058,6 +6057,25 @@ static mus_float_t saved_min(int ch, int nn) return((mus_float_t)nn); } +static mus_float_t set_saved_min(int ch, int nn, mus_float_t new_val) +{ + if (nn <= 128) + { + switch (ch) + { + case ALL: all_mins[nn - 1] = new_val; break; + case ODD: odd_mins[nn - 1] = new_val; break; + case EVEN: even_mins[nn - 1] = new_val; break; + case PRIME: prime_mins[nn - 1] = new_val; break; + } + } + if (nn == 256) min_8[ch] = new_val; + if (nn == 512) min_9[ch] = new_val; + if (nn == 1024) min_10[ch] = new_val; + if (nn == 2048) min_11[ch] = new_val; + return((mus_float_t)nn); +} + static mus_float_t get_peak(int choice, int fft_size, int n, mus_float_t *phases, mus_float_t *rl, mus_float_t *im) { @@ -6127,7 +6145,7 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm pk_data **choices = NULL, **free_choices = NULL; mus_float_t *rl, *im; const char *file = NULL; - bool just_best = false; + bool just_best; #ifndef _MSC_VER { @@ -6169,9 +6187,10 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm min_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t)); overall_min = saved_min(choice, n); +#if 0 if (overall_min < sqrt((double)n)) overall_min = sqrt((double)n); overall_min += .5; - +#endif temp_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t)); diff_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t)); @@ -6248,6 +6267,7 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm fprintf(ofile, "%f)\n", min_phases[n - 1]); if (file) fclose(ofile); overall_min = pk; + set_saved_min(choice, n, pk); } } } @@ -6357,6 +6377,7 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm fprintf(ofile, "%f)\n", min_phases[llen - 1]); if (file) fclose(ofile); overall_min = pk; + set_saved_min(choice, llen, pk); } } diff --git a/snd-test.scm b/snd-test.scm index 4d0e67a..45581d8 100644 --- a/snd-test.scm +++ b/snd-test.scm @@ -19906,11 +19906,19 @@ EDITS: 2 (for-each (lambda (arg1) ;; how did this ever work?? - (catch #t (lambda () (runp gen arg1)) (lambda args (car args))) - (for-each - (lambda (arg2) - (catch #t (lambda () (runp gen arg1 arg2)) (lambda args (car args)))) - a1)) + (catch #t + (lambda () + (runp gen arg1) + (for-each + (lambda (arg2) + (catch #t + (lambda () + (runp gen arg1 arg2)) + (lambda args + (car args)))) + a1)) + (lambda args + (car args)))) a2) ;; generic args @@ -1,5 +1,5 @@ /* Snd help index (generated by make-index.scm) */ -#define HELP_NAMES_SIZE 1598 +#define HELP_NAMES_SIZE 1600 #if HAVE_SCHEME || HAVE_FORTH static const char *help_names[HELP_NAMES_SIZE] = { "*#readers*", "abcos", "abcos?", "abort", "absin", "absin?", @@ -188,87 +188,87 @@ static const char *help_names[HELP_NAMES_SIZE] = { "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-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", - "setter", "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", - "signature", "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", "subvector", "subvector-position", "subvector-vector", - "subvector?", "superimpose-ffts", "swap-channels", "swap-selection-channels", "symbol->dynamic-value", "symbol->value", - "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", "tree-count", "tree-cyclic?", "tree-leaves", "tree-memq", - "tree-set-memq", "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", "weak-hash-table", "weak-hash-table?", - "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"}; + "polyshape?", "polywave", "polywave?", "port-file", "port-filename", "port-line-number", + "port-position", "position->x", "position->y", "position-color", "power-env", "pqw", + "pqw-vox", "preferences-dialog", "previous-sample", "print-dialog", "print-length", "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", "setter", "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", "signature", "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", "subvector", + "subvector-position", "subvector-vector", "subvector?", "superimpose-ffts", "swap-channels", "swap-selection-channels", + "symbol->dynamic-value", "symbol->value", "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", "tree-count", "tree-cyclic?", + "tree-leaves", "tree-memq", "tree-set-memq", "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", + "weak-hash-table", "weak-hash-table?", "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] = { @@ -458,87 +458,87 @@ static const char *help_names[HELP_NAMES_SIZE] = { "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_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", - "setter", "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", - "signature", "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", "subvector", "subvector_position", "subvector_vector", - "subvector?", "superimpose_ffts", "swap_channels", "swap_selection_channels", "symbol2dynamic_value", "symbol2value", - "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", "tree_count", "tree_cyclic?", "tree_leaves", "tree_memq", - "tree_set_memq", "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", "weak_hash_table", "weak_hash_table?", - "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"}; + "polyshape?", "polywave", "polywave?", "port_file", "port_filename", "port_line_number", + "port_position", "position2x", "position2y", "position_color", "power_env", "pqw", + "pqw_vox", "preferences_dialog", "previous_sample", "print_dialog", "print_length", "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", "setter", "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", "signature", "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", "subvector", + "subvector_position", "subvector_vector", "subvector?", "superimpose_ffts", "swap_channels", "swap_selection_channels", + "symbol2dynamic_value", "symbol2value", "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", "tree_count", "tree_cyclic?", + "tree_leaves", "tree_memq", "tree_set_memq", "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", + "weak_hash_table", "weak_hash_table?", "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; @@ -823,127 +823,127 @@ static const char *help_urls[HELP_NAMES_SIZE] = { "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#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", - "s7.html#setter", "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", "s7.html#signature", "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", "s7.html#subvector", - "s7.html#subvectorposition", "s7.html#subvectorvector", "s7.html#subvectorp", "sndscm.html#superimposeffts", - "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels", "s7.html#symboltodynamicvalue", "s7.html#symboltovalue", - "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", "s7.html#treecount", "s7.html#treecyclic", - "s7.html#treeleaves", "s7.html#treememq", "s7.html#treesetmemq", "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", - "sndscm.html#singerdoc", "sndscm.html#voicedtounvoiced", "sndscm.html#volterrafilter", "sndscm.html#fmvox", - "sndclm.html#wave-train", "sndclm.html#wave-train?", "extsnd.html#wavelettype", "sndscm.html#pqwvox", - "extsnd.html#wavohop", "extsnd.html#wavotrace", "s7.html#weakhashtable", "s7.html#weakhashtablep", - "sndclm.html#weighted-moving-average", "extsnd.html#widgetposition", "extsnd.html#widgetsize", "extsnd.html#widgettext", - "extsnd.html#windowheight", "sndscm.html#windowsamples", "extsnd.html#windowwidth", "extsnd.html#windowx", - "extsnd.html#windowy", "extsnd.html#withbackgroundprocesses", "s7.html#withbaffle", "extsnd.html#withfilemonitor", - "extsnd.html#withgl", "extsnd.html#withinsetgraph", "extsnd.html#withinterrupts", "s7.html#with-let", - "sndscm.html#withlocalhook", "extsnd.html#withmenuicons", "extsnd.html#withmixtags", "extsnd.html#withpointerfocus", - "extsnd.html#withrelativepanes", "extsnd.html#withsmptelabel", "sndscm.html#withsound", "sndscm.html#withtemporaryselection", - "extsnd.html#withtoolbar", "extsnd.html#withtooltips", "extsnd.html#withtrackingcursor", "extsnd.html#withverbosecursor", - "extsnd.html#xtoposition", "extsnd.html#xaxislabel", "extsnd.html#xaxisstyle", "extsnd.html#xbounds", - "extsnd.html#xpositionslider", "extsnd.html#xzoomslider", "sndscm.html#xbopen", "extsnd.html#xrampchannel", - "extsnd.html#ytoposition", "extsnd.html#yaxislabel", "extsnd.html#ybounds", "extsnd.html#ypositionslider", - "extsnd.html#yzoomslider", "sndscm.html#ztransform", "sndscm.html#zecho", "sndscm.html#zeroplus", - "extsnd.html#zeropad", "sndscm.html#zerophase", "sndscm.html#zipsound", "sndscm.html#zipper", - "extsnd.html#zoomcolor", "extsnd.html#zoomfocusstyle"}; + "sndclm.html#polyshape?", "sndclm.html#polywave", "sndclm.html#polywave?", "s7.html#portfile", + "s7.html#portfilename", "s7.html#portlinenumber", "s7.html#portposition", "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#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", "s7.html#setter", "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", + "s7.html#signature", "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", "s7.html#subvector", "s7.html#subvectorposition", "s7.html#subvectorvector", + "s7.html#subvectorp", "sndscm.html#superimposeffts", "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels", + "s7.html#symboltodynamicvalue", "s7.html#symboltovalue", "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", + "s7.html#treecount", "s7.html#treecyclic", "s7.html#treeleaves", "s7.html#treememq", + "s7.html#treesetmemq", "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", "sndscm.html#singerdoc", "sndscm.html#voicedtounvoiced", + "sndscm.html#volterrafilter", "sndscm.html#fmvox", "sndclm.html#wave-train", "sndclm.html#wave-train?", + "extsnd.html#wavelettype", "sndscm.html#pqwvox", "extsnd.html#wavohop", "extsnd.html#wavotrace", + "s7.html#weakhashtable", "s7.html#weakhashtablep", "sndclm.html#weighted-moving-average", "extsnd.html#widgetposition", + "extsnd.html#widgetsize", "extsnd.html#widgettext", "extsnd.html#windowheight", "sndscm.html#windowsamples", + "extsnd.html#windowwidth", "extsnd.html#windowx", "extsnd.html#windowy", "extsnd.html#withbackgroundprocesses", + "s7.html#withbaffle", "extsnd.html#withfilemonitor", "extsnd.html#withgl", "extsnd.html#withinsetgraph", + "extsnd.html#withinterrupts", "s7.html#with-let", "sndscm.html#withlocalhook", "extsnd.html#withmenuicons", + "extsnd.html#withmixtags", "extsnd.html#withpointerfocus", "extsnd.html#withrelativepanes", "extsnd.html#withsmptelabel", + "sndscm.html#withsound", "sndscm.html#withtemporaryselection", "extsnd.html#withtoolbar", "extsnd.html#withtooltips", + "extsnd.html#withtrackingcursor", "extsnd.html#withverbosecursor", "extsnd.html#xtoposition", "extsnd.html#xaxislabel", + "extsnd.html#xaxisstyle", "extsnd.html#xbounds", "extsnd.html#xpositionslider", "extsnd.html#xzoomslider", + "sndscm.html#xbopen", "extsnd.html#xrampchannel", "extsnd.html#ytoposition", "extsnd.html#yaxislabel", + "extsnd.html#ybounds", "extsnd.html#ypositionslider", "extsnd.html#yzoomslider", "sndscm.html#ztransform", + "sndscm.html#zecho", "sndscm.html#zeroplus", "extsnd.html#zeropad", "sndscm.html#zerophase", + "sndscm.html#zipsound", "sndscm.html#zipper", "extsnd.html#zoomcolor", "extsnd.html#zoomfocusstyle"}; static const char *Tracking_cursors_xrefs[] = { "play from the current cursor position with a tracking cursor: {pfc}", @@ -1758,7 +1758,7 @@ static const char *Reverb_urls[] = { #if HAVE_SCHEME -static const char *snd_names[11720] = { +static const char *snd_names[11718] = { "*clm-array-print-length*", "ws.scm", "*clm-channels*", "ws.scm", "*clm-clipped*", "ws.scm", @@ -3716,7 +3716,6 @@ static const char *snd_names[11720] = { "butterworth-prototype", "analog-filter.scm", "byte", "stuff.scm", "bytevector->list", "r7rs.scm", - "bytevector-append", "r7rs.scm", "bytevector-copy", "r7rs.scm", "bytevector-copy!", "r7rs.scm", "bytevector-length", "r7rs.scm", @@ -6933,6 +6932,7 @@ static const char *snd_names[11720] = { "pretty-print", "write.scm", "previous-phrase", "spokenword.scm", "primes.scm", "primes.scm", + "profile.scm", "profile.scm", "progv", "stuff.scm", "protoent.p_aliases", "libc.scm", "protoent.p_name", "libc.scm", @@ -7122,7 +7122,6 @@ static const char *snd_names[11720] = { "send", "libc.scm", "sendmsg", "libc.scm", "sendto", "libc.scm", - "sequence->string", "stuff.scm", "sequences->list", "stuff.scm", "servent.s_aliases", "libc.scm", "servent.s_name", "libc.scm", @@ -7623,7 +7622,7 @@ static const char *snd_names[11720] = { static void autoload_info(s7_scheme *sc) { - s7_autoload_set_names(sc, snd_names, 5860); + s7_autoload_set_names(sc, snd_names, 5859); } #endif @@ -55,11 +55,11 @@ #include "snd-strings.h" -#define SND_DATE "11-Mar-19" +#define SND_DATE "15-Apr-19" #ifndef SND_VERSION -#define SND_VERSION "19.2" +#define SND_VERSION "19.3" #endif #define SND_MAJOR_VERSION "19" -#define SND_MINOR_VERSION "2" +#define SND_MINOR_VERSION "3" #endif diff --git a/sndscm.html b/sndscm.html index 144c4ac..482f99f 100644 --- a/sndscm.html +++ b/sndscm.html @@ -8675,12 +8675,12 @@ of harmonics, then the minimum peak amplitude, then (log peak n). ============================================================================================= 20 4.288 0.4860 | 11 3.177 0.4820 | 120 11.314 0.5067 | 24 5.642 0.5444 -14 3.612 0.4867 | 9 2.886 0.4824 | 115 11.111 0.5075 | 101 12.400 0.5455 -23 4.604 0.4870 | 17 3.926 0.4827 | 88 9.718 0.5079 | 127 14.084 0.5460 +14 3.612 0.4867 | 9 2.886 0.4824 | 115 11.111 0.5075 | 127 14.038 0.5453 +23 4.604 0.4870 | 17 3.926 0.4827 | 88 9.718 0.5079 | 101 12.400 0.5455 11 3.218 0.4874 | 10 3.053 0.4848 | 113 11.042 0.5080 | 102 12.509 0.5463 17 3.980 0.4876 | 19 4.172 0.4851 | 114 11.098 0.5082 | 73 10.425 0.5464 16 3.874 0.4884 | 14 3.598 0.4852 | 111 10.962 0.5084 | 19 4.999 0.5465 -24 4.728 0.4888 | 13 3.475 0.4856 | 126 11.703 0.5086 | 106 12.798 0.5467 +24 4.728 0.4888 | 13 3.475 0.4856 | 126 11.703 0.5086 | 106 12.794 0.5466 19 4.218 0.4889 | 18 4.070 0.4856 | 124 11.614 0.5087 | 18 4.855 0.5467 22 4.540 0.4894 | 21 4.399 0.4866 | 122 11.530 0.5089 | 25 5.811 0.5467 21 4.443 0.4898 | 16 3.857 0.4869 | 117 11.296 0.5091 | 110 13.074 0.5469 @@ -8692,84 +8692,84 @@ of harmonics, then the minimum peak amplitude, then (log peak n). 10 3.102 0.4917 | 23 4.634 0.4891 | 125 11.697 0.5094 | 95 12.086 0.5472 29 5.241 0.4920 | 25 4.834 0.4895 | 99 10.388 0.5094 | 92 11.878 0.5473 27 5.064 0.4922 | 31 5.419 0.4921 | 100 10.442 0.5094 | 23 5.562 0.5473 -28 5.157 0.4923 | 24 4.783 0.4925 | 93 10.066 0.5094 | 126 14.125 0.5475 -37 5.918 0.4924 | 33 5.597 0.4925 | 104 10.656 0.5095 | 77 10.787 0.5475 -35 5.762 0.4926 | 29 5.257 0.4929 | 94 10.123 0.5095 | 22 5.434 0.5476 -26 4.982 0.4929 | 30 5.353 0.4932 | 116 11.278 0.5097 | 86 11.464 0.5476 -33 5.608 0.4931 | 27 5.085 0.4935 | 96 10.241 0.5097 | 17 4.719 0.5476 -59 7.469 0.4931 | 8 2.791 0.4935 | 105 10.724 0.5098 | 94 12.040 0.5477 -32 5.526 0.4932 | 26 4.997 0.4938 | 256 16.896 0.5098 | 128 14.265 0.5478 -30 5.361 0.4937 | 37 5.959 0.4943 | 83 9.527 0.5101 | 103 12.673 0.5479 -51 6.972 0.4939 | 35 5.801 0.4945 | 103 10.638 0.5101 | 120 13.784 0.5480 -31 5.453 0.4939 | 7 2.618 0.4946 | 108 10.902 0.5102 | 47 8.247 0.5480 -36 5.872 0.4940 | 32 5.554 0.4947 | 70 8.738 0.5102 | 96 12.200 0.5480 -9 2.962 0.4941 | 34 5.726 0.4948 | 109 10.958 0.5103 | 122 13.913 0.5481 +28 5.157 0.4923 | 24 4.783 0.4925 | 93 10.066 0.5094 | 126 14.116 0.5474 +37 5.918 0.4924 | 33 5.597 0.4925 | 104 10.656 0.5095 | 128 14.240 0.5474 +35 5.762 0.4926 | 29 5.257 0.4929 | 94 10.123 0.5095 | 77 10.787 0.5475 +26 4.982 0.4929 | 30 5.353 0.4932 | 116 11.278 0.5097 | 22 5.434 0.5476 +33 5.608 0.4931 | 27 5.085 0.4935 | 96 10.241 0.5097 | 120 13.757 0.5476 +59 7.469 0.4931 | 8 2.791 0.4935 | 105 10.724 0.5098 | 86 11.464 0.5476 +32 5.526 0.4932 | 26 4.997 0.4938 | 256 16.896 0.5098 | 17 4.719 0.5476 +30 5.361 0.4937 | 37 5.959 0.4943 | 83 9.527 0.5101 | 94 12.040 0.5477 +51 6.972 0.4939 | 35 5.801 0.4945 | 103 10.638 0.5101 | 103 12.673 0.5479 +31 5.453 0.4939 | 7 2.618 0.4946 | 108 10.902 0.5102 | 122 13.907 0.5479 +36 5.872 0.4940 | 32 5.554 0.4947 | 70 8.738 0.5102 | 47 8.247 0.5480 +9 2.962 0.4941 | 34 5.726 0.4948 | 109 10.958 0.5103 | 96 12.200 0.5480 8 2.795 0.4942 | 52 7.080 0.4954 | 119 11.463 0.5104 | 30 6.452 0.5481 -34 5.715 0.4943 | 50 6.947 0.4955 | 97 10.332 0.5105 | 39 7.452 0.5482 -70 8.177 0.4946 | 38 6.071 0.4958 | 106 10.813 0.5105 | 63 9.693 0.5482 -39 6.124 0.4946 | 82 8.895 0.4960 | 112 11.128 0.5106 | 125 14.114 0.5483 -93 9.413 0.4947 | 48 6.828 0.4962 | 107 10.872 0.5106 | 123 13.990 0.5483 -41 6.278 0.4947 | 41 6.322 0.4966 | 118 11.430 0.5107 | 89 11.717 0.5483 -82 8.850 0.4948 | 43 6.474 0.4966 | 1024 34.487 0.5108 | 97 12.294 0.5485 -81 8.797 0.4948 | 39 6.168 0.4966 | 82 9.497 0.5108 | 87 11.587 0.5486 -60 7.589 0.4950 | 72 8.366 0.4967 | 84 9.615 0.5108 | 100 12.508 0.5486 -38 6.056 0.4951 | 45 6.625 0.4967 | 85 9.676 0.5109 | 98 12.373 0.5486 -69 8.140 0.4952 | 42 6.403 0.4968 | 101 10.574 0.5110 | 121 13.890 0.5486 -49 6.872 0.4952 | 74 8.488 0.4969 | 92 10.094 0.5113 | 107 12.988 0.5487 -73 8.372 0.4952 | 78 8.715 0.4970 | 110 11.060 0.5113 | 79 11.000 0.5488 -58 7.471 0.4953 | 46 6.709 0.4972 | 91 10.043 0.5114 | 51 8.652 0.5488 -48 6.804 0.4953 | 105 10.116 0.4972 | 86 9.758 0.5114 | 76 10.773 0.5489 -103 9.936 0.4954 | 47 6.785 0.4973 | 95 10.269 0.5115 | 56 9.112 0.5489 -64 7.850 0.4955 | 40 6.265 0.4974 | 79 9.357 0.5118 | 119 13.796 0.5491 -56 7.349 0.4955 | 89 9.332 0.4976 | 90 10.005 0.5118 | 114 13.476 0.5492 -42 6.374 0.4956 | 111 10.417 0.4976 | 87 9.834 0.5118 | 104 12.817 0.5492 -63 7.793 0.4956 | 56 7.419 0.4979 | 81 9.484 0.5119 | 20 5.183 0.5492 -83 8.935 0.4956 | 36 5.956 0.4979 | 75 9.122 0.5120 | 21 5.324 0.5492 -40 6.224 0.4956 | 106 10.198 0.4980 | 71 8.871 0.5121 | 124 14.124 0.5493 -85 9.050 0.4958 | 59 7.618 0.4980 | 73 8.999 0.5121 | 57 9.217 0.5493 -67 8.044 0.4959 | 57 7.489 0.4980 | 98 10.469 0.5122 | 74 10.646 0.5495 -76 8.567 0.4960 | 91 9.457 0.4981 | 77 9.259 0.5124 | 111 13.304 0.5495 -92 9.420 0.4960 | 51 7.088 0.4981 | 78 9.328 0.5126 | 71 10.407 0.5495 -75 8.512 0.4960 | 80 8.870 0.4981 | 80 9.451 0.5126 | 75 10.729 0.5496 -55 7.300 0.4961 | 81 8.926 0.4981 | 61 8.227 0.5126 | 115 13.571 0.5496 -53 7.168 0.4961 | 101 9.965 0.4982 | 74 9.090 0.5128 | 29 6.365 0.5496 -105 10.064 0.4961 | 119 10.815 0.4982 | 512 24.510 0.5128 | 116 13.640 0.5497 -52 7.102 0.4961 | 77 8.707 0.4982 | 72 8.966 0.5129 | 72 10.497 0.5497 -104 10.017 0.4962 | 76 8.651 0.4982 | 89 9.997 0.5129 | 80 11.125 0.5498 -50 6.966 0.4962 | 62 7.817 0.4982 | 57 7.966 0.5133 | 117 13.720 0.5499 -65 7.935 0.4962 | 55 7.364 0.4982 | 68 8.738 0.5137 | 78 10.979 0.5499 -71 8.291 0.4962 | 67 8.128 0.4983 | 67 8.681 0.5140 | 105 12.929 0.5500 -47 6.757 0.4962 | 110 10.408 0.4984 | 63 8.411 0.5140 | 59 9.418 0.5500 -45 6.613 0.4962 | 90 9.422 0.4985 | 76 9.267 0.5141 | 38 7.396 0.5501 -100 9.828 0.4962 | 60 7.700 0.4985 | 64 8.488 0.5143 | 61 9.597 0.5501 -74 8.468 0.4964 | 86 9.213 0.4985 | 66 8.632 0.5145 | 37 7.291 0.5502 -44 6.544 0.4964 | 108 10.325 0.4986 | 65 8.567 0.5146 | 33 6.846 0.5502 -57 7.441 0.4964 | 44 6.599 0.4986 | 51 7.569 0.5148 | 31 6.616 0.5502 -46 6.691 0.4965 | 88 9.324 0.4986 | 58 8.101 0.5152 | 118 13.810 0.5503 -54 7.246 0.4965 | 64 7.957 0.4987 | 69 8.861 0.5153 | 41 7.719 0.5503 -84 9.023 0.4965 | 83 9.061 0.4988 | 62 8.387 0.5153 | 27 6.134 0.5503 -94 9.544 0.4965 | 68 8.204 0.4988 | 2048 50.887 0.5154 | 70 10.362 0.5504 -95 9.595 0.4966 | 71 8.384 0.4988 | 55 7.888 0.5154 | 36 7.187 0.5504 -43 6.475 0.4966 | 102 10.046 0.4988 | 53 7.748 0.5157 | 113 13.491 0.5504 +34 5.715 0.4943 | 50 6.947 0.4955 | 97 10.332 0.5105 | 125 14.110 0.5482 +70 8.177 0.4946 | 38 6.071 0.4958 | 106 10.813 0.5105 | 123 13.986 0.5482 +39 6.124 0.4946 | 82 8.895 0.4960 | 112 11.128 0.5106 | 115 13.481 0.5482 +93 9.413 0.4947 | 48 6.828 0.4962 | 107 10.872 0.5106 | 39 7.452 0.5482 +41 6.278 0.4947 | 41 6.322 0.4966 | 118 11.430 0.5107 | 63 9.693 0.5482 +82 8.850 0.4948 | 43 6.474 0.4966 | 1024 34.487 0.5108 | 89 11.717 0.5483 +81 8.797 0.4948 | 39 6.168 0.4966 | 82 9.497 0.5108 | 119 13.746 0.5484 +60 7.589 0.4950 | 72 8.366 0.4967 | 84 9.615 0.5108 | 97 12.294 0.5485 +38 6.056 0.4951 | 45 6.625 0.4967 | 85 9.676 0.5109 | 121 13.881 0.5485 +69 8.140 0.4952 | 42 6.403 0.4968 | 101 10.574 0.5110 | 87 11.587 0.5486 +49 6.872 0.4952 | 74 8.488 0.4969 | 92 10.094 0.5113 | 100 12.508 0.5486 +73 8.372 0.4952 | 78 8.715 0.4970 | 110 11.060 0.5113 | 98 12.373 0.5486 +58 7.471 0.4953 | 46 6.709 0.4972 | 91 10.043 0.5114 | 113 13.379 0.5486 +48 6.804 0.4953 | 105 10.116 0.4972 | 86 9.758 0.5114 | 107 12.988 0.5487 +103 9.936 0.4954 | 47 6.785 0.4973 | 95 10.269 0.5115 | 79 11.000 0.5488 +64 7.850 0.4955 | 40 6.265 0.4974 | 79 9.357 0.5118 | 51 8.652 0.5488 +56 7.349 0.4955 | 89 9.332 0.4976 | 90 10.005 0.5118 | 76 10.773 0.5489 +42 6.374 0.4956 | 111 10.417 0.4976 | 87 9.834 0.5118 | 56 9.112 0.5489 +63 7.793 0.4956 | 56 7.419 0.4979 | 81 9.484 0.5119 | 114 13.476 0.5492 +83 8.935 0.4956 | 36 5.956 0.4979 | 75 9.122 0.5120 | 124 14.115 0.5492 +40 6.224 0.4956 | 106 10.198 0.4980 | 71 8.871 0.5121 | 116 13.609 0.5492 +85 9.050 0.4958 | 59 7.618 0.4980 | 73 8.999 0.5121 | 104 12.817 0.5492 +67 8.044 0.4959 | 57 7.489 0.4980 | 98 10.469 0.5122 | 20 5.183 0.5492 +76 8.567 0.4960 | 91 9.457 0.4981 | 77 9.259 0.5124 | 21 5.324 0.5492 +92 9.420 0.4960 | 51 7.088 0.4981 | 78 9.328 0.5126 | 117 13.680 0.5493 +75 8.512 0.4960 | 80 8.870 0.4981 | 80 9.451 0.5126 | 57 9.217 0.5493 +55 7.300 0.4961 | 81 8.926 0.4981 | 61 8.227 0.5126 | 74 10.646 0.5495 +53 7.168 0.4961 | 101 9.965 0.4982 | 74 9.090 0.5128 | 111 13.304 0.5495 +105 10.064 0.4961 | 119 10.815 0.4982 | 512 24.510 0.5128 | 71 10.407 0.5495 +52 7.102 0.4961 | 77 8.707 0.4982 | 72 8.966 0.5129 | 75 10.729 0.5496 +104 10.017 0.4962 | 76 8.651 0.4982 | 89 9.997 0.5129 | 29 6.365 0.5496 +50 6.966 0.4962 | 62 7.817 0.4982 | 57 7.966 0.5133 | 72 10.497 0.5497 +65 7.935 0.4962 | 55 7.364 0.4982 | 68 8.738 0.5137 | 105 12.917 0.5497 +71 8.291 0.4962 | 67 8.128 0.4983 | 67 8.681 0.5140 | 80 11.125 0.5498 +47 6.757 0.4962 | 110 10.408 0.4984 | 63 8.411 0.5140 | 78 10.979 0.5499 +45 6.613 0.4962 | 90 9.422 0.4985 | 76 9.267 0.5141 | 59 9.418 0.5500 +100 9.828 0.4962 | 60 7.700 0.4985 | 64 8.488 0.5143 | 38 7.396 0.5501 +74 8.468 0.4964 | 86 9.213 0.4985 | 66 8.632 0.5145 | 61 9.597 0.5501 +44 6.544 0.4964 | 108 10.325 0.4986 | 65 8.567 0.5146 | 37 7.291 0.5502 +57 7.441 0.4964 | 44 6.599 0.4986 | 51 7.569 0.5148 | 33 6.846 0.5502 +46 6.691 0.4965 | 88 9.324 0.4986 | 58 8.101 0.5152 | 31 6.616 0.5502 +54 7.246 0.4965 | 64 7.957 0.4987 | 69 8.861 0.5153 | 118 13.810 0.5503 +84 9.023 0.4965 | 83 9.061 0.4988 | 62 8.387 0.5153 | 41 7.719 0.5503 +94 9.544 0.4965 | 68 8.204 0.4988 | 2048 50.887 0.5154 | 27 6.134 0.5503 +95 9.595 0.4966 | 71 8.384 0.4988 | 55 7.888 0.5154 | 70 10.362 0.5504 +43 6.475 0.4966 | 102 10.046 0.4988 | 53 7.748 0.5157 | 36 7.187 0.5504 87 9.188 0.4966 | 85 9.173 0.4989 | 44 7.039 0.5157 | 16 4.600 0.5504 66 8.012 0.4967 | 114 10.621 0.4989 | 59 8.192 0.5158 | 62 9.697 0.5505 -68 8.131 0.4967 | 61 7.775 0.4989 | 56 7.975 0.5158 | 66 10.041 0.5506 -88 9.243 0.4967 | 125 11.122 0.4989 | 47 7.290 0.5159 | 90 11.912 0.5506 -72 8.368 0.4967 | 70 8.328 0.4989 | 38 6.536 0.5161 | 60 9.529 0.5506 -114 10.518 0.4968 | 75 8.621 0.4989 | 54 7.843 0.5163 | 54 8.996 0.5507 -77 8.656 0.4969 | 98 9.853 0.4990 | 50 7.547 0.5167 | 83 11.400 0.5507 -86 9.145 0.4969 | 63 7.904 0.4990 | 60 8.295 0.5167 | 43 7.936 0.5507 -79 8.767 0.4969 | 107 10.296 0.4990 | 48 7.392 0.5168 | 88 11.779 0.5508 -91 9.407 0.4969 | 103 10.102 0.4990 | 52 7.705 0.5168 | 112 13.454 0.5509 +68 8.131 0.4967 | 61 7.775 0.4989 | 56 7.975 0.5158 | 112 13.432 0.5505 +88 9.243 0.4967 | 125 11.122 0.4989 | 47 7.290 0.5159 | 66 10.041 0.5506 +72 8.368 0.4967 | 70 8.328 0.4989 | 38 6.536 0.5161 | 90 11.912 0.5506 +114 10.518 0.4968 | 75 8.621 0.4989 | 54 7.843 0.5163 | 60 9.529 0.5506 +77 8.656 0.4969 | 98 9.853 0.4990 | 50 7.547 0.5167 | 54 8.996 0.5507 +86 9.145 0.4969 | 63 7.904 0.4990 | 60 8.295 0.5167 | 83 11.400 0.5507 +79 8.767 0.4969 | 107 10.296 0.4990 | 48 7.392 0.5168 | 43 7.936 0.5507 +91 9.407 0.4969 | 103 10.102 0.4990 | 52 7.705 0.5168 | 88 11.779 0.5508 78 8.713 0.4969 | 118 10.812 0.4990 | 45 7.164 0.5173 | 52 8.817 0.5509 98 9.767 0.4971 | 115 10.674 0.4990 | 40 6.748 0.5176 | 84 11.487 0.5510 80 8.832 0.4971 | 58 7.586 0.4990 | 46 7.274 0.5183 | 91 12.006 0.5510 61 7.718 0.4971 | 128 11.261 0.4990 | 42 6.940 0.5183 | 85 11.571 0.5511 -89 9.316 0.4972 | 53 7.253 0.4990 | 39 6.680 0.5184 | 45 8.155 0.5513 -101 9.922 0.4972 | 94 9.654 0.4991 | 34 6.223 0.5184 | 64 9.905 0.5514 -90 9.369 0.4972 | 69 8.275 0.4991 | 49 7.529 0.5187 | 12 3.936 0.5514 -99 9.827 0.4973 | 92 9.553 0.4991 | 43 7.052 0.5193 | 34 6.991 0.5515 -97 9.734 0.4974 | 120 10.909 0.4991 | 41 6.880 0.5194 | 99 12.604 0.5515 +89 9.316 0.4972 | 53 7.253 0.4990 | 39 6.680 0.5184 | 99 12.590 0.5512 +101 9.922 0.4972 | 94 9.654 0.4991 | 34 6.223 0.5184 | 45 8.155 0.5513 +90 9.369 0.4972 | 69 8.275 0.4991 | 49 7.529 0.5187 | 64 9.905 0.5514 +99 9.827 0.4973 | 92 9.553 0.4991 | 43 7.052 0.5193 | 12 3.936 0.5514 +97 9.734 0.4974 | 120 10.909 0.4991 | 41 6.880 0.5194 | 34 6.991 0.5515 109 10.316 0.4974 | 113 10.586 0.4991 | 36 6.432 0.5194 | 46 8.260 0.5515 62 7.792 0.4975 | 96 9.759 0.4991 | 37 6.530 0.5197 | 44 8.065 0.5517 112 10.460 0.4975 | 66 8.095 0.4992 | 32 6.061 0.5199 | 42 7.863 0.5517 @@ -17,8 +17,6 @@ (define applicable? arity) -;(define sequence? length) -- now built-in for signatures - (define (nth-value n . args) ; untested... (and (> (length args) n) (list-ref args n))) @@ -138,10 +136,22 @@ (define (built-in? x) (not (undefined? (eval-string (string-append "#_" (object->string x)))))) ; just a guess... +#| (define (the type expr) (if (type expr) expr (error 'bad-type "~S is ~S but should be ~S" expr (type-of expr) type))) +|# +(define (the type expr) + (let ((e expr) + (bp type)) + (if (and (procedure? bp) + (signature bp) + (eq? 'boolean? (car (signature bp)))) + (if (type e) + e + (error 'bad-type "~S is ~S but should be ~S" e (type-of e) bp)) + (error 'bad-type "~S is not a boolean procedure" bp)))) (define iota (let ((+documentation+ "(iota n (start 0) (incr 1)) returns a list counting from start for n:\n\ @@ -338,8 +348,7 @@ |# (define-macro (and-let* vars . body) ; bind vars, if any is #f stop, else evaluate body with those bindings - (if (or (pair? vars) - (null? vars)) + (if (list? vars) `(let () (and ,@(map (lambda (v) (cons 'define v)) vars) (begin ,@body))) (error 'wrong-type-arg "and-let* var list is ~S" vars))) @@ -362,8 +371,6 @@ `(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))))) vars))))) -;;; 14-8-16: moved let-temporarily to s7.c - (define-macro (let/setter vars . body) (let ((setters (map (lambda (binding) (and (pair? (cddr binding)) @@ -920,17 +927,13 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (define (byte siz pos) ;; -> cache size, position and mask. (list siz pos (ash (- (ash 1 siz) 1) pos))) -(define byte-size car) -(define byte-position cadr) -(define byte-mask caddr) - (define (ldb bytespec integer) - (ash (logand integer (byte-mask bytespec)) - (- (byte-position bytespec)))) + (ash (logand integer (caddr bytespec)) + (- (cadr bytespec)))) (define (dpb integer bytespec into) - (logior (ash (logand integer (- (ash 1 (byte-size bytespec)) 1)) (byte-position bytespec)) - (logand into (lognot (byte-mask bytespec))))) + (logior (ash (logand integer (- (ash 1 (car bytespec)) 1)) (cadr bytespec)) + (logand into (lognot (caddr bytespec))))) ;;; ---------------- @@ -1181,6 +1184,8 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (if (continuation? ((owlet) 'continue)) (((owlet) 'continue)))))) +;;; ---------------- + (define (call-with-input-vector v proc) (if (vector? v) (let ((i -1)) @@ -1208,7 +1213,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (if (not (let? p)) (apply format p args) (write (apply format #f args) p)))))) - (subvector v i))) ; ignore extra trailing elements + (subvector v i))) ; ignore extra trailing elements (i = subvector length) @@ -1379,21 +1384,6 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") ((= i new-len) lst) (set! (lst i) (obj (+ i start)))))))) - -(define (sequence->string val) - (let ((ctrl-str (cond ((or (not (sequence? val)) - (empty? val)) "~S") - ((int-vector? val) "#i(~{~D~| ~})") - ((byte-vector? val) "#u(~{~D~| ~})") - ((float-vector? val) "#r(~{~A~| ~})") - ((vector? val) "#(~{~A~| ~})") - ((let? val) "(inlet ~{'~A~| ~})") - ((hash-table? val) "~W") - ((not (string? val)) "(~{~A~| ~})") - (else "\"~{~A~|~}\"")))) - (format #f ctrl-str val))) - - ;;; ---------------- (define-macro (elambda args . body) ; lambda but pass extra arg "*env*" = run-time env @@ -1411,350 +1401,33 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") ;;; ---------------- -(if (not (or (defined? 'apropos) - (provided? 'snd))) - (define* (apropos name (port *stdout*) (e (rootlet))) - (let ((ap-name (if (string? name) - name - (if (symbol? name) - (symbol->string name) - (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol")))) - (ap-env (if (let? e) - e - (error 'wrong-type-arg "apropos argument 3 should be an environment"))) - (ap-port (if (output-port? port) - port - (error 'wrong-type-arg "apropos argument 2 should be an output port")))) - (for-each - (lambda (binding) - (if (and (pair? binding) - (string-position ap-name (symbol->string (car binding)))) - (format ap-port "~A: ~A~%" - (car binding) - (if (procedure? (cdr binding)) - (documentation (cdr binding)) - (cdr binding))))) - ap-env)))) - - -;;; ---------------- - -;; these need to be globally accessible since they're inserted in arbitrary source -(define Display #f) -(define Display-port #f) - -(let ((spaces 0) - (*display-spacing* 2) ; (set! ((funclet Display) '*display-spacing*) 1) etc - (*display-print-length* 6) - (*display* *stderr*) ; exported via Display-port - (e (gensym)) - (result (gensym)) - (vlp (gensym))) - - ;; local symbol access -- this does not affect any other uses of these symbols - (set! (setter '*display-spacing* (curlet)) - (lambda (s v) (if (and (integer? v) (not (negative? v))) v *display-spacing*))) - - (set! (setter '*display-print-length* (curlet)) - (lambda (s v) (if (and (integer? v) (not (negative? v))) v *display-print-length*))) - - ;; export *display* -- just a convenience - (set! Display-port (dilambda - (lambda () *display*) - (lambda (val) (set! *display* val)))) - - (define (prepend-spaces) - (format *display* (format #f "~~~DC" spaces) #\space)) - - (define (display-let le e) - (let ((vlp (*s7* 'print-length))) +(unless (or (defined? 'apropos) + (provided? 'snd)) + (define* (apropos name (port *stdout*) (e (rootlet))) + (let ((ap-name (if (string? name) + name + (if (symbol? name) + (symbol->string name) + (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol")))) + (ap-env (if (let? e) + e + (error 'wrong-type-arg "apropos argument 3 should be an environment"))) + (ap-port (if (output-port? port) + port + (error 'wrong-type-arg "apropos argument 2 should be an output port")))) (for-each - (lambda (slot) - (unless (or (gensym? (car slot)) - (eq? (cdr slot) e)) - (set! (*s7* 'print-length) *display-print-length*) - (let ((str (sequence->string (cdr slot)))) - (set! (*s7* 'print-length) 30) - (format (Display-port) " :~A ~{~A~|~}" (car slot) str)))) - le) - (set! (*s7* 'print-length) vlp))) - - (define (last lst) - (let ((end (let ((len (length lst))) - (list-tail lst (if (negative? len) (abs len) (- len 1)))))) - (if (pair? end) - (car end) - end))) - - (define* (butlast lst (result ())) - (if (or (not (pair? lst)) - (null? (cdr lst))) - (reverse result) - (butlast (cdr lst) (cons (car lst) result)))) - - (define* (remove-keys args (lst ())) - (if (pair? args) - (remove-keys (cdr args) - (if (or (not (keyword? (car args))) - (eq? (car args) :rest)) - (cons (car args) lst) - lst)) - (if (null? args) - (reverse lst) - (append (reverse lst) args)))) - - (define (proc-walk source) - - (define (display-format str . args) - `(let ((,vlp (*s7* 'print-length))) - (with-let (funclet Display) - (set! (*s7* 'print-length) *display-print-length*) - (prepend-spaces)) - (format (Display-port) ,str ,@args) - (set! (*s7* 'print-length) ,vlp))) - - (define (walk-let-body source) - (let ((previous (butlast source)) - (end (last source))) - `(begin - ,@previous - (let ((,result ,end)) - (with-let (funclet Display) - (prepend-spaces)) - (format (Display-port) " ~A~A) -> ~A~%" - ,(if (pair? previous) " ... " "") - ',end - ,result) - ,result)))) - - (if (not (pair? source)) - source - (case (car source) - - ((let let* letrec letrec*) - ;; show local variables, (let vars . body) -> (let vars print-vars . body) - (if (symbol? (cadr source)) ; named let? - (append - (list (car source) ; let - (cadr source) ; name - (caddr source) ; vars - (display-format "(let ~A (~{~A~| ~})~%" (cadr source) '(outlet (curlet)))) - (walk-let-body (cdddr source))) ; body - (append - (list (car source) ; let - (cadr source) ; vars - (display-format "(~A (~{~A~| ~})~%" (car source) '(outlet (curlet)))) - (walk-let-body (cddr source))))) ; body - - ((or and) - ;; report form that short-circuits the evaluation - (cons (car source) - (let ((ctr -1) - (len (- (length source) 2)) - (eob (if (eq? (car source) 'or) 'when 'unless))) - (map (lambda (expr) - (set! ctr (+ ctr 1)) - `(let ((,result ,expr)) - (,eob ,result - (format (Display-port) " (~A ~A~A~A) -> ~A~%" - ',(car source) - ,(if (> ctr 0) " ... " "") - ',expr - ,(if (< ctr len) " ... " "") - ,result)) - ,result)) - (cdr source))))) - - ((begin with-let with-baffle) - ;; report last form - (let ((previous (butlast (cdr source))) - (end (last source))) - `(,(car source) - ,@previous - (let ((,result ,end)) - (format (Display-port) "(~A ~A~A) -> ~A~%" - ',(car source) - ,(if (pair? previous) " ... " "") - ',end - ,result) - ,result)))) - - ((when unless) - ;; report expr if body not walked, else report last form of body - (let ((previous (butlast (cddr source))) - (end (last (cddr source)))) - `(,(car source) (let ((,result ,(cadr source))) - (,(car source) (not ,result) - (format (Display-port) "(~A ~A -> ~A ...)~%" - ',(car source) - ',(cadr source) - ,result)) - ,result) - ,@previous - (let ((,result ,end)) - (format (Display-port) "(~A ... ~A) -> ~A~%" - ',(car source) - ',end - ,result) - ,result)))) - - ((quote) - source) - - ((cond) - ;; report form that satisifies cond - (let ((ctr -1) - (len (- (length source) 2))) - `(cond ,@(map (lambda (clause) - (let ((test (car clause)) - (body (cdr clause))) - (set! ctr (+ ctr 1)) - (if (eq? (car body) '=>) - `(,test => (lambda (,result) - (let ((,result (,@(cdr body) ,result))) - (format (Display-port) " (cond ~A~A~A) -> ~A~%" - ,(if (> ctr 0) " ... " "") - ',clause - ,(if (< ctr len) " ... " "") - ,result) - ,result))) - `(,test (let ((,result (begin ,@body))) - (format (Display-port) " (cond ~A~A~A) -> ~A~%" - ,(if (> ctr 0) " ... " "") - ',clause - ,(if (< ctr len) " ... " "") - ,result) - ,result))))) - (cdr source))))) - - ((case) - ;; as in cond but include selector value in [] and report fall throughs - (let ((ctr -1) - (len (- (length source) 3)) - (default (member '(else #t) (cddr source) (lambda (a b) - (memq (car b) a))))) - `(case ,(cadr source) - ,@(append - (map (lambda (clause) - (let ((test (car clause)) - (body (cdr clause))) - (set! ctr (+ ctr 1)) - (if (eq? (car body) '=>) - `(,test => (lambda (,result) - (let ((,result (,@(cdr body) ,result))) - (format (Display-port) " (case [~A] ~A~A~A) -> ~A~%" - ,(cadr source) - ,(if (> ctr 0) " ... " "") - ',clause - ,(if (< ctr len) " ... " "") - ,result) - ,result))) - `(,test (let ((,result (begin ,@body))) - (format (Display-port) " (case [~A] ~A~A~A) -> ~A~%" - ,(cadr source) - ,(if (> ctr 0) " ... " "") - ',clause - ,(if (< ctr len) " ... " "") - ,result) - ,result))))) - (cddr source)) - (if default - () - `((else - (format (Display-port) " (case [~A] falls through~%" ,(cadr source)) - #<unspecified>))))))) - - ((dynamic-wind) - ;; here we want to ignore the first and last clauses, and report the last of the second - (let ((body (let ((p (caddr source))) - (and (eq? (car p) 'lambda) - (cddr p))))) - (if (not body) - source - (let ((previous (and body (butlast body))) - (end (and body (last body)))) - `(dynamic-wind - ,(cadr source) - (lambda () - ,@previous - (let ((,result ,end)) - (format (Display-port) "(dynamic-wind ... ~A) -> ~A~%" ',end ,result) - ,result)) - ,(cadddr source)))))) - - (else - (cons (proc-walk (car source)) - (proc-walk (cdr source))))))) - - - (define-macro (Display-1 definition) - (if (not (and (pair? definition) - (memq (car definition) '(define define*)) - (pair? (cdr definition)) - (pair? (cadr definition)))) - - ;; (Display <anything-else>) - (proc-walk definition) ; (Display (+ x 1)) etc - - ;; (Display (define (f ...) ...) - (let ((func (caadr definition)) - (args (cdadr definition)) - (body (cons 'begin (proc-walk (cddr definition))))) - ;(format *stderr* "~A ~A ~A~%" func args body) - (let* ((no-noise-args (remove-keys args)) ; omit noise words like :optional - (arg-names (cond ((null? args) - ()) - ((proper-list? args) ; handle (f x ...), (f (x 1) ...), (f . x), and (f x . z) - (map (lambda (a) - (if (symbol? a) a (car a))) ; omit the default values - no-noise-args)) - ((pair? args) - (append (butlast no-noise-args) (list :rest (last args)))) - (else (list :rest args)))) - (call-args (cond ((null? args) - ()) - ((proper-list? args) - (if (memq :rest args) - (append (butlast (butlast no-noise-args)) ; also omit the :rest - (list (list 'apply-values (last args)))) - arg-names)) ; (... y x) - ((pair? args) - (append (butlast no-noise-args) ; (... y (apply-values x)) - (list (list 'apply-values (last args))))) - (else (list (list 'apply-values args)))))) ; (... (apply-values x)) - `(define ,func - (define-macro* ,(cons (gensym) args) ; args might be a symbol etc - `((lambda* ,(cons ',e ',arg-names) ; prepend added env arg because there might be a rest arg - (let ((,',result '?)) - (dynamic-wind - (lambda () #f) - (lambda () ; when function called, show args and caller - (with-let (funclet Display) ; indent - (prepend-spaces) - (set! spaces (+ spaces *display-spacing*))) - (format (Display-port) "(~A" ',',func) ; show args, ruthlessly abbreviated - (((funclet Display) 'display-let) (outlet (outlet (curlet))) ,',e) - (format (Display-port) ")") - (let ((caller (eval '__func__ ,',e))) ; show caller - (if (not (eq? caller #<undefined>)) - (format (Display-port) " ;called from ~A" caller))) - (newline (Display-port)) - (set! ,',result ,',body)) ; but annotated by proc-walk - (lambda () ; at the end, show the result - (with-let (funclet Display) - (set! spaces (- spaces *display-spacing*)) ; unindent - (prepend-spaces)) - (format (Display-port) " -> ~S~%" ,',result))))) - (curlet) ,,@call-args))))))) ; pass in the original args and the curlet - - - (set! Display Display-1)) ; make Display-1 globally accessible - - + (lambda (binding) + (if (and (pair? binding) + (string-position ap-name (symbol->string (car binding)))) + (format ap-port "~A: ~A~%" + (car binding) + (if (procedure? (cdr binding)) + (documentation (cdr binding)) + (cdr binding))))) + ap-env)))) ;;; -------------------------------------------------------------------------------- - (define (*s7*->list) (list :print-length (*s7* 'print-length) @@ -1938,6 +1611,13 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") #_getenv #_system #_delete-file #_directory->list #_directory? #_file-exists? #_file-mtime)) ))) (lambda (code) + (if (tree-cyclic? code) + (error 'wrong-type-arg "sandbox argument is circular: ~S~%" code)) + (if (and (pair? code) + (>= (length code) 10000)) + (error 'wrong-type-arg + (let-temporarily (((*s7* 'print-length) 16)) + (format #f "sandbox code looks bogus: ~S~%" code)))) ;; block any change to calling program, or access to files, etc (let ((new-code (call-with-exit @@ -1968,6 +1648,11 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") ((not (pair? tree)) tree) + ((eq? 'quote (car tree)) ; tree-cyclic? ignores quoted lists + (if (tree-cyclic? (cdr tree)) + (error 'wrong-type-arg "sandbox argument is circular: ~S~%" tree)) + tree) + (else ;; do we need to check IO ports and set! here? (cons (walk (car tree)) diff --git a/tools/auto-tester.scm b/tools/auto-tester.scm index 3e9f956..d0b034d 100644 --- a/tools/auto-tester.scm +++ b/tools/auto-tester.scm @@ -1,6 +1,6 @@ ;;; this is an extension of tauto.scm, an auto-tester (for-each (lambda (x) - (unless (memq (car x) '(make-string make-byte-vector)) + (unless (memq (car x) '(make-string make-byte-vector *features* *libraries* *#readers*)) ; last 2 for sandbox (immutable! (car x)))) (rootlet)) @@ -87,9 +87,6 @@ (define estr "") (define nostr "") -(define __var__ #f) -(define __old_var__ #f) -(define __var1__ #f) (define error-type #f) (define error-info #f) (define false #f) @@ -184,10 +181,34 @@ ;(define (_fnc6_ x) (unless (let? x) (let-temporarily (((*s7* 'safety) 1)) (fill! x #\a)))) ;;; (define (_fnc7_ x) (let-temporarily (((*s7* 'safety) 1)) (reverse! x))) +(define (local-random . args) + (type-of (apply random args))) + +(define (local-read-string . args) + (with-input-from-file "/home/bil/cl/all-lg-results" + (lambda () + (read-string (car args))))) + (define (checked-eval code) - (and (null? (cyclic-sequences code)) + (and (pair? code) + (< (length code) 100) + (null? (cyclic-sequences code)) (eval code))) +(define (local-varlet . args) + (let ((e (car args))) + (when (and (let? e) + (not (eq? e (rootlet))) + (not (defined? e 'error-type))) + (apply varlet e (cdr args))))) + +(define (local-let-set! . args) + (let ((e (car args))) + (when (and (let? e) + (not (eq? e (rootlet))) + (not (defined? e 'error-type))) + (apply let-set! e (cdr args))))) + (define (checked-hash-table . args) (let ((_h_ (make-hash-table (*s7* 'default-hash-table-length) equivalent?))) (do ((key/value args (cddr key/value))) @@ -196,14 +217,17 @@ (error 'wrong-number-of-args "no value") (set! (_h_ (car key/value)) (cadr key/value)))))) -(define (checked-hash-table . args) - (let ((_h_ (make-hash-table (*s7* 'default-hash-table-length) equivalent?))) - (do ((key/value args (cdr key/value))) - ((null? key/value) _h_) - (if (not (pair? (car key/value))) - (error 'wrong-type-args "not a pair") - (set! (_h_ (caar key/value)) (cdar key/value)))))) - +(define (checked-read-char . args) (with-input-from-string "0123" (lambda () (apply read-char args)))) +(define (checked-read-byte . args) (with-input-from-string "0123" (lambda () (apply read-byte args)))) +(define (checked-read-line . args) (with-input-from-file "s7test.scm" (lambda () (apply read-line args)))) +(define (checked-read-string . args) (with-input-from-file "s7test.scm" (lambda () (apply read-string args)))) +(define (checked-read . args) (with-input-from-file "s7test.scm" (lambda () (apply read args)))) +(define (checked-reverse! . args) (reverse! (copy (car args)))) +(define (checked-port-line-number . args) (apply port-line-number args) 0) +(define (checked-let-set! . args) (apply let-set! (curlet) args)) +(define (checked-varlet . args) (apply varlet (curlet) args)) +(define (checked-cutlet . args) (apply cutlet (curlet) args)) +(define (checked-procedure-source . args) (copy (apply procedure-source args) :readable)) (load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init))) @@ -243,6 +267,9 @@ (define-expansion (_cw_ . args) `(call-with-exit (lambda (_x_) (_x_ ,@args)))) +(define-expansion (_cc_ . args) + `(call/cc (lambda (_x_) (_x_ ,@args)))) + (define-expansion (_ct1_ . args) `(catch 'oops (lambda () (call-with-exit (lambda (goto) (values ,@args)))) (lambda args 'error))) @@ -285,17 +312,19 @@ args)))) (define-expansion (_do4_ . args) - `(do ((_i_ 0 (+ _i_ 1))) + `(do ((__var__ #f) + (_i_ 0 (+ _i_ 1))) ((= _i_ 1) __var__) - ,@args)) + (set! __var__ ,@args))) (define-expansion (_do5_ . args) - `(let doer ((_i_ 0)) - (if (= _i_ 1) - __var__ - (begin - ,@args - (doer (+ _i_ 1)))))) + `(let ((__var__ #f)) + (let doer ((_i_ 0)) + (if (= _i_ 1) + __var__ + (begin + (set! __var__ ,@args) + (doer (+ _i_ 1))))))) (define-expansion (_do3_ . args) `(let ((exiter (vector #f))) (do ,(car args) ((vector-ref exiter 0) 1) ,@(cdr args) (vector-set! exiter 0 #t)))) @@ -312,7 +341,7 @@ `(let ((port #f)) (dynamic-wind (lambda () - (set! port (open-input-string (format #f "~S" (car (list ,@args)))))) + (set! port (open-input-string (format #f "~W" (car (list ,@args)))))) (lambda () (read port)) (lambda () @@ -320,7 +349,7 @@ (define-expansion (_rd4_ . args) `(with-input-from-string - (object->string (car (list ,@args))) ; defaults to ~S + (object->string (car (list ,@args)) :readable) ; defaults to ~S read)) (define-expansion (_rd5_ . args) @@ -338,6 +367,22 @@ (object->string (car (list ,@args))) read-line)) +(define-expansion (_rd7_ . args) + `(with-input-from-file "/home/bil/cl/all-lg-results" + (lambda () + ,@args))) + +(define-expansion (_rd8_ . args) + `(let ((old-port (current-input-port))) + (dynamic-wind + (lambda () + (set-current-input-port (open-input-file "/home/bil/cl/all-lg-results"))) + (lambda () + ,@args) + (lambda () + (close-input-port (current-input-port)) + (set-current-input-port old-port))))) + (define-expansion (_wr1_ . args) `(let ((port #f)) (dynamic-wind @@ -354,19 +399,41 @@ (lambda (port) (write (car (list ,@args)) port)))) - -(define ims (immutable! (string #\a #\b #\c))) -(define imbv (immutable! (byte-vector 0 1 2))) -(define imv (immutable! (vector 0 1 2))) -(define imiv (immutable! (int-vector 0 1 2))) -(define imfv (immutable! (float-vector 0 1 2))) -(define imi (immutable! (inlet 'a 1 'b 2))) -(define imb (immutable! (block 0.0 1.0 2.0))) -(define imh (immutable! (hash-table 'a 1 'b 2))) -(define imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ()))))))) -(define imfi (immutable! (mock-port (open-input-string "asdf")))) -(define imfo (immutable! (mock-port (open-output-string)))) -(define imr (immutable! (mock-random-state 123456))) +(define-expansion (_wr3_ . args) + `(format #f "~W" (car (list ,@args)))) + +(define-expansion (_wr4_ . args) + `(object->string (car (list ,@args)) :readable)) + +(define-expansion (_let1_ . args) + `(let-temporarily ((x 1)) (call-with-exit (lambda (go) (go ,@args))))) + +(define-expansion (_let2_ . args) + `(call-with-exit (lambda (go) (let-temporarily ((x 1)) (go ,@args))))) + +(define-expansion (_iter_ . args) + `(let ((erg (list-values ,@args))) + (let ((iter (if (iterator? erg) erg (make-iterator erg))) + (result ())) + (do ((x (iter) (iter))) + ((iterator-at-end? iter) (reverse result)) + (set! result (cons x result)))))) + +(define-expansion (_map_ . args) + `(map values (list ,@args))) + +(define-constant ims (immutable! (string #\a #\b #\c))) +(define-constant imbv (immutable! (byte-vector 0 1 2))) +(define-constant imv (immutable! (vector 0 1 2))) +(define-constant imiv (immutable! (int-vector 0 1 2))) +(define-constant imfv (immutable! (float-vector 0 1 2))) +(define-constant imi (immutable! (inlet 'a 3 'b 2))) +(define-constant imb (immutable! (block 0.0 1.0 2.0))) +(define-constant imh (immutable! (hash-table 'a 1 'b 2))) +(define-constant imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ()))))))) +(define-constant imfi (immutable! (mock-port (open-input-string "asdf")))) +(define-constant imfo (immutable! (mock-port (open-output-string)))) +(define-constant imr (immutable! (mock-random-state 123456))) (if (provided? 'gmp) (begin @@ -385,8 +452,16 @@ (define bigcmp 1+2i))) (define vvv (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) v)) -(define vvvi (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) (immutable! v))) -(define vvvf (immutable! (vector abs log sin))) +(define-constant vvvi (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) (immutable! v))) +(define-constant vvvf (immutable! (vector abs log sin))) + +#| +(define typed-hash (make-hash-table 8 eq? (cons symbol? integer?))) +(define typed-vector (make-vector 8 'a symbol?)) +(define orig-typed-let (let ((a 1)) (set! (setter 'a) integer?) (curlet))) +(define typed-let (let ((a 1)) (set! (setter 'a) integer?) (curlet))) +(define constant-let (let () (define-constant a 1) (curlet))) +|# (set! (hook-functions *unbound-variable-hook*) ()) (define x 0) @@ -426,7 +501,7 @@ 'string-ci<=? 'cadadr 'cdadr 'provided? 'caaaar 'caaddr 'caddar 'cdaaar 'cdaadr 'cdaddr 'cddar ;'fill! ; see _fnc6_ 'hash-table-ref 'list->vector 'caaadr 'caaar 'caadar 'cadaar 'cdadar 'cdddar 'string-fill! 'cdaar 'cddaar 'cddadr - ;'symbol->keyword 'string->keyword + 'symbol->keyword 'string->keyword 'keyword->symbol 'keyword? 'logxor 'memv 'char-ready? 'exact? 'integer-length 'port-filename 'char>=? @@ -441,20 +516,20 @@ 'vector-dimensions 'get-output-string 'sublet 'call-with-input-string 'documentation - 'continuation? 'hash-table? 'port-closed? + 'continuation? 'hash-table? 'port-closed? 'port-position 'port-file 'output-port? 'input-port? 'provide 'call-with-output-string - 'checked-hash-table 'checked-hash-table + 'checked-hash-table 'with-output-to-string 's7-version 'dilambda? 'hook-functions - 'c-pointer->list 'c-pointer-info 'c-pointer-type 'c-pointer-weak1 + 'c-pointer->list 'c-pointer-info 'c-pointer-type 'c-pointer-weak1 'c-pointer-weak2 ;'make-hook - 'let 'let* 'letrec - ; 'lambda 'lambda* - ; 'multiple-value-bind 'call-with-values + 'let 'let* 'letrec 'letrec* + 'lambda 'lambda* ; these get bogus errors from (lambda 'value...) -- quote as arg name, (immutable? quote): #f + ;'multiple-value-bind 'call-with-values 'inlet 'object->let @@ -468,7 +543,6 @@ 'byte-vector-set! 'make-byte-vector 'write-char 'call/cc 'write-byte 'write-string 'file-mtime - 'letrec* 'write 'display ;'outlet 'directory->list @@ -476,14 +550,18 @@ 'set! 'set-car! 'call-with-output-file 'with-output-to-file ;'read-char 'read-byte 'read-line 'read-string 'read ; stdin=>hangs - ;'close-input-port - ;'current-input-port ;-- too many (read...) also close of it can close the load port [fixed] + 'checked-read-char 'checked-read-line 'checked-read-string 'checked-read-byte 'checked-read + 'checked-reverse! 'checked-port-line-number + 'checked-let-set! 'checked-varlet 'checked-cutlet + 'close-input-port + ;;'current-input-port ;-- too many (read...) + ;;'set-current-input-port ; -- collides with rd8 etc ;'set-cdr! ;'unlet ;-- spurious diffs ;'port-line-number ;-- too many spurious diffs ;'load ;'current-error-port ;-- spurious output ;'close-output-port - ; 'hash-table ; -- handled as equivalent via checked-hash-table + 'hash-table ; -- handled as equivalent via checked-hash-table ;'current-output-port ;'cutlet ;'set-current-error-port ;-- too many bogus eq? complaints @@ -495,27 +573,27 @@ 'autoload ;'varlet ;-- error exits, chaos in rootlet ;'eval ; -- can't use if signature (circular program) or (make-list (max-list-len)) + 'checked-eval ;'immutable! - ;'procedure-source ;-- appears to be the culprit when hook body becomes (apply) after optimization + 'checked-procedure-source ;'owlet ;too many uninteresting diffs ;'gc ;'reader-cond ;-- cond test clause can involve unbound vars: (null? i) for example - ;'pair-line-number ;'funclet ;'random ;'quote '*error-hook* ;'cond-expand ;'random-state->list - ;'pair-filename + ;; 'pair-line-number 'pair-filename ; -- too many uninteresting diffs ;'let-set! ;-- rootlet troubles? ;'coverlet ;-- blocks block's equivalent? - ;'help ;-- snd goes crazy + 'help ;-- snd goes crazy ;'macroexpand ;-- uninteresting objstr stuff 'signature ; -- circular lists cause infinite loops with (e.g.) for-each?? ;'rootlet ; cyclic-sequences oddness and rootlet can be stepped on 'eval-string - ;'tree-count 'tree-leaves 'tree-memq 'tree-set-memq ;-- no cycle checks and we have signature creating circular lists + 'tree-memq 'tree-set-memq 'tree-count 'tree-leaves 'tree-cyclic? 'require 'else ;'_mac_ '_mac*_ '_bac_ '_bac*_ @@ -537,7 +615,7 @@ 'int-vector-set! 'c-object? 'c-object-type 'proper-list? 'symbol->dynamic-value 'vector-append 'flush-output-port 'c-pointer 'make-float-vector 'iterate 'float-vector? - ;'apply-values + 'apply-values 'values 'byte-vector-ref 'file-exists? 'make-int-vector 'string-downcase 'string-upcase 'byte-vector 'equivalent? @@ -553,12 +631,12 @@ 's7-stacktrace-defaults ; clobbered by reverse! ;'s7-set-print-length - ;'s7-set-stacktrace-defaults + 's7-set-stacktrace-defaults ;'s7-set-default-rationalize-error ;'s7-set-equivalent-float-epsilon ;'s7-set-hash-table-float-epsilon ;'s7-set-bignum-precision - ;'s7-set-float-format-precision + ;'s7-set-float-format-precision ; tedious quibbles #| 's7-set-max-string-length 's7-set-max-list-length @@ -587,9 +665,9 @@ ;'s7-cpu-time 's7-file-names 's7-autoloading? - 's7-rootlet-size 's7-heap-size 's7-free-heap-size 's7-gc-freed 's7-stack-size 's7-max-stack-size 's7-gc-stats + ;'s7-rootlet-size 's7-heap-size 's7-free-heap-size 's7-gc-freed 's7-stack-size 's7-max-stack-size 's7-gc-stats - 'block-reverse! 'subblock 'unquote 'block-append ;'block-let + 'block-reverse! 'subblock 'unquote 'block-append 'block-let ;'simple-block? 'make-simple-block 'make-c-tag ; -- uninteresting diffs 'undefined-function @@ -597,31 +675,38 @@ 'empty? 'indexable? 'first 'adjoin 'cdr-assoc ;'progv ;'value->symbol -- correctly different values sometimes, progv localizes - ;'and-let* 'string-case 'hash-table->alist 'concatenate + ;'and-let* 'string-case 'concatenate ;'union -- heap overflow if cyclic arg '2^n? 'lognor 'ldb 'clamp - ;'sequence->string ;-- either this or rootlet but not both (endless printout) ;'*s7*->list ; reverse! etc - 'log-n-of ; stack grows if n < 0? + + ;;'log-n-of ; uninteresting complaints + ;;'sandbox -- slow + 'circular-list? 'hash-table->alist 'weak-hash-table 'byte? 'the 'lognand 'logeqv + 'local-random 'local-read-string 'local-varlet 'local-let-set! ;'pp 'kar '_dilambda_ '_vals_ 'free1 'free2 'free3 'catch 'length 'eq? 'car '< 'assq 'complex? 'vector-ref + + ;; '<cycle> 'cycle-set! 'cycle-ref 'make-cycle -- none are protected against randomness + )) - (args (vector "-123" "1234" "-3/4" "-1" "(expt 2 32)" "4294967297" "1001" "10001" ;;"(+ a 1)" "(- a 1)" "(logand (ash 1 b) a)" - "\"ho\"" ":ho" "'ho" "':go" "(list 1)" "(list 1 2)" "(cons 1 2)" "'()" "(list (list 1 2))" "(list (list 1))" "(list ())" "=>" + (args (vector "-123" "1234" "-3/4" "-1" "1/2" "(expt 2 32)" "4294967297" "1001" "10001" ;;"(+ a 1)" "(- a 1)" "(logand (ash 1 b) a)" + "\"ho\"" ":ho" "'ho" "(list 1)" "(list 1 2)" "(cons 1 2)" "'()" "(list (list 1 2))" "(list (list 1))" "(list ())" "=>" "#f" "#t" "()" "#()" "\"\"" "'#()" ; ":write" -- not this because sr2 calls write and this can be an arg to sublet redefining write ":readable" ":rest" ":allow-other-keys" ":a" ;"__func__" "1/0+i" "0+0/0i" "0+1/0i" "1+0/0i" "0/0+0/0i" "0/0+i" "+nan.0-3i" "+inf.0-nan.0i" "cons" "''2" "\"ra\"" + "#\\a" "#\\A" "\"str1\"" "\"STR1\"" "#\\0" "(make-hook)" "(make-hook '__x__)" "1+i" "0+i" "(ash 1 43)" "(integer->char 255)" "(string (integer->char 255))" "(string #\\null)" "(byte-vector 0)" - ;"most-positive-fixnum" ;"most-negative-fixnum" - ;"(/ 1 most-positive-fixnum)" "(complex most-negative-fixnum most-negative-fixnum)" - ;"(/ most-negative-fixnum most-positive-fixnum)" - "pi" "nan.0" "inf.0" "-inf.0" ;-nan.0 is the same as +nan.0 + ;;"most-positive-fixnum" "most-negative-fixnum" + ;;"(/ 1 most-positive-fixnum)" "(complex most-negative-fixnum most-negative-fixnum)" + ;;"(/ most-negative-fixnum most-positive-fixnum)" + "pi" "+nan.0" "+inf.0" "-inf.0" "-nan.0" "(list)" "(string)" "#r()" "#u()" "(vector)" "#i()" "(make-iterator #(10 20))" "#i(1)" "0" "1" "4" "1.0" "-1.0" "1.0+123.0i" "3/4" "(make-vector 3)" "(make-string 3 #\\space)" "(make-vector '(2 3))" "'((111 2222) (3 4))" "'((1 (2)) (((3) 4)))" "(byte-vector 255)" "(make-byte-vector '(2 3) 0)" @@ -635,22 +720,28 @@ "(values 1 2)" "(values)" "(values #\\c 3 1.2)" "(values \"ho\")" "(values 1 2 3 4 5 6 7 8 9 10)" "`(x)" "`(+ x 1)" "`(x 1)" "`((x))" "`((+ x 1))" "`(((+ x 1)))" "`((set! x (+ x 1)) (* x 2))" "`((x 1))" "`(((x 1))) " "`(x . 1)" "`((x . 1))" "`(1)" "`((1))" "`((1) . x)" ;; "'(- 1)" - "(+ i 1)" + "(+ i 1)" "(pi)" ;;"'((X . 1) . 2)" "'((x 1) . 2)" "'((x 1) (y . 2))" "'((x 1) y . 2)" "'((x 1) (y) . 2)" "'((x 1 . 2) . 3)" "'((x 1) 2)" "'(((x 1) 2) 3)" "'(())" "'((()))" "(random-state 1234)" - "(c-pointer 0 'integer?)" "(c-pointer -1)" "(c-pointer 1234)" - "(inlet 'integer? (lambda (f) #f))" "(inlet 'a 1)" ;;"(openlet (inlet 'abs (lambda (x) (- x))))" + "(c-pointer 0 'integer?)" "(c-pointer -1)" "(c-pointer 1234 1.0 2.0 3.0)" + "(inlet 'integer? (lambda (f) #f))" "(inlet 'a 1)" + "(openlet (inlet 'abs (lambda (x) (if (real? x) (if (< x 0.0) (- x) x) (error 'wrong-type-arg \"not a real\")))))" + "(openlet (inlet 'zero? (lambda (x) (if (number? x) (= x 0.0) (error 'wrong-type-arg \"not a number\")))))" + "(inlet 'a (inlet 'b 1))" "'(15 26 . 36)" - " . " + ;" . " ; -- read-errors "((i 0 (+ i 1)))" "(null? i)" "(= i 2)" "(zero? i)" "((null? i) i)" "(#t ())" ;;"(x => y)" "((0 1) ())" "(- i 1)" "(if x y)" "(or x y)" ;;"(f x) i" "x y z" "1 2" "`(+ ,a ,@b)" "`(+ ,a ,b)" "`(+ ,a ,b ,@c)" "`(+ ,a b ,@c ',d)" - "_definee_" "(_definee_ __var__)" "(_definee_ x)" ;"(__var__ 0)" "(__var__ 'a)" - "(hash-table 'a 1)" "(hash-table)" + "_definee_" + "(hash-table 'a 1.5)" "(hash-table)" "(hash-table 'a (hash-table 'b 1))" + "(weak-hash-table 1.0 'a 2.0 'b 3.0 'c)" "(make-iterator (list 11 22 33))" "(make-iterator (int-vector 1 2 3))" "(make-iterator (string #\\1))" "(make-iterator x)" - "(make-iterator (hash-table 'a 1 'b 2))" "(make-iterator (block 1 2 3))" + "(make-iterator (make-vector '(2 3) #f))" "(make-iterator #r())" + "(make-iterator (hash-table 'a -1/2 'b 2))" "(make-iterator (block 1 2 3))" + "(make-iterator (weak-hash-table 1.0 'a 2.0 'b 3.0 'c))" "(make-iterator (let ((lst '((a . 1) (b . 2) (c . 2))) (+iterator+ #t)) (lambda () @@ -665,10 +756,8 @@ "(call-with-exit (lambda (goto) goto))" "(with-baffle (call/cc (lambda (cc) cc)))" "(symbol->string 'x)" "(symbol \"a b\")" "(symbol \"(\\\")\")" - ;;"(setter _definee_)" - "(setter car)" "(setter kar)" "(call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y))))" - "(call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))" + ;;"(call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))" "(let ((x 1)) (dynamic-wind (lambda () (set! x 2)) (lambda () (+ x 1)) (lambda () (set! x 1))))" "(let-temporarily ((x 1)) (free1))" "(let-temporarily ((x #(1)) (i 0)) (free2))" "(let-temporarily ((local-func (lambda (x) x))) (free3))" @@ -679,16 +768,30 @@ "(random 1)" ;;"(else ())" "(else (f x) B)" "(else)" - "else" "x" "(+ x 1)" "(+ 1/2 x)" "(abs x)" "(+ x 1 2+i)" "(* 2 x 3.0 4)" "((x 1234))" "((x 1234) (y 1/2))" "'x" "(x 1)" + "else" "x" "(+ x 1)" ;"(+ 1/2 x)" "(abs x)" "(+ x 1 2+i)" "(* 2 x 3.0 4)" "((x 1234))" "((x 1234) (y 1/2))" "'x" "(x 1)" "_undef_" "(begin |undef1|)" + "+signature+" "+documentation+" "+setter+" "+iterator+" - "__var2__" ;"(define x #f)" - ;"(define (x) #f)" "(define (x) (if (not (integer? (*s7* 'print-length))) (__var__) 0))" "'__var__" + "(let ((+documentation+ \"help\")) (lambda (x) x))" + "(let ((+iterator+ #t)) (lambda (x) #<eof>))" + "(let ((+signature+ (list 'integer? 'integer?))) (lambda (x) (logand x 1)))" + "(let ((x 1)) (let ((+setter+ (lambda (val) (set! x val)))) (lambda () x)))" + + "__var2__" ;; "\"~S~%\"" "\"~A~D~X\"" "\"~{~A~^~}~%\"" "\"~NC~&\"" -- creates files by these names! + "(call-with-input-file \"s7test.scm\" (lambda (p) p))" + "(call-with-output-string (lambda (p) p))" "ims" "imbv" "imv" "imiv" "imfv" "imi" "imb" "imh" "imfi" "imfo" "imp" "imr" - "vvv" "vvvi" "vvvf" + "vvv" "vvvi" "vvvf" ;"typed-hash" "typed-vector" "typed-let" "constant-let" + + "(make-hash-table 8 eq? (cons symbol? integer?))" + "(make-hash-table 8 equivalent? (cons symbol? #t))" + ;"(let ((a 1)) (set! (setter 'a) integer?) (curlet))" + ;"(let () (define-constant a 1) (curlet))" + "bigi0" "bigi1" "bigi2" "bigrat" "bigflt" "bigcmp" + "(ims 1)" "(imbv 1)" "(imv 1)" "(imb 1)" "(imh 'a)" "(mock-number 0)" "(mock-number 1-i)" "(mock-number 4/3)" "(mock-number 2.0)" "(mock-string #\\h #\\o #\\h #\\o)" @@ -712,7 +815,8 @@ "#xfeedback" "#_asdf" ;"quote" "'" - "if" "begin" "cond" "case" "when" "unless" "letrec" "letrec*" "or" "and" "let-temporarily" + ;"if" ; causes stack overflow when used as lambda arg name and (()... loop) + "begin" "cond" "case" "when" "unless" "letrec" "letrec*" "or" "and" "let-temporarily" ;;"lambda*" "lambda" ;-- cyclic body etc ;;"let" "let*" "do" "set!" "with-let" ;"define" "define*" "define-macro" "define-macro*" "define-bacro" "define-bacro*" @@ -726,6 +830,9 @@ "(let ((<1> (list 1 #f))) (set! (<1> 1) (let ((<L> (list #f 3))) (set-car! <L> <1>) <L>)) <1>)" "(let ((cp (list 1))) (set-cdr! cp cp) (list '+ 1 (list 'quote cp)))" + "(let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda () lst ()))" + "(let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda* () lst ()))" + "(gensym \"g_123\")" "(make-list 256 1)" "(make-vector '(2 3) 1)" @@ -760,15 +867,21 @@ ;"(rootlet)" ;"(curlet)" "(make-block 2)" "(block 1.0 2.0 3.0)" "(block)" - "(make-simple-block 3)" + ;"(make-simple-block 3)" + ;"*s7*" ; -- gradually fills up with junk + + "(symbol \"1\\\\\")" "#\\xff" "#\\backspace" ":0" "(list (list 1 2) (cons 1 2))" + "#i2d((1 1 1) (2 2 2) (1 1 1))" "(subvector (vector 1 2 3 4 5 6) '(2 3))" + "(let ((<1> (vector #f #f #f))) (set! (<1> 0) <1>) (set! (<1> 1) <1>) (set! (<1> 2) <1>) <1>)" + "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))" + "(hash-table +nan.0 1)" "#\\7" "(inlet :a (hash-table 'b 1))" "(openlet (immutable! (inlet :a 1)))" - #f + #f #f #f )) (codes (vector (list "(do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) " "(let ((x 0.1) (i 1)) (begin ") (list "(do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x " "(let ((x 0) (i 0)) (set! x ") - ;;(list "(let () (let () " "((lambda () ") ;; (list "((lambda x " "((lambda* ((x ())) ") ;;(list "((lambda* ((x 1)) " "(let* ((_aaa_ 1) (x _aaa_)) (begin ") (list "(cond (else " "(case x (else ") @@ -777,19 +890,16 @@ (list "(if (not x) (begin " "(if x #<unspecified> (begin ") (list "(cond ((not false) " "(unless false (begin ") (list "(let () (let-temporarily ((x 1)) " "(let () (let ((x 1)) ") - (list "(let-temporarily ((x 1)) (call-with-exit (lambda (go) " - "(call-with-exit (lambda (go) (let-temporarily ((x 1)) ") + ;(list "(let-temporarily ((x 1)) (call-with-exit (lambda (go) " "(call-with-exit (lambda (go) (let-temporarily ((x 1)) ") + (list "(begin (_let1_ " "(begin (_let2_ ") (list "(begin (_dw_ " "((lambda () ") (list "(begin (append " "(apply append (list ") (list "(begin (with-let (inlet 'i 0) " "(with-let (inlet) (let ((i 0)) ") (list "(list (_cw_ " "(list (values ") - (list "(set! __var1__ (list " "(list (let () ") + ;(list "(list (_cw_ " "(list (_cc_ ") (list "(do () ((not false) " "(begin (when (not false) ") ;;(list "((define-macro (_m_) " "((define-bacro (_m_) ") ; circular source if signature in body - ;;(list "(let ((mx max)) (let ((max min) (min mx)) " "(begin (_lt2_ ") ; loops? ;;(list "(begin (letrec ((x 1)) " "(begin (letrec* ((x 1)) ") - ;(reader-cond ((not (provided? 'pure-s7)) (list "(with-input-from-string \"1234\" (lambda () " "(begin (_dw_string_ "))) - ;;(list "(map + (begin " "(map * (begin ") (list "(for-each display (list " "(for-each (lambda (x) (display x)) (list ") (list "(begin (_ct1_ " "(begin (_ct2_ ") (list "(begin (_mem1_ " "(begin (_mem2_ ") @@ -806,22 +916,31 @@ (list "(begin (_ft1_ " "(begin (_ft2_ ") (list "(begin (_rd3_ " "(begin (_rd4_ ") (list "(begin (_rd5_ " "(begin (_rd6_ ") + (list "(begin (_rd7_ " "(begin (_rd8_ ") (list "(format #f \"~S\" (list " "(object->string (list ") (list "(begin (_wr1_ " "(begin (_wr2_ ") + (list "(begin (_wr3_ " "(begin (_wr4_ ") (list "(begin (vector " "(apply vector (list ") + (list "(begin (string " "(apply string (list ") + (list "(begin (float-vector " "(apply float-vector (list ") + (list "(begin (values " "(apply values (list ") + + (list "(begin (_iter_ " "(begin (_map_ ") )) (chars (vector #\( #\( #\) #\space))) ; #\/ #\# #\, #\` #\@ #\. #\:)) ; #\\ #\> #\space)) (let ((clen (length chars)) (flen (length functions)) (alen (length args)) - (codes-len (length codes))) + (codes-len (length codes)) + (args-ran 5) + (both-ran 8)) (define (get-arg) (let ((str (args (random alen)))) - (if (string? str) + (if (string? str) ; else #f str - (cycler 4)))) + (cycler (+ 3 (random 3)))))) ;(for-each (lambda (x) (if (not (symbol? x)) (format *stderr* "~A " x))) functions) ;(for-each (lambda (x) (if (not (string? x)) (format *stderr* "~A " x))) args) @@ -832,7 +951,7 @@ (define (fix-op op) (case op - ((set!) "set! __var__") + ((set!) (if (> (random 10) 4) "set! x" "set!")) ((let) "let ()") ((let*) "let* ()") ((do) "_do3_") @@ -896,7 +1015,7 @@ (set! parens 0))) ((#\space) - (let ((nargs (random 5))) + (let ((nargs (random args-ran))) (do ((n 0 (+ n 1))) ((= n nargs)) (let ((argstr (get-arg))) @@ -952,23 +1071,17 @@ str str1 str2 str3 str4 (tp val1) (tp val2) (tp val3) (tp val4))))) - ((sequence? val1) + ((sequence? val1) ; there are too many unreadable/unequivalent-but the same cases to check these by element (goto, continuation, ...) (let ((len1 (length val1))) (unless (or (let? val1) + (hash-table? val1) (and (eqv? len1 (length val2)) (eqv? len1 (length val3)) (eqv? len1 (length val4)))) (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~% ~A~% ~A~% ~A~% ~A~%~%" str str1 str2 str3 str4 - (tp val1) (tp val2) (tp val3) (tp val4))) - (if (and (string? val1) - (not (and (eq? (byte-vector? val1) (byte-vector? val2)) - (eq? (byte-vector? val1) (byte-vector? val3)) - (eq? (byte-vector? val1) (byte-vector? val4))))) - (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~% ~A~% ~A~% ~A~% ~A~%~%" - str str1 str2 str3 str4 - (tp val1) (tp val2) (tp val3) (tp val4))))) - + (tp val1) (tp val2) (tp val3) (tp val4))))) + ((number? val1) (if (or (and (nan? val1) (not (and (nan? val2) (nan? val3) (nan? val4)))) @@ -1007,8 +1120,7 @@ ) (begin (unless (eq? error-type 'baffled!) ; _rd3_ vs _rd4_ for example where one uses dynamic-wind which has built-in baffles - (format *stderr* "~%~%__var__: ~S~%~S~%~S~%~S~%~S~% ~A~% ~A~% ~A~% ~A~%" - __old_var__ + (format *stderr* "~%~%~S~%~S~%~S~%~S~% ~A~% ~A~% ~A~% ~A~%" str1 str2 str3 str4 (tp val1) (tp val2) (tp val3) (tp val4)) (if (or (eq? val1 'error) @@ -1019,9 +1131,8 @@ ))) (define (eval-it str) - ;(format *stderr* "~S~%" str) - (set! __var__ __old_var__) (set! (current-output-port) #f) + ;(format *stderr* "~S~%" str) (set! estr str) (get-output-string imfo #t) (catch #t @@ -1038,6 +1149,12 @@ (format *stderr* "stack overflow from ~S~%" str)) (when (eq? type 'heap-too-big) (format *stderr* "heap overflow from ~S~%" str)) + (when (and (eq? type 'read-error) + (not (string-position "junk" (car info))) + (not (string-position "clobbered" (car info))) + (not (string-position "unexpected" (car info)))) + ;; "unexpected" close paren from: (eval-string (reverse (object->string ()))) -> (eval-string ")(") + (format *stderr* "read-error from ~S: ~S~%" str (apply format #f info))) 'error))) (define (try-both str) @@ -1063,118 +1180,26 @@ (val3 (eval-it str3)) (val4 (eval-it str4))) (same-type? val1 val2 val3 val4 str str1 str2 str3 str4) - - (when (current-output-port) - (format *stderr* "current-output-port is ~S from ~S and ~S~%" (current-output-port) str3 str4) - (set! (current-output-port) #f)) - - ;; if val1 examined, remember: (if (and (let? val1) (openlet? val1)); (not (eq? val1 (rootlet)))) (coverlet val1)) ; might be open and have a length func - )) - -#| - (let ((nstr (make-expr (+ 1 (random 4)))) - (pstr (make-expr (+ 1 (random 4))))) - (let ((str1 (string-append "(let ((x (car (list " nstr ")))) (do ((i 0 (+ i 1))) ((= i 2) x) " ostr " (set! x (car (list " pstr ")))))"))) - (eval-it str1))) - - (catch #t - (lambda () - (let ((val1 (car (list (eval-string str))))) - (let ((newstr (object->string val1 :readable))) - (let ((val2 (eval-string newstr))) - (if (not (equivalent? val1 val2)) - (format *stderr* "~%~S~%~S~% ~W -> ~W~%" str newstr val1 val2)))))) - (lambda arg 'error)) - - (catch #t - (lambda () - (let ((val1 (list (eval-string str)))) - (let ((val2 (list (eval (with-input-from-string str read))))) - (call-with-exit - (lambda (ok) - (for-each - (lambda (x y) - (unless (and (equivalent x y) - (not (gensym? x))) - (format *stderr* "eval/string ~%~S~% ~W -> ~W~%" str val1 val2) - (ok))) - val1 val2)))))) - (lambda arg 'error)) - - (catch #t - (lambda () - (pretty-print (with-input-from-string str read))) - (lambda arg 'error)) - - (let ((nstr (make-expr (+ 1 (random 2))))) - (set! nostr nstr) - (catch #t - (lambda () - (s7-optimize (list (catch #t - (lambda () - (with-input-from-string nstr read)) - (lambda args ()))))) - (lambda arg 'error)) - (let ((str5 (string-append "(let ((_y_ (begin " nstr "))) (define (f x) " str ") (define (g) (f _y_)) (g))")) - (str6 (string-append "((lambda (x) " str ") (begin " nstr "))")) - (str7 (string-append "(let ((x (begin " nstr "))) " str ")")) - (str8 (string-append "(do ((x (begin " nstr "))) (#t " str "))"))) - (let ((val5 (eval-it str5)) - (val6 (eval-it str6)) - (val7 (eval-it str7)) - (val8 (eval-it str8))) - (same-type? val5 val6 val7 val8 nstr str5 str6 str7 str8))) - (let ((str5 (string-append "(let ((x 0)) (cond ((not ((lambda args (car args)) (let () " nstr "))) #<unspecified>) (else " str ")))")) - (str6 (string-append "(let ((x 0)) (when (let () " nstr ") " str "))")) - (str7 (string-append "(let ((x 0)) (unless (not ((lambda args (car args)) (let () " nstr "))) " str "))")) - (str8 (string-append "(let ((x 0)) (cond ((let () " nstr ") " str ")))"))) - (let ((val5 (eval-it str5)) - (val6 (eval-it str6)) - (val7 (eval-it str7)) - (val8 (eval-it str8))) - (same-type? val5 val6 val7 val8 nstr str5 str6 str7 str8)))) - - (let ((mstr (make-expr (+ 1 (random 2))))) - (let* ((str5 (string-append "(let () (if (begin " mstr " ) (begin " nstr ") (begin " str ")))")) - (str6 (string-append "(let () (define (func) " str5 ") (define (hi) (func)) (hi))")) - (str7 (string-append "(let () (cond ((begin " mstr ") " nstr ") (else " str ")))")) - (str8 (string-append "(let () (define (func) " str7 ") (define (hi) (func)) (hi))"))) - (let ((val5 (eval-it str5)) - (val6 (eval-it str6)) - (val7 (eval-it str7)) - (val8 (eval-it str8))) - (same-type? val5 val6 val7 val8 nstr str5 str6 str7 str8)))) -|# - ) + ))) (define dots (vector "." "-" "+" "-")) (define (test-it) (do ((m 0 (+ m 1)) - (n 0) -; (p 0) - ) + (n 0)) ((= m 100000000) (format *stderr* "reached end of loop??~%")) (when (zero? (modulo m 100000)) (set! m 0) -; (set! p (+ p 1)) (set! n (+ n 1)) (if (= n 4) (set! n 0)) - (format *stderr* "~A" (vector-ref dots n)) -#| - (when (= p 100) - (set! p 0) - (gc) (gc) - (format *stderr* "~A~%" (*s7* 'memory-usage))) -|# - ) + (format *stderr* "~A" (vector-ref dots n))) - (try-both (make-expr (+ 1 (random 3)))) ; min 1 here not 0, was 6 - (set! __var__ ((lambda args (car args)) (catch #t (lambda () (eval-string (get-arg))) (lambda () #f)))) - (if (iterator? __var__) (set! __var__ #f)) - (set! __old_var__ __var__) - ;(set! - #_-) + (try-both (make-expr (+ 1 (random both-ran)))) ; min 1 here not 0, was 6 )) - (test-it))) + (catch #t + (lambda () + (test-it)) + (lambda (type info) + (format *stderr* "outer: ~S ~S from ~S~%" type (apply format #f info) estr))))) diff --git a/tools/compsnd b/tools/compsnd index 05ddcba..089cc18 100755 --- a/tools/compsnd +++ b/tools/compsnd @@ -90,7 +90,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet CC=g++ CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -Wextra -Wno-unused-parameter -Wno-implicit-fallthrough -Wno-clobbered -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make ./snd --version ./snd -noinit --features "'clm" @@ -104,7 +104,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- clang ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=clang CFLAGS="-Wall -Wno-array-bounds -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet CC=clang CFLAGS="-Wall -Wno-array-bounds -Wno-parentheses -Wextra -Wno-unused-parameter -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make ./snd --version ./snd -noinit --features "'clm" @@ -113,7 +113,7 @@ make allclean rm -f snd rm -f config.cache -./configure --quiet CC=clang CFLAGS="-Wall -Wno-array-bounds -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet CC=clang CFLAGS="-Wall -Wno-array-bounds -Wno-parentheses -Wextra -Wno-unused-parameter -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make make allclean rm -f snd diff --git a/tools/make-index.scm b/tools/make-index.scm index 147ab9d..790a202 100644 --- a/tools/make-index.scm +++ b/tools/make-index.scm @@ -236,17 +236,17 @@ (if (or (alphanumeric? c) (memv c '(#\? #\!))) (begin - (set! (string-ref rb-name j) c) + (string-set! rb-name j c) (set! i (+ i 1)) (set! j (+ j 1))) (if (and (char=? c #\-) (char=? (string-ref scheme-name (+ i 1)) #\>)) (begin - (set! (string-ref rb-name j) #\2) + (string-set! rb-name j #\2) (set! j (+ j 1)) (set! i (+ i 2))) (begin - (set! (string-ref rb-name j) #\_) + (string-set! rb-name j #\_) (set! i (+ i 1)) (set! j (+ j 1))))))) (if (= j strlen) diff --git a/tools/tauto.scm b/tools/tauto.scm index d1e3545..242894b 100644 --- a/tools/tauto.scm +++ b/tools/tauto.scm @@ -44,8 +44,8 @@ (with-baffle (call/cc (lambda (cc) cc))) (string #\a #\null #\b) #2d((1 2) (3 4)) (inlet 'a 2 'b 3) #<undefined> #<unspecified> (make-int-vector 3) (make-float-vector 3 -1.4) - (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (subvector (make-int-vector '(2 3) 1) '(6)) - (subvector (subvector (make-float-vector '(2 3) 1.0) '(6)) '(2 2)) + (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (subvector (make-int-vector '(2 3) 1) 6) + (subvector (subvector (make-float-vector '(2 3) 1.0) 6) '(2 2)) (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))) @@ -179,7 +179,7 @@ all delete-file system set-cdr! stacktrace test-sym cutlet varlet gc cond-expand reader-cond openlet coverlet eval vector list cons values - symbol-table load throw error + symbol-table load throw error openlets coverlets global-environment current-environment make-rectangular hash-table* make-keyword morally-equal? copy fill! hash-table-set! vector-set! let-set! list-values apply-values immutable! #| diff --git a/tools/tbig.scm b/tools/tbig.scm index 888b55f..3dc1e87 100644 --- a/tools/tbig.scm +++ b/tools/tbig.scm @@ -37,8 +37,8 @@ ((= i n)) (if (> j i) (let ((temp (data j))) - (set! (data j) (data i)) - (set! (data i) temp))) + (vector-set! data j (vector-ref data i)) + (vector-set! data i temp))) (let ((m (/ n 2))) (do () ((not (<= 2 m j))) @@ -53,16 +53,17 @@ (theta (complex 0.0 (* pi dir)) (* theta 0.5))) ((= lg ipow)) (let ((wpc (exp theta)) - (wc 1.0)) + (wc 1.0) + (tc 0.0)) (do ((ii 0 (+ ii 1))) ((= ii prev)) (do ((jj 0 (+ jj 1)) (i ii (+ i mmax)) (j (+ ii prev) (+ j mmax))) ((>= jj pow)) - (let ((tc (* wc (data j)))) - (set! (data j) (- (data i) tc)) - (set! (data i) (+ (data i) tc)))) + (set! tc (* wc (vector-ref data j))) + (vector-set! data j (- (vector-ref data i) tc)) + (vector-set! data i (+ (vector-ref data i) tc))) (set! wc (* wc wpc))) (set! prev mmax)))) data)) @@ -112,12 +113,12 @@ (j 0)) ((= i n)) (if (> j i) - (let ((tempr (rl j)) - (tempi (im j))) - (set! (rl j) (rl i)) - (set! (im j) (im i)) - (set! (rl i) tempr) - (set! (im i) tempi))) + (let ((tempr (vector-ref rl j)) + (tempi (vector-ref im j))) + (vector-set! rl j (vector-ref rl i)) + (vector-set! im j (vector-ref im i)) + (vector-set! rl i tempr) + (vector-set! im i tempi))) (let ((m (/ n 2))) (do () ((not (<= 2 m j))) @@ -134,19 +135,21 @@ (let ((wpr (rationalize (cos theta))) (wpi (rationalize (sin theta))) (wr 1) - (wi 0)) + (wi 0) + (tempr 0) + (tempi 0)) (do ((ii 0 (+ ii 1))) ((= ii prev)) (do ((jj 0 (+ jj 1)) (i ii (+ i mmax)) (j (+ ii prev) (+ j mmax))) ((>= jj pow)) - (let ((tempr (rationalize (- (* wr (rl j)) (* wi (im j))))) - (tempi (rationalize (+ (* wr (im j)) (* wi (rl j)))))) - (set! (rl j) (rationalize (- (rl i) tempr))) - (set! (rl i) (rationalize (+ (rl i) tempr))) - (set! (im j) (rationalize (- (im i) tempi))) - (set! (im i) (rationalize (+ (im i) tempi))))) + (set! tempr (rationalize (- (* wr (vector-ref rl j)) (* wi (vector-ref im j))))) + (set! tempi (rationalize (+ (* wr (vector-ref im j)) (* wi (vector-ref rl j))))) + (vector-set! rl j (rationalize (- (vector-ref rl i) tempr))) + (vector-set! rl i (rationalize (+ (vector-ref rl i) tempr))) + (vector-set! im j (rationalize (- (vector-ref im i) tempi))) + (vector-set! im i (rationalize (+ (vector-ref im i) tempi)))) (let ((wtemp wr)) (set! wr (rationalize (- (* wr wpr) (* wi wpi)))) (set! wi (rationalize (+ (* wi wpr) (* wtemp wpi)))))) @@ -177,7 +180,7 @@ (let ((mx 0.0)) (do ((i 0 (+ i 1))) ((= i fft-size)) - (set! mx (max mx (abs (fvr i)) (abs (fvi i))))) + (set! mx (max mx (abs (vector-ref fvr i)) (abs (vector-ref fvi i))))) (format () "noise: ~A~%" (* 1.0 mx))))) (define (ratio-test) @@ -187,7 +190,7 @@ (do ((i 0 (+ i 1)) (x 0.0 (+ x scl))) ((= i fft-size)) - (set! (fvr i) (rationalize (sin x)))) + (vector-set! fvr i (rationalize (sin x)))) (ratio-fft fvr fvi fft-size 1) (ratio-checker fvr fvi) (ratio-fft #f #f fft-size 1) @@ -833,6 +836,7 @@ (test (bigfv (ash 1 31)) 3)) (clear-and-gc)) + (define (int-vector-fft rl im n dir) (when rl (let ((tempr 0.0) @@ -1203,12 +1207,12 @@ (j 0)) ((= i n)) (if (> j i) - (let ((tempr (rl j)) - (tempi (im j))) - (set! (rl j) (rl i)) - (set! (im j) (im i)) - (set! (rl i) tempr) - (set! (im i) tempi))) + (let ((tempr (block-ref rl j)) + (tempi (block-ref im j))) + (block-set! rl j (block-ref rl i)) + (block-set! im j (block-ref im i)) + (block-set! rl i tempr) + (block-set! im i tempi))) (let ((m (/ n 2))) (do () ((not (<= 2 m j))) @@ -1235,12 +1239,12 @@ (j (+ ii prev) (+ j mmax)) (jj 0 (+ jj 1))) ((>= jj pow)) - (set! tempr (- (* wr (rl j)) (* wi (im j)))) - (set! tempi (+ (* wr (im j)) (* wi (rl j)))) - (set! (rl j) (- (rl i) tempr)) - (set! (rl i) (+ (rl i) tempr)) - (set! (im j) (- (im i) tempi)) - (set! (im i) (+ (im i) tempi))) + (set! tempr (- (* wr (block-ref rl j)) (* wi (block-ref im j)))) + (set! tempi (+ (* wr (block-ref im j)) (* wi (block-ref rl j)))) + (block-set! rl j (- (block-ref rl i) tempr)) + (block-set! rl i (+ (block-ref rl i) tempr)) + (block-set! im j (- (block-ref im i) tempi)) + (block-set! im i (+ (block-ref im i) tempi))) (set! wtemp wr) (set! wr (- (* wr wpr) (* wi wpi))) (set! wi (+ (* wi wpr) (* wtemp wpi)))) @@ -1254,7 +1258,7 @@ (do ((i 0 (+ i 1)) (x 0.0 (+ x scl))) ((= i fft-size)) - (set! (fvr i) (sin x))) + (block-set! fvr i (sin x))) (block-fft fvr fvi fft-size 1) (do ((mx 0.0) (mxloc 0) @@ -1275,7 +1279,7 @@ (i 0 (+ i 1))) ((= i fft-size) (format () "noise: ~A~%" mx)) - (set! mx (max mx (abs (fvr i)) (abs (fvi i))))) + (set! mx (max mx (abs (block-ref fvr i)) (abs (block-ref fvi i))))) (block-fft #f #f fft-size 1))) (block-test) @@ -2034,16 +2038,17 @@ (theta (complex 0.0 (* pi dir)) (* theta 0.5))) ((= lg ipow)) (let ((wpc (exp theta)) - (wc 1.0)) + (wc 1.0) + (tc 0.0)) (do ((ii 0 (+ ii 1))) ((= ii prev)) (do ((jj 0 (+ jj 1)) (i ii (+ i mmax)) (j (+ ii prev) (+ j mmax))) ((>= jj pow)) - (let ((tc (* wc (old-value (vector-ref data j))))) - (vector-set! data j (new-value (- (old-value (vector-ref data i)) tc))) - (vector-set! data i (new-value (+ (old-value (vector-ref data i)) tc))))) + (set! tc (* wc (old-value (vector-ref data j)))) + (vector-set! data j (new-value (- (old-value (vector-ref data i)) tc))) + (vector-set! data i (new-value (+ (old-value (vector-ref data i)) tc)))) (set! wc (* wc wpc))) (set! prev mmax)))) data)) diff --git a/tools/teq.scm b/tools/teq.scm index 5d7b79d..575899f 100644 --- a/tools/teq.scm +++ b/tools/teq.scm @@ -69,35 +69,12 @@ ;(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 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 teq-vars k)) - (if (not (= j k)) - (format *stderr* "oops! (~D ~D): ~A ~A~%" j k vj (vector-ref teq-vars k))))) - (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)))) - (close-output-port p))) -|# (define (tests size) (let ((str #f) (vj #f) (p (open-output-string))) - (do ((i 0 (+ i 1))) + (do ((i 0 (+ i 1))) ; nested for-each is almost as fast ((= i size)) (do ((a teq-vars (cdr a))) ((null? a)) @@ -106,42 +83,13 @@ ((null? b)) (if (equal? vj (car b)) (if (not (eq? a b)) - (format *stderr* "oops!: ~A ~A~%" a b)))) + (format *stderr* "oops!: ~A ~A~%" a b)))) (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)))) + (get-output-string p #t) + (object->string vj) + (format #f "~A~%" vj) + (cyclic-sequences vj))) (close-output-port p))) -#| -;; almost as fast -(define (tests size) - (let ((str #f) - (p (open-output-string)) - (k 0) (j 0)) - (do ((i 0 (+ i 1))) - ((= i size)) - (set! k 0) - (for-each - (lambda (vj) - (set! j 0) - (for-each - (lambda (w) - (if (equal? vj w) - (if (not (= j k)) - (format *stderr* "oops! (~D ~D): ~A ~A~%" j k vj w))) - (set! j (+ j 1))) - 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))) - teq-vars)) - (close-output-port p))) -|# - (tests 10000) diff --git a/tools/thash.scm b/tools/thash.scm index 58bbb32..4112ef9 100644 --- a/tools/thash.scm +++ b/tools/thash.scm @@ -125,7 +125,7 @@ (set! sym-hash #f))) (define (test7 size) - (let ((chr-hash (make-hash-table 256))) + (let ((chr-hash (make-hash-table 256 char=?))) (do ((i 0 (+ i 1))) ((= i 256)) (hash-table-set! chr-hash (integer->char i) i)) @@ -168,7 +168,7 @@ (set! any-hash1 #f))) (define (test10 size) - (let ((cmp-hash (make-hash-table size))) + (let ((cmp-hash (make-hash-table size =))) (do ((i 0 (+ i 1))) ((= i size)) (hash-table-set! cmp-hash (complex i i) i)) diff --git a/tools/titer.scm b/tools/titer.scm index 42c0072..b2de879 100644 --- a/tools/titer.scm +++ b/tools/titer.scm @@ -2,9 +2,7 @@ (set! (*s7* 'heap-size) (* 4 1024000)) -(let () - - (define with-blocks #f) +(let ((with-blocks #f)) (when with-blocks (let ((new-env (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible (load "s7test-block.so" new-env))) diff --git a/tools/tmap.scm b/tools/tmap.scm index 2f489c9..52f0ba8 100644 --- a/tools/tmap.scm +++ b/tools/tmap.scm @@ -268,8 +268,8 @@ (v-tst (expt b i)) (s-tst (expt b i)) (p-tst (expt b i)))) - (list 2 3 4 7 10) - (list 12 4 3 6 6))) + '(2 3 4 7 10) + '(12 4 3 6 6))) (test-it) diff --git a/tools/tread.scm b/tools/tread.scm index a5759ae..05dca4e 100644 --- a/tools/tread.scm +++ b/tools/tread.scm @@ -103,13 +103,13 @@ ((3) (format #f "~W" (cadr set))) ((4) (symbol->keyword (cadr set)))) (#(p v cy h e it cp) (caddr set)))) - ((= (car set) 5) - (format *stderr* " (set! ((iterator-sequence it) ~A) ~A)~%" - (cadr set) - (#(p v cy h e it cp) (caddr set)))) - (else (format *stderr* " (set! (((object->let cp) 'c-type) ~A) ~A)~%" - (cadr set) - (#(p v cy h e it cp) (caddr set)))))) + ((= (car set) 5) + (format *stderr* " (set! ((iterator-sequence it) ~A) ~A)~%" + (cadr set) + (#(p v cy h e it cp) (caddr set)))) + (else (format *stderr* " (set! (((object->let cp) 'c-type) ~A) ~A)~%" + (cadr set) + (#(p v cy h e it cp) (caddr set)))))) sets) (format *stderr* " ~A)~%" (#(p v cy h e it cp) bi))) (set! bi (+ bi 1)))) diff --git a/tools/trec.scm b/tools/trec.scm index 91ce641..a80805b 100644 --- a/tools/trec.scm +++ b/tools/trec.scm @@ -11,6 +11,19 @@ (display f32) (newline))) +#| +(define* (tfib n (a 1) (b 1)) + (if (= n 0) + a + (if (= n 1) + b + (tfib (- n 1) b (+ a b))))) + +(let ((f32 (tfib 31))) + (unless (= f32 2178309) + (display f32) + (newline))) +|# (define (trib n) (if (< n 3) diff --git a/tools/tset.scm b/tools/tset.scm index 0941f76..716bf46 100644 --- a/tools/tset.scm +++ b/tools/tset.scm @@ -16,6 +16,8 @@ (format *stderr* "a: ~D ~D~%" a x))) (let ((a 3)) (set! a 2)) + (if (not (= x 2)) + (format *stderr* "x: ~D~%" x)) (let ((a 1)) (do ((k 0 (+ k 1))) ((= k 1)) @@ -27,8 +29,12 @@ (set! c 2) (if (not (= x 5)) (format *stderr* "set: ~S ~S ~S ~S~%" x a b c)))) - (set! b 3))) - (set! a 4)) + (set! b 3) + (if (not (= x 6)) + (format *stderr* "set: ~S ~S ~S~%" x a b)))) + (set! a 4) + (if (not (= x 9)) + (format *stderr* "set: ~S ~S~%" x a))) (reactive-let ((y (* x 2)) (z (+ (* x 3) 1))) (set! x 1) @@ -41,7 +47,7 @@ (if (or (not (= y 2)) (not (= z 5))) (format *stderr* "let*: ~D ~D ~D~%" x y z))) - + (if (zero? (modulo i 8)) (gc))))) (t) diff --git a/tools/tshoot.scm b/tools/tshoot.scm index 8641fea..81aae93 100644 --- a/tools/tshoot.scm +++ b/tools/tshoot.scm @@ -224,6 +224,33 @@ long lived tree of depth 21 check: 4194303 ;;; -------------------------------------------------------------------------------- +(define (prime? z) ; from exobrain.se + (or (memq z '(2 3 5 7)) ; memv... + (and (positive? (remainder z 2)) + (positive? (remainder z 3)) + (positive? (remainder z 5)) + (positive? (remainder z 7)) + (let ((increments (list 4 2 4 2 4 6 2 6))) + (set-cdr! (list-tail increments 7) increments) + (do ((lim (sqrt z)) + (divisor 11 (+ divisor (car increments)))) + ((or (zero? (remainder z divisor)) + (>= divisor lim)) + (> divisor lim)) + (set! increments (cdr increments))))))) + +(let () + (define (count-primes limit) ; for limit=10000000 20.5 secs 664579 + (let ((primes 0)) + (do ((i 2 (+ i 1))) + ((= i limit) + primes) + (if (prime? i) + (set! primes (+ primes 1)))))) + + (display (count-primes 100000)) (newline)) ; 9592 + +;;; -------------------------------------------------------------------------------- (s7-version) (exit) diff --git a/tools/tvect.scm b/tools/tvect.scm index 9220e42..0c6ca69 100644 --- a/tools/tvect.scm +++ b/tools/tvect.scm @@ -214,7 +214,7 @@ (sum 0)) (do ((i 0 (+ i 1))) ((= i size) sum) - (set! sum (+ sum (if (zero? (real-part (v i))) 1 0)))))) + (set! sum (+ sum (if (zero? (real-part (vector-ref v i))) 1 0)))))) ; faster is (imag-part...) (unless (= (g6) size) (format *stderr* "g6: ~S~%" (g6))) diff --git a/tools/valcall.scm b/tools/valcall.scm index a962eff..fa2a592 100644 --- a/tools/valcall.scm +++ b/tools/valcall.scm @@ -66,8 +66,8 @@ (system (format #f "./snd compare-calls.scm -e '(compare-calls \"~A~D\" \"~A~D\")'" outfile (- next 1) outfile next))))) (list (list "repl" "tpeak.scm") (list "repl" "tmac.scm") - (list "repl" "tshoot.scm") (list "repl" "tauto.scm") + (list "repl" "tshoot.scm") (list "repl" "tref.scm") (list "snd -noinit" "make-index.scm") (list "repl" "teq.scm") @@ -80,12 +80,12 @@ (list "repl" "tvect.scm") (list "repl" "tlet.scm") (list "repl" "tclo.scm") - (list "repl" "tmap.scm") (list "repl" "dup.scm") + (list "repl" "tmap.scm") (list "repl" "tsort.scm") + (list "repl" "tset.scm") (list "repl" "titer.scm") (list "repl" "thash.scm") - (list "repl" "tset.scm") (list "repl" "trec.scm") (list "snd -noinit" "tgen.scm") ; repl here + cload sndlib was slower (list "snd -noinit" "tall.scm") |