[SCM] snd/master: New upstream version 16.8
umlaeute at users.alioth.debian.org
umlaeute at users.alioth.debian.org
Thu Sep 8 22:43:07 UTC 2016
The following commit has been merged in the master branch:
commit a91adfdf373f6914bfec9901421cba0e99746b0b
Author: IOhannes m zmölnig <zmoelnig at umlautQ.umlaeute.mur.at>
Date: Thu Sep 8 23:58:23 2016 +0200
New upstream version 16.8
diff --git a/HISTORY.Snd b/HISTORY.Snd
index e434ad2..93d5d5a 100644
--- a/HISTORY.Snd
+++ b/HISTORY.Snd
@@ -1,5 +1,6 @@
Snd change log
+ 6-Sep: Snd 16.8.
28-Jul: Snd 16.7.
14-Jun: Snd 16.6.
30-May: snd-lint.scm, symbol takes any number of args.
diff --git a/NEWS b/NEWS
index ca62b9d..a10873d 100644
--- a/NEWS
+++ b/NEWS
@@ -1,7 +1,11 @@
-Snd 16.7.
+Snd 16.8.
-changed compute-string and compute-uniform-circular-string to vibrating-string, etc.
+cmn: Michael Edwards got cmn to work in ECL.
-checked: gtk 3.21.3|4, sbcl 1.3.7.
+s7: object->let
+ changed ->byte-vector to string->byte-vector
+ let-temporarily is now built-in
-Thanks!: Carlos Carrasco
+checked: sbcl 1.3.8|9, gtk 3.21.5
+
+Thanks!: Michael Edwards.
\ No newline at end of file
diff --git a/animals.scm b/animals.scm
index c7ff644..35968d9 100644
--- a/animals.scm
+++ b/animals.scm
@@ -1436,13 +1436,12 @@
(defanimal (green-toad beg dur amp)
;; rocky 31 1
;; (an experiment with wave-train in place of pulsed env)
- (let ((pulse (let* ((wave-len 256)
- (v (make-float-vector wave-len))
- (pulse-ampf (make-env '(0.000 0.000 0.063 0.312 0.277 0.937 0.405 1.000 0.617 0.696 0.929 0.146 2.000 0.000) :length wave-len)))
- (do ((i 0 (+ i 1)))
- ((= i wave-len))
- (set! (v i) (env pulse-ampf)))
- v)))
+ (let ((pulse (let ((wave-len 256))
+ (do ((v (make-float-vector wave-len))
+ (pulse-ampf (make-env '(0.000 0.000 0.063 0.312 0.277 0.937 0.405 1.000 0.617 0.696 0.929 0.146 2.000 0.000) :length wave-len))
+ (i 0 (+ i 1)))
+ ((= i wave-len) v)
+ (set! (v i) (env pulse-ampf))))))
(let ((start (seconds->samples beg))
(stop (seconds->samples (+ beg dur)))
(ampf (make-env (list 0 0 .2 .9 .3 .7 .4 1 (max .5 (- dur .01)) 1 (max .51 dur) 0) :duration dur :scaler amp))
@@ -4523,10 +4522,8 @@
(fr2 (* 30 (sin (hz->radians 1700))))
(fr3 (* 10 (sin (hz->radians 5600)))))
- (let ((fb (vector frm1 frm2 frm3)))
- (let ((fs (float-vector fr1 fr2 fr3)))
- (set! fb (make-formant-bank fb fs)))
-
+ (let ((fb (make-formant-bank (vector frm1 frm2 frm3)
+ (float-vector fr1 fr2 fr3))))
(do ((i 0 (+ i 1)))
((= i 3))
(set! (starts i) (seconds->samples (+ beg (begs i))))
@@ -6774,39 +6771,38 @@
(let ((stop (seconds->samples (+ beg dur)))
(frqf (make-env '(0 0 1 -1) :duration dur :scaler (hz->radians 500)))
(pulse-spacing (seconds->samples .064))
- (pulse-samps (seconds->samples pulse-dur)))
- (let ((pulse-ampf (make-env '(0.000 0.000 0.114 0.486 0.182 0.988 0.394 0.763 0.620 1.000 0.769 0.937 0.889 1.000 1.000 0.000)
- :duration pulse-dur :scaler amp))
- (pulse-frqf (make-env '(0.000 0.230 0.109 0.291 0.212 0.322 0.298 0.343 0.410 0.348 0.654 0.357 0.821 0.354 0.889 0.337 0.952 0.304 1.000 0.231)
- :duration pulse-dur :scaler (hz->radians 22050.0)))
- (gen1 (make-polywave 0.0 '(1 .99 2 .01)))
- (gen2 (make-polywave 0.0 '(5 .9 7 .07 8 .02 9 .01 11 .02)))
- (pulse-ampf2 (make-env '(0 0 .65 0 .8 1 .9 1 1 0)
- :duration pulse-dur :scaler .4))
- (pulse-frqf2 (make-env '(0 5400 .6 5400 .75 6300 1 5400)
- :duration pulse-dur :scaler (hz->radians 0.2) :base .1)))
-
- (let ((first-stop (+ start pulse-samps)))
- (do ((i start (+ i 1)))
- ((= i first-stop))
- (outa i (* (env pulse-ampf)
- (polywave gen1 (+ (env pulse-frqf)
- (env frqf)))))))
- (set! start (+ start pulse-spacing))
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)
-
- (do ((i start (+ i pulse-spacing)))
- ((>= i stop))
- (let ((reset-stop (min stop (+ i pulse-samps))))
- (do ((k i (+ k 1)))
- ((= k reset-stop))
- (outa k (+ (* (env pulse-ampf)
- (polywave gen1 (+ (env pulse-frqf)
- (env frqf))))
- (* (env pulse-ampf2)
- (polywave gen2 (env pulse-frqf2))))))
- (for-each mus-reset (vector pulse-ampf pulse-frqf pulse-ampf2 pulse-frqf2))))))))
+ (pulse-samps (seconds->samples pulse-dur))
+ (pulse-ampf (make-env '(0.000 0.000 0.114 0.486 0.182 0.988 0.394 0.763 0.620 1.000 0.769 0.937 0.889 1.000 1.000 0.000)
+ :duration pulse-dur :scaler amp))
+ (pulse-frqf (make-env '(0.000 0.230 0.109 0.291 0.212 0.322 0.298 0.343 0.410 0.348 0.654 0.357 0.821 0.354 0.889 0.337 0.952 0.304 1.000 0.231)
+ :duration pulse-dur :scaler (hz->radians 22050.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01)))
+ (gen2 (make-polywave 0.0 '(5 .9 7 .07 8 .02 9 .01 11 .02)))
+ (pulse-ampf2 (make-env '(0 0 .65 0 .8 1 .9 1 1 0)
+ :duration pulse-dur :scaler .4))
+ (pulse-frqf2 (make-env '(0 5400 .6 5400 .75 6300 1 5400)
+ :duration pulse-dur :scaler (hz->radians 0.2) :base .1)))
+ (let ((first-stop (+ start pulse-samps)))
+ (do ((i start (+ i 1)))
+ ((= i first-stop))
+ (outa i (* (env pulse-ampf)
+ (polywave gen1 (+ (env pulse-frqf)
+ (env frqf)))))))
+ (set! start (+ start pulse-spacing))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf)
+
+ (do ((i start (+ i pulse-spacing)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (+ (* (env pulse-ampf)
+ (polywave gen1 (+ (env pulse-frqf)
+ (env frqf))))
+ (* (env pulse-ampf2)
+ (polywave gen2 (env pulse-frqf2))))))
+ (for-each mus-reset (vector pulse-ampf pulse-frqf pulse-ampf2 pulse-frqf2)))))))
;; (with-sound (:play #t) (bushtit 0 .5))
@@ -6939,8 +6935,8 @@
(ampf (make-env '(0.000 0.000 0.106 0.826 0.190 0.996 0.418 0.818 0.688 0.458 0.897 0.447 0.962 0.348 1.000 0.000)
:duration dur :scaler amp))
(frqf (make-env '(0 4400 .4 4200 1 4300) :duration dur :scaler (hz->radians 1.0)))
- (gen-up (make-polywave 0.0 (vector 1 .95 2 .03 3 .02)))
- (gen-down (make-polywave 0.0 (vector 1 .95 2 .03 3 .02)))
+ (gen-up (make-polywave 0.0 #(1 .95 2 .03 3 .02)))
+ (gen-down (make-polywave 0.0 #(1 .95 2 .03 3 .02)))
(mod-up (make-oscil 142.0))
(mod-down (make-oscil 142.0))
(pulse-samps (seconds->samples (/ 1.0 142.0)))
@@ -8634,7 +8630,7 @@
(defanimal (inca-dove-2 beg amp)
;; south 11 11.3 ("what the hell")
- (let ((pitch 5150)
+ (let ((pitch (hz->radians 5150))
(dur1 .1)
(dur2 .07)
(dur3 .29)
@@ -8646,14 +8642,14 @@
:duration dur1 :scaler amp))
(frqf1 (make-env '(0.000 0.092 0.082 0.115 0.201 0.137 0.351 0.143 0.477 0.140 0.553 0.162 0.624 0.166
0.675 0.159 0.770 0.166 0.838 0.162 0.933 0.156 1.000 0.156)
- :duration dur1 :scaler (hz->radians pitch)))
+ :duration dur1 :scaler pitch))
(start2 (seconds->samples (+ beg .2))))
(let ((stop2 (+ start2 (seconds->samples dur2)))
(ampf2 (make-env '(0.000 0.000 0.254 0.252 0.513 0.997 0.612 0.943 0.675 0.990 0.851 0.809 0.906 0.608 1.000 0.000)
:duration dur2 :scaler amp))
(frqf2 (make-env '(0.000 0.129 0.158 0.154 0.369 0.173 0.450 0.173 0.867 0.164 1.000 0.138)
- :duration dur2 :scaler (hz->radians pitch)))
+ :duration dur2 :scaler pitch))
(start3 (seconds->samples (+ beg .3))))
(let ((stop3 (+ start3 (seconds->samples dur3)))
@@ -8673,7 +8669,7 @@
:duration dur3 :scaler amp))
(frqf3 (make-env '(0.000 0.172 0.135 0.191 0.199 0.192 0.266 0.176 0.325 0.173 0.384 0.182 0.423 0.186
0.614 0.173 0.896 0.145 1.000 0.138)
- :duration dur3 :scaler (hz->radians pitch)))
+ :duration dur3 :scaler pitch))
(gen1 (make-polywave 0.0 '(1 .99 3 .01)))
(rnd (make-rand-interp 300 (hz->radians 50))))
diff --git a/bess1.scm b/bess1.scm
index e2935d6..ba2f36d 100644
--- a/bess1.scm
+++ b/bess1.scm
@@ -61,31 +61,31 @@
(let ((documentation "(make-rt-violin dur freq amp (fm-index 1.0) (amp-env '(0 0 25 1 75 1 100 0))) real time simple violin (see fm.html)"))
(lambda* (dur freq amp (fm-index 1.0) (amp-env '(0 0 25 1 75 1 100 0)))
(let* ((frq-scl (hz->radians freq))
- (maxdev (* frq-scl fm-index))
- (carrier (make-oscil :frequency freq))
- (fmosc1 (make-oscil :frequency freq))
- (fmosc2 (make-oscil :frequency (* 3 freq)))
- (fmosc3 (make-oscil :frequency (* 4 freq)))
- (ampf (make-env :envelope amp-env :scaler amp :duration dur))
- (indf1 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
- :scaler (* maxdev (/ 5.0 (log freq)))
- :duration dur))
- (indf2 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
- :scaler (/ (* maxdev 3.0 (- 8.5 (log freq))) (+ 3.0 (/ freq 1000)))
- :duration dur))
- (indf3 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
- :scaler (* maxdev (/ 4.0 (sqrt freq)))
- :duration dur))
- (pervib (make-triangle-wave :frequency 5 :amplitude (* 0.0025 frq-scl)))
- (ranvib (make-rand-interp :frequency 16 :amplitude (* 0.005 frq-scl))))
- (lambda ()
- (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
- (* (env ampf)
- (oscil carrier
- (+ vib
- (* (env indf1) (oscil fmosc1 vib))
- (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
- (* (env indf3) (oscil fmosc3 (* 4.0 vib))))))))))))
+ (maxdev (* frq-scl fm-index)))
+ (let ((carrier (make-oscil :frequency freq))
+ (fmosc1 (make-oscil :frequency freq))
+ (fmosc2 (make-oscil :frequency (* 3 freq)))
+ (fmosc3 (make-oscil :frequency (* 4 freq)))
+ (ampf (make-env :envelope amp-env :scaler amp :duration dur))
+ (indf1 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
+ :scaler (* maxdev (/ 5.0 (log freq)))
+ :duration dur))
+ (indf2 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
+ :scaler (/ (* maxdev 3.0 (- 8.5 (log freq))) (+ 3.0 (/ freq 1000)))
+ :duration dur))
+ (indf3 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
+ :scaler (* maxdev (/ 4.0 (sqrt freq)))
+ :duration dur))
+ (pervib (make-triangle-wave :frequency 5 :amplitude (* 0.0025 frq-scl)))
+ (ranvib (make-rand-interp :frequency 16 :amplitude (* 0.005 frq-scl))))
+ (lambda ()
+ (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
+ (* (env ampf)
+ (oscil carrier
+ (+ vib
+ (* (env indf1) (oscil fmosc1 vib))
+ (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
+ (* (env indf3) (oscil fmosc3 (* 4.0 vib)))))))))))))
(define lim 256)
diff --git a/big-gens.scm b/big-gens.scm
index 561c088..8707a04 100644
--- a/big-gens.scm
+++ b/big-gens.scm
@@ -30,22 +30,22 @@
(/ samps *clm-srate*))
(define (big-rectangular->polar rl im)
- (let ((len (length rl)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((rl1 (rl i))
- (im1 (im i)))
- (set! (rl i) (sqrt (+ (* rl1 rl1) (* im1 im1))))
- (set! (im i) (- (atan im1 rl1)))))))
+ (do ((len (length rl))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (let ((rl1 (rl i))
+ (im1 (im i)))
+ (set! (rl i) (sqrt (+ (* rl1 rl1) (* im1 im1))))
+ (set! (im i) (- (atan im1 rl1))))))
(define (big-polar->rectangular mag ang)
- (let ((len (length mag)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((mag1 (mag i))
- (ang1 (- (ang i))))
- (set! (mag i) (* mag1 (cos ang1)))
- (set! (ang i) (* mag1 (sin ang1)))))))
+ (do ((len (length mag))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (let ((mag1 (mag i))
+ (ang1 (- (ang i))))
+ (set! (mag i) (* mag1 (cos ang1)))
+ (set! (ang i) (* mag1 (sin ang1))))))
;;; -------- arrays (vectors in this context) --------
diff --git a/binary-io.scm b/binary-io.scm
index be83523..6f5bba5 100644
--- a/binary-io.scm
+++ b/binary-io.scm
@@ -10,12 +10,12 @@
;;; -------- strings (0-terminated)
(define (io-read-string)
- (let ((chars ()))
- (do ((c (read-byte) (read-byte)))
- ((or (eof-object? c)
- (= c 0))
- (reverse (apply string chars)))
- (set! chars (cons (integer->char c) chars)))))
+ (do ((chars ())
+ (c (read-byte) (read-byte)))
+ ((or (eof-object? c)
+ (= c 0))
+ (reverse (apply string chars)))
+ (set! chars (cons (integer->char c) chars))))
(define (io-write-string str)
(format () "~{~A~}" str)
@@ -26,10 +26,10 @@
;;; -------- strings (unterminated)
(define* (read-chars (len 4))
- (let ((str (make-string len)))
- (do ((i 0 (+ i 1)))
- ((= i len) str)
- (set! (str i) (read-char)))))
+ (do ((str (make-string len))
+ (i 0 (+ i 1)))
+ ((= i len) str)
+ (set! (str i) (read-char))))
(define (write-chars str)
(format () "~{~A~}" str))
@@ -88,16 +88,16 @@
;;; -------- 64-bit ints
(define (read-bint64)
- (let ((int 0))
- (do ((i 56 (- i 8)))
- ((< i 0) int)
- (set! int (logior int (ash (read-byte) i))))))
+ (do ((int 0)
+ (i 56 (- i 8)))
+ ((< i 0) int)
+ (set! int (logior int (ash (read-byte) i)))))
(define (read-lint64)
- (let ((int 0))
- (do ((i 0 (+ i 8)))
- ((= i 64) int)
- (set! int (logior int (ash (read-byte) i))))))
+ (do ((int 0)
+ (i 0 (+ i 8)))
+ ((= i 64) int)
+ (set! int (logior int (ash (read-byte) i)))))
(define (write-bint64 int)
(do ((i 56 (- i 8)))
diff --git a/clean.scm b/clean.scm
index 45f76c6..b4ca1d6 100644
--- a/clean.scm
+++ b/clean.scm
@@ -117,13 +117,13 @@
(define* (smooth-float-vector data beg dur)
(let ((y0 (data beg))
(y1 (data (+ beg dur))))
- (let ((angle (if (> y1 y0) pi 0.0))
- (off (* .5 (+ y0 y1)))
- (scale (* 0.5 (abs (- y1 y0))))
- (incr (/ pi dur)))
- (do ((i 0 (+ i 1)))
- ((= i dur))
- (set! (data (+ beg i)) (+ off (* scale (cos (+ angle (* i incr))))))))))
+ (do ((angle (if (> y1 y0) pi 0.0))
+ (off (* .5 (+ y0 y1)))
+ (scale (* 0.5 (abs (- y1 y0))))
+ (incr (/ pi dur))
+ (i 0 (+ i 1)))
+ ((= i dur))
+ (set! (data (+ beg i)) (+ off (* scale (cos (+ angle (* i incr)))))))))
(define* (remove-pops (size 8) snd chn)
(let* ((len (framples snd chn))
@@ -260,7 +260,7 @@
(format () "~%;notch hum 0: ~A" mx)))
(close-sound (find-sound test)))
(let ((test (with-sound ("test.snd" :srate 22050)
- (let ((p (make-polywave 20.0 (list 2 1 3 1 4 1)))
+ (let ((p (make-polywave 20.0 '(2 1 3 1 4 1)))
(e (make-env '(0 0 1 .3 9 .3 10 0) :scaler 1/3 :length 44100)))
(do ((i 0 (+ i 1)))
((= i 44100))
@@ -280,7 +280,7 @@
(close-sound (find-sound test)))
(let ((test (with-sound ("test.snd" :srate 22050)
- (let ((p (make-polywave 5.0 (list 11 1 12 1 13 1)))
+ (let ((p (make-polywave 5.0 '(11 1 12 1 13 1)))
(e (make-env '(0 0 1 .3 9 .3 10 0) :scaler 1/3 :length 44100)))
(do ((i 0 (+ i 1)))
((= i 44100))
diff --git a/clm-ins.scm b/clm-ins.scm
index 26c005e..c070824 100644
--- a/clm-ins.scm
+++ b/clm-ins.scm
@@ -2313,82 +2313,82 @@ is a physical model of a flute:
(grn2 (make-grn :rampval 0.0 :rampinc (/ 1.0 rampdur) :loc 0 :segctr 0 :whichseg 0 :ramplen rampdur :steadylen steadydur :trigger 0 :file fil2))
(out1 beg)
(out2 (+ hop beg)))
- (do ((i beg (+ i 1)))
+ (do ((i beg (+ i 1))
+ (val 0.0 0.0))
((= i end))
- (let ((val 0.0))
- (when (= i out1)
- (set! val (with-let grn1
- (let ((inval (ina loc file)))
- (set! loc (+ loc 1))
- (if (= whichseg 0) ;ramp-up
- (begin
- (set! inval (* inval rampval))
- (set! rampval (+ rampval rampinc))
- (set! segctr (+ segctr 1))
- (if (= segctr ramplen)
- (begin
- (set! segctr 0)
- (set! whichseg (+ whichseg 1)))))
- (if (= whichseg 1) ;steady-state
+ (when (= i out1)
+ (set! val (with-let grn1
+ (let ((inval (ina loc file)))
+ (set! loc (+ loc 1))
+ (if (= whichseg 0) ;ramp-up
+ (begin
+ (set! inval (* inval rampval))
+ (set! rampval (+ rampval rampinc))
+ (set! segctr (+ segctr 1))
+ (if (= segctr ramplen)
(begin
- (set! segctr (+ segctr 1))
- (if (= segctr steadylen)
- (begin
- (set! segctr 0)
- (set! whichseg (+ whichseg 1)))))
- (begin ;ramp-down
- (set! inval (* inval rampval))
- (set! segctr (+ segctr 1))
- (set! rampval (- rampval rampinc))
- (if (= segctr ramplen)
- (begin
- (set! segctr 0)
- (set! trigger 1)
- (set! whichseg 0)
- (set! rampval 0.0))))))
- inval)))
- (set! out1 (+ out1 1))
- (if (= (grn1 'trigger) 1)
- (begin
- (set! (grn1 'trigger) 0)
- (set! out1 (+ out1 hop)))))
- (when (= i out2)
- (set! val (+ val (with-let grn2
- (let ((inval (ina loc file)))
- (set! loc (+ loc 1))
- (if (= whichseg 0) ;ramp-up
- (begin
- (set! inval (* inval rampval))
- (set! rampval (+ rampval rampinc))
- (set! segctr (+ segctr 1))
- (if (= segctr ramplen)
- (begin
- (set! segctr 0)
- (set! whichseg (+ whichseg 1)))))
- (if (= whichseg 1) ;steady-state
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (if (= whichseg 1) ;steady-state
+ (begin
+ (set! segctr (+ segctr 1))
+ (if (= segctr steadylen)
+ (begin
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (begin ;ramp-down
+ (set! inval (* inval rampval))
+ (set! segctr (+ segctr 1))
+ (set! rampval (- rampval rampinc))
+ (if (= segctr ramplen)
+ (begin
+ (set! segctr 0)
+ (set! trigger 1)
+ (set! whichseg 0)
+ (set! rampval 0.0))))))
+ inval)))
+ (set! out1 (+ out1 1))
+ (if (= (grn1 'trigger) 1)
+ (begin
+ (set! (grn1 'trigger) 0)
+ (set! out1 (+ out1 hop)))))
+ (when (= i out2)
+ (set! val (+ val (with-let grn2
+ (let ((inval (ina loc file)))
+ (set! loc (+ loc 1))
+ (if (= whichseg 0) ;ramp-up
+ (begin
+ (set! inval (* inval rampval))
+ (set! rampval (+ rampval rampinc))
+ (set! segctr (+ segctr 1))
+ (if (= segctr ramplen)
(begin
- (set! segctr (+ segctr 1))
- (if (= segctr steadylen)
- (begin
- (set! segctr 0)
- (set! whichseg (+ whichseg 1)))))
- (begin ;ramp-down
- (set! inval (* inval rampval))
- (set! segctr (+ segctr 1))
- (set! rampval (- rampval rampinc))
- (if (= segctr ramplen)
- (begin
- (set! segctr 0)
- (set! trigger 1)
- (set! whichseg 0)
- (set! rampval 0.0))))))
- inval))))
- (set! out2 (+ out2 1))
- (if (= (grn2 'trigger) 1)
- (begin
- (set! (grn2 'trigger) 0)
- (set! out2 (+ out2 hop)))))
- (outa i val))))))
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (if (= whichseg 1) ;steady-state
+ (begin
+ (set! segctr (+ segctr 1))
+ (if (= segctr steadylen)
+ (begin
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (begin ;ramp-down
+ (set! inval (* inval rampval))
+ (set! segctr (+ segctr 1))
+ (set! rampval (- rampval rampinc))
+ (if (= segctr ramplen)
+ (begin
+ (set! segctr 0)
+ (set! trigger 1)
+ (set! whichseg 0)
+ (set! rampval 0.0))))))
+ inval))))
+ (set! out2 (+ out2 1))
+ (if (= (grn2 'trigger) 1)
+ (begin
+ (set! (grn2 'trigger) 0)
+ (set! out2 (+ out2 hop)))))
+ (outa i val)))))
;;; (with-sound () (expfil 0 2 .2 .01 .1 "oboe.snd" "fyow.snd"))
diff --git a/clm.c b/clm.c
index ed3070d..9b23a8b 100644
--- a/clm.c
+++ b/clm.c
@@ -7774,8 +7774,8 @@ static mus_float_t fb_one_with_amps_c1_c2(mus_any *fbank, mus_float_t inval)
* we still need to set x0[0]=gain: enter mctr.
*
* So in the current case, we can save x0[0]=gain -> x1 -> x2, then in fm_many
- * mctr=1 -- x2 is ok, x1[0] needs to be propogated
- * mctr>1 -- x2 and x1 need propogation
+ * mctr=1 -- x2 is ok, x1[0] needs to be propagated
+ * mctr>1 -- x2 and x1 need propagation
* On the other side, if mctr>=3, then x2[i] was not set, so don't access it.
*/
diff --git a/clm23.scm b/clm23.scm
index 47262a5..1917b0f 100644
--- a/clm23.scm
+++ b/clm23.scm
@@ -53,8 +53,8 @@
(let ((fm-index (hz->radians (* index mc-ratio freq))))
(let ((start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
- (cr (make-oscil freq)) ; our carrier
- (md (make-oscil (* freq mc-ratio))) ; our modulator
+ (cr (make-oscil freq)) ; carrier
+ (md (make-oscil (* freq mc-ratio))) ; modulator
(ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
(indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
(do ((i start (+ i 1)))
@@ -536,10 +536,10 @@
(outa i (* amp (in-any ctr 0 fil))))))
(define (simple-in-rev beg dur ampa ampb)
- (let ((start (seconds->samples beg))
- (end (seconds->samples (+ beg dur)))
- (chns (mus-channels *reverb*)))
- (if (or (> ampa 0.0) (> ampb 0.0))
+ (if (or (> ampa 0.0) (> ampb 0.0))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (chns (mus-channels *reverb*)))
(if (or (zero? ampb) (= chns 1))
(do ((i start (+ i 1))) ((= i end))
(outa i (* ampa (ina i *reverb*))))
@@ -1417,18 +1417,6 @@
((= i end))
(outa i (* amp (oscil os (env frqe)))))))
-(definstrument (sndclmdoc-simple-fm beg dur freq amp mc-ratio index amp-env index-env)
- (let ((fm-index (hz->radians (* index mc-ratio freq))))
- (let ((start (seconds->samples beg))
- (end (seconds->samples (+ beg dur)))
- (cr (make-oscil freq)) ; carrier
- (md (make-oscil (* freq mc-ratio))) ; modulator
- (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
- (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))
-
(define (sndclmdoc-simple-add beg dur freq amp)
(let ((start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
@@ -2114,7 +2102,7 @@
(outa i (my-oscil osc 0.0)))))
(with-sound ()
(sndclmdoc-simp-5 0 10000 440 .1 '(0 0 1 1)) ; sweep up an octave
- (sndclmdoc-simple-fm 1 1 440 .1 2 1.0)
+ (simple-fm 1 1 440 .1 2 1.0)
(sndclmdoc-simple-add 2 1 220 .3)
(sndclmdoc-mapenv 3 1 440 .4 '(0 0 50 1 75 0 86 .5 100 0)))
(if (file-exists? "/home/bil/sf1/forest.aiff")
@@ -2194,10 +2182,8 @@
(with-sound (:channels 4) (sndclmdoc-simple-dloc 0 2 440 .5))
(with-sound () (when? 0 4 2.0 8.0 "1a.snd"))
(with-sound () (move-formants 0 "oboe.snd" 2.0 0.99 '(0 1200 1.6 2400 2 1400) 4))
- (test-filter (make-one-zero 0.5 0.5))
- (test-filter (make-one-pole 0.1 -0.9))
- (test-filter (make-two-pole 0.1 0.1 0.9))
- (test-filter (make-two-zero 0.5 0.2 0.3))
+
+ (for-each test-filter (vector (make-one-zero 0.5 0.5) (make-one-pole 0.1 -0.9) (make-two-pole 0.1 0.1 0.9) (make-two-zero 0.5 0.2 0.3)))
(with-sound (:scaled-to .5) ; .875
(flux 0 "oboe.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6))
diff --git a/configure b/configure
index de4ae62..07f728e 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for snd 16.7.
+# Generated by GNU Autoconf 2.69 for snd 16.8.
#
# Report bugs to <bil at ccrma.stanford.edu>.
#
@@ -580,8 +580,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='snd'
PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz'
-PACKAGE_VERSION='16.7'
-PACKAGE_STRING='snd 16.7'
+PACKAGE_VERSION='16.8'
+PACKAGE_STRING='snd 16.8'
PACKAGE_BUGREPORT='bil at ccrma.stanford.edu'
PACKAGE_URL=''
@@ -1310,7 +1310,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 16.7 to adapt to many kinds of systems.
+\`configure' configures snd 16.8 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1380,7 +1380,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of snd 16.7:";;
+ short | recursive ) echo "Configuration of snd 16.8:";;
esac
cat <<\_ACEOF
@@ -1496,7 +1496,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-snd configure 16.7
+snd configure 16.8
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1957,7 +1957,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 16.7, which was
+It was created by snd $as_me 16.8, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -3304,7 +3304,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
-VERSION=16.7
+VERSION=16.8
#--------------------------------------------------------------------------------
# configuration options
@@ -6691,7 +6691,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 16.7, which was
+This file was extended by snd $as_me 16.8, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6753,7 +6753,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 16.7
+snd config.status 16.8
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
diff --git a/configure.ac b/configure.ac
index 7278f82..4898133 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5,7 +5,7 @@
# gmp, mpfr, and mpc deliberately have none!
-AC_INIT(snd, 16.7, bil at ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz)
+AC_INIT(snd, 16.8, bil at ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.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=16.7
+VERSION=16.8
#--------------------------------------------------------------------------------
# configuration options
diff --git a/dlocsig.scm b/dlocsig.scm
index 3075534..5afbd1f 100644
--- a/dlocsig.scm
+++ b/dlocsig.scm
@@ -244,13 +244,12 @@
(* (m 0 1) (mat 1 0))
(* (m 0 2) (mat 2 0)))))
(and (> (abs det) 1e-06)
- (let ((invdet (/ 1.0 det)))
- (do ((row 0 (+ 1 row)))
- ((= row 3))
- (do ((col 0 (+ 1 col)))
- ((= col 3))
- (set! (mat row col) (* (mat row col) invdet))))
- mat)))))
+ (do ((invdet (/ 1.0 det))
+ (row 0 (+ 1 row)))
+ ((= row 3) mat)
+ (do ((col 0 (+ 1 col)))
+ ((= col 3))
+ (set! (mat row col) (* (mat row col) invdet))))))))
(define (invert2x2 mat) ; invert a 2x2 matrix
(let ((m (make-float-vector '(2 2)))
@@ -284,12 +283,11 @@
(let ((len (length speakers)))
(if (= len 1)
(set! groups (list (list 0)))
- (begin
- (do ((i 0 (+ i 1))
- (j 1 (+ j 1)))
- ((= i len))
- (set! groups (cons (list i (modulo j len)) groups)))
- (set! groups (reverse groups)))))))
+ (do ((i 0 (+ i 1))
+ (j 1 (+ j 1)))
+ ((= i len)
+ (set! groups (reverse groups)))
+ (set! groups (cons (list i (modulo j len)) groups)))))))
(if (null? groups)
(error 'mus-error "no groups specified, speakers must be arranged in groups~%"))
@@ -367,21 +365,21 @@
(let* ((size (length group))
(vertices (map coords group))
(matrix (if (= size 3)
- (let ((m (make-float-vector '(3 3))))
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (do ((j 0 (+ j 1)))
- ((= j 3))
- (set! (m i j) ((vertices i) j))))
- (invert3x3 m))
+ (do ((m (make-float-vector '(3 3)))
+ (i 0 (+ i 1)))
+ ((= i 3)
+ (invert3x3 m))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (m i j) ((vertices i) j))))
(and (= size 2)
- (let ((m (make-float-vector '(2 2))))
- (do ((i 0 (+ i 1)))
- ((= i 2))
- (do ((j 0 (+ j 1)))
- ((= j 2))
- (set! (m i j) ((vertices i) j))))
- (invert2x2 m))))))
+ (do ((m (make-float-vector '(2 2)))
+ (i 0 (+ i 1)))
+ ((= i 2)
+ (invert2x2 m))
+ (do ((j 0 (+ j 1)))
+ ((= j 2))
+ (set! (m i j) ((vertices i) j))))))))
(set! vals (cons (make-group :id id
:size size
:speakers group
@@ -410,12 +408,11 @@
:coords coords
:groups groups
:delays times
- :omap (let ((v (make-vector (length speakers))))
- (do ((chan 0 (+ 1 chan)))
- ((= chan (length speakers)))
- (set! (v chan) (or (and (pair? channel-map) (channel-map chan))
- chan)))
- v))))
+ :omap (do ((v (make-vector (length speakers)))
+ (chan 0 (+ 1 chan)))
+ ((= chan (length speakers)) v)
+ (set! (v chan) (or (and (pair? channel-map) (channel-map chan))
+ chan))))))
;;; Default speaker configurations
@@ -564,29 +561,28 @@
(define* (ambisonics-channels
(h-order dlocsig-ambisonics-h-order)
(v-order dlocsig-ambisonics-v-order))
- (let ((count 0))
- (if (< h-order 0)
- 0 ;; error: we need at least horizontal order 1!
- (begin
- (if (>= h-order 1)
- ;; W X Y
- (set! count (+ count 3)))
- (if (>= v-order 1)
- ;; Z
- (set! count (+ count 1)))
- (if (>= v-order 2)
- ;; R S T
- (set! count (+ count 3)))
- (if (>= h-order 2)
- ;; U V
- (set! count (+ count 2)))
- (if (>= v-order 3)
- ;; K L M N O
- (set! count (+ count 5)))
- (if (>= h-order 3)
- ;; P Q
- (set! count (+ count 2)))
- count))))
+ (if (< h-order 0)
+ 0 ;; error: we need at least horizontal order 1!
+ (let ((count 0))
+ (if (>= h-order 1)
+ ;; W X Y
+ (set! count (+ count 3)))
+ (if (>= v-order 1)
+ ;; Z
+ (set! count (+ count 1)))
+ (if (>= v-order 2)
+ ;; R S T
+ (set! count (+ count 3)))
+ (if (>= h-order 2)
+ ;; U V
+ (set! count (+ count 2)))
+ (if (>= v-order 3)
+ ;; K L M N O
+ (set! count (+ count 5)))
+ (if (>= h-order 3)
+ ;; P Q
+ (set! count (+ count 2)))
+ count)))
;;;;;;;;;
@@ -869,23 +865,21 @@
;; it's a three dimensional list
;; '(x0 y0 z0 x1 y1 z1 ... xn yn zn)
;; x, y, z: coordinates of source
- (let ((pz ()))
- (do ((i 0 (+ i 3)))
- ((>= i len))
- (set! px (cons (points i) px))
- (set! py (cons (points (+ i 1)) py))
- (set! pz (cons (points (+ i 2)) pz)))
- (list (reverse px) (reverse py) (reverse pz) (make-list (length px) #f)))
-
+ (do ((pz ())
+ (i 0 (+ i 3)))
+ ((>= i len)
+ (list (reverse px) (reverse py) (reverse pz) (make-list (length px) #f)))
+ (set! px (cons (points i) px))
+ (set! py (cons (points (+ i 1)) py))
+ (set! pz (cons (points (+ i 2)) pz)))
;; it's a two dimensional list
;; '(x0 y0 x1 y1 ... xn yn)
;; x, y, z: coordinates of source [missing z's assumed 0.0]
- (let ()
- (do ((i 0 (+ i 2)))
- ((>= i len))
- (set! px (cons (points i) px))
- (set! py (cons (points (+ i 1)) py)))
- (list (reverse px) (reverse py) (make-list (length px) 0.0) (make-list (length px) #f)))))))))
+ (do ((i 0 (+ i 2)))
+ ((>= i len)
+ (list (reverse px) (reverse py) (make-list (length px) 0.0) (make-list (length px) #f)))
+ (set! px (cons (points i) px))
+ (set! py (cons (points (+ i 1)) py)))))))))
;;; Parse a set of 2d or 3d polar points into the separate coordinates
@@ -1071,8 +1065,8 @@
;;; (path-x (make-path '((-10 10)(0 5)(10 10))))
(define (fit path)
- (cond ((not (eq? (car path) 'open-bezier-path))
- (let ((n (- (length (bezier-x path )) 1)))
+ (let ((n (- (length (bezier-x path )) 1)))
+ (cond ((not (eq? (car path) 'open-bezier-path))
(let ((m (/ (- n (if (odd? n) 3 4)) 2))
;; data points P(i)
(p (vector (apply vector (bezier-x path))
@@ -1081,7 +1075,7 @@
;; control points D(i)
(d (let ((maker (lambda () (make-vector n 0.0))))
(vector (maker) (maker) (maker)))))
-
+
(define (a-1 k n)
(if (odd? (min (+ (* path-maxcoeff 2) 1) n))
(begin
@@ -1114,9 +1108,8 @@
(set! (d 0 i) (* (d 0 i) (bezier-curvature path)))
(set! (d 1 i) (* (d 1 i) (bezier-curvature path)))
(set! (d 2 i) (* (d 2 i) (bezier-curvature path)))))
- (list (- n 1) p d))))
- (else
- (let ((n (- (length (bezier-x path)) 1)))
+ (list (- n 1) p d)))
+ (else
(let ((m (- n 1))
;; data points P(i)
(p (vector (apply vector (bezier-x path))
@@ -1936,18 +1929,17 @@
(zcoords (path-z path))
(tcoords (path-time path))
(total-distance
- (let ((sum 0.0)
- (len (length xcoords)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((x1 (xcoords i))
- (x2 (xcoords (+ i 1)))
- (y1 (ycoords i))
- (y2 (ycoords (+ i 1)))
- (z1 (zcoords i))
- (z2 (zcoords (+ i 1))))
- (set! sum (+ sum (distance (- x2 x1) (- y2 y1) (- z2 z1))))))
- sum))
+ (do ((sum 0.0)
+ (len (length xcoords))
+ (i 0 (+ i 1)))
+ ((= i len) sum)
+ (let ((x1 (xcoords i))
+ (x2 (xcoords (+ i 1)))
+ (y1 (ycoords i))
+ (y2 (ycoords (+ i 1)))
+ (z1 (zcoords i))
+ (z2 (zcoords (+ i 1))))
+ (set! sum (+ sum (distance (- x2 x1) (- y2 y1) (- z2 z1)))))))
(start-time (car tcoords))
(velocity (/ total-distance (- (tcoords (- (length tcoords) 1)) start-time)))
(now ()))
@@ -2238,16 +2230,16 @@
;; push zero gains on all channels
(define (push-zero-gains time)
- (let ((len (speaker-config-number speakers)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (channel-gains i) (cons time (channel-gains i)))
- (set! (channel-gains i) (cons 0.0 (channel-gains i)))))
- (let ((len rev-channels))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (channel-rev-gains i) (cons time (channel-rev-gains i)))
- (set! (channel-rev-gains i) (cons 0.0 (channel-rev-gains i))))))
+ (do ((len (speaker-config-number speakers))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (set! (channel-gains i) (cons time (channel-gains i)))
+ (set! (channel-gains i) (cons 0.0 (channel-gains i))))
+ (do ((len rev-channels)
+ (i 0 (+ i 1)))
+ ((= i len))
+ (set! (channel-rev-gains i) (cons time (channel-rev-gains i)))
+ (set! (channel-rev-gains i) (cons 0.0 (channel-rev-gains i)))))
;; push gain and time into envelopes
(define (push-gains group gains dist time)
@@ -2272,15 +2264,15 @@
(- 1.0 (expt (/ dist inside-radius) (/ inside-direct-power))))))
(if (>= dist inside-radius)
;; outside the inner sphere, signal is sent to group
- (let ((len (length gains)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((speaker ((group-speakers group) i))
- (gain (gains i)))
- (set! (outputs speaker) (* gain att))
- (if (and (> rev-channels 1)
- (< speaker (length rev-outputs)))
- (set! (rev-outputs speaker) (* gain ratt))))))
+ (do ((len (length gains))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (let ((speaker ((group-speakers group) i))
+ (gain (gains i)))
+ (set! (outputs speaker) (* gain att))
+ (if (and (> rev-channels 1)
+ (< speaker (length rev-outputs)))
+ (set! (rev-outputs speaker) (* gain ratt)))))
(let ((gain 0.0)
(len (speaker-config-number speakers)))
@@ -2931,11 +2923,11 @@
;; returns the new duration of a sound after using an envelope for time-varying sampling-rate conversion
;; (from Bill's dsp.scm)
(define (src-duration e)
- (let* ((len (length e))
- (all-x (- (e (- len 2)) (e 0))) ; last x - first x
- (dur 0.0))
- (do ((i 0 (+ i 2)))
- ((>= i (- len 2)) dur)
+ (let ((len (- (length e) 2)))
+ (do ((all-x (- (e len) (e 0))) ; last x - first x
+ (dur 0.0)
+ (i 0 (+ i 2)))
+ ((>= i len) dur)
(let ((area (let ((x0 (e i))
(x1 (e (+ i 2)))
(y0 (e (+ i 1))) ; 1/x x points
@@ -2954,26 +2946,26 @@
(walk-all-rooms (car xpoints) (car ypoints) (car zpoints) (car tpoints))
;; moving source
- (let ((len (- (min (length xpoints) (length ypoints) (length zpoints) (length tpoints)) 1)))
- (do ((i 0 (+ i 1)))
- ((>= i len))
- (let ((xa (xpoints i))
- (ya (ypoints i))
- (za (zpoints i))
- (ta (tpoints i))
- (xb (xpoints (+ i 1)))
- (yb (ypoints (+ i 1)))
- (zb (zpoints (+ i 1)))
- (tb (tpoints (+ i 1))))
- (fminimum-segment-length xa ya za ta xb yb zb tb)
- (if (= i len)
- (walk-all-rooms xb yb zb tb))))))
+ (do ((len (- (min (length xpoints) (length ypoints) (length zpoints) (length tpoints)) 1))
+ (i 0 (+ i 1)))
+ ((>= i len))
+ (let ((xa (xpoints i))
+ (ya (ypoints i))
+ (za (zpoints i))
+ (ta (tpoints i))
+ (xb (xpoints (+ i 1)))
+ (yb (ypoints (+ i 1)))
+ (zb (zpoints (+ i 1)))
+ (tb (tpoints (+ i 1))))
+ (fminimum-segment-length xa ya za ta xb yb zb tb)
+ (if (= i len)
+ (walk-all-rooms xb yb zb tb)))))
;; create delay lines for output channels that need them
(if speakers
- (let* ((delays (speaker-config-delays speakers))
- (len (length delays)))
- (do ((channel 0 (+ 1 channel)))
+ (let ((delays (speaker-config-delays speakers)))
+ (do ((len (length delays))
+ (channel 0 (+ 1 channel)))
((= channel len))
(let ((delayo (delays channel)))
(set! (out-delays channel) (and (not (= delayo 0.0))
@@ -3055,30 +3047,27 @@
;; :out-delays
out-delays
;; :gains
- (let ((v (make-vector out-channels)))
- (do ((i 0 (+ i 1)))
- ((= i out-channels))
- (set! (v i) (make-env (reverse (channel-gains i))
- :scaler (if (= render-using ambisonics) amb-unity-gain unity-gain)
- :duration real-dur)))
- v)
+ (do ((v (make-vector out-channels))
+ (i 0 (+ i 1)))
+ ((= i out-channels) v)
+ (set! (v i) (make-env (reverse (channel-gains i))
+ :scaler (if (= render-using ambisonics) amb-unity-gain unity-gain)
+ :duration real-dur)))
;; :rev-gains
(and (> rev-channels 0)
- (let ((v (make-vector rev-channels)))
- (do ((i 0 (+ i 1)))
- ((= i rev-channels))
- (set! (v i) (make-env (reverse (channel-rev-gains i))
- :scaler (if (= render-using ambisonics) amb-unity-rev-gain unity-rev-gain)
- :duration real-dur)))
- v))
+ (do ((v (make-vector rev-channels))
+ (i 0 (+ i 1)))
+ ((= i rev-channels) v)
+ (set! (v i) (make-env (reverse (channel-rev-gains i))
+ :scaler (if (= render-using ambisonics) amb-unity-rev-gain unity-rev-gain)
+ :duration real-dur))))
;; :out-map
(if speakers
(speaker-config-map speakers)
- (let ((v (make-vector out-channels)))
- (do ((i 0 (+ i 1)))
- ((= i out-channels))
- (set! (v i) i))
- v)))
+ (do ((v (make-vector out-channels))
+ (i 0 (+ i 1)))
+ ((= i out-channels) v)
+ (set! (v i) i))))
*output*
*reverb*)))
(list gen
diff --git a/dsp.scm b/dsp.scm
index ecb7b1c..26bacdb 100644
--- a/dsp.scm
+++ b/dsp.scm
@@ -21,9 +21,9 @@
0
(if (= mn 0)
1
- (let* ((mx (max k (- n k)))
- (cnk (+ 1 mx)))
- (do ((i 2 (+ 1 i)))
+ (let ((mx (max k (- n k))))
+ (do ((cnk (+ 1 mx))
+ (i 2 (+ 1 i)))
((> i mn) cnk)
(set! cnk (/ (* cnk (+ mx i)) i))))))))))
@@ -37,11 +37,11 @@
(define src-duration
(let ((documentation "(src-duration envelope) returns the new duration of a sound after using 'envelope' for time-varying sampling-rate conversion"))
(lambda (e)
- (let* ((len (length e))
- (all-x (- (e (- len 2)) (e 0))) ; last x - first x
- (dur 0.0))
- (do ((i 0 (+ i 2)))
- ((>= i (- len 2)) dur)
+ (let ((len (- (length e) 2)))
+ (do ((all-x (- (e len) (e 0))) ; last x - first x
+ (dur 0.0)
+ (i 0 (+ i 2)))
+ ((>= i len) dur)
(let ((area (let ((x0 (e i))
(x1 (e (+ i 2)))
(y0 (e (+ i 1))) ; 1/x x points
@@ -113,14 +113,14 @@
;; now take the DFT
(let ((pk 0.0)
(w (make-vector N)))
- (do ((i 0 (+ i 1)))
+ (do ((i 0 (+ i 1))
+ (sum 0.0 0.0))
((= i N))
- (let ((sum 0.0))
- (do ((k 0 (+ k 1)))
- ((= k N))
- (set! sum (+ sum (* (vals k) (exp (/ (* 2.0 0+1.0i pi k i) N))))))
- (set! (w i) (magnitude sum))
- (set! pk (max pk (w i)))))
+ (do ((k 0 (+ k 1)))
+ ((= k N))
+ (set! sum (+ sum (* (vals k) (exp (/ (* 2.0 0+1.0i pi k i) N))))))
+ (set! (w i) (magnitude sum))
+ (set! pk (max pk (w i))))
;; scale to 1.0 (it's usually pretty close already, that is pk is close to 1.0)
(do ((i 0 (+ i 1)))
((= i N))
@@ -574,23 +574,23 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(let ((documentation "(make-hilbert-transform (len 30)) makes a Hilbert transform filter"))
(lambda* ((len 30))
(let ((arrlen (+ 1 (* 2 len))))
- (let ((arr (make-float-vector arrlen))
- (lim (if (even? len) len (+ 1 len))))
- (do ((i (- len) (+ i 1)))
- ((= i lim))
- (let ((k (+ i len))
- (denom (* pi i))
- (num (- 1.0 (cos (* pi i)))))
- (set! (arr k)
- (if (or (= num 0.0)
- (= i 0))
- 0.0
- ;; this is the "ideal" -- rectangular window -- version:
- ;; (set! (arr k) (/ num denom))
- ;; this is the Hamming window version:
- (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len))))))))) ; window
- (make-fir-filter arrlen arr))))))
+ (do ((arr (make-float-vector arrlen))
+ (lim (if (even? len) len (+ 1 len)))
+ (i (- len) (+ i 1)))
+ ((= i lim)
+ (make-fir-filter arrlen arr))
+ (let ((k (+ i len))
+ (denom (* pi i))
+ (num (- 1.0 (cos (* pi i)))))
+ (set! (arr k)
+ (if (or (= num 0.0)
+ (= i 0))
+ 0.0
+ ;; this is the "ideal" -- rectangular window -- version:
+ ;; (set! (arr k) (/ num denom))
+ ;; this is the Hamming window version:
+ (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len))))))))))))) ; window
(define hilbert-transform fir-filter)
@@ -644,10 +644,11 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define make-highpass
(let ((documentation "(make-highpass fc (len 30)) makes an FIR highpass filter"))
(lambda* (fc (len 30))
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-float-vector arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
+ (let ((arrlen (+ 1 (* 2 len))))
+ (do ((arr (make-float-vector arrlen))
+ (i (- len) (+ i 1)))
+ ((= i len)
+ (make-fir-filter arrlen arr))
(let ((k (+ i len))
(denom (* pi i))
(num (- (sin (* fc i)))))
@@ -655,8 +656,8 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(if (= i 0)
(- 1.0 (/ fc pi))
(* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))))
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))))))
+
(define highpass fir-filter)
@@ -672,10 +673,11 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define make-lowpass
(let ((documentation "(make-lowpass fc (len 30)) makes an FIR lowpass filter"))
(lambda* (fc (len 30))
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-float-vector arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
+ (let ((arrlen (+ 1 (* 2 len))))
+ (do ((arr (make-float-vector arrlen))
+ (i (- len) (+ i 1)))
+ ((= i len)
+ (make-fir-filter arrlen arr))
(let ((k (+ i len))
(denom (* pi i))
(num (sin (* fc i))))
@@ -683,8 +685,7 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(if (= i 0)
(/ fc pi)
(* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))))
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))))))
(define lowpass fir-filter)
@@ -699,10 +700,11 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define make-bandpass
(let ((documentation "(make-bandpass flo fhi (len 30)) makes an FIR bandpass filter"))
(lambda* (flo fhi (len 30))
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-float-vector arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
+ (let ((arrlen (+ 1 (* 2 len))))
+ (do ((arr (make-float-vector arrlen))
+ (i (- len) (+ i 1)))
+ ((= i len)
+ (make-fir-filter arrlen arr))
(let ((k (+ i len))
(denom (* pi i))
(num (- (sin (* fhi i)) (sin (* flo i)))))
@@ -710,8 +712,7 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(if (= i 0)
(/ (- fhi flo) pi)
(* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))))
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))))))
(define bandpass fir-filter)
@@ -741,10 +742,11 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define make-bandstop
(let ((documentation "(make-bandstop flo fhi (len 30)) makes an FIR bandstop (notch) filter"))
(lambda* (flo fhi (len 30))
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-float-vector arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
+ (let ((arrlen (+ 1 (* 2 len))))
+ (do ((arr (make-float-vector arrlen))
+ (i (- len) (+ i 1)))
+ ((= i len)
+ (make-fir-filter arrlen arr))
(let ((k (+ i len))
(denom (* pi i))
(num (- (sin (* flo i)) (sin (* fhi i)))))
@@ -752,8 +754,7 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(if (= i 0)
(- 1.0 (/ (- fhi flo) pi))
(* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))))
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))))))
(define bandstop fir-filter)
@@ -768,18 +769,18 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define make-differentiator
(let ((documentation "(make-differentiator (len 30)) makes an FIR differentiator (highpass) filter"))
(lambda* ((len 30))
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-float-vector arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
+ (let ((arrlen (+ 1 (* 2 len))))
+ (do ((arr (make-float-vector arrlen))
+ (i (- len) (+ i 1)))
+ ((= i len)
+ (make-fir-filter arrlen arr))
(let ((k (+ i len)))
(set! (arr k)
(if (= i 0)
0.0
(* (/ (cos (* pi i)) i)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))))
-
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))))))
+
(define differentiator fir-filter)
#|
@@ -987,41 +988,41 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(let ((documentation "(make-butter-lp M fc) returns a butterworth low-pass filter; its order is 'M' * 2, 'fc' is the cutoff frequency in Hz"))
(lambda (M fc)
(let ((theta (/ (* 2 pi fc) *clm-srate*)))
- (let ((xcoeffs ())
- (ycoeffs ())
- (st (sin theta))
- (ct (cos theta)))
- (do ((k 1 (+ k 1)))
- ((> k M))
- (let* ((beta (let ((d (* st (sin (/ (* pi (- (* 2 k) 1)) (* 4 M))))))
- (* 0.5 (/ (- 1.0 d) (+ 1.0 d)))))
- (gamma (* ct (+ 0.5 beta)))
- (alpha (* 0.25 (- (+ 0.5 beta) gamma))))
- (set! xcoeffs (cons (float-vector (* 2 alpha) (* 4 alpha) (* 2 alpha)) xcoeffs))
- (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))
- (make-filter (+ 1 (* 2 M))
- (cascade->canonical xcoeffs)
- (cascade->canonical ycoeffs)))))))
+ (do ((xcoeffs ())
+ (ycoeffs ())
+ (st (sin theta))
+ (ct (cos theta))
+ (k 1 (+ k 1)))
+ ((> k M)
+ (make-filter (+ 1 (* 2 M))
+ (cascade->canonical xcoeffs)
+ (cascade->canonical ycoeffs)))
+ (let* ((beta (let ((d (* st (sin (/ (* pi (- (* 2 k) 1)) (* 4 M))))))
+ (* 0.5 (/ (- 1.0 d) (+ 1.0 d)))))
+ (gamma (* ct (+ 0.5 beta)))
+ (alpha (* 0.25 (- (+ 0.5 beta) gamma))))
+ (set! xcoeffs (cons (float-vector (* 2 alpha) (* 4 alpha) (* 2 alpha)) xcoeffs))
+ (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))))))
(define make-butter-hp
(let ((documentation "(make-butter-hp M fc) returns a butterworth high-pass filter; its order is 'M' * 2, 'fc' is the cutoff frequency in Hz"))
(lambda (M fc)
(let ((theta (/ (* 2 pi fc) *clm-srate*)))
- (let ((xcoeffs ())
- (ycoeffs ())
- (st (sin theta))
- (ct (cos theta)))
- (do ((k 1 (+ k 1)))
- ((> k M))
- (let* ((beta (let ((d (* st (sin (/ (* pi (- (* 2 k) 1)) (* 4 M))))))
- (* 0.5 (/ (- 1.0 d) (+ 1.0 d)))))
- (gamma (* ct (+ 0.5 beta)))
- (alpha (* 0.25 (+ 0.5 beta gamma))))
- (set! xcoeffs (cons (float-vector (* 2 alpha) (* -4 alpha) (* 2 alpha)) xcoeffs))
- (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))
- (make-filter (+ 1 (* 2 M))
- (cascade->canonical xcoeffs)
- (cascade->canonical ycoeffs)))))))
+ (do ((xcoeffs ())
+ (ycoeffs ())
+ (st (sin theta))
+ (ct (cos theta))
+ (k 1 (+ k 1)))
+ ((> k M)
+ (make-filter (+ 1 (* 2 M))
+ (cascade->canonical xcoeffs)
+ (cascade->canonical ycoeffs)))
+ (let* ((beta (let ((d (* st (sin (/ (* pi (- (* 2 k) 1)) (* 4 M))))))
+ (* 0.5 (/ (- 1.0 d) (+ 1.0 d)))))
+ (gamma (* ct (+ 0.5 beta)))
+ (alpha (* 0.25 (+ 0.5 beta gamma))))
+ (set! xcoeffs (cons (float-vector (* 2 alpha) (* -4 alpha) (* 2 alpha)) xcoeffs))
+ (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))))))
(define make-butter-bp
(let ((documentation "(make-butter-bp M f1 f2) returns a butterworth band-pass filter; its order is 'M' * 2, 'f1' and 'f2' are the band edge frequencies in Hz"))
@@ -1149,27 +1150,27 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(lambda (fr fi n v)
;; this is the slow (dft) form
;; v=1 -> normal fourier transform
- (let ((hr (make-float-vector n))
- (hi (make-float-vector n))
- (ph0 (/ (* v 2 pi) n)))
- (do ((w 0 (+ 1 w)))
- ((= w n))
- (let ((sr 0.0)
- (si 0.0))
- (do ((k 0 (+ k 1)))
- ((= k n))
- (let ((phase (* ph0 k w)))
- (let ((c (cos phase))
- (s (sin phase))
- (x (fr k))
- (y (fi k)))
- (let ((r (- (* x c) (* y s)))
- (i (+ (* y c) (* x s))))
- (set! sr (+ sr r))
- (set! si (+ si i))))))
- (set! (hr w) sr)
- (set! (hi w) si)))
- (list hr hi)))))
+ (do ((hr (make-float-vector n))
+ (hi (make-float-vector n))
+ (ph0 (/ (* v 2 pi) n))
+ (w 0 (+ 1 w))
+ (sr 0.0 0.0)
+ (si 0.0 0.0))
+ ((= w n)
+ (list hr hi))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (let ((phase (* ph0 k w)))
+ (let ((c (cos phase))
+ (s (sin phase))
+ (x (fr k))
+ (y (fi k)))
+ (let ((r (- (* x c) (* y s)))
+ (i (+ (* y c) (* x s))))
+ (set! sr (+ sr r))
+ (set! si (+ si i))))))
+ (set! (hr w) sr)
+ (set! (hi w) si)))))
(define z-transform
(let ((documentation "(z-transform data n z) performs a Z transform on data; if z=e^2*pi*j/n you get a Fourier transform; complex results in returned vector"))
@@ -1179,15 +1180,15 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(let ((res ((if (float-vector? f) make-float-vector make-vector) n)))
(do ((w 0 (+ 1 w)))
((= w n))
- (let ((sum 0.0)
- (t 1.0)
- (m (expt z w)))
- ;; -w?? there seems to be confusion here -- slowzt.cc in the fxt package uses +w
- (do ((k 0 (+ k 1)))
- ((= k n))
- (set! sum (+ sum (* (f k) t)))
- (set! t (* t m)))
- (set! (res w) sum)))
+ (do ((sum 0.0)
+ (t 1.0)
+ (m (expt z w))
+ ;; -w?? there seems to be confusion here -- slowzt.cc in the fxt package uses +w
+ (k 0 (+ k 1)))
+ ((= k n)
+ (set! (res w) sum))
+ (set! sum (+ sum (* (f k) t)))
+ (set! t (* t m))))
res))))
@@ -1199,17 +1200,16 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(lambda (data)
;; taken from Perry Cook's SignalProcessor.m (the slow version of the Hartley transform)
(let ((len (length data)) )
- (let ((arr (make-float-vector len))
- (w (/ (* 2.0 pi) len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (do ((j 0 (+ j 1)))
- ((= j len))
- (set! (arr i) (+ (arr i)
- (* (data j)
- (+ (cos (* i j w))
- (sin (* i j w))))))))
- arr)))))
+ (do ((arr (make-float-vector len))
+ (w (/ (* 2.0 pi) len))
+ (i 0 (+ i 1)))
+ ((= i len) arr)
+ (do ((j 0 (+ j 1)))
+ ((= j len))
+ (set! (arr i) (+ (arr i)
+ (* (data j)
+ (+ (cos (* i j w))
+ (sin (* i j w))))))))))))
(define find-sine
(let ((documentation "(find-sine freq beg dur snd) returns the amplitude and initial-phase (for sin) at freq"))
@@ -1545,11 +1545,11 @@ shift the given channel in pitch without changing its length. The higher 'order
(set! *output* summer)
(do ((i 0 (+ i 1)))
((= i pairs))
- (let ((gen (vector-ref ssbs i))
- (filt (vector-ref bands i)))
- (do ((k 0 (+ k 1)))
- ((= k len))
- (outa k (ssb-am gen (bandpass filt (ina k data))))))) ; outa adds, (ina i v) is the same as (float-vector-ref v i)
+ (do ((gen (vector-ref ssbs i))
+ (filt (vector-ref bands i))
+ (k 0 (+ k 1)))
+ ((= k len))
+ (outa k (ssb-am gen (bandpass filt (ina k data)))))) ; outa adds, (ina i v) is the same as (float-vector-ref v i)
(set! *output* #f)
(float-vector-scale! summer (/ mx (float-vector-peak summer)))
(float-vector->channel summer beg len snd chn current-edit-position
@@ -1583,12 +1583,12 @@ shift the given channel in pitch without changing its length. The higher 'order
(set! *output* summer)
(do ((i 0 (+ i 1)))
((= i pairs))
- (let ((gen (vector-ref ssbs i))
- (filt (vector-ref bands i))
- (e (vector-ref frenvs i)))
- (do ((k 0 (+ k 1)))
- ((= k len))
- (outa k (ssb-am gen (bandpass filt (ina k data)) (env e))))))
+ (do ((gen (vector-ref ssbs i))
+ (filt (vector-ref bands i))
+ (e (vector-ref frenvs i))
+ (k 0 (+ k 1)))
+ ((= k len))
+ (outa k (ssb-am gen (bandpass filt (ina k data)) (env e)))))
(set! *output* #f)
(float-vector-scale! summer (/ mx (float-vector-peak summer)))
(float-vector->channel summer beg len snd chn current-edit-position
@@ -1846,24 +1846,24 @@ and replaces it with the spectrum given in coeffs"))
;; ignore startup
(do ((k 0 (+ k 1)))
((= k startup))
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i pairs))
- (let ((sig (bandpass (vector-ref bands i) (float-vector-ref indata k))))
- (set! sum (+ sum (* (moving-max (vector-ref peaks i) sig)
- (polynomial pcoeffs (* sig (moving-norm (vector-ref peaks2 i) sig))))))))
- (filter flt sum)))
-
+ (do ((sum 0.0)
+ (i 0 (+ i 1)))
+ ((= i pairs)
+ (filter flt sum))
+ (let ((sig (bandpass (vector-ref bands i) (float-vector-ref indata k))))
+ (set! sum (+ sum (* (moving-max (vector-ref peaks i) sig)
+ (polynomial pcoeffs (* sig (moving-norm (vector-ref peaks2 i) sig)))))))))
+
(set! *output* summer)
(do ((pair 0 (+ pair 1)))
((= pair pairs))
- (let ((bp (vector-ref bands pair))
- (pk (vector-ref peaks pair))
- (pk2 (vector-ref peaks2 pair)))
- (do ((k startup (+ k 1)))
- ((= k len))
- (let ((x (bandpass bp (float-vector-ref indata k))))
- (outa k (* (moving-max pk x) (polynomial pcoeffs (* x (moving-norm pk2 x)))))))))
+ (do ((bp (vector-ref bands pair))
+ (pk (vector-ref peaks pair))
+ (pk2 (vector-ref peaks2 pair))
+ (k startup (+ k 1)))
+ ((= k len))
+ (let ((x (bandpass bp (float-vector-ref indata k))))
+ (outa k (* (moving-max pk x) (polynomial pcoeffs (* x (moving-norm pk2 x))))))))
;; we're normalizing the polynomial input so its waveshaping index is more-or-less 1.0
;; this might work better with len=256, max .1 -- we're assuming a well-behaved signal
@@ -1900,12 +1900,12 @@ and replaces it with the spectrum given in coeffs"))
(outa samp
(let ((pos intrp))
(if (>= pos 1.0)
- (let ((num (floor pos)))
- (do ((i 0 (+ i 1)))
- ((= i num))
- (set! last next)
- (set! next (read-sample rd)))
- (set! pos (- pos num))))
+ (do ((num (floor pos))
+ (i 0 (+ i 1)))
+ ((= i num)
+ (set! pos (- pos num)))
+ (set! last next)
+ (set! next (read-sample rd))))
(set! intrp (+ pos sr))
(+ last (* pos (- next last))))))))))
(set-samples 0 (- (framples tempfile) 1) tempfile snd chn #t "linear-src" 0 #f #t)
@@ -2307,10 +2307,10 @@ is assumed to be outside -1.0 to 1.0."))
(let ((index (or snd (selected-sound) (car (sounds)))))
(if (not (sound? index))
(error 'no-such-sound (list "unclip-sound" snd))
- (let ((chns (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (unclip-channel index chn))))))))
+ (do ((chns (channels index))
+ (chn 0 (+ 1 chn)))
+ ((= chn chns))
+ (unclip-channel index chn)))))))
(define* (kalman-filter-channel (Q 1.0e-5))
@@ -2365,62 +2365,59 @@ is assumed to be outside -1.0 to 1.0."))
(let ((cols (make-vector n 0))
(rows (make-vector n 0))
(pivots (make-vector n 0)))
- (do ((i 0 (+ i 1)))
+ (do ((i 0 (+ i 1))
+ (col 0 0)
+ (row 0 0))
((= i n))
- (let ((col 0)
- (row 0))
- (let ((biggest 0.0))
- (do ((j 0 (+ j 1)))
- ((= j n))
- ;(format () "j: ~A, n: ~A~%" j n)
- (if (not (= (pivots j) 1))
- (do ((k 0 (+ k 1)))
- ((= k n))
- (if (= (pivots k) 0)
- (let ((val (abs (matrix j k))))
- (if (> val biggest)
- (begin
- (set! col k)
- (set! row j)
- ;(format () "k: ~A, row: ~D, col: ~A~%" k row col)
- (set! biggest val))))
- (if (> (pivots k) 1)
- (return #f))))))
- (if (< biggest zero)
- (return #f))) ; this can be fooled (floats...): (invert-matrix (make-share-vector (float-vector 1 2 3 3 2 1 4 5 6) (list 3 3)))
- (set! (pivots col) (+ (pivots col) 1))
- ;(format () "i: ~D, row: ~D, col: ~A~%" i row col)
- (if (not (= row col))
- (let ((temp (if (sequence? b) (b row) 0.0)))
- (if (sequence? b)
- (begin
- (set! (b row) (b col))
- (set! (b col) temp)))
- (do ((k 0 (+ k 1)))
- ((= k n))
- (set! temp (matrix row k))
- (set! (matrix row k) (matrix col k))
- (set! (matrix col k) temp))))
- (set! (cols i) col)
- (set! (rows i) row)
- ;; round-off troubles here
- (if (< (abs (matrix col col)) zero)
- (return #f))
- (let ((inverse-pivot (/ 1.0 (matrix col col))))
- (set! (matrix col col) 1.0)
- (do ((k 0 (+ k 1)))
- ((= k n))
- (set! (matrix col k) (* inverse-pivot (matrix col k))))
- (if b (set! (b col) (* inverse-pivot (b col)))))
+ (do ((biggest 0.0)
+ (j 0 (+ j 1)))
+ ((= j n)
+ (if (< biggest zero)
+ (return #f))) ; this can be fooled (floats...): (invert-matrix (make-share-vector (float-vector 1 2 3 3 2 1 4 5 6) (list 3 3)))
+ (if (not (= (pivots j) 1))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (if (= (pivots k) 0)
+ (let ((val (abs (matrix j k))))
+ (if (> val biggest)
+ (begin
+ (set! col k)
+ (set! row j)
+ (set! biggest val))))
+ (if (> (pivots k) 1)
+ (return #f))))))
+ (set! (pivots col) (+ (pivots col) 1))
+ (if (not (= row col))
+ (let ((temp (if (sequence? b) (b row) 0.0)))
+ (if (sequence? b)
+ (begin
+ (set! (b row) (b col))
+ (set! (b col) temp)))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! temp (matrix row k))
+ (set! (matrix row k) (matrix col k))
+ (set! (matrix col k) temp))))
+ (set! (cols i) col)
+ (set! (rows i) row)
+ ;; round-off troubles here
+ (if (< (abs (matrix col col)) zero)
+ (return #f))
+ (let ((inverse-pivot (/ 1.0 (matrix col col))))
+ (set! (matrix col col) 1.0)
(do ((k 0 (+ k 1)))
((= k n))
- (if (not (= k col))
- (let ((scl (matrix k col)))
- (set! (matrix k col) 0.0)
- (do ((m 0 (+ 1 m)))
- ((= m n))
- (set! (matrix k m) (- (matrix k m) (* scl (matrix col m)))))
- (if b (set! (b k) (- (b k) (* scl (b col))))))))))
+ (set! (matrix col k) (* inverse-pivot (matrix col k))))
+ (if b (set! (b col) (* inverse-pivot (b col)))))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (if (not (= k col))
+ (let ((scl (matrix k col)))
+ (set! (matrix k col) 0.0)
+ (do ((m 0 (+ 1 m)))
+ ((= m n))
+ (set! (matrix k m) (- (matrix k m) (* scl (matrix col m)))))
+ (if b (set! (b k) (- (b k) (* scl (b col)))))))))
(do ((i (- n 1) (- i 1)))
((< i 0))
(if (not (= (rows i) (cols i)))
@@ -2579,23 +2576,22 @@ the multi-modulator FM case described by the list of modulator frequencies and i
;;; waveshaping harmonic amplitude at a given index
(define (cheby-hka k a coeffs) ; (coeff 0 = DC)
- (let ((sum 0.0)
- (n (length coeffs)))
- (do ((j 0 (+ j 1)))
- ((= j n))
- (let ((dsum 0.0)
- (p (+ k (* 2 j))))
- (do ((i 0 (+ i 1)))
- ((>= (+ p (* 2 i)) n))
- (set! dsum (+ dsum (* (expt -1 i)
- (coeffs (+ p (* 2 i)))
- (+ (binomial (+ p i) i)
- (binomial (+ p i -1) (- i 1)))))))
- (set! sum (+ sum (* dsum
- (expt a p)
- (binomial p j))))))
- sum))
-
+ (do ((sum 0.0)
+ (n (length coeffs))
+ (j 0 (+ j 1)))
+ ((= j n)
+ sum)
+ (do ((dsum 0.0)
+ (p (+ k (* 2 j)))
+ (i 0 (+ i 1)))
+ ((>= (+ p (* 2 i)) n)
+ (set! sum (+ sum (* dsum
+ (expt a p)
+ (binomial p j)))))
+ (set! dsum (+ dsum (* (expt -1 i)
+ (coeffs (+ p (* 2 i)))
+ (+ (binomial (+ p i) i)
+ (binomial (+ p i -1) (- i 1)))))))))
#|
(with-sound ()
(let ((gen (make-polyshape 1000.0 :partials (list 1 .5 2 .25 3 .125 4 .125))))
@@ -2627,23 +2623,23 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(len (length partials))
(topk 0)
(DC 0.0)
- (original-sum (let ((sum 0.0))
- (do ((i 0 (+ i 2)))
- ((>= i len) sum)
- (let ((hnum (partials i))
- (amp (partials (+ i 1))))
- (if (= hnum 0)
- (set! DC amp)
- (begin
- (set! topk (max topk hnum))
- (set! sum (+ sum amp))))))))
+ (original-sum (do ((sum 0.0)
+ (i 0 (+ i 2)))
+ ((>= i len) sum)
+ (let ((hnum (partials i))
+ (amp (partials (+ i 1))))
+ (if (= hnum 0)
+ (set! DC amp)
+ (begin
+ (set! topk (max topk hnum))
+ (set! sum (+ sum amp)))))))
(min-sum original-sum)
- (original-partials (let ((v (make-float-vector topk)))
- (do ((i 0 (+ i 2)))
- ((>= i len) v)
- (let ((hnum (partials i)))
- (if (not (= hnum 0))
- (set! (v (- hnum 1)) (partials (+ i 1))))))))
+ (original-partials (do ((v (make-float-vector topk))
+ (i 0 (+ i 2)))
+ ((>= i len) v)
+ (let ((hnum (partials i)))
+ (if (not (= hnum 0))
+ (set! (v (- hnum 1)) (partials (+ i 1)))))))
(min-partials (copy original-partials)))
(if (<= topk (log tries 2))
diff --git a/edit123.scm b/edit123.scm
index e868f6b..9b82dcd 100644
--- a/edit123.scm
+++ b/edit123.scm
@@ -36,20 +36,20 @@
(current-sorted-files #f))
(define (file-from-path curfile)
- (let ((last-slash 0))
- (do ((i 0 (+ 1 i)))
- ((= i (length curfile)))
- (if (char=? (curfile i) #\/)
- (set! last-slash i)))
- (substring curfile (+ 1 last-slash))))
+ (do ((last-slash 0)
+ (i 0 (+ 1 i)))
+ ((= i (length curfile))
+ (substring curfile (+ 1 last-slash)))
+ (if (char=? (curfile i) #\/)
+ (set! last-slash i))))
(define (directory-from-path curfile)
- (let ((last-slash 0))
- (do ((i 0 (+ 1 i)))
- ((= i (length curfile)))
- (if (char=? (curfile i) #\/)
- (set! last-slash i)))
- (substring curfile 0 last-slash)))
+ (do ((last-slash 0)
+ (i 0 (+ 1 i)))
+ ((= i (length curfile))
+ (substring curfile 0 last-slash))
+ (if (char=? (curfile i) #\/)
+ (set! last-slash i))))
(define (find-next-file)
;; find the next file in the sorted list, with wrap-around
diff --git a/env.scm b/env.scm
index 4425bac..14e3242 100644
--- a/env.scm
+++ b/env.scm
@@ -85,12 +85,11 @@ end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"))
(ee2 (at0 e2))
(newe ()))
(set! xs (sort! (remove-duplicates xs) <))
- (let ((len (length xs)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((x (xs i)))
- (set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2)))))))
- newe)))))))))
+ (do ((len (length xs))
+ (i 0 (+ i 1)))
+ ((= i len) newe)
+ (let ((x (xs i)))
+ (set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2)))))))))))))))
;;; -------- multiply-envelopes, add-envelopes
@@ -310,11 +309,11 @@ repetition to be in reverse."))
(set! new-env (cons first-y (cons x new-env)))))))
(set! new-env (reverse new-env))
(if normalized
- (let ((scl (/ x-max x))
- (new-len (length new-env)))
- (do ((i 0 (+ i 2)))
- ((>= i new-len))
- (set! (new-env i) (* scl (new-env i))))))
+ (do ((scl (/ x-max x))
+ (new-len (length new-env))
+ (i 0 (+ i 2)))
+ ((>= i new-len))
+ (set! (new-env i) (* scl (new-env i)))))
new-env))))))
@@ -433,19 +432,18 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"))
(let ((largest-diff (* 1.0 (- (max-envelope e) mn)))
(x-min (car e))
(x-max (e (- (length e) 2))))
- (let ((x-incr (* 1.0 (/ (- x-max x-min) xgrid)))
- (new-e ()))
- (do ((x x-min (+ x x-incr)))
- ((>= x x-max))
- (let ((y (envelope-interp x e)))
- (set! new-e (cons (if (= largest-diff 0.0)
- y
- (+ mn
- (* largest-diff
- (expt (/ (- y mn) largest-diff) power))))
- (cons x new-e)))))
- (reverse new-e)))))))
-
+ (do ((x-incr (* 1.0 (/ (- x-max x-min) xgrid)))
+ (new-e ())
+ (x x-min (+ x x-incr)))
+ ((>= x x-max)
+ (reverse new-e))
+ (let ((y (envelope-interp x e)))
+ (set! new-e (cons (if (= largest-diff 0.0)
+ y
+ (+ mn
+ (* largest-diff
+ (expt (/ (- y mn) largest-diff) power))))
+ (cons x new-e))))))))))
;;; rms-envelope
@@ -534,30 +532,31 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"))
(xmin (car env1)))
(if (= ymin ymax)
(list xmin ymin xmax ymax)
- (let ((y-scl (/ ygrid (- ymax ymin)))
- (x-scl (/ (or xgrid ygrid) (- xmax xmin)))
- (px #f) (py #f)
- (qx #f) (qy #f)
- (tx #f) (ty #f)
- (qtx #f) (qty #f))
- (do ((i 0 (+ i 2)))
- ((>= i (length env1)))
- (let ((ttx (env1 i))
- (tty (env1 (+ i 1))))
- (set! tx (round (* ttx x-scl)))
- (set! ty (round (* tty y-scl)))
- (if px
- (if (not (point-on-line? px py qx qy tx ty))
- (begin
- (set! new-env (cons qty (cons qtx new-env)))
- (set! px qx)
- (set! py qy)))
- (begin
- (set! px qx)
- (set! py qy)))
- (set! qx tx)
- (set! qy ty)
- (set! qtx ttx)
- (set! qty tty)))
- (set! new-env (cons qty (cons qtx new-env)))
- (reverse new-env))))))
+ (do ((y-scl (/ ygrid (- ymax ymin)))
+ (x-scl (/ (or xgrid ygrid) (- xmax xmin)))
+ (px #f) (py #f)
+ (qx #f) (qy #f)
+ (tx #f) (ty #f)
+ (qtx #f) (qty #f)
+ (i 0 (+ i 2)))
+ ((>= i (length env1))
+ (set! new-env (cons qty (cons qtx new-env)))
+ (reverse new-env))
+ (let ((ttx (env1 i))
+ (tty (env1 (+ i 1))))
+ (set! tx (round (* ttx x-scl)))
+ (set! ty (round (* tty y-scl)))
+ (if px
+ (if (not (point-on-line? px py qx qy tx ty))
+ (begin
+ (set! new-env (cons qty (cons qtx new-env)))
+ (set! px qx)
+ (set! py qy)))
+ (begin
+ (set! px qx)
+ (set! py qy)))
+ (set! qx tx)
+ (set! qy ty)
+ (set! qtx ttx)
+ (set! qty tty)))))))
+
\ No newline at end of file
diff --git a/enved.scm b/enved.scm
index d113de7..af275c4 100644
--- a/enved.scm
+++ b/enved.scm
@@ -148,17 +148,17 @@
(let ((snd (hook 'snd))
(chn (hook 'chn))
(key (hook 'key))
- (state (hook 'state)))
+ (state4 (= (hook 'state) 4)))
;; C-g returns to original env
;; C-. applies current env to amplitude
(if (and (= key (char->integer #\.))
- (= state 4))
+ state4)
(begin
(env-channel (channel-envelope snd chn) 0 (framples snd chn) snd chn)
(set! (hook 'result) #t))
(if (and (= key (char->integer #\g))
- (= state 4))
+ state4)
(begin
(set! (channel-envelope snd chn) '(0.0 1.0 1.0 1.0))
(set! (hook 'result) #t))))))
@@ -189,17 +189,17 @@
(define play-with-envs
(let ((documentation "(play-with-envs snd) sets channel amps during playback from the associated enved envelopes"))
(lambda* (sound)
- (let ((chans (channels sound)))
- (do ((chan 0 (+ 1 chan)))
- ((= chan chans))
- (let ((player (make-player sound chan))
- (e (make-env (channel-envelope sound chan)
- :length (floor (/ (framples sound chan) *dac-size*)))))
- (add-player player 0 -1 -1 (lambda (reason) (set! (hook-functions play-hook) ())))
- (hook-push play-hook (lambda (hook)
- ;; if dac buffer size in framples is not dac-size, we should do something debonair
- (set! (amp-control player) (env e))))))
- (start-playing chans (srate sound))))))
+ (do ((chans (channels sound))
+ (chan 0 (+ 1 chan)))
+ ((= chan chans)
+ (start-playing chans (srate sound)))
+ (let ((player (make-player sound chan))
+ (e (make-env (channel-envelope sound chan)
+ :length (floor (/ (framples sound chan) *dac-size*)))))
+ (add-player player 0 -1 -1 (lambda (reason) (set! (hook-functions play-hook) ())))
+ (hook-push play-hook (lambda (hook)
+ ;; if dac buffer size in framples is not dac-size, we should do something debonair
+ (set! (amp-control player) (env e)))))))))
#|
(define play-panned
diff --git a/examp.scm b/examp.scm
index b4bb7a2..d7e3ba1 100644
--- a/examp.scm
+++ b/examp.scm
@@ -409,20 +409,20 @@ read an ASCII sound file"))
(bufsize1 8191))
(as-one-edit
(lambda ()
- (let ((data (make-float-vector bufsize))
- (short->float (/ 1.0 32768.0)))
- (do ((fr 0 (+ fr bufsize)))
- ((eof-object? (peek-char in-fd)))
- (do ((loc 0 (+ loc 1))
- (val (read-line in-fd) (read-line in-fd)))
- ((or (eof-object? val)
- (= loc bufsize1)) ; bufsize-1 so that we don't throw away a sample at the buffer end
- (if (number? val)
- (begin
- (float-vector-set! data loc (* (string->number val) short->float))
- (float-vector->channel data fr (+ loc 1) out-fd 0))
- (float-vector->channel data fr loc out-fd 0)))
- (float-vector-set! data loc (* (string->number val) short->float)))))))
+ (do ((data (make-float-vector bufsize))
+ (short->float (/ 1.0 32768.0))
+ (fr 0 (+ fr bufsize)))
+ ((eof-object? (peek-char in-fd)))
+ (do ((loc 0 (+ loc 1))
+ (val (read-line in-fd) (read-line in-fd)))
+ ((or (eof-object? val)
+ (= loc bufsize1)) ; bufsize-1 so that we don't throw away a sample at the buffer end
+ (if (number? val)
+ (begin
+ (float-vector-set! data loc (* (string->number val) short->float))
+ (float-vector->channel data fr (+ loc 1) out-fd 0))
+ (float-vector->channel data fr loc out-fd 0)))
+ (float-vector-set! data loc (* (string->number val) short->float))))))
(close-input-port in-fd)
out-fd))))
@@ -796,18 +796,18 @@ then inverse ffts."))
(let ((documentation "(fft-env-interp env1 env2 interp snd chn) interpolates between two fft-filtered versions (env1 and env2 are the
spectral envelopes) following interp (an env between 0 and 1)"))
(lambda* (env1 env2 interp snd chn)
- (let* ((data1 (fft-env-data env1 snd chn))
+ (let ((data1 (fft-env-data env1 snd chn))
(data2 (fft-env-data env2 snd chn))
- (len (framples snd chn))
- (new-data (make-float-vector len))
- (e (make-env interp :length len))
- (erev (make-env (scale-envelope interp -1.0 1.0) :length len))) ; 1.0 - e
- (do ((i 0 (+ i 1)))
- ((= i len))
- (float-vector-set! new-data i
- (+ (* (env erev) (float-vector-ref data1 i))
- (* (env e) (float-vector-ref data2 i)))))
- (float-vector->channel new-data 0 (- len 1) snd chn #f (format #f "fft-env-interp '~A '~A '~A" env1 env2 interp))))))
+ (len (framples snd chn)))
+ (let ((new-data (make-float-vector len))
+ (e (make-env interp :length len))
+ (erev (make-env (scale-envelope interp -1.0 1.0) :length len))) ; 1.0 - e
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! new-data i
+ (+ (* (env erev) (float-vector-ref data1 i))
+ (* (env e) (float-vector-ref data2 i)))))
+ (float-vector->channel new-data 0 (- len 1) snd chn #f (format #f "fft-env-interp '~A '~A '~A" env1 env2 interp)))))))
(define filter-fft
@@ -897,10 +897,10 @@ section: (float-vector->channel (fft-smoother .1 (cursor) 400) (cursor) 400)"))
(float-vector-scale! rl (/ oldmax newmax)))
(let* ((new0 (rl 0))
(new1 (rl (- samps 1)))
- (offset0 (- old0 new0))
- (incr (let ((offset1 (- old1 new1)))
- (if (= offset1 offset0) 0.0 (/ (- offset1 offset0) samps)))))
- (do ((i 0 (+ i 1))
+ (offset0 (- old0 new0)))
+ (do ((incr (let ((offset1 (- old1 new1)))
+ (if (= offset1 offset0) 0.0 (/ (- offset1 offset0) samps))))
+ (i 0 (+ i 1))
(trend offset0 (+ trend incr)))
((= i samps))
(set! (rl i) (+ (rl i) trend)))
@@ -1096,11 +1096,11 @@ formants, then calls map-channel: (osc-formants .99 (float-vector 400.0 800.0 12
(define vibro
(let ((documentation "(vibro speed depth) adds vibrato or tremolo"))
(lambda (speed depth)
- (let* ((sine (make-oscil speed))
- (scl (* 0.5 depth))
- (offset (- 1.0 scl)))
- (lambda (y)
- (* y (+ offset (* scl (oscil sine)))))))))
+ (let ((sine (make-oscil speed))
+ (scl (* 0.5 depth)))
+ (let ((offset (- 1.0 scl)))
+ (lambda (y)
+ (* y (+ offset (* scl (oscil sine))))))))))
;;; -------- hello-dentist
@@ -1181,17 +1181,17 @@ to produce a sound at a new pitch but at the original tempo. It returns a funct
(let* ((dur (/ (* (/ (framples snd chn) (srate snd))
(integrate-envelope gr-env)) ; in env.scm
(envelope-last-x gr-env)))
+ (len (max (round (* (srate snd) dur)) (framples snd chn))))
+ (do ((out-data (make-float-vector len))
(gr (make-granulate :expansion (cadr gr-env)
:jitter 0
:input (make-sampler 0 snd chn)))
(ge (make-env gr-env :duration dur))
- (len (max (round (* (srate snd) dur)) (framples snd chn)))
- (out-data (make-float-vector len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (float-vector->channel out-data 0 len snd chn #f (format #f "expsnd '~A" gr-env)))
(float-vector-set! out-data i (granulate gr))
- (set! (mus-increment gr) (env ge)))
- (float-vector->channel out-data 0 len snd chn #f (format #f "expsnd '~A" gr-env))))))
+ (set! (mus-increment gr) (env ge)))))))
;;; -------- cross-synthesis
@@ -1204,18 +1204,16 @@ selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"))
(lambda (cross-snd amp fftsize r)
(let ((freq-inc (/ fftsize 2)))
(let ((spectr (make-float-vector freq-inc))
- (formants (make-vector freq-inc))
- (old-srate *clm-srate*))
- (set! *clm-srate* (srate))
- ;; if mus-srate is 44.1k and srate is 48k, make-formant thinks we're trying to go past srate/2
- ;; and in any case it's setting its formants incorrectly for the actual output srate
- (do ((radius (- 1.0 (/ r fftsize)))
- (bin (/ (srate) fftsize))
- (i 0 (+ i 1)))
- ((= i freq-inc))
- (set! (formants i) (make-formant (* i bin) radius)))
- (set! formants (make-formant-bank formants spectr))
- (set! *clm-srate* old-srate)
+ (formants (make-vector freq-inc)))
+ (let-temporarily ((*clm-srate* (srate)))
+ ;; if mus-srate is 44.1k and srate is 48k, make-formant thinks we're trying to go past srate/2
+ ;; and in any case it's setting its formants incorrectly for the actual output srate
+ (do ((radius (- 1.0 (/ r fftsize)))
+ (bin (/ (srate) fftsize))
+ (i 0 (+ i 1)))
+ ((= i freq-inc))
+ (set! (formants i) (make-formant (* i bin) radius)))
+ (set! formants (make-formant-bank formants spectr)))
(let ((fdr #f)
(ctr freq-inc)
(inctr 0))
@@ -1233,7 +1231,6 @@ selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"))
(* amp (formant-bank formants inval)))))))))
-
;;; similar ideas can be used for spectral cross-fades, etc -- for example:
(define voiced->unvoiced
@@ -1766,20 +1763,20 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
(current-sorted-files #f))
(define (file-from-path curfile)
- (let ((last-slash 0))
- (do ((i 0 (+ i 1)))
- ((= i (length curfile)))
- (if (char=? (curfile i) #\/)
- (set! last-slash i)))
- (substring curfile (+ 1 last-slash))))
+ (do ((last-slash 0)
+ (i 0 (+ i 1)))
+ ((= i (length curfile))
+ (substring curfile (+ 1 last-slash)))
+ (if (char=? (curfile i) #\/)
+ (set! last-slash i))))
(define (directory-from-path curfile)
- (let ((last-slash 0))
- (do ((i 0 (+ i 1)))
- ((= i (length curfile)))
- (if (char=? (curfile i) #\/)
- (set! last-slash i)))
- (substring curfile 0 last-slash)))
+ (do ((last-slash 0)
+ (i 0 (+ i 1)))
+ ((= i (length curfile))
+ (substring curfile 0 last-slash))
+ (if (char=? (curfile i) #\/)
+ (set! last-slash i))))
(define (find-next-file)
;; find the next file in the sorted list, with wrap-around
@@ -1817,9 +1814,11 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
(set! last-file-opened (file-name (or (selected-sound)
(car (sounds))))))
(if (not current-directory)
- (if (null? (sounds))
- (get-current-files (getcwd))
- (get-current-files (directory-from-path last-file-opened))))
+ (get-current-files
+ (if (null? (sounds))
+ (getcwd)
+ (directory-from-path last-file-opened))))
+
(if (null? current-sorted-files)
(error 'no-such-file (list "open-next-file-in-directory" current-directory))
(let ((next-file (find-next-file)))
@@ -1917,11 +1916,11 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(define (scramble-channels-1 cur-chans end-chans chans loc)
(define (find-chan chans chan len)
- (let ((pos #f))
- (do ((i 0 (+ i 1)))
- ((or pos (= i len)) pos)
- (if (= (chans i) chan)
- (set! pos i)))))
+ (do ((pos #f)
+ (i 0 (+ i 1)))
+ ((or pos (= i len)) pos)
+ (if (= (chans i) chan)
+ (set! pos i))))
(if (> chans loc)
(let* ((end-chan (end-chans loc)) ; we want this channel at loc
(cur-chan (cur-chans loc)) ; this (original) channel is currently at loc
diff --git a/extensions.scm b/extensions.scm
index b78b379..ac262b7 100644
--- a/extensions.scm
+++ b/extensions.scm
@@ -57,11 +57,9 @@ two sounds open (indices 0 and 1 for example), and the second has two channels,
(let ((new-maxamp (maxamp snd chn)))
(if (= original-maxamp new-maxamp)
1.0
- (let ((scaler (/ original-maxamp new-maxamp))
- (old-sync (sync snd)))
- (set! (sync snd) (+ (sync-max) 1))
- (scale-by scaler snd chn)
- (set! (sync snd) old-sync)
+ (let ((scaler (/ original-maxamp new-maxamp)))
+ (let-temporarily (((sync snd) (+ (sync-max) 1)))
+ (scale-by scaler snd chn))
scaler)))))))
@@ -420,10 +418,10 @@ connects them with 'func', and applies the result as an amplitude envelope to th
(lambda* (off (beg 0) dur snd)
(let ((index (or snd (selected-sound) (car (sounds)))))
(if (sound? index)
- (let ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (offset-channel off beg dur index chn)))
+ (do ((out-chans (channels index))
+ (chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (offset-channel off beg dur index chn))
(error 'no-such-sound "offset-sound: no such sound: ~A" snd))))))
@@ -434,10 +432,10 @@ connects them with 'func', and applies the result as an amplitude envelope to th
(lambda* (beg dur snd)
(let ((index (or snd (selected-sound) (car (sounds)))))
(if (sound? index)
- (let ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (pad-channel beg dur index chn)))
+ (do ((out-chans (channels index))
+ (chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (pad-channel beg dur index chn))
(error 'no-such-sound "pad-sound: no such sound: ~A" snd))))))
@@ -447,24 +445,23 @@ connects them with 'func', and applies the result as an amplitude envelope to th
(let ((documentation "(dither-channel (amount .00006) (beg 0) dur snd chn edpos) adds amount dither to each sample"))
(lambda* ((amount .00006) (beg 0) dur snd chn edpos)
(let ((len (if (number? dur) dur (- (framples snd chn) beg))))
- (let ((dither (* .5 amount))
- (data (samples beg len snd chn edpos)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (float-vector-set! data i (+ (float-vector-ref data i) (mus-random dither) (mus-random dither))))
- (float-vector->channel data beg len snd chn current-edit-position
- (format #f "dither-channel ~,8F ~A ~A" amount beg dur)))))))
-
+ (do ((dither (* .5 amount))
+ (data (samples beg len snd chn edpos))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (float-vector->channel data beg len snd chn current-edit-position
+ (format #f "dither-channel ~,8F ~A ~A" amount beg dur)))
+ (float-vector-set! data i (+ (float-vector-ref data i) (mus-random dither) (mus-random dither))))))))
(define dither-sound
(let ((documentation "(dither-sound (amount .00006) beg dur snd) adds dithering to every channel of 'snd'"))
(lambda* ((amount .00006) (beg 0) dur snd)
(let ((index (or snd (selected-sound) (car (sounds)))))
(if (sound? index)
- (let ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (dither-channel amount beg dur index chn)))
+ (do ((out-chans (channels index))
+ (chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (dither-channel amount beg dur index chn))
(error 'no-such-sound "dither-sound: no such sound: ~A" snd))))))
@@ -473,24 +470,23 @@ connects them with 'func', and applies the result as an amplitude envelope to th
(define contrast-channel
(let ((documentation "(contrast-channel index (beg 0) dur snd chn edpos) applies contrast enhancement to the sound"))
(lambda* (index (beg 0) dur snd chn edpos)
- (let* ((len (if (number? dur) dur (- (framples snd chn) beg)))
- (data (samples beg len snd chn edpos)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (float-vector-set! data i (contrast-enhancement (float-vector-ref data i) index))) ; (sin (+ (* 0.5 pi y) (* index (sin (* 2.0 pi y))))))))
- (float-vector->channel data beg len snd chn current-edit-position
- (format #f "contrast-channel ~A ~A ~A" index beg dur))))))
-
+ (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
+ (do ((data (samples beg len snd chn edpos))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (float-vector->channel data beg len snd chn current-edit-position
+ (format #f "contrast-channel ~A ~A ~A" index beg dur)))
+ (float-vector-set! data i (contrast-enhancement (float-vector-ref data i) index))))))) ; (sin (+ (* 0.5 pi y) (* index (sin (* 2.0 pi y))))))))
(define contrast-sound
(let ((documentation "(contrast-sound index beg dur snd) applies contrast-enhancement to every channel of 'snd'"))
(lambda* (index (beg 0) dur snd)
(let ((ind (or snd (selected-sound) (car (sounds)))))
(if (sound? ind)
- (let ((out-chans (channels ind)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (contrast-channel index beg dur ind chn)))
+ (do ((out-chans (channels ind))
+ (chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (contrast-channel index beg dur ind chn))
(error 'no-such-sound "contrast-sound: no such sound: ~A" snd))))))
@@ -503,10 +499,10 @@ connects them with 'func', and applies the result as an amplitude envelope to th
;; (map-sound (lambda (fr) (frame* fr scl)) beg dur snd))
(let ((index (or snd (selected-sound) (car (sounds)))))
(if (sound? index)
- (let ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (scale-channel scl beg dur index chn)))
+ (do ((out-chans (channels index))
+ (chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (scale-channel scl beg dur index chn))
(error 'no-such-sound "scale-sound: no such sound: ~A" snd))))))
diff --git a/extsnd.html b/extsnd.html
index 2cc7659..971ea1f 100644
--- a/extsnd.html
+++ b/extsnd.html
@@ -2254,16 +2254,15 @@ and decay portions in the envelope editor, or use functions such as
(hook-push <em class=red>enved-hook</em>
(lambda (hook)
(let ((env (hook 'envelope))
- (pt (hook 'point))
+ (pt (* 2 (hook 'point)))
(x (hook 'x))
(y (hook 'y))
(reason (hook 'reason)))
(if (and (= reason enved-move-point)
(> x 0.0)
(< x (envelope-last-x env)))
- (let* ((old-x (env (* pt 2)))
- (new-env (stretch-envelope env old-x x)))
- (set! (new-env (+ (* pt 2) 1)) y)
+ (let ((new-env (stretch-envelope env (env pt) x)))
+ (set! (new-env (+ pt 1)) y)
(set! (hook 'result) new-env))))))
</pre>
@@ -6123,15 +6122,13 @@ The Edit:Mix selection menu choice is (mix-selection (cursor)).
saving them in files named 'base'.n: (brksnd 1.0 \"sec\")"))
(lambda (dur base)
(let ((hop (floor (* (<a class=quiet href="#srate">srate</a>) dur)))
- (len (<a class=quiet href="#framples">framples</a>))
- (old-sync (<a class=quiet href="#sync">sync</a>)))
- (set! (<a class=quiet href="#sync">sync</a>) 1) ; save all chans
- (do ((i 0 (+ i hop))
- (j 0 (+ j 1)))
- ((>= i len))
- (<a class=quiet href="sndscm.html#makeselection">make-selection</a> i (+ i hop)) ; in extensions.scm
- (<em class=red>save-selection</em> (string-append base "." (number->string j))))
- (set! (<a class=quiet href="#sync">sync</a>) old-sync)))))
+ (len (<a class=quiet href="#framples">framples</a>)))
+ (let-temporarily (((sync) 1)) ; save all chans
+ (do ((i 0 (+ i hop))
+ (j 0 (+ j 1)))
+ ((>= i len))
+ (<a class=quiet href="sndscm.html#makeselection">make-selection</a> i (+ i hop)) ; in extensions.scm
+ (<em class=red>save-selection</em> (string-append base "." (number->string j)))))))))
</pre>
<pre class="indented">
@@ -9298,13 +9295,13 @@ the end points:
<pre class="indented">
(define (smoother y0 y1 num)
- (let ((v (make-float-vector (+ 1 num)))
- (angle (if (> y1 y0) pi 0.0))
- (off (* .5 (+ y0 y1)))
- (scale (* 0.5 (abs (- y1 y0)))))
- (do ((i 0 (+ i 1)))
- ((= i num) v)
- (set! (v i) (+ off (* scale (cos (+ angle (* i (/ pi num))))))))))
+ (do ((v (make-float-vector (+ 1 num)))
+ (angle (if (> y1 y0) pi 0.0))
+ (off (* .5 (+ y0 y1)))
+ (scale (* 0.5 (abs (- y1 y0))))
+ (i 0 (+ i 1)))
+ ((= i num) v)
+ (set! (v i) (+ off (* scale (cos (+ angle (* i (/ pi num)))))))))
</pre>
<img class="indented" src="pix/click.png" alt="smoother">
@@ -11292,16 +11289,16 @@ Here's an example that displays a histogram of the current values in 16 bins:
<pre class="indented">
(<em class=red>add-transform</em> "histogram" "bins" 0.0 1.0
(lambda (len fd)
- (let ((v (make-float-vector len))
- (steps (/ len 16))
- (step (/ 1.0 len)))
- (do ((i 0 (+ i 1)))
- ((= i len) v)
- (let* ((val (<a class=quiet href="#readsample">read-sample</a> fd))
- (bin (floor (* (abs val) 16.0))))
- (do ((j 0 (+ j 1)))
- ((= j steps))
- (set! (v (+ j bin)) (+ step (v (+ j bin))))))))))
+ (do ((v (make-float-vector len))
+ (steps (/ len 16))
+ (step (/ 1.0 len))
+ (i 0 (+ i 1)))
+ ((= i len) v)
+ (let* ((val (<a class=quiet href="#readsample">read-sample</a> fd))
+ (bin (floor (* (abs val) 16.0))))
+ (do ((j 0 (+ j 1)))
+ ((= j steps))
+ (set! (v (+ j bin)) (+ step (v (+ j bin)))))))))
</pre>
<p>If GSL is included in Snd, the following code ties in the (slow) Hankel transform:
diff --git a/generators.scm b/generators.scm
index 707e67c..12c1530 100644
--- a/generators.scm
+++ b/generators.scm
@@ -1528,9 +1528,9 @@ returns many cosines spaced by frequency with amplitude r^k."))
(let ((carrier (make-rcos freq (* .5 r)))
(clang (make-rkoddssb (* freq 2) (/ 1.618 2) r))
(ampf (make-env '(0 0 1 1 2 .5 4 .25 10 0) :scaler amp :duration dur))
- (clangf (make-env (list 0 0 .1 1 .2 .1 .3 0) :scaler (* amp .5) :duration .1))
- (rf (make-env (list 0 1 1 0) :scaler (* 0.5 r) :duration dur))
- (crf (make-env (list 0 1 1 0) :scaler r :duration .1)))
+ (clangf (make-env '(0 0 .1 1 .2 .1 .3 0) :scaler (* amp .5) :duration .1))
+ (rf (make-env '(0 1 1 0) :scaler (* 0.5 r) :duration dur))
+ (crf (make-env '(0 1 1 0) :scaler r :duration .1)))
(let ((set-clang-scaler (procedure-setter (clang 'mus-scaler))))
(do ((i start (+ i 1)))
((= i stop))
@@ -3046,7 +3046,7 @@ returns many sinusoids from frequency spaced by frequency * 2 * ratio with ampli
(stop (seconds->samples (+ beg dur)))
(clang (make-rkoddssb (* freq 2) (/ 1.618 2) r))
(clangf (make-env (list 0 0 .01 1 .1 1 .2 .4 (max .3 dur) 0) :scaler amp :duration dur))
- (crf (make-env (list 0 1 1 0) :scaler r :duration dur)))
+ (crf (make-env '(0 1 1 0) :scaler r :duration dur)))
(do ((i start (+ i 1)))
((= i stop))
(set! (clang 'r) (env crf))
@@ -4890,23 +4890,23 @@ generator. (adjustable-oscil gen (fm 0.0)) returns a sinusoid where the duty-fac
;;;--------------------------------------------------------------------------------
(define* (make-table-lookup-with-env frequency pulse-env size)
- (let* ((len (or size *clm-table-size*))
- (ve (make-float-vector len))
- (e (make-env pulse-env :length len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (float-vector-set! ve i (env e)))
- (make-table-lookup frequency 0.0 ve len)))
-
+ (let ((len (or size *clm-table-size*)))
+ (do ((ve (make-float-vector len))
+ (e (make-env pulse-env :length len))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (make-table-lookup frequency 0.0 ve len))
+ (float-vector-set! ve i (env e)))))
+
(define* (make-wave-train-with-env frequency pulse-env size)
- (let* ((len (or size *clm-table-size*))
- (ve (make-float-vector len))
- (e (make-env pulse-env :length len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (float-vector-set! ve i (env e)))
- (make-wave-train frequency 0.0 ve len)))
-
+ (let ((len (or size *clm-table-size*)))
+ (do ((ve (make-float-vector len))
+ (e (make-env pulse-env :length len))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (make-wave-train frequency 0.0 ve len))
+ (float-vector-set! ve i (env e)))))
+
;;; --------------------------------------------------------------------------------
@@ -5678,13 +5678,13 @@ returns the sum of the last n inputs weighted by (-n/(n+1))^k"))
(define* (make-polyoid (frequency *clm-default-frequency*) partial-amps-and-phases)
(let* ((len (length partial-amps-and-phases))
- (topk (let ((n 0))
- (do ((i 0 (+ i 3)))
- ((>= i len))
- (set! n (max n (floor (partial-amps-and-phases i)))))
- n)))
- (let ((sin-amps (make-float-vector (+ topk 1)))
- (cos-amps (make-float-vector (+ topk 1))))
+ (topk (do ((n 0)
+ (i 0 (+ i 3)))
+ ((>= i len)
+ (+ n 1))
+ (set! n (max n (floor (partial-amps-and-phases i)))))))
+ (let ((sin-amps (make-float-vector topk))
+ (cos-amps (make-float-vector topk)))
(do ((j 0 (+ j 3)))
((>= j len))
(let ((n (floor (partial-amps-and-phases j)))
diff --git a/gl.c b/gl.c
index 26e6bad..4b403d6 100644
--- a/gl.c
+++ b/gl.c
@@ -4455,7 +4455,7 @@ static void define_functions(void)
{
#if HAVE_SCHEME
static s7_pointer s_boolean, s_integer, s_real, s_any;
-static s7_pointer pl_t, pl_ttri, pl_ttit, pl_ttr, pl_ttir, pl_ttb, pl_tti, pl_ttiti, pl_ttrriir, pl_ttititiiti, pl_ttititi, pl_ttrri, pl_ttrrri, pl_tb, pl_bt, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiit, pl_iiiiiiiiit, pl_irrrt, pl_irrrrtttrrt, pl_i, pl_tiirrrrt, pl_tiiiit, pl_tiiit, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriit, pl_tirriirriit, pl_tirrir, pl_tir, pl_tit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiib, pl_ti, pl_tiiiiiit, pl_tiir, pl_tiiiiit, pl_tiit, pl_tibiit, pl_tiib, pl_trrrrt, pl_tr, pl_bit, pl_bi;
+static s7_pointer pl_bit, pl_bi, pl_t, pl_ttri, pl_ttit, pl_ttr, pl_ttir, pl_ttb, pl_tti, pl_ttiti, pl_ttrriir, pl_ttititiiti, pl_ttititi, pl_ttrri, pl_ttrrri, pl_tb, pl_bt, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiit, pl_iiiiiiiiit, pl_irrrt, pl_irrrrtttrrt, pl_i, pl_tiirrrrt, pl_tiiiit, pl_tiiit, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriit, pl_tirriirriit, pl_tirrir, pl_tir, pl_tit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiib, pl_ti, pl_tiiiiiit, pl_tiir, pl_tiiiiit, pl_tiit, pl_tibiit, pl_tiib, pl_trrrrt, pl_tr;
#if USE_MOTIF
static s7_pointer pl_tttti, pl_ttttb, pl_ittit;
#endif
@@ -4465,6 +4465,8 @@ static s7_pointer pl_tttti, pl_ttttb, pl_ittit;
s_real = s7_make_symbol(s7, "real?");
s_any = s7_t(s7);
+ pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any);
+ pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
pl_ttri = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_real, s_integer);
pl_ttit = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_any);
@@ -4512,8 +4514,6 @@ static s7_pointer pl_tttti, pl_ttttb, pl_ittit;
pl_tiib = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_boolean);
pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any);
pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real);
- pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any);
- pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
#if USE_MOTIF
pl_tttti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_any, s_integer);
@@ -5727,7 +5727,7 @@ void Init_libgl(void)
define_integers();
define_functions();
Xen_provide_feature("gl");
- Xen_define("gl-version", C_string_to_Xen_string("26-Jul-16"));
+ Xen_define("gl-version", C_string_to_Xen_string("05-Sep-16"));
gl_already_inited = true;
}
}
diff --git a/gtk-effects.scm b/gtk-effects.scm
index e885c0d..f7b0872 100644
--- a/gtk-effects.scm
+++ b/gtk-effects.scm
@@ -62,12 +62,12 @@
0)))
(apply for-each
(lambda (snd chn)
- (let ((end (if (memq target '(sound cursor))
- (- (framples snd chn) 1)
- (if (eq? target 'selection)
- (+ (selection-position) (selection-framples))
- (cadr ms)))))
- (if (= (sync snd) snc)
+ (if (= (sync snd) snc)
+ (let ((end (if (memq target '(sound cursor))
+ (- (framples snd chn) 1)
+ (if (eq? target 'selection)
+ (+ (selection-position) (selection-framples))
+ (cadr ms)))))
(map-channel (func (- end beg)) beg (+ end overlap 1) snd chn #f
(format #f "~A ~A ~A"
(origin target (- end beg))
@@ -362,23 +362,23 @@
(define effects-echo
(let ((documentation "(effects-echo input-samps-1 delay-time echo-amount beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
(lambda* (input-samps-1 delay-time echo-amount beg dur snd chn)
- (let* ((del (make-delay (round (* delay-time (srate snd)))))
- (len (or dur (framples snd chn)))
- (input-samps (or input-samps-1 len)))
- (as-one-edit
- (lambda ()
- (map-channel
- (lambda (inval)
- (+ inval
- (delay del (* echo-amount (+ (tap del) inval)))))
- beg input-samps snd chn)
- (if (> len input-samps)
- (map-channel
- (lambda (inval)
- (+ inval
- (delay del (* echo-amount (tap del)))))
- (+ beg input-samps) (- dur input-samps) snd chn)))
- (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur))))))
+ (let ((len (or dur (framples snd chn))))
+ (let ((del (make-delay (round (* delay-time (srate snd)))))
+ (input-samps (or input-samps-1 len)))
+ (as-one-edit
+ (lambda ()
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (+ (tap del) inval)))))
+ beg input-samps snd chn)
+ (if (> len input-samps)
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (tap del)))))
+ (+ beg input-samps) (- dur input-samps) snd chn)))
+ (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur)))))))
(define* (effects-flecho-1 scaler secs input-samps-1 beg dur snd chn)
(let ((flt (make-fir-filter :order 4 :xcoeffs (float-vector .125 .25 .25 .125)))
@@ -1613,16 +1613,16 @@ Values greater than 1.0 speed up file play, negative values reverse it."))
(define rm-effect ; avoid collision with examp.scm
(lambda (freq gliss-env)
- (let* ((os (make-oscil freq))
- (need-env (and rm-envelope (not (equal? (xe-envelope rm-envelope) '(0.0 1.0 1.0 1.0)))))
- (e (and need-env (make-env (xe-envelope rm-envelope) :length (effect-framples rm-target))))
- (genv (make-env :envelope gliss-env :length (framples))))
- (if need-env
- (lambda (inval)
- (* inval (env e) (oscil os (env genv))))
- (lambda (inval)
- (* inval (oscil os (env genv))))))))
-
+ (let ((need-env (and rm-envelope (not (equal? (xe-envelope rm-envelope) '(0.0 1.0 1.0 1.0))))))
+ (let ((os (make-oscil freq))
+ (e (and need-env (make-env (xe-envelope rm-envelope) :length (effect-framples rm-target))))
+ (genv (make-env :envelope gliss-env :length (framples))))
+ (if need-env
+ (lambda (inval)
+ (* inval (env e) (oscil os (env genv))))
+ (lambda (inval)
+ (* inval (oscil os (env genv)))))))))
+
(gtk_menu_shell_append (GTK_MENU_SHELL mod-cascade) child)
(gtk_widget_show child)
(g_signal_connect child "activate"
@@ -2661,18 +2661,18 @@ the synthesis amplitude, the FFT size, and the radius value."))
(remove-click (+ click 2))))))))
(define* (effects-remove-dc snd chn)
- (let* ((len (framples snd chn))
- (data (make-float-vector len))
- (reader (make-sampler 0 snd chn)))
- (let ((lastx 0.0)
- (lasty 0.0))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((inval (next-sample reader)))
- (set! lasty (- (+ inval (* 0.999 lasty)) lastx))
- (set! lastx inval)
- (float-vector-set! data i lasty))))
- (float-vector->channel data 0 len snd chn current-edit-position "effects-remove-dc")))
+ (let ((len (framples snd chn)))
+ (do ((data (make-float-vector len))
+ (reader (make-sampler 0 snd chn))
+ (lastx 0.0)
+ (lasty 0.0)
+ (i 0 (+ i 1)))
+ ((= i len)
+ (float-vector->channel data 0 len snd chn current-edit-position "effects-remove-dc"))
+ (let ((inval (next-sample reader)))
+ (set! lasty (- (+ inval (* 0.999 lasty)) lastx))
+ (set! lastx inval)
+ (float-vector-set! data i lasty)))))
(add-to-menu effects-menu "Remove DC" effects-remove-dc)
(add-to-menu effects-menu "Spiker" spike)
diff --git a/heart.scm b/heart.scm
new file mode 100644
index 0000000..9b07e91
--- /dev/null
+++ b/heart.scm
@@ -0,0 +1,56 @@
+;;; use with-sound to write the data to a sound file
+(require snd-ws.scm)
+
+;;; turn off clipping (the numbers will be between 70 and 150)
+(set! (mus-clipping) #f)
+(set! *clm-clipped* #f)
+(set! (with-inset-graph) #f)
+
+;;; tell Snd not to try to load the data file
+(set! (script-arg) (+ 1 (script-arg)))
+
+;;; search for "...[<number>am|pm <number>/<number>...", put the two readings in a stereo file
+(let* ((hpsum 0) ; for average readings
+ (lpsum 0)
+ (ind (find-sound
+ (with-sound (:channels 6 :sample-type mus-lfloat)
+ (let ((samp 0))
+ (call-with-input-file
+ (list-ref (script-args) 1) ; invocation arg = text file of data ("snd heart.scm data.txt")
+ (let ((average (make-moving-average 14)) ; 2-week average
+ (average1 (make-moving-average 90))) ; 3-month average
+ (lambda (file)
+ (let loop ((line (read-line file #t)))
+ (or (eof-object? line)
+ (do ((len (length line))
+ (i 0 (+ 1 i)))
+ ((>= i (- len 14))
+ (loop (read-line file #t)))
+ (when (and (char=? (line i) #\[)
+ (char=? (line (+ i 3)) #\m)
+ (memv (line (+ i 2)) '(#\a #\p)))
+ (let ((hp (string->number (substring line (+ i 5) (+ i 8))))
+ (lp (string->number (substring line (+ i 9) (+ i 11)))))
+ (set! hpsum (+ hpsum hp))
+ (set! lpsum (+ lpsum lp))
+ (out-any samp hp 0) ; output the readings
+ (out-any samp lp 1)
+ (out-any samp 120 2)
+ (out-any samp 80 3)
+ (out-any samp (max 90 (moving-average average (* 0.5 (+ lp hp)))) 4)
+ (out-any samp (max 90 (moving-average average1 (* 0.5 (+ lp hp)))) 5)
+ (set! samp (+ 1 samp)))))))))))))))
+
+ ;; now display the data with y-axis bounds between 50 and 150, both traces in the same graph, x-axis in "samples" (readings)
+ (set! (channel-style ind) channels-superimposed)
+ (do ((chan 0 (+ 1 chan)))
+ ((= chan 6))
+ (set! (x-axis-style ind chan) x-axis-in-samples)
+ (set! (x-axis-label ind chan) "days")
+ (set! (y-bounds ind chan) (list 65 150)))
+
+ ;; print the average readings over the full sequence
+ (snd-print (format #f ";average: ~A/~A~%"
+ (round (/ hpsum (framples)))
+ (round (/ lpsum (framples))))))
+
diff --git a/index.html b/index.html
index df4a212..6cb7b7e 100644
--- a/index.html
+++ b/index.html
@@ -37,362 +37,356 @@
</head>
<body class="body">
<div class="topheader">Index</div>
-<!-- created 01-Jul-16 09:52 PDT -->
+<!-- created 16-Aug-16 04:29 PDT -->
<table>
- <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</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#makebiquad">make-biquad</a></em></td><td></td><td class="green"><div class="centered">N</div></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td></tr>
- <tr><td><em class=tab> </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#makebirds">make-birds</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td></tr>
- <tr><td class="green"><div class="centered">-</div></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-blackman">make-blackman</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos">n1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#erssb">erssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-brown-noise">make-brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos?">n1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#tobytevector">->byte-vector</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="s7.html#makebytevector">make-byte-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#evenmultiple">even-multiple</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedropsite">make-channel-drop-site</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos">nchoosekcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td></tr>
- <tr><td class="green"><div class="centered">A</div></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="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos?">nchoosekcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td></tr>
- <tr><td><em class=tab> </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-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</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#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makecombbank">make-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos2?">ncos2?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#abcos?">abcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos4?">ncos4?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</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#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</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="sndclm.html#absin">absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</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#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-eoddcos">make-eoddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncontext">selection-context</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#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ercos">make-ercos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#adddeleteoption">add-delete-option</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-erssb">make-erssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframples">selection-framples</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb">nkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</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="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframple">make-file->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssbinterp">nkssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</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#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb?">nkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsnd">expsnd</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos">noddcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</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="sndscm.html#expsrc">expsrc</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#noddcos?">noddcos?</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="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#makefilteredcombbank">make-filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin">noddsin</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#addplayer">add-player</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-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin?">noddsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb">noddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</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="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb?">noddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></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="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makefv">make-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</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#fft">fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftcancel">fft-cancel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fmssb">make-fmssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvedit">fft-env-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeformantbank">make-formant-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvinterp">fft-env-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frampletofile">make-frample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</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#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullrange">show-full-range</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#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</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#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise">make-green-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</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#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise-interp">make-green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave?">adjustable-triangle-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</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="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#npcos?">npcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="s7.html#makehook">make-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos">nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos?">nrcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</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#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="s7.html#makeintvector">make-int-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</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="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="s7.html#makeiterator">make-iterator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin">nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</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="sndclm.html#filetoframple">file->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-izcos">make-izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin?">nrsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple?">file->frample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0evencos">make-j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb">nrssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#allchans">all-chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0j1cos">make-j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssbinterp">nrssb-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j2cos">make-j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb?">nrssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</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#filename">file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jjcos">make-jjcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train?">sinc-train?</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#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jncos">make-jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</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="s7.html#fillb">fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jpcos">make-jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jycos">make-jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</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#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2cos">make-k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</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#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2sin">make-k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2ssb">make-k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos">nsincos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</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#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k3sin">make-k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos?">nsincos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</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#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-krksin">make-krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb">nssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></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#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb?">nssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#anyrandom">any-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos">nxy1cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos?">nxy1cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarks">snap-marks</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin">nxy1sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#aritablep">aritable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin?">nxy1sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#arity">arity</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos">nxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</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="sndscm.html#filterfft">filter-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos?">nxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</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#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-max">make-moving-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin">nxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-norm">make-moving-norm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin?">nxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</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#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</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="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</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="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> </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="sndclm.html#asyfmJ">asyfm-J</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbank">filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-n1cos">make-n1cos</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="sndscm.html#sndscmhooks">snd-hooks</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#filteredcombbankp">filtered-comb-bank?</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#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</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-ncos">make-ncos</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#sndprint">snd-print</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#filtersinsnd"><b>Filters</b></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="sndscm.html#offsetchannel">offset-channel</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#autoresize">auto-resize</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-noddcos">make-noddcos</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#sndtempnam">snd-tempnam</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#findmark">find-mark</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-pole">one-pole</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#autoupdate">auto-update</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-noddssb">make-noddssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass">one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</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-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass?">one-pole-all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#finfo">finfo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</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="s7.html#autoload"><b>autoload</b></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-nrcos">make-nrcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrsin">make-nrsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</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#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#sortb">sort!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</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-nrxycos">make-nrxycos</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="sndclm.html#make-locsig"><b>Sound placement</b></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#firmant?">firmant?</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#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr>
- <tr><td><em class=tab> </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-nsin">make-nsin</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#soundtointeger">sound->integer</a></em></td></tr>
- <tr><td class="green"><div class="centered">B</div></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-nsincos">make-nsincos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
- <tr><td><em class=tab> </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-nssb">make-nssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</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="extsnd.html#fvtimes">float-vector*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1cos">make-nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</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#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvplus">float-vector+</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1sin">make-nxy1sin</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#soundinterp">sound-interp</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#fvtochannel">float-vector->channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxycos">make-nxycos</a></em></td><td></td><td><em class=tab><a href="s7.html#openletp">openlet?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</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-nxysin">make-nxysin</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#soundproperties">sound-properties</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#fvtostring">float-vector->string</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#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvabs">float-vector-abs!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole-all-pass">make-one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank">oscil-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvadd">float-vector-add!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank?">oscil-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</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#fvcopy">float-vector-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</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="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvequal">float-vector-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil-bank">make-oscil-bank</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#sounds">sounds</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvfill">float-vector-fill!</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#outbank">out-bank</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="extsnd.html#beforetransformhook">before-transform-hook</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-pink-noise">make-pink-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectra">spectra</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#besj0">bes-j0</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmax">float-vector-max</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#outlet">outlet</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="sndclm.html#bess">bess</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="extsnd.html#makeplayer">make-player</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#spectralpolynomial">spectral-polynomial</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#bess?">bess?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmove">float-vector-move!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel 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-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</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#fvoffset">float-vector-offset!</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="s7.html#owlet">owlet</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#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvpeak">float-vector-peak</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vctpolynomial">float-vector-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulsed-env">make-pulsed-env</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</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-r2k!cos">make-r2k!cos</a></em></td><td></td><td><em class=tab> </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#bindkey">bind-key</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-r2k2cos">make-r2k2cos</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#spectrozscale">spectro-z-scale</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#fvscale">float-vector-scale!</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#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#blackman">blackman</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvset">float-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</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="sndscm.html#spectrumtocoeffs">spectrum->coeffs</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#fvsubseq">float-vector-subseq</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="s7.html#pairfilename">pair-filename</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="sndclm.html#blackman?">blackman?</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-rcos">make-rcos</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#spectrumstart">spectrum-start</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#fvp">float-vector?</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="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixvct">pan-mix-float-vector</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="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</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#speedstyle">speed-control-style</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="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!cos">make-rk!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!ssb">make-rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spotfreq">spot-freq</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bytevector">byte-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkcos">make-rkcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</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#bytevectorp">byte-vector?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkoddssb">make-rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmparallelcomponent">fm-parallel-component</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rksin">make-rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
- <tr><td class="green"><div class="centered">C</div></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkssb">make-rkssb</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#squelchvowels">squelch-vowels</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-round-interp">make-round-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definecfunction">c-define</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rssb">make-rssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvoice">fm-voice</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxycos">make-rxycos</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="sndclm.html#src">src</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cobject">c-object?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb">fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!cos">make-rxyk!cos</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#srcchannel">src-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cpoint">c-pointer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb?">fmssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!sin">make-rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cpointer">c-pointer?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxysin">make-rxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise?">pink-noise?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcfitenvelope">src-fit-envelope</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#callwithexit">call-with-exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">pins</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bagpipe">canter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">fofins</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</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#srcsoundselection">src-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#catch">catch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cellon">cellon</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sinc-train">make-sinc-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeltovct">channel->vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makespencerfilter">make-spencer-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbank">formant-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playoften">play-often</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbankp">formant-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</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#startdac">start-dac</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</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="extsnd.html#startplaying">start-playing</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="s7.html#format">format</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup-with-env">make-table-lookup-with-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">fp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-tanhsin">make-tanhsin</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#startprogressreport">start-progress-report</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</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#statusreport">status-report</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile">frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</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#stdinprompt">stdin-prompt</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile?">frample->file?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletoframple">frample->frample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">stereo-flute</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#framples">framples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframples"><b>framples (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevct">make-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-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="extsnd.html#freeplayer">free-player</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#pluck">pluck</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#chans">chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train-with-env">make-wave-train-with-env</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#stopplayingselectionhook">stop-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="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar->rectangular</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#chebyhka">cheby-hka</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</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="s7.html#stringposition">string-position</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="s7.html#sublet">sublet</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chordalize">chordalize</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chorus">chorus</a></em></td><td></td><td class="green"><div class="centered">G</div></td><td></td><td><em class=tab><a href="sndscm.html#markclickinfo">mark-click-info</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#swapchannels">swap-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcontext">mark-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltodynamicvalue">symbol->dynamic-value</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-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#symboltovalue">symbol->value</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#symbolaccess">symbol-access</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</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#symboltable">symbol-table</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</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="extsnd.html#sync">sync</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#clmexpsrc">clm-expsrc</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym?">gensym?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</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#genericsync"><b>sync (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</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#sync-everything">sync-everything</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</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="extsnd.html#syncstyle">sync-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqw">pqw</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</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="sndscm.html#syncdmixes">syncd-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</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="sndscm.html#syncup">syncup</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marksynccolor">mark-sync-color</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> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td class="green"><div class="centered">T</div></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduredocumentation">procedure-documentation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresetter">procedure-setter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</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="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresignature">procedure-signature</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin">tanhsin</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin?">tanhsin?</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="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</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="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap?">tap?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#combbank">comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#combbankp">comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td class="green"><div class="centered">R</div></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#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp?">green-noise-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab> </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#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise?">green-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</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#timestosamples">times->samples</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos?">r2k!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</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">touch-tone</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#complexify">complexify</a></em></td><td></td><td class="green"><div class="centered">H</div></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos?">r2k2cos?</a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#mixtovct">mix->float-vector</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#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</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#trackingcursorstyle">tracking-cursor-style</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#continuationp">continuation?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</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#transformtointeger">transform->integer</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-frampletofile">continue-frample->file</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</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#transformtovct">transform->vct</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablestar">hash-table*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</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#transformdialog">transform-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableentries">hash-table-entries</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframples">transform-framples</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableref">hash-table-ref</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclickinfo">mix-click-info</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#transformgraphstyle">transform-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="s7.html#hashtableset">hash-table-set!</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#random">random</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#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablep">hash-table?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-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="extsnd.html#headertype">header-type</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="s7.html#randomstate">random-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and sample types</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</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#transformsample">transform-sample</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</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#transformsize">transform-size</a></em></td></tr>
- <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos?">rcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</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#transformp">transform?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</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="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</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="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab><a href="s7.html#hookfunctions">hook-functions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</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="sndscm.html#tubebell">tubebell</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</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="sndscm.html#tubebell">tubular bell</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</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="sndclm.html#two-pole">two-pole</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#html">html</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</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="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#s7copy">copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">two-tab</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copycontext">copy-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz->radians</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</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> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td class="green"><div class="centered">I</div></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td class="green"><div class="centered">U</div></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="s7.html#coverlet">coverlet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontovct">region->vct</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="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</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#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</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#regionframples">region-framples</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="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</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="extsnd.html#undo">undo</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#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixvct">mix-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</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#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</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="s7.html#unlet">unlet</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorcontext">cursor-context</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialbeg">initial-beg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></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#updategraphs">update-graphs</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialdur">initial-dur</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionrms">region-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</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="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="s7.html#morallyequalp">morally-equal?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="s7.html#inlet">inlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="sndscm.html#uponsaveyourself">upon-save-yourself</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cutlet">cutlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cyclicsequences">cyclic-sequences</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#removeclicks">remove-clicks</a></em></td><td></td><td class="green"><div class="centered">V</div></td></tr>
- <tr><td class="green"><div class="centered">D</div></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab> </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#mouseleavelabelhook">mouse-leave-label-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="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-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#variablegraphp">variable-graph?</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#insertionexamples"><b>Insertions</b></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="s7.html#requires7">require</a></em></td><td></td><td><em class=tab><a href="s7.html#varlet">varlet</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="s7.html#intvector">int-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-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#vct">vct</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="s7.html#intvectorref">int-vector-ref</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#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttimes">vct*</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorset">int-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</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#vctplus">vct+</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorp">int-vector?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttochannel">vct->channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">reson</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttolist">vct->list</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movesyncdmarks">move-syncd-marks</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#vcttostring">vct->string</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer->mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttovector">vct->vector</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer->region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctabs">vct-abs!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctadd">vct-add!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer->transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctcopy">vct-copy</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctequal">vct-equal?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="sndscm.html#invertfilter">invert-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctfill">vct-fill!</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definestar">define*</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctlength">vct-length</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</a></em></td><td></td><td><em class=tab><a href="s7.html#iterate">iterate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmax">vct-max</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratoratend">iterator-at-end?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max?">moving-max?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmin">vct-min</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#expansion">define-expansion</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorsequence">iterator-sequence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm">moving-norm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmove">vct-move!</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorp">iterator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm?">moving-norm?</a></em></td><td></td><td><em class=tab><a href="s7.html#reverseb">reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmultiply">vct-multiply!</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos">izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reversebyblocks">reverse-by-blocks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctoffset">vct-offset!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos?">izcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctpeak">vct-peak</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definedp">defined?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</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#vctref">vct-ref</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</a></em></td><td></td><td class="green"><div class="centered">J</div></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctreverse">vct-reverse!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctscale">vct-scale!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos">j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctset">vct-set!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos?">j0evencos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubseq">vct-subseq</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos">j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</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#vctsubtract">vct-subtract!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos?">j0j1cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</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#vctp">vct?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos">j2cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</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#Vcts"><b>Vcts</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos?">j2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos?">rk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vectortovct">vector->vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb">rk!ssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vibratinguniformcircularstring">vibrating-uniform-circular-string</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb?">rk!ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos">jjcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos">rkcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos?">jjcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos?">rkcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesamplesandsmooth">delete-samples-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos">jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos?">jncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos">jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos?">jpcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</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#viewfilesspeed">view-files-speed</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos">jycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb?">rkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos?">jycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</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#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dht">dht</a></em></td><td></td><td><em class=tab> </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="sndscm.html#rmsgain">rms, gain, balance gens</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#dialogwidgets">dialog-widgets</a></em></td><td></td><td class="green"><div class="centered">K</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</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#viewsound">view-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#dilambda">dilambda</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="s7.html#rootlet">rootlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos">k2cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp">round-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos?">k2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp?">round-interp?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaycorrelation">display-correlation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin">k2sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb">rssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">vox</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin?">k2sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</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> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb">k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb?">rssb?</a></em></td><td></td><td class="green"><div class="centered">W</div></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displayenergy">display-energy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb?">k2ssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fft">mus-fft</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> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin">k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</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="sndclm.html#wave-train">wave-train</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin?">k3sin?</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#rxycos">rxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musfilemix">mus-file-mix</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#wavelettype">wavelet-type</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="extsnd.html#key">key</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#rxyk!cos">rxyk!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</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#wavohop">wavo-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin">rxyk!sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#downoct">down-oct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin">krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</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="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin?">krksin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin">rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</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="sndclm.html#rxysin?">rxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td class="green"><div class="centered">L</div></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td class="green"><div class="centered">S</div></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</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#windowsamples">window-samples</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#lambdastar">lambda*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</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#windowwidth">window-width</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lbjpiano">lbj-piano</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#drone">drone</a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</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#windowy">window-y</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</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#withbackgroundprocesses">with-background-processes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#lettolist">let->list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</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="s7.html#withbaffle">with-baffle</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#letref">let-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#letset">let-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</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#withgl">with-gl</a></em></td></tr>
- <tr><td class="green"><div class="centered">E</div></td><td></td><td><em class=tab><a href="s7.html#letp">let?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</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> </em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear->db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinterrupts">with-interrupts</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="s7.html#with-let">with-let</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lintdoc">lint for scheme</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</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#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</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#editlisttofunction">edit-list->function</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-rand-seed">mus-rand-seed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</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#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtofv">list->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</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#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtovct">list->vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</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#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypetostring">mus-sample-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</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#edits">edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypename">mus-sample-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolorized">listener-colorized</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</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#effectshook">effects-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</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="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</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="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</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="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#saveregion">save-region</a></em></td><td></td><td class="green"><div class="centered">X</div></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</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#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab> </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="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#saveselection">save-selection</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#envchannelwithbase">env-channel-with-base</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#saveselectiondialog">save-selection-dialog</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="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#locatezero">locate-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</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#xaxisstyle">x-axis-style</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="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#savesoundas">save-sound-as</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#envmixes">env-mixes</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#savesounddialog">save-sound-dialog</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#envselection">env-selection</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#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</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#savestatefile">save-state-file</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="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envsquaredchannel">env-squared-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></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?">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="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td class="green"><div class="centered">Y</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="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpath">mus-sound-path</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</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#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpreload">mus-sound-preload</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</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#filterenv">enved-filter</a></em></td><td></td><td class="green"><div class="centered">M</div></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</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#filterenvorder">enved-filter-order</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</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#envedhook">enved-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="s7.html#macroexpand">macroexpand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td><td class="green"><div class="centered">Z</div></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsampletype">mus-sound-sample-type</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</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#envedtarget">enved-target</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-abcos">make-abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframple">mus-sound-seek-frample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</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#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-absin">make-absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</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#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-square-wave">make-adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</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="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-triangle-wave">make-adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</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#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</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="sndclm.html#eoddcos">eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#eoddcos?">eoddcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></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#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#searchforclick">search-for-click</a></em></td><td></td>
-</tr>
- <tr><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td><td></td>
-</tr>
- <tr><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td><td></td>
-</tr>
- <tr><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-bess">make-bess</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td><td></td>
-</tr>
-
+ <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#erssb">erssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td class="green"><div class="centered">N</div></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#erssb?">erssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-blackman">make-blackman</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td></tr>
+ <tr><td class="green"><div class="centered">A</div></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-brown-noise">make-brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos">n1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td></tr>
+ <tr><td><em class=tab> </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="s7.html#makebytevector">make-byte-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos?">n1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#abcos">abcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedropsite">make-channel-drop-site</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#abcos?">abcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos">nchoosekcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</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#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos?">nchoosekcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#absin">absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makecombbank">make-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#absin?">absin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos2?">ncos2?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</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-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos4?">ncos4?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</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="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#adddeleteoption">add-delete-option</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-env">make-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</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-eoddcos">make-eoddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection->mix</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</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-ercos">make-ercos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</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-erssb">make-erssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</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-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncontext">selection-context</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</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-filetoframple">make-file->frample</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="sndscm.html#addmarkpane">add-mark-pane</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-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssbinterp">nkssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframples">selection-framples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</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#nkssb?">nkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td class="green"><div class="centered">F</div></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos">noddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</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> </em></td><td></td><td><em class=tab><a href="sndclm.html#makefilteredcombbank">make-filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos?">noddcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin">noddsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</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#noddsin?">noddsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</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-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb">noddssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionrms">selection-rms</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftcancel">fft-cancel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makefv">make-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb?">noddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</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-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvedit">fft-env-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fmssb">make-fmssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvinterp">fft-env-interp</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="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave">adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeformantbank">make-formant-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave?">adjustable-square-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</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#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave">adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave?">adjustable-triangle-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</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="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise">make-green-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise-interp">make-green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullrange">show-full-range</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</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#nbdoc">file database</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#npcos?">npcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos">nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#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#nrcos?">nrcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#allchans">all-chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple?">file->frample?</a></em></td><td></td><td><em class=tab><a href="s7.html#makeiterator">make-iterator</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</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#nrsin">nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#allpassbank">all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0evencos">make-j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin?">nrsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#allpassbankp">all-pass-bank?</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-j0j1cos">make-j0j1cos</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#all-pass?">all-pass?</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-j2cos">make-j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssbinterp">nrssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></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-jjcos">make-jjcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb?">nrssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</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-jncos">make-jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</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#fillpolygon">fill-polygon</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#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</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-jycos">make-jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train?">sinc-train?</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</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#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anoi">anoi</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-k2sin">make-k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</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#filtercontrolcoeffs">filter-control-coeffs</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#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anyrandom">any-random</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-k3sin">make-k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos">nsincos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</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#nsincos?">nsincos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</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-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb">nssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#aritablep">aritable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</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#nssb?">nssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#arity">arity</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="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos">nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></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#filtercontrolp">filter-control?</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#nxy1cos?">nxy1cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterfft">filter-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin">nxy1sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</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#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin?">nxy1sin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarks">snap-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</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-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos">nxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</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#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-max">make-moving-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos?">nxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfmI">asyfm-I</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-norm">make-moving-norm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin">nxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</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#filtered-comb">filtered-comb</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#nxysin?">nxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfm?">asyfm?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbank">filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbankp">filtered-comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</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> </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#autoresize">auto-resize</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-nchoosekcos">make-nchoosekcos</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttolet">object->let</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</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-ncos">make-ncos</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttostring">object->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</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-nkssb">make-nkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</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-noddcos">make-noddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddweight">odd-weight</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</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-noddsin">make-noddsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></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-noddssb">make-noddssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</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-noid">make-noid</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#axisinfo">axis-info</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="sndclm.html#one-pole-all-pass">one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrcos">make-nrcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass?">one-pole-all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</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="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrssb">make-nrssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr>
+ <tr><td class="green"><div class="centered">B</div></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-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
+ <tr><td><em class=tab> </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-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</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-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="s7.html#sortb">sort!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtimes">float-vector*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsincos">make-nsincos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</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-nssb">make-nssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</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-nxy1cos">make-nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound->integer</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</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-nxy1sin">make-nxy1sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</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-nxycos">make-nxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvabs">float-vector-abs!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxysin">make-nxysin</a></em></td><td></td><td><em class=tab><a href="s7.html#openlet">openlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvadd">float-vector-add!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="s7.html#openletp">openlet?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvcopy">float-vector-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole-all-pass">make-one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvequal">float-vector-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvfill">float-vector-fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank">oscil-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#besj0">bes-j0</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvlength">float-vector-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil-bank">make-oscil-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank?">oscil-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#bess">bess</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmax">float-vector-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#bess?">bess?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmin">float-vector-min</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pink-noise">make-pink-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel 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="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outbank">out-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</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="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundstosegmentdata">sounds->segment-data</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvoffset">float-vector-offset!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="s7.html#outlet">outlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectra">spectra</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvpeak">float-vector-peak</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vctpolynomial">float-vector-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</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-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bird">bird</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-pulsed-env">make-pulsed-env</a></em></td><td></td><td><em class=tab><a href="s7.html#owlet">owlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#blackman">blackman</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-r2k!cos">make-r2k!cos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvset">float-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k2cos">make-r2k2cos</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#blackman?">blackman?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubseq">float-vector-subseq</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeramp">make-ramp</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubtract">float-vector-subtract!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#break">break</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-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rcos">make-rcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#brown-noise?">brown-noise?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="s7.html#pairfilename">pair-filename</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="s7.html#pairlinenumber">pair-line-number</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevector">byte-vector</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#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevectorp">byte-vector?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!cos">make-rk!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixvct">pan-mix-float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
+ <tr><td><em class=tab> </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!ssb">make-rk!ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials->polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr>
+ <tr><td class="green"><div class="centered">C</div></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-rkcos">make-rkcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr>
+ <tr><td><em class=tab> </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-rkoddssb">make-rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definecfunction">c-define</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-rksin">make-rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spotfreq">spot-freq</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</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-rkssb">make-rkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cobject">c-object?</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-round-interp">make-round-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cpoint">c-pointer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb">fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rssb">make-rssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cpointer">c-pointer?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb?">fmssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxycos">make-rxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</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="extsnd.html#focuswidget">focus-widget</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="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bagpipe">canter</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!sin">make-rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</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-rxysin">make-rxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#catch">catch</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-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cellon">cellon</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise?">pink-noise?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</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-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">pins</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcfitenvelope">src-fit-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeltovct">channel->vct</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="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</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-sinc-train">make-sinc-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbank">formant-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</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#makespencerfilter">make-spencer-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</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-square-wave">make-square-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="sndclm.html#ssb-am?">ssb-am?</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="s7.html#format">format</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#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</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-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playoften">play-often</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">fp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playregionforever">play-region-forever</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</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-with-env">make-table-lookup-with-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsine">play-sine</a></em></td><td></td><td><em class=tab><a href="sndscm.html#startdac">start-dac</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile">frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-tanhsin">make-tanhsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile?">frample->file?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletoframple">frample->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playuntilcg">play-until-c-g</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</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-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playwithenvs">play-with-envs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelseq">channels=?</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="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#statusreport">status-report</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stdinprompt">stdin-prompt</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#charposition">char-position</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#makevct">make-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chebyhka">cheby-hka</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">stereo-flute</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="fm.html#fmintro"><b>Frequency Modulation</b></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="extsnd.html#playexamples"><b>Playing</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="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chordalize">chordalize</a></em></td><td></td><td><em class=tab><a href="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chorus">chorus</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#polartorectangular">polar->rectangular</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td class="green"><div class="centered">G</div></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#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab> </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="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</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#markclickinfo">mark-click-info</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#cliphook">clip-hook</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#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="s7.html#stringposition">string-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</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#markcontext">mark-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="s7.html#sublet">sublet</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</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#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#clmexpsrc">clm-expsrc</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#closehook">close-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#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</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#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltodynamicvalue">symbol->dynamic-value</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</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#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="s7.html#portfilename">port-filename</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltovalue">symbol->value</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</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#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="s7.html#portlinenumber">port-line-number</a></em></td><td></td><td><em class=tab><a href="s7.html#symbolaccess">symbol-access</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</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#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position->x</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltable">symbol-table</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</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#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position->y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</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#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-everything">sync-everything</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqw">pqw</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorp">color?</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="sndscm.html#marksynccolor">mark-sync-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">pqw-vox</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncstyle">sync-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormap">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#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap->integer</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#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncdmixes">syncd-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</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#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncup">syncup</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</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#markp">mark?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</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#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="s7.html#proceduredocumentation">procedure-documentation</a></em></td><td></td><td class="green"><div class="centered">T</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</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#emarks">marks</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresetter">procedure-setter</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresignature">procedure-signature</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb">comb</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="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#combbank">comb-bank</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#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin">tanhsin</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#combbankp">comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin?">tanhsin?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</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#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp?">green-noise-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap?">tap?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise?">green-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></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#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#complexify">complexify</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 class="green"><div class="centered">R</div></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td class="green"><div class="centered">H</div></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab> </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#r2k!cos">r2k!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#continuationp">continuation?</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#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos?">r2k!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-frampletofile">continue-frample->file</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#mixtovct">mix->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos">r2k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#timestosamples">times->samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos?">r2k2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablestar">hash-table*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians->degrees</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">touch-tone</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableentries">hash-table-entries</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians->hz</a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</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#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</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#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-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="s7.html#hashtablep">hash-table?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclickinfo">mix-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform->integer</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="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclicksetsamp">mix-click-sets-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtovct">transform->vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</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#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></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#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="s7.html#random">random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframples">transform-framples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</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#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstate">random-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</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#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstatep">random-state?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="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#mixlength">mix-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos">rcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</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#hilberttransform">hilbert-transform</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#rcos?">rcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</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#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="s7.html#readerrorhook">*read-error-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</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#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#s7copy">copy</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#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</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#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copycontext">copy-context</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#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</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#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsamplewithdirection">read-sample-with-direction</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubebell</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab> </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="s7.html#readercond">reader-cond</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td class="green"><div class="centered">I</div></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#coverlet">coverlet</a></em></td><td></td><td><em class=tab> </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="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">two-tab</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</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#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#curlet">curlet</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#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</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#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontovct">region->vct</a></em></td><td></td><td class="green"><div class="centered">U</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</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#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</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#mixvct">mix-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframples">region-framples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorcontext">cursor-context</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#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</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#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</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#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</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#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="s7.html#inlet">inlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="s7.html#unlet">unlet</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#morallyequalp">morally-equal?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionrms">region-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cutlet">cutlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</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#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#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
+ <tr><td><em class=tab> </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="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
+ <tr><td class="green"><div class="centered">D</div></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="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
+ <tr><td><em class=tab> </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="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</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#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</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="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#uponsaveyourself">upon-save-yourself</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</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="sndscm.html#removeclicks">remove-clicks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</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#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</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#replacewithselection">replace-with-selection</a></em></td><td></td><td class="green"><div class="centered">V</div></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</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="sndscm.html#reportmarknames">report-mark-names</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></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="s7.html#requires7">require</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="s7.html#varlet">varlet</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</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#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vct">vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</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#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttimes">vct*</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">reson</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctplus">vct+</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</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#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttochannel">vct->channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</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="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttolist">vct->list</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definestar">define*</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="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttostring">vct->string</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</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#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttovector">vct->vector</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</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="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctabs">vct-abs!</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#expansion">define-expansion</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="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctadd">vct-add!</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</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#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctcopy">vct-copy</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorp">iterator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max?">moving-max?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctequal">vct-equal?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos">izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm">moving-norm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctfill">vct-fill!</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definedp">defined?</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#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctlength">vct-length</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</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#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmax">vct-max</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay">delay</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="s7.html#reverseb">reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmin">vct-min</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</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="sndscm.html#reversebyblocks">reverse-by-blocks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmove">vct-move!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos">j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmultiply">vct-multiply!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td><em class=tab><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="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctoffset">vct-offset!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos">j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctpeak">vct-peak</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos?">j0j1cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctref">vct-ref</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos">j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctreverse">vct-reverse!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos?">j2cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctscale">vct-scale!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</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="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctset">vct-set!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</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#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubseq">vct-subseq</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos">jjcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos">rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubtract">vct-subtract!</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#jjcos?">jjcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos?">rk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctp">vct?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos">jncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb">rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#Vcts"><b>Vcts</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#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#rk!ssb?">rk!ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vectortovct">vector->vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos">jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos">rkcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vibratinguniformcircularstring">vibrating-uniform-circular-string</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#jpcos?">jpcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos?">rkcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</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="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos">jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dht">dht</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos?">jycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</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> </em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#dilambda">dilambda</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#rkssb">rkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</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#rkssb?">rkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos">k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaycorrelation">display-correlation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos?">k2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin">k2sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin?">k2sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="s7.html#rootlet">rootlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displayenergy">display-energy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb">k2ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp">round-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</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#k2ssb?">k2ssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp?">round-interp?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin">k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb">rssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</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#k3sin?">k3sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fft">mus-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssbinterp">rssb-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</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="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#rssb?">rssb?</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="sndclm.html#dot-product">dot-product</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="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#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="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td class="green"><div class="centered">W</div></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="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#rxycos">rxycos</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin">krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos?">rxycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin?">krksin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos">rxyk!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</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> </em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos?">rxyk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</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><a href="sndclm.html#rxyk!sin">rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</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="sndclm.html#rxyk!sin?">rxyk!sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin">rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="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#rxysin?">rxysin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</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> </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#drone">drone</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 class="green"><div class="centered">S</div></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#makedropsite">drop sites</a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</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#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="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#lettolist">let->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
+ <tr><td><em class=tab> </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="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr>
+ <tr><td class="green"><div class="centered">E</div></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="sndclm.html#sampletofile?">sample->file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr>
+ <tr><td><em class=tab> </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#sampletype">sample-type</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#editlists"><b>Edit lists</b></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="extsnd.html#sampleratendQ">sampler-at-end?</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#editfragment">edit-fragment</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#samplerhome">sampler-home</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#editheaderdialog">edit-header-dialog</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#samplerposition">sampler-position</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#edithook">edit-hook</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#samplerQ">sampler?</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#editlisttofunction">edit-list->function</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#samplers"><b>samplers</b></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#editposition">edit-position</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#samples">samples</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#editproperties">edit-properties</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="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinterrupts">with-interrupts</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</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#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="s7.html#with-let">with-let</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtovct">list->vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</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="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmenuicons">with-menu-icons</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#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</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#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypetostring">mus-sample-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</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#listenercolorized">listener-colorized</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypename">mus-sample-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</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#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</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#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</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#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</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#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="extsnd.html#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#savemarks">save-marks</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="sndscm.html#envexptchannel">env-expt-channel</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#savemix">save-mix</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="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</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="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#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">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#saveselection">save-selection</a></em></td><td></td><td class="green"><div class="centered">X</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-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#saveselectiondialog">save-selection-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-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#savesound">save-sound</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="sndscm.html#envsquaredchannel">env-squared-channel</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#savesoundas">save-sound-as</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#env?">env?</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="extsnd.html#savesounddialog">save-sound-dialog</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#envedbase">enved-base</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="extsnd.html#savestate">save-state</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="extsnd.html#envedclipping">enved-clip?</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="extsnd.html#savestatefile">save-state-file</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#enveddialog">enved-dialog</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#savestatehook">save-state-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="extsnd.html#envedenvelope">enved-envelope</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#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#xbopen">xb-open</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="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</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> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpath">mus-sound-path</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td class="green"><div class="centered">M</div></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpreload">mus-sound-preload</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td class="green"><div class="centered">Y</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</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#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsampletype">mus-sound-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-abcos">make-abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-absin">make-absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframple">mus-sound-seek-frample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td><td></td><td class="green"><div class="centered">Z</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-square-wave">make-adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#eoddcos">eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-triangle-wave">make-adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#eoddcos?">eoddcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zecho">zecho</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zeroplus">zero+</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zerophase">zero-phase</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#ercos">ercos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#ercos?">ercos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-bess">make-bess</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#searchforclick">search-for-click</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#errorhook">*error-hook*</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> </em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr>
</table>
</body></html>
diff --git a/index.scm b/index.scm
index dbb506a..d7c0670 100644
--- a/index.scm
+++ b/index.scm
@@ -34,7 +34,8 @@ and if one is found, and the Snd documentation can be found, calls *html-program
(let ((pos (char-position ") " doc)))
(and pos
(substring doc 1 pos)))))))))
- (if (string? name)
- (cond ((snd-url name) => goto-html)
- (else (snd-print (format #f "no url for ~A?" name))))
- (snd-print (format #f "no doc for ~A?" name)))))))
+ (cond ((not (string? name))
+ (snd-print (format #f "no doc for ~A?" name)))
+ ((snd-url name) => goto-html)
+ (else (snd-print (format #f "no url for ~A?" name))))))))
+
diff --git a/libutf8proc.scm b/libutf8proc.scm
index f12740c..fe9d877 100644
--- a/libutf8proc.scm
+++ b/libutf8proc.scm
@@ -55,7 +55,13 @@
UTF8PROC_BOUNDCLASS_CONTROL UTF8PROC_BOUNDCLASS_EXTEND UTF8PROC_BOUNDCLASS_L UTF8PROC_BOUNDCLASS_V
UTF8PROC_BOUNDCLASS_T UTF8PROC_BOUNDCLASS_LV UTF8PROC_BOUNDCLASS_LVT UTF8PROC_BOUNDCLASS_REGIONAL_INDICATOR
UTF8PROC_BOUNDCLASS_SPACINGMARK))
-
+
+ ;; in version 2:
+ ;; UTF8PROC_BOUNDCLASS_PREPEND UTF8PROC_BOUNDCLASS_ZWJ UTF8PROC_BOUNDCLASS_E_BASE
+ ;; UTF8PROC_BOUNDCLASS_E_MODIFIER UTF8PROC_BOUNDCLASS_GLUE_AFTER_ZWJ UTF8PROC_BOUNDCLASS_E_BASE_GAZ
+ ;; utf8proc_int32_t utf8proc_totitle(utf8proc_int32_t c)
+ ;; utf8proc_bool utf8proc_grapheme_break_stateful(utf8proc_int32_t codepoint1, utf8proc_int32_t codepoint2, utf8proc_int32_t *state)
+
(char* utf8proc_version (void))
(char* utf8proc_errmsg (int))
(int utf8proc_tolower ((utf8proc_int32_t int)))
@@ -121,11 +127,19 @@
s7_make_symbol(sc, \"combining_class\"), s7_make_integer(sc, info->combining_class),
s7_make_symbol(sc, \"bidi_class\"), s7_make_integer(sc, info->bidi_class),
s7_make_symbol(sc, \"decomp_type\"), s7_make_integer(sc, info->decomp_type),
+ #if (UTF8PROC_VERSION_MAJOR >= 2)
+ s7_make_symbol(sc, \"uppercase_seqindex\"), s7_make_integer(sc, info->uppercase_seqindex),
+ s7_make_symbol(sc, \"lowercase_seqindex\"), s7_make_integer(sc, info->lowercase_seqindex),
+ s7_make_symbol(sc, \"titlecase_seqindex\"), s7_make_integer(sc, info->titlecase_seqindex),
+ s7_make_symbol(sc, \"casefold_seqindex\"), s7_make_integer(sc, info->casefold_seqindex),
+ s7_make_symbol(sc, \"comb_index\"), s7_make_integer(sc, info->comb_index),
+ #else
s7_make_symbol(sc, \"uppercase_mapping\"), s7_make_integer(sc, info->uppercase_mapping),
s7_make_symbol(sc, \"lowercase_mapping\"), s7_make_integer(sc, info->lowercase_mapping),
s7_make_symbol(sc, \"titlecase_mapping\"), s7_make_integer(sc, info->titlecase_mapping),
s7_make_symbol(sc, \"comb1st_index\"), s7_make_integer(sc, info->comb1st_index),
s7_make_symbol(sc, \"comb2nd_index\"), s7_make_integer(sc, info->comb2nd_index),
+ #endif
s7_make_symbol(sc, \"bidi_mirrored\"), s7_make_integer(sc, info->bidi_mirrored),
s7_make_symbol(sc, \"comp_exclusion\"), s7_make_integer(sc, info->comp_exclusion),
s7_make_symbol(sc, \"ignorable\"), s7_make_integer(sc, info->ignorable),
@@ -186,8 +200,3 @@
(curlet))))
*libutf8proc*
-
-
-
-
-
diff --git a/lint.scm b/lint.scm
index 61a2436..1fd2a91 100644
--- a/lint.scm
+++ b/lint.scm
@@ -16,16 +16,22 @@
(define *report-one-armed-if* 90) ; if -> when/unless, can be #f/#t; if an integer, sets tree length which triggers revision (80 is too small)
(define *report-loaded-files* #f) ; if load is encountered, include that file in the lint process
(define *report-any-!-as-setter* #t) ; unknown funcs/macros ending in ! are treated as setters
-(define *report-function-stuff* #t) ; checks for missed function uses etc
(define *report-doc-strings* #f) ; old-style (CL) doc strings
(define *report-func-as-arg-arity-mismatch* #f) ; as it says... (slow, and this error almost never happens)
(define *report-constant-expressions-in-do* #f) ; kinda dumb
-(define *report-bad-variable-names* '(l ll O)) ; bad names -- a list to check such as:
-;;; '(l ll .. data datum new item info temp tmp temporary val vals value foo bar baz aux dummy O var res retval result count str)
+(define *report-bad-variable-names* '(l ll O ~)) ; bad names -- a list to check such as:
+;;; '(l ll .. ~ data datum new item info temp tmp temporary val vals value foo bar baz aux dummy O var res retval result count str)
(define *report-built-in-functions-used-as-variables* #f) ; string and length are the most common cases
(define *report-forward-functions* #f) ; functions used before being defined
(define *report-sloppy-assoc* #t) ; i.e. (cdr (assoc x y)) and the like
-(define *report-bloated-arg* 24) ; min arg expr tree size that can trigger a rewrite-as-let suggestion
+(define *report-bloated-arg* 24) ; min arg expr tree size that can trigger a rewrite-as-let suggestion (32 is too high I think)
+(define *report-clobbered-function-return-value* #f) ; function returns constant sequence, which is then stomped on -- very rare!
+(define *report-boolean-functions-misbehaving* #t) ; function name ends in #\? but function returns a non-boolean value -- dubious.
+(define *report-repeated-code-fragments* #t)
+
+;;; work-in-progress
+(define *fragments-size* 128) ; biggest seen if 512: 180 -- appears to be in a test suite
+(define *report-blocks* #f) ; report huge blocks that could be moved into the closure
(define *lint* #f) ; the lint let
;; this gives other programs a way to extend or edit lint's tables: for example, the
@@ -67,48 +73,12 @@
`(begin
(format outport "lint.scm line ~A~%" ,(port-line-number))
(lint-format-1 ,str ,caller , at args)))
-|#
-(define-macro (let*-temporarily vars . body)
- `(with-let (#_inlet :orig (#_curlet)
- :saved (#_list ,@(map car vars)))
- (dynamic-wind
- (lambda () #f)
- (lambda ()
- (with-let orig
- ,@(map (lambda (v)
- `(set! ,(car v) ,(cadr v)))
- vars)
- , at body))
- (lambda ()
- ,@(map (let ((ctr -1))
- (lambda (v)
- (if (symbol? (car v))
- `(set! (orig ',(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))
- `(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1)))))))
- vars)))))
-
-(define-macro (let-temporarily vars . body)
- `(with-let (#_inlet :orig (#_curlet)
- :saved (#_list ,@(map car vars))
- :new (#_list ,@(map cadr vars)))
- (dynamic-wind
- (lambda () #f)
- (lambda () ; this could be (with-let orig (let ,vars , at body)) but I want to handle stuff like individual vector locations
- ,@(map (let ((ctr -1))
- (lambda (v)
- (if (symbol? (car v))
- `(set! (orig ',(car v)) (list-ref new ,(set! ctr (+ ctr 1))))
- `(set! (with-let orig ,(car v)) (list-ref new ,(set! ctr (+ ctr 1)))))))
- vars)
- (with-let orig , at body))
- (lambda ()
- ,@(map (let ((ctr -1))
- (lambda (v)
- (if (symbol? (car v))
- `(set! (orig ',(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))
- `(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1)))))))
- vars)))))
+(define-expansion (lint-format* caller . args)
+ `(begin
+ (format outport "lint.scm line ~A~%" ,(port-line-number))
+ (lint-format*-1 ,caller , at args)))
+|#
;;; --------------------------------------------------------------------------------
@@ -199,21 +169,26 @@
make-list length copy fill! reverse reverse! sort! append assq assv memq memv vector-append
list->vector vector-fill! vector-length vector->list vector-ref vector-set! vector-dimensions
make-vector make-shared-vector vector float-vector make-float-vector float-vector-set!
- float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref ->byte-vector
+ float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref string->byte-vector
byte-vector make-byte-vector hash-table hash-table* make-hash-table hash-table-ref
hash-table-set! hash-table-entries cyclic-sequences call/cc call-with-current-continuation
call-with-exit load autoload eval eval-string apply for-each map dynamic-wind values
catch throw error procedure-documentation procedure-signature help procedure-source funclet
procedure-setter arity aritable? not eq? eqv? equal? morally-equal? gc s7-version emergency-exit
- exit dilambda make-hook hook-functions stacktrace tree-leaves
+ exit dilambda make-hook hook-functions stacktrace tree-leaves object->let
#_{list} #_{apply_values} #_{append} unquote))
ht))
- (makers '(gensym sublet inlet make-iterator let->list random-state random-state->list number->string
- make-string string string-copy copy list->string string->list string-append substring object->string
- format cons list make-list reverse append vector-append list->vector vector->list make-vector
- make-shared-vector vector make-float-vector float-vector make-int-vector int-vector byte-vector
- hash-table hash-table* make-hash-table make-hook #_{list} #_{append} gentemp)) ; gentemp for other schemes
+ (makers (let ((h (make-hash-table)))
+ (for-each
+ (lambda (op)
+ (set! (h op) #t))
+ '(gensym sublet inlet make-iterator let->list random-state random-state->list number->string object->let
+ make-string string string-copy copy list->string string->list string-append substring object->string
+ format cons list make-list reverse append vector-append list->vector vector->list make-vector
+ make-shared-vector vector make-float-vector float-vector make-int-vector int-vector byte-vector
+ hash-table hash-table* make-hash-table make-hook #_{list} #_{append} gentemp)) ; gentemp for other schemes
+ h))
(non-negative-ops (let ((h (make-hash-table)))
(for-each
@@ -288,7 +263,6 @@
(outport #t)
(linted-files ())
(big-constants (make-hash-table))
- (equable-closures (make-hash-table))
(other-names-counts (make-hash-table))
(*e* #f)
(other-identifiers (make-hash-table))
@@ -305,7 +279,13 @@
(lint-left-margin 1)
(*current-file* "")
(*top-level-objects* (make-hash-table))
- (*output-port* *stderr*))
+ (*output-port* *stderr*)
+ (fragments (let ((v (make-vector *fragments-size* #f)))
+ (do ((i 0 (+ i 1)))
+ ((= i *fragments-size*))
+ (set! (v i) (make-hash-table)))
+ v))
+ (*max-cdr-len* 16)) ; 40 is too high, 24 questionable, if #f the let+do rewrite is turned off
(set! *e* (curlet))
(set! *lint* *e*) ; external access to (for example) the built-in-functions hash-table via (*lint* 'built-in-functions)
@@ -429,6 +409,7 @@
(define var-set (dilambda (lambda (v) (let-ref (cdr v) 'set)) (lambda (v x) (let-set! (cdr v) 'set x))))
(define var-history (dilambda (lambda (v) (let-ref (cdr v) 'history)) (lambda (v x) (let-set! (cdr v) 'history x))))
(define var-ftype (dilambda (lambda (v) (let-ref (cdr v) 'ftype)) (lambda (v x) (let-set! (cdr v) 'ftype x))))
+ (define var-retcons (dilambda (lambda (v) (let-ref (cdr v) 'retcons)) (lambda (v x) (let-set! (cdr v) 'retcons x))))
(define var-arglist (dilambda (lambda (v) (let-ref (cdr v) 'arglist)) (lambda (v x) (let-set! (cdr v) 'arglist x))))
(define var-definer (dilambda (lambda (v) (let-ref (cdr v) 'definer)) (lambda (v x) (let-set! (cdr v) 'definer x))))
(define var-leaves (dilambda (lambda (v) (let-ref (cdr v) 'leaves)) (lambda (v x) (let-set! (cdr v) 'leaves x))))
@@ -437,7 +418,7 @@
(define var-env (dilambda (lambda (v) (let-ref (cdr v) 'env)) (lambda (v x) (let-set! (cdr v) 'env x))))
(define var-decl (dilambda (lambda (v) (let-ref (cdr v) 'decl)) (lambda (v x) (let-set! (cdr v) 'decl x))))
(define var-match-list (dilambda (lambda (v) (let-ref (cdr v) 'match-list)) (lambda (v x) (let-set! (cdr v) 'match-list x))))
- (define var-initial-value (lambda (v) (let-ref (cdr v) 'initial-value))) ; not settable
+ (define var-initial-value (lambda (v) (let-ref (cdr v) 'initial-value))) ; not (easily) settable
(define var-side-effect (dilambda (lambda (v)
(if (null? (let-ref (cdr v) 'side-effect))
@@ -620,6 +601,12 @@
(tree-member sym (car tree))
(tree-member sym (cdr tree)))))
+ (define (tree-equal-member sym tree)
+ (and (pair? tree)
+ (or (equal? (car tree) sym)
+ (tree-member sym (car tree))
+ (tree-member sym (cdr tree)))))
+
(define (tree-unquoted-member sym tree)
(and (pair? tree)
(not (eq? (car tree) 'quote))
@@ -666,8 +653,17 @@
(and (pair? (cdr tree))
(member #f (cdr tree) (lambda (a b) (tree-set-car-member set b)))))))
+ (define (tree-table-car-member set tree) ; hash-table as car
+ (and (pair? tree)
+ (or (and (hash-table-ref set (car tree))
+ tree)
+ (and (pair? (car tree))
+ (tree-table-car-member set (car tree)))
+ (and (pair? (cdr tree))
+ (member #f (cdr tree) (lambda (a b) (tree-table-car-member set b)))))))
+
(define (maker? tree)
- (tree-set-car-member makers tree))
+ (tree-table-car-member makers tree))
(define (tree-symbol-walk tree syms)
(if (pair? tree)
@@ -876,19 +872,22 @@
((pair? (car args)) (cons (caar args) (args->proper-list (cdr args))))
(else (cons (car args) (args->proper-list (cdr args))))))
- (define (out-vars func-name arglist body) ; t367 has tests
+ (define (out-vars func-name arglist body)
(let ((ref ())
(set ()))
(let var-walk ((tree body)
(e (cons func-name arglist)))
+
(define (var-walk-body tree e)
(when (pair? tree)
(for-each (lambda (p) (set! e (var-walk p e))) tree)))
+
(define (shadowed v)
(if (and (or (memq v e) (memq v ref))
(not (memq v set)))
(set! set (cons v set)))
v)
+
(if (symbol? tree)
(if (not (or (memq tree e) (memq tree ref) (defined? tree (rootlet))))
(set! ref (cons tree ref)))
@@ -912,15 +911,30 @@
(let* ((named (symbol? (cadr tree)))
(vars (if named
(list (shadowed (cadr tree)))
- ())))
- (for-each (lambda (v)
- (when (and (pair? v)
- (pair? (cdr v)))
- (var-walk (cadr v) e)
- (set! vars (cons (shadowed (car v)) vars))))
- ((if named caddr cadr) tree))
+ ()))
+ (varlist ((if named caddr cadr) tree)))
+ (when (pair? varlist)
+ (for-each (lambda (v)
+ (when (and (pair? v)
+ (pair? (cdr v)))
+ (var-walk (cadr v) e)
+ (set! vars (cons (shadowed (car v)) vars))))
+ ((if named caddr cadr) tree)))
(var-walk-body ((if named cdddr cddr) tree) (append vars e)))))
+ ((let* letrec*)
+ (let* ((named (symbol? (cadr tree)))
+ (vars (if named (list (cadr tree)) ()))
+ (varlist ((if named caddr cadr) tree)))
+ (when (pair? varlist)
+ (for-each (lambda (v)
+ (when (and (pair? v)
+ (pair? (cdr v)))
+ (var-walk (cadr v) (append vars e))
+ (set! vars (cons (shadowed (car v)) vars))))
+ varlist))
+ (var-walk-body ((if named cdddr cddr) tree) (append vars e))))
+
((case)
(when (and (pair? (cdr tree))
(pair? (cddr tree)))
@@ -930,16 +944,6 @@
(cddr tree))))
((quote) #f)
- ((let* letrec*)
- (let* ((named (symbol? (cadr tree)))
- (vars (if named (list (cadr tree)) ())))
- (for-each (lambda (v)
- (when (and (pair? v)
- (pair? (cdr v)))
- (var-walk (cadr v) (append vars e))
- (set! vars (cons (shadowed (car v)) vars))))
- ((if named caddr cadr) tree))
- (var-walk-body ((if named cdddr cddr) tree) (append vars e))))
((do)
(let ((vars ()))
@@ -1003,6 +1007,7 @@
(x (- len 1)))))
(define* (make-fvar name ftype arglist decl initial-value env)
+ ;(format *stderr* "fvar: ~A~%" name)
(let ((new (let ((old (hash-table-ref other-identifiers name)))
(cons name
(inlet 'signature ()
@@ -1020,6 +1025,7 @@
'decl decl
'arglist arglist
'ftype ftype
+ 'retcons #f
'history (if old
(begin
(hash-table-set! other-identifiers name #f)
@@ -1027,12 +1033,7 @@
(if initial-value (list initial-value) ()))
'set 0
'ref (if old (length old) 0))))))
- (when (and *report-function-stuff*
- (not (memq name '(:lambda :dilambda)))
- (memq ftype '(define lambda define* lambda*))
- (pair? (caddr initial-value)))
- (hash-table-set! equable-closures (caaddr initial-value)
- (cons new (or (hash-table-ref equable-closures (caaddr initial-value)) ()))))
+ (reduce-function-tree new env)
new))
(define (return-type sym e)
@@ -1483,11 +1484,11 @@
(list (cdr lst)))))))
(define (keywords lst)
- (let ((count 0))
- (do ((p lst (cdr p)))
- ((null? p) count)
- (if (keyword? (car p))
- (set! count (+ count 1))))))
+ (do ((count 0)
+ (p lst (cdr p)))
+ ((null? p) count)
+ (if (keyword? (car p))
+ (set! count (+ count 1)))))
(define (eqv-selector clause)
(if (not (pair? clause))
@@ -2016,9 +2017,9 @@
(typer c2))
(cond ((or (eq? op1 op2)
(eq? op2 (cadr (assq op1 relops))))
- (if ((symbol->value op1) c1 c2)
- (return `(,op2 ,x ,c2))
- (return `(,op1 ,x ,c1))))
+ (return (if ((symbol->value op1) c1 c2)
+ `(,op2 ,x ,c2)
+ `(,op1 ,x ,c1))))
((eq? op1 (caddr (assq op2 relops)))
(if ((symbol->value op1) c2 c1)
(return #t))
@@ -2076,66 +2077,70 @@
args)))))))))
(define (and-redundants env . args)
- (let ((locals ())
- (diffs #f))
- (do ((p args (cdr p)))
- ((or (null? p)
- (not (and (pair? (car p))
- (pair? (cdar p))
- (hash-table-ref booleans (caar p)))))
- (and (null? p)
- (pair? locals)
- (or diffs
- (any? (lambda (a) (pair? (cddr a))) locals))
- (let ((keepers ()))
- (for-each (lambda (a)
- (cond ((null? (cddr a))
- (set! keepers (cons (cadr a) keepers)))
-
- ((null? (cdddr a))
- (let ((res (apply and-redundant? (reverse (cdr a)))))
+ (do ((locals ())
+ (diffs #f)
+ (p args (cdr p)))
+ ((or (null? p)
+ (not (and (pair? (car p))
+ (pair? (cdar p))
+ (hash-table-ref booleans (caar p)))))
+ (and (null? p)
+ (pair? locals)
+ (or diffs
+ (any? (lambda (a) (pair? (cddr a))) locals))
+ (let ((keepers ()))
+ (for-each (lambda (a)
+ (let ((next-a (cdr a)))
+ (cond ((null? (cdr next-a))
+ (set! keepers (cons (car next-a) keepers)))
+
+ ((null? (cddr next-a))
+ (let ((res (apply and-redundant? (reverse next-a))))
(if res
(begin
- (set! keepers (cons ((if (eq? res (caadr a)) cadr caddr) a) keepers))
+ (set! keepers (cons ((if (eq? res (caar next-a)) car cadr) next-a) keepers))
(set! diffs #t))
- (set! keepers (cons (cadr a) (cons (caddr a) keepers))))))
-
+ (set! keepers (cons (car next-a) (cons (cadr next-a) keepers))))))
+
(else
- (let ((ar (reverse (cdr a))))
- (let ((res1 (and-redundant? (car ar) (cadr ar))) ; if res1 either 1 or 2 is out
- (res2 (and-redundant? (cadr ar) (caddr ar))) ; if res2 either 2 or 3 is out
- (res3 (and-redundant? (car ar) (caddr ar)))) ; if res3 either 1 or 3 is out
- ;; only in numbers can 3 actually be reducible
- (if (not (or res1 res2 res3))
- (set! keepers (append (cdr a) keepers))
- (begin
- (set! diffs #t)
- (if (and (or (not res1)
- (eq? res1 (caar ar)))
- (or (not res3)
- (eq? res3 (caar ar))))
- (set! keepers (cons (car ar) keepers)))
- (if (and (or (not res1)
- (eq? res1 (caadr ar)))
- (or (not res2)
- (eq? res2 (caadr ar))))
- (set! keepers (cons (cadr ar) keepers)))
- (if (and (or (not res2)
- (eq? res2 (car (caddr ar))))
- (or (not res3)
- (eq? res3 (car (caddr ar)))))
- (set! keepers (cons (caddr ar) keepers)))
- (if (pair? (cdddr ar))
- (set! keepers (append (reverse (cdddr ar)) keepers))))))))))
- (reverse locals))
- (and diffs (reverse keepers)))))
- (let* ((bool (car p))
- (local (assoc (cadr bool) locals)))
- (if (pair? local)
- (if (member bool (cdr local))
- (set! diffs #t)
- (set-cdr! local (cons bool (cdr local))))
- (set! locals (cons (list (cadr bool) bool) locals)))))))
+ (let ((ar (reverse next-a)))
+ (let ((ar1 (car ar))
+ (ar2 (cadr ar))
+ (ar3 (caddr ar)))
+ (let ((res1 (and-redundant? ar1 ar2)) ; if res1 either 1 or 2 is out
+ (res2 (and-redundant? ar2 ar3)) ; if res2 either 2 or 3 is out
+ (res3 (and-redundant? ar1 ar3))) ; if res3 either 1 or 3 is out
+ ;; only in numbers can 3 actually be reducible
+ (if (not (or res1 res2 res3))
+ (set! keepers (append (cdr a) keepers))
+ (begin
+ (set! diffs #t)
+ (if (and (or (not res1)
+ (eq? res1 (car ar1)))
+ (or (not res3)
+ (eq? res3 (car ar1))))
+ (set! keepers (cons ar1 keepers)))
+ (if (and (or (not res1)
+ (eq? res1 (car ar2)))
+ (or (not res2)
+ (eq? res2 (car ar2))))
+ (set! keepers (cons ar2 keepers)))
+ (if (and (or (not res2)
+ (eq? res2 (car ar3)))
+ (or (not res3)
+ (eq? res3 (car ar3))))
+ (set! keepers (cons ar3 keepers)))
+ (if (pair? (cdddr ar))
+ (set! keepers (append (reverse (cdddr ar)) keepers))))))))))))
+ (reverse locals))
+ (and diffs (reverse keepers)))))
+ (let* ((bool (car p))
+ (local (assoc (cadr bool) locals)))
+ (if (pair? local)
+ (if (member bool (cdr local))
+ (set! diffs #t)
+ (set-cdr! local (cons bool (cdr local))))
+ (set! locals (cons (list (cadr bool) bool) locals))))))
(define (and-not-redundant arg1 arg2)
@@ -2532,9 +2537,9 @@
((if (eq? (car val) 'cond) cdr cddr) val))))
((begin)
- (let* ((len (length val))
- (new-last (simplify-boolean `(not ,(list-ref val (- len 1))) () () env)))
- `(,@(copy val (make-list (- len 1))) ,new-last)))))
+ (let* ((len1 (- (length val) 1))
+ (new-last (simplify-boolean `(not ,(list-ref val len1)) () () env)))
+ `(,@(copy val (make-list len1)) ,new-last)))))
((not (equal? val arg))
`(not ,val))
@@ -2737,21 +2742,21 @@
(let ((temp arg1))
(set! arg1 arg2)
(set! arg2 temp)))
- (if (and (eq? (car arg2) 'not)
- (pair? (cadr arg2))
- (pair? (cdadr arg2))
- (not (eq? (caadr arg2) 'let?))
- (or (equal? (cadr arg1) (cadadr arg2))
- (and (pair? (cddr arg1))
- (equal? (caddr arg1) (cadadr arg2))))
- (eq? (return-type (car arg1) env) 'boolean?)
- (eq? (return-type (caadr arg2) env) 'boolean?))
- (let ((t2 (or-not-redundant arg1 arg2)))
- (when t2
- (if (eq? t2 'fatuous)
- (return #t)
- (if (pair? t2)
- (return t2)))))))
+ (when (and (eq? (car arg2) 'not)
+ (pair? (cadr arg2))
+ (pair? (cdadr arg2))
+ (not (eq? (caadr arg2) 'let?))
+ (or (equal? (cadr arg1) (cadadr arg2))
+ (and (pair? (cddr arg1))
+ (equal? (caddr arg1) (cadadr arg2))))
+ (eq? (return-type (car arg1) env) 'boolean?)
+ (eq? (return-type (caadr arg2) env) 'boolean?))
+ (let ((t2 (or-not-redundant arg1 arg2)))
+ (when t2
+ (if (eq? t2 'fatuous)
+ (return #t)
+ (if (pair? t2)
+ (return t2)))))))
;; (or (if a c d) (if b c d)) -> (if (or a b) c d) never happens, sad to say
;; or + if + if does happen but not in this easily optimized form
@@ -2761,14 +2766,13 @@
(let ((nots 0)
(revers 0)
(arglen (- len 1)))
- (do ((p (cdr form) (cdr p)))
- ((not (pair? p)))
- (let ((a (car p)))
- (if (pair? a)
- (if (eq? (car a) 'not)
- (set! nots (+ nots 1))
- (if (hash-table-ref notables (car a))
- (set! revers (+ revers 1)))))))
+ (for-each (lambda (a)
+ (if (pair? a)
+ (if (eq? (car a) 'not)
+ (set! nots (+ nots 1))
+ (if (hash-table-ref notables (car a))
+ (set! revers (+ revers 1))))))
+ (cdr form))
(if (= nots arglen) ; every arg is `(not ...)
(let ((nf (simplify-boolean `(and ,@(map cadr (cdr form))) () () env)))
(return (simplify-boolean `(not ,nf) () () env)))
@@ -2941,176 +2945,177 @@
,(gather-or-eqf-elements eqfnc sym vals)
, at trailer)))))))))
- (let ((selector #f) ; (or (and (eq?...)...)....) -> (case ....)
- (keys ()))
- (do ((fp (cdr form) (cdr fp)))
- ((or (null? fp)
- (let ((p (and (pair? fp)
- (car fp))))
- (not (and (pair? p)
- (eq? (car p) 'and)
- (pair? (cdr p))
- (pair? (cadr p))
- (pair? (cdadr p))
- (or selector
- (set! selector (cadadr p)))
- (let ((expr (cadr p)))
- (case (car expr)
- ((null?)
- (and (equal? selector (cadr expr))
- (not (memq () keys))
- (set! keys (cons () keys))))
- ;; we have to make sure no keys are repeated:
- ;; (or (and (eq? x 'a) (< y 1)) (and (eq? x 'a) (< y 2)))
- ;; this rewrite has become much trickier than expected...
-
- ((boolean?)
- (and (equal? selector (cadr expr))
- (not (memq #f keys))
- (not (memq #t keys))
- (set! keys (cons #f (cons #t keys)))))
-
- ((eof-object?)
- (and (equal? selector (cadr expr))
- (not (memq #<eof> keys))
- (set! keys (cons #<eof> keys))))
-
- ((zero?)
- (and (equal? selector (cadr expr))
- (not (memv 0 keys))
- (not (memv 0.0 keys))
- (set! keys (cons 0.0 (cons 0 keys)))))
-
- ((memq memv)
- (and (equal? selector (cadr expr))
- (pair? (cddr expr))
- (pair? (caddr expr))
- (eq? (caaddr expr) 'quote)
- (pair? (cadr (caddr expr)))
- (not (any? (lambda (g)
- (memv g keys))
- (cadr (caddr expr))))
- (set! keys (append (cadr (caddr expr)) keys))))
-
- ((eq? eqv? char=?)
- (and (pair? (cddr expr))
- (null? (cdddr expr))
- (or (and (equal? selector (cadr expr))
- (code-constant? (caddr expr))
- (not (memv (unquoted (caddr expr)) keys))
- (set! keys (cons (unquoted (caddr expr)) keys)))
- (and (equal? selector (caddr expr))
- (code-constant? (cadr expr))
- (not (memv (unquoted (cadr expr)) keys))
- (set! keys (cons (unquoted (cadr expr)) keys))))))
-
- ((not)
- ;; no hits here for last+not eq(etc)+no collision in keys
- (and (equal? selector (cadr expr))
- (not (memq #f keys))
- (set! keys (cons #f keys))))
-
- (else #f)))))))
- (if (null? fp)
- (return `(case ,selector
- ,@(map (lambda (p)
- (let ((expr (cadr p))
- (result (if (null? (cdddr p))
- (caddr p)
- `(and ,@(cddr p)))))
- `(,(case (car expr)
- ((eq? eqv? char=?)
- (if (equal? selector (cadr expr))
- (list (unquoted (caddr expr)))
- (list (unquoted (cadr expr)))))
- ((memq memv) (unquoted (caddr expr)))
- ((null?) (list ()))
- ((eof-object?) (list #<eof>))
- ((zero?) (list 0 0.0))
- ((not) (list #f))
- ((boolean?) (list #t #f)))
- ,result)))
- (cdr form))
- (else #f)))))))
+ (do ((selector #f) ; (or (and (eq?...)...)....) -> (case ....)
+ (keys ())
+ (fp (cdr form) (cdr fp)))
+ ((or (null? fp)
+ (let ((p (and (pair? fp)
+ (car fp))))
+ (not (and (pair? p)
+ (eq? (car p) 'and)
+ (pair? (cdr p))
+ (pair? (cadr p))
+ (pair? (cdadr p))
+ (or selector
+ (set! selector (cadadr p)))
+ (let ((expr (cadr p))
+ (arg1 (cadadr p)))
+ (case (car expr)
+ ((null?)
+ (and (equal? selector arg1)
+ (not (memq () keys))
+ (set! keys (cons () keys))))
+ ;; we have to make sure no keys are repeated:
+ ;; (or (and (eq? x 'a) (< y 1)) (and (eq? x 'a) (< y 2)))
+ ;; this rewrite has become much trickier than expected...
+
+ ((boolean?)
+ (and (equal? selector arg1)
+ (not (memq #f keys))
+ (not (memq #t keys))
+ (set! keys (cons #f (cons #t keys)))))
+
+ ((eof-object?)
+ (and (equal? selector arg1)
+ (not (memq #<eof> keys))
+ (set! keys (cons #<eof> keys))))
+
+ ((zero?)
+ (and (equal? selector arg1)
+ (not (memv 0 keys))
+ (not (memv 0.0 keys))
+ (set! keys (cons 0.0 (cons 0 keys)))))
+
+ ((memq memv)
+ (and (equal? selector arg1)
+ (pair? (cddr expr))
+ (pair? (caddr expr))
+ (eq? (caaddr expr) 'quote)
+ (pair? (cadr (caddr expr)))
+ (not (any? (lambda (g)
+ (memv g keys))
+ (cadr (caddr expr))))
+ (set! keys (append (cadr (caddr expr)) keys))))
+
+ ((eq? eqv? char=?)
+ (and (pair? (cddr expr))
+ (null? (cdddr expr))
+ (or (and (equal? selector arg1)
+ (code-constant? (caddr expr))
+ (not (memv (unquoted (caddr expr)) keys))
+ (set! keys (cons (unquoted (caddr expr)) keys)))
+ (and (equal? selector (caddr expr))
+ (code-constant? arg1)
+ (not (memv (unquoted arg1) keys))
+ (set! keys (cons (unquoted arg1) keys))))))
+
+ ((not)
+ ;; no hits here for last+not eq(etc)+no collision in keys
+ (and (equal? selector arg1)
+ (not (memq #f keys))
+ (set! keys (cons #f keys))))
+
+ (else #f)))))))
+ (if (null? fp)
+ (return `(case ,selector
+ ,@(map (lambda (p)
+ (let ((result (if (null? (cdddr p))
+ (caddr p)
+ `(and ,@(cddr p))))
+ (key (let ((expr (cadr p)))
+ (case (car expr)
+ ((eq? eqv? char=?)
+ (let ((repeats (equal? selector (cadr expr))))
+ (list (unquoted ((if repeats caddr cadr) expr)))))
+ ((memq memv) (unquoted (caddr expr)))
+ ((null?) (list ()))
+ ((eof-object?) (list #<eof>))
+ ((zero?) (list 0 0.0))
+ ((not) (list #f))
+ ((boolean?) (list #t #f))))))
+ (list key result)))
+ (cdr form))
+ (else #f))))))
- (let ((new-form ())
- (retry #f))
- (do ((exprs (cdr form) (cdr exprs)))
- ((null? exprs)
- (return (and (pair? new-form)
- (if (null? (cdr new-form))
- (car new-form)
- (if retry
- (simplify-boolean `(or ,@(reverse new-form)) () () env)
- `(or ,@(reverse new-form)))))))
- (let ((val (classify (car exprs)))
- (old-form new-form))
-
- (when (and (pair? val)
- (memq (car val) '(and or not)))
- (set! val (classify (simplify-boolean val true false env)))
- (when (and (> len 3)
- (pair? val)
- (eq? (car val) 'not)
- (pair? (cdr exprs)))
- (if (symbol? (cadr val))
- (if (and (pair? (cadr exprs))
- (memq (cadr val) (cadr exprs)))
- (and-incomplete form 'or (cadr val) (cadr exprs) env)
- (do ((ip (cdr exprs) (cdr ip))
- (found-it #f))
- ((or found-it
- (not (pair? ip))))
- (do ((p (car ip) (cdr p)))
- ((or (not (pair? p))
- (and (memq (cadr val) p)
- (set! found-it p)))
- (if (pair? found-it)
- (and-incomplete form 'or (cadr val) found-it env))))))
- (when (and (pair? (cadr val))
- (pair? (cadr exprs))
- (hash-table-ref bools (caadr val)))
- (if (member (cadadr val) (cadr exprs))
- (and-forgetful form 'or (cadr val) (cadr exprs) env)
- (do ((p (cadr exprs) (cdr p)))
- ((or (not (pair? p))
- (and (pair? (car p))
- (member (cadadr val) (car p))))
- (if (pair? p)
- (and-forgetful form 'or (cadr val) (car p) env)))))))))
- (if (not (or retry
- (equal? val (car exprs))))
- (set! retry #t))
-
- (if val ; #f in or is ignored
- (cond ((or (eq? val #t) ; #t or any non-#f constant in or ends the expression
- (code-constant? val))
- (set! new-form (if (null? new-form) ; (or x1 123) -> value of x1 first
- (list val)
- (cons val new-form)))
- ;; reversed when returned
- (set! exprs '(#t)))
-
- ((and (pair? val) ; (or ...) -> splice into current
- (eq? (car val) 'or))
- (set! exprs (append val (cdr exprs)))) ; we'll skip the 'or in do step
-
- ((not (or (memq val new-form)
- (and (pair? val) ; and redundant tests
- (hash-table-ref booleans (car val))
- (any? (lambda (p)
- (and (pair? p)
- (subsumes? (car p) (car val))
- (equal? (cadr val) (cadr p))))
- new-form))))
- (set! new-form (cons val new-form)))))
-
- (if (and (not (eq? new-form old-form))
- (pair? (cdr new-form)))
- (let ((rel (relsub (cadr new-form) (car new-form) 'or env))) ; new-form is reversed
- (if (or (boolean? rel)
- (pair? rel))
- (set! new-form (cons rel (cddr new-form)))))))))))))))
+ (do ((new-form ())
+ (retry #f)
+ (exprs (cdr form) (cdr exprs)))
+ ((null? exprs)
+ (return (and (pair? new-form)
+ (if (null? (cdr new-form))
+ (car new-form)
+ (if retry
+ (simplify-boolean `(or ,@(reverse new-form)) () () env)
+ `(or ,@(reverse new-form)))))))
+ (let ((val (classify (car exprs)))
+ (old-form new-form))
+
+ (when (and (pair? val)
+ (memq (car val) '(and or not)))
+ (set! val (classify (simplify-boolean val true false env)))
+ (when (and (> len 3)
+ (pair? val)
+ (eq? (car val) 'not)
+ (pair? (cdr exprs)))
+ (if (symbol? (cadr val))
+ (if (and (pair? (cadr exprs))
+ (memq (cadr val) (cadr exprs)))
+ (and-incomplete form 'or (cadr val) (cadr exprs) env)
+ (do ((ip (cdr exprs) (cdr ip))
+ (found-it #f))
+ ((or found-it
+ (not (pair? ip))))
+ (do ((p (car ip) (cdr p)))
+ ((or (not (pair? p))
+ (and (memq (cadr val) p)
+ (set! found-it p)))
+ (if (pair? found-it)
+ (and-incomplete form 'or (cadr val) found-it env))))))
+ (when (and (pair? (cadr val))
+ (pair? (cadr exprs))
+ (hash-table-ref bools (caadr val)))
+ (if (member (cadadr val) (cadr exprs))
+ (and-forgetful form 'or (cadr val) (cadr exprs) env)
+ (do ((p (cadr exprs) (cdr p)))
+ ((or (not (pair? p))
+ (and (pair? (car p))
+ (member (cadadr val) (car p))))
+ (if (pair? p)
+ (and-forgetful form 'or (cadr val) (car p) env)))))))))
+ (if (not (or retry
+ (equal? val (car exprs))))
+ (set! retry #t))
+
+ (cond ((not val)) ; #f in or is ignored
+
+ ((or (eq? val #t) ; #t or any non-#f constant in or ends the expression
+ (code-constant? val))
+ (set! new-form (if (null? new-form) ; (or x1 123) -> value of x1 first
+ (list val)
+ (cons val new-form)))
+ ;; reversed when returned
+ (set! exprs '(#t)))
+
+ ((and (pair? val) ; (or ...) -> splice into current
+ (eq? (car val) 'or))
+ (set! exprs (append val (cdr exprs)))) ; we'll skip the 'or in do step
+
+ ((not (or (memq val new-form)
+ (and (pair? val) ; and redundant tests
+ (hash-table-ref booleans (car val))
+ (any? (lambda (p)
+ (and (pair? p)
+ (subsumes? (car p) (car val))
+ (equal? (cadr val) (cadr p))))
+ new-form))))
+ (set! new-form (cons val new-form))))
+
+ (if (and (not (eq? new-form old-form))
+ (pair? (cdr new-form)))
+ (let ((rel (relsub (cadr new-form) (car new-form) 'or env))) ; new-form is reversed
+ (if (or (boolean? rel)
+ (pair? rel))
+ (set! new-form (cons rel (cddr new-form))))))))))))))
;; --------------------------------
((and)
@@ -3140,10 +3145,9 @@
(if (symbol? arg1) ; (and x (pair? x)) -> (pair? x)
(if (memq arg1 arg2)
(begin
- (if (eq? (car arg2) 'not)
- (return #f))
- (if (eq? (car arg2) 'boolean?)
- (return `(eq? ,arg1 #t)))
+ (case (car arg2)
+ ((not) (return #f))
+ ((boolean?) (return `(eq? ,arg1 #t))))
(and-incomplete form 'and arg1 arg2 env)
(if (hash-table-ref booleans (car arg2))
(return arg2)))
@@ -3323,6 +3327,7 @@
(let ((temp arg1))
(set! arg1 arg2)
(set! arg2 temp)))
+
(when (and (eq? (car arg2) 'not)
(pair? (cadr arg2))
(pair? (cdadr arg2))
@@ -3385,14 +3390,13 @@
(let ((nots 0)
(revers 0)
(arglen (- len 1)))
- (do ((p (cdr form) (cdr p)))
- ((not (pair? p)))
- (let ((a (car p)))
- (if (pair? a)
- (if (eq? (car a) 'not)
- (set! nots (+ nots 1))
- (if (hash-table-ref notables (car a))
- (set! revers (+ revers 1)))))))
+ (for-each (lambda (a)
+ (if (pair? a)
+ (if (eq? (car a) 'not)
+ (set! nots (+ nots 1))
+ (if (hash-table-ref notables (car a))
+ (set! revers (+ revers 1))))))
+ (cdr form))
(if (= nots arglen) ; every arg is `(not ...)
(let ((nf (simplify-boolean `(or ,@(map cadr (cdr form))) () () env)))
(return (simplify-boolean `(not ,nf) () () env)))
@@ -3426,161 +3430,174 @@
(return (simplify-boolean `(and , at diff) () () env))))
;; now there are redundancies below (see subsumes?) but they assumed the tests were side-by-side
- (let ((new-form ())
- (retry #f))
+ (do ((new-form ())
+ (retry #f)
+ (exprs (cdr form) (cdr exprs)))
+ ((null? exprs)
+ (or (null? new-form) ; (and) -> #t
+ (let ((newer-form (let ((nform (reverse new-form)))
+ (map (lambda (x cdr-x)
+ (if (and x (code-constant? x))
+ (values)
+ x))
+ nform (cdr nform)))))
+ (return
+ (cond ((null? newer-form)
+ (car new-form))
+
+ ((and (eq? (car new-form) #t) ; trailing #t is dumb if next-to-last is boolean func
+ (pair? (cdr new-form))
+ (pair? (cadr new-form))
+ (symbol? (caadr new-form))
+ (eq? (return-type (caadr new-form) env) 'boolean?))
+ (if (null? (cdr newer-form))
+ (car newer-form)
+ `(and , at newer-form)))
+
+ (retry
+ (simplify-boolean `(and , at newer-form ,(car new-form)) () () env))
+
+ (else `(and , at newer-form ,(car new-form))))))))
- (do ((exprs (cdr form) (cdr exprs)))
- ((null? exprs)
- (or (null? new-form) ; (and) -> #t
- (let ((newer-form (let ((nform (reverse new-form)))
- (map (lambda (x cdr-x)
- (if (and x (code-constant? x))
- (values)
- x))
- nform (cdr nform)))))
- (return
- (cond ((null? newer-form)
- (car new-form))
-
- ((and (eq? (car new-form) #t) ; trailing #t is dumb if next-to-last is boolean func
- (pair? (cdr new-form))
- (pair? (cadr new-form))
- (symbol? (caadr new-form))
- (eq? (return-type (caadr new-form) env) 'boolean?))
- (if (null? (cdr newer-form))
- (car newer-form)
- `(and , at newer-form)))
-
- (retry
- (simplify-boolean `(and , at newer-form ,(car new-form)) () () env))
-
- (else `(and , at newer-form ,(car new-form))))))))
-
- (let* ((e (car exprs))
- (val (classify e))
- (old-form new-form))
-
- (if (and (pair? val)
- (memq (car val) '(and or not)))
- (set! val (classify (set! e (simplify-boolean val () false env))))
-
- (when (and (> len 3)
- (pair? (cdr exprs)))
- (if (symbol? val)
- (if (and (pair? (cadr exprs))
- (memq val (cadr exprs)))
- (let ((nval (simplify-boolean `(and ,val ,(cadr exprs)) () false env)))
- (if (and (pair? nval)
- (eq? (car nval) 'and))
- (and-incomplete form 'and val (cadr exprs) env)
- (begin
- (set! val nval)
- (set! exprs (cdr exprs)))))
- (do ((ip (cdr exprs) (cdr ip))
- (found-it #f))
- ((or found-it
- (not (pair? ip))))
- (do ((p (car ip) (cdr p)))
- ((or (not (pair? p))
- (and (memq val p)
- (let ((nval (simplify-boolean `(and ,val ,p) () false env)))
- (if (and (pair? nval)
- (eq? (car nval) 'and))
- (set! found-it p)
- (let ((ln (and (< 0 line-number 100000) line-number)))
- (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) "")
- (+ lint-left-margin 4) #\space
- `(and ... ,val ... ,p)
- nval)
- (set! found-it #t)))))
- (and (pair? (car p))
- (memq val (car p))
- (set! found-it (car p))))
- (if (pair? found-it)
- (and-incomplete form 'and val found-it env))))))
- (if (and (pair? val)
+ (let* ((e (car exprs))
+ (val (classify e))
+ (old-form new-form))
+
+ (if (and (pair? val)
+ (memq (car val) '(and or not)))
+ (set! val (classify (set! e (simplify-boolean val () false env))))
+
+ (when (and (> len 3)
+ (pair? (cdr exprs)))
+ (if (symbol? val)
+ (if (and (pair? (cadr exprs))
+ (memq val (cadr exprs)))
+ (let ((nval (simplify-boolean `(and ,val ,(cadr exprs)) () false env)))
+ (if (and (pair? nval)
+ (eq? (car nval) 'and))
+ (and-incomplete form 'and val (cadr exprs) env)
+ (begin
+ (set! val nval)
+ (set! exprs (cdr exprs)))))
+ (do ((ip (cdr exprs) (cdr ip))
+ (found-it #f))
+ ((or found-it
+ (not (pair? ip))))
+ (do ((p (car ip) (cdr p)))
+ ((or (not (pair? p))
+ (and (memq val p)
+ (let ((nval (simplify-boolean `(and ,val ,p) () false env)))
+ (if (and (pair? nval)
+ (eq? (car nval) 'and))
+ (set! found-it p)
+ (let ((ln (and (< 0 line-number 100000) line-number)))
+ (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) "")
+ (+ lint-left-margin 4) #\space
+ `(and ... ,val ... ,p)
+ nval)
+ (set! found-it #t)))))
+ (and (pair? (car p))
+ (memq val (car p))
+ (set! found-it (car p))))
+ (if (pair? found-it)
+ (and-incomplete form 'and val found-it env))))))
+ (when (and (pair? val)
(pair? (cadr exprs))
(hash-table-ref bools (car val)))
- (if (member (cadr val) (cadr exprs))
- (and-forgetful form 'and val (cadr exprs) env)
- (do ((p (cadr exprs) (cdr p)))
- ((or (not (pair? p))
- (and (pair? (car p))
- (member (cadr val) (car p))))
- (if (pair? p)
- (and-forgetful form 'and val (car p) env)))))))))
-
- (if (not (or retry
- (equal? e (car exprs))))
- (set! retry #t))
-
- ;; (and x1 x2 x1) is not reducible
- ;; the final thing has to remain at the end, but can be deleted earlier if it can't short-circuit the evaluation,
- ;; but if there are expressions following the first x1, we can't be sure that it is not
- ;; protecting them:
- ;; (and false-or-0 (display (list-ref lst false-or-0)) false-or-0)
- ;; so I'll not try to optimize that case. But (and x x) is optimizable.
-
- (cond ((eq? val #t)
- (if (null? (cdr exprs)) ; (and x y #t) should not remove the #t
- (if (or (and (pair? e)
- (eq? (return-type (car e) env) 'boolean?))
- (eq? e #t))
- (set! new-form (cons val new-form))
- (if (or (null? new-form)
- (not (equal? e (car new-form))))
- (set! new-form (cons e new-form))))
- (if (and (not (eq? e #t))
- (or (null? new-form)
- (not (member e new-form))))
- (set! new-form (cons e new-form)))))
-
- ((not val) ; #f in 'and' ends the expression
- (set! new-form (if (or (null? new-form)
- (just-symbols? new-form))
- '(#f)
- (cons #f new-form))) ;was (append '(#f) new-form)))
- (set! exprs '(#f)))
-
- ((and (pair? e) ; if (and ...) splice into current
- (eq? (car e) 'and))
- (set! exprs (append e (cdr exprs))))
-
- ((and (pair? e) ; (and (list? p) (pair? p) ...) -> (and (pair? p) ...)
- (pair? (cdr exprs))
- (pair? (cadr exprs))
- (eq? (and-redundant? e (cadr exprs)) (caadr exprs))
- (equal? (cadr e) (cadadr exprs))))
-
- ((not (and (pair? e) ; (and ... (or ... 123) ...) -> splice out or
- (pair? (cdr exprs))
- (eq? (car e) 'or)
- (pair? (cdr e))
- (pair? (cddr e))
- (cond ((list-ref e (- (length e) 1)) => code-constant?) ; (or ... #f)
- (else #f))))
- (if (not (and (pair? new-form)
- (or (eq? val (car new-form)) ; omit repeated tests
- (and (pair? val) ; and redundant tests
- (hash-table-ref booleans (car val))
- (any? (lambda (p)
- (and (pair? p)
- (subsumes? (car val) (car p))
- (equal? (cadr val) (cadr p))))
- new-form)))))
- (set! new-form (cons val new-form)))))
-
- (if (and (not (eq? new-form old-form))
- (pair? (cdr new-form)))
- (let ((rel (relsub (car new-form) (cadr new-form) 'and env)))
- ;; rel #f should halt everything as above, and it looks ugly in the output,
- ;; but it never happens in real code
- (if (or (pair? rel)
- (boolean? rel))
- (set! new-form (cons rel (cddr new-form)))))))))))))))))))))))))
+ (if (member (cadr val) (cadr exprs))
+ (and-forgetful form 'and val (cadr exprs) env)
+ (do ((p (cadr exprs) (cdr p)))
+ ((or (not (pair? p))
+ (and (pair? (car p))
+ (member (cadr val) (car p))))
+ (if (pair? p)
+ (and-forgetful form 'and val (car p) env)))))))))
+
+ (if (not (or retry
+ (equal? e (car exprs))))
+ (set! retry #t))
+
+ ;(format *stderr* "val: ~A, e: ~A~%" val e)
+
+ ;; (and x1 x2 x1) is not reducible
+ ;; the final thing has to remain at the end, but can be deleted earlier if it can't short-circuit the evaluation,
+ ;; but if there are expressions following the first x1, we can't be sure that it is not
+ ;; protecting them:
+ ;; (and false-or-0 (display (list-ref lst false-or-0)) false-or-0)
+ ;; so I'll not try to optimize that case. But (and x x) is optimizable.
+
+ (cond ((eq? val #t)
+ (if (null? (cdr exprs)) ; (and x y #t) should not remove the #t
+ (if (or (and (pair? e)
+ (eq? (return-type (car e) env) 'boolean?))
+ (eq? e #t))
+ (set! new-form (cons val new-form))
+ (if (or (null? new-form)
+ (not (equal? e (car new-form))))
+ (set! new-form (cons e new-form))))
+ (if (and (not (eq? e #t))
+ (or (null? new-form)
+ (not (member e new-form))))
+ (set! new-form (cons e new-form)))))
+
+ ((not val) ; #f in 'and' ends the expression
+ (set! new-form (if (or (null? new-form)
+ (just-symbols? new-form))
+ '(#f)
+ (cons #f new-form)))
+ (set! exprs '(#f)))
+
+ ((and (pair? e) ; if (and ...) splice into current
+ (eq? (car e) 'and))
+ (set! exprs (append e (cdr exprs))))
+
+ ((and (pair? e) ; (and (list? p) (pair? p) ...) -> (and (pair? p) ...)
+ (pair? (cdr exprs))
+ (pair? (cadr exprs))
+ (eq? (and-redundant? e (cadr exprs)) (caadr exprs))
+ (equal? (cadr e) (cadadr exprs))))
+
+ ((and (pair? e) ; (and (list? p) (not (null? p)) ...) -> (and (pair? p) ...)
+ (memq (car e) '(list? pair?))
+ (pair? (cdr exprs))
+ (let ((p (cadr exprs)))
+ (and (pair? p)
+ (eq? (car p) 'not)
+ (pair? (cadr p))
+ (eq? (caadr p) 'null?)
+ (equal? (cadr e) (cadadr p)))))
+ (set! new-form (cons `(pair? ,(cadr e)) new-form))
+ (set! exprs (cdr exprs)))
+
+ ((not (and (pair? e) ; (and ... (or ... 123) ...) -> splice out or
+ (pair? (cdr exprs))
+ (eq? (car e) 'or)
+ (pair? (cdr e))
+ (pair? (cddr e))
+ (cond ((list-ref e (- (length e) 1)) => code-constant?) ; (or ... #f)
+ (else #f))))
+ (if (not (and (pair? new-form)
+ (or (eq? val (car new-form)) ; omit repeated tests
+ (and (pair? val) ; and redundant tests
+ (hash-table-ref booleans (car val))
+ (any? (lambda (p)
+ (and (pair? p)
+ (subsumes? (car val) (car p))
+ (equal? (cadr val) (cadr p))))
+ new-form)))))
+ (set! new-form (cons val new-form)))))
+
+ (if (and (not (eq? new-form old-form))
+ (pair? (cdr new-form)))
+ (let ((rel (relsub (car new-form) (cadr new-form) 'and env)))
+ ;; rel #f should halt everything as above, and it looks ugly in the output,
+ ;; but it never happens in real code
+ (if (or (pair? rel)
+ (boolean? rel))
+ (set! new-form (cons rel (cddr new-form))))))))))))))))))))))))
(define (splice-if f lst)
(cond ((null? lst) ())
@@ -3630,20 +3647,19 @@
(else
(let ((ctr 0)
(ax 1))
- (do ((q (cdr cx) (cdr q)))
- ((not (pair? q)))
- (let ((qx (car q)))
- (if (symbol? qx)
- (if (not sym)
- (begin
- (set! sym qx)
- (set! ctr 1))
- (if (not (eq? sym qx))
- (return #f)
- (set! ctr (+ ctr 1))))
- (if (number? qx)
- (set! ax (* ax qx))
- (return #f)))))
+ (for-each (lambda (qx)
+ (if (symbol? qx)
+ (if (not sym)
+ (begin
+ (set! sym qx)
+ (set! ctr 1))
+ (if (not (eq? sym qx))
+ (return #f)
+ (set! ctr (+ ctr 1))))
+ (if (number? qx)
+ (set! ax (* ax qx))
+ (return #f))))
+ (cdr cx))
(if (not coeffs) (set! coeffs (make-vector 4 0)))
(if (>= ctr (length coeffs))
(set! coeffs (copy coeffs (make-vector (* ctr 2) 0))))
@@ -3720,6 +3736,8 @@
(if (pair? p)
(set-car! p (* 1.0 (car p))))))))
val)
+
+ ;; polar notation (@) is never used anywhere except test suites
(let* ((args (map simplify-arg (cdr form)))
(len (length args)))
@@ -3761,11 +3779,11 @@
(if (rational? (cadr p))
(set! c (+ c (cadr p)))
(set! plus (cons (cadr p) plus)))
- (do ((p1 (cddr p) (cdr p1)))
- ((null? p1))
- (if (rational? (car p1))
- (set! c (- c (car p1)))
- (set! minus (cons (car p1) minus))))))))
+ (for-each (lambda (p1)
+ (if (rational? p1)
+ (set! c (- c p1))
+ (set! minus (cons p1 minus))))
+ (cddr p))))))
val)
(simplify-numerics `(- (+ ,@(reverse plus) ,@(if (positive? c) (list c) ()))
,@(reverse minus) ,@(if (negative? c) (list (abs c)) ()))
@@ -3794,23 +3812,23 @@
(any? (lambda (a)
(member a (cdr arg2)))
(cdr arg1)))
- (let ((times ())
- (pluses ())
- (rset (cdr arg2)))
- (do ((p (cdr arg1) (cdr p)))
- ((null? p)
- ;; times won't be () because we checked above for a match
- ;; if pluses is (), arg1 is completely included in arg2
- ;; if rset is (), arg2 is included in arg1
- (simplify-numerics `(* ,@(reverse times)
- (+ (* ,@(reverse (if (pair? pluses) pluses (list (if (null? pluses) 1 pluses)))))
- (* , at rset)))
- env))
- (if (member (car p) rset)
- (begin
- (set! times (cons (car p) times))
- (set! rset (remove (car p) rset)))
- (set! pluses (cons (car p) pluses))))))
+ (do ((times ())
+ (pluses ())
+ (rset (cdr arg2))
+ (p (cdr arg1) (cdr p)))
+ ((null? p)
+ ;; times won't be () because we checked above for a match
+ ;; if pluses is (), arg1 is completely included in arg2
+ ;; if rset is (), arg2 is included in arg1
+ (simplify-numerics `(* ,@(reverse times)
+ (+ (* ,@(reverse (if (pair? pluses) pluses (list (if (null? pluses) 1 pluses)))))
+ (* , at rset)))
+ env))
+ (if (member (car p) rset)
+ (begin
+ (set! times (cons (car p) times))
+ (set! rset (remove (car p) rset)))
+ (set! pluses (cons (car p) pluses)))))
((and (pair? arg1) (eq? (car arg1) '/) ; (+ (/ a b) (/ c b)) -> (/ (+ a c) b)
(pair? arg2) (eq? (car arg2) '/)
@@ -4113,9 +4131,9 @@
(eq? op1 '/)
(pair? arg2)
(eq? '/ op2))
- (let ((a1 (if (null? (cddr arg1)) `(/ 1 ,op1-arg1) arg1))
- (a2 (if (null? (cddr arg2)) `(/ 1 ,op2-arg1) arg2)))
- (simplify-numerics `(/ (* ,(cadr a1) ,@(cddr a2)) (* ,@(cddr a1) ,(cadr a2))) env)))
+ (let ((a1 (if (null? (cddr arg1)) (list 1 op1-arg1) (cdr arg1)))
+ (a2 (if (null? (cddr arg2)) (list 1 op2-arg1) (cdr arg2))))
+ (simplify-numerics `(/ (* ,(car a1) ,@(cdr a2)) (* ,@(cdr a1) ,(car a2))) env)))
((and (pair? arg2)
(eq? op2 '*)
@@ -4611,7 +4629,7 @@
(set! args (lint-remove-duplicates (splice-if (lambda (x) (eq? x 'gcd)) args) env))
(cond ((null? args) 0)
((memv 1 args) 1)
- ((just-integers? args)
+ ((just-rationals? args)
(catch #t ; maybe (gcd -9223372036854775808 -9223372036854775808)
(lambda ()
(apply gcd args))
@@ -4626,7 +4644,7 @@
(set! args (lint-remove-duplicates (splice-if (lambda (x) (eq? x 'lcm)) args) env))
(cond ((null? args) 1) ; (lcm) -> 1
((memv 0 args) 0) ; (lcm ... 0 ...) -> 0
- ((just-integers? args) ; (lcm 3 4) -> 12
+ ((just-rationals? args) ; (lcm 3 4) -> 12
(catch #t
(lambda ()
(apply lcm args))
@@ -4709,25 +4727,30 @@
(pair? (cddr binding)) ; (do ((i 0 . 1))...)
(null? (cdddr binding))))))
- ((not (pair? binding)) (lint-format "~A binding is not a list? ~S" caller head binding) #f)
- ((not (symbol? (car binding))) (lint-format "~A variable is not a symbol? ~S" caller head binding) #f)
- ((keyword? (car binding)) (lint-format "~A variable is a keyword? ~S" caller head binding) #f)
- ((constant? (car binding)) (lint-format "can't bind a constant: ~S" caller binding) #f)
+ ((not (pair? binding)) (lint-format "~A binding is not a list? ~S" caller head binding) #f) ; (let (a) a)
+ ((not (symbol? (car binding))) (lint-format "~A variable is not a symbol? ~S" caller head binding) #f) ; (let ((1 2)) #f)
+ ((keyword? (car binding)) (lint-format "~A variable is a keyword? ~S" caller head binding) #f) ; (let ((:a 1)) :a)
+ ((constant? (car binding)) (lint-format "can't bind a constant: ~S" caller binding) #f) ; (let ((pi 2)) #f)
((not (pair? (cdr binding)))
(lint-format (if (null? (cdr binding))
- "~A variable value is missing? ~S"
- "~A binding is an improper list? ~S")
+ "~A variable value is missing? ~S" ; (let ((a)) #f)
+ "~A binding is an improper list? ~S") ; (let ((a . 1)) #f)
caller head binding)
#f)
- ((and (pair? (cddr binding))
+ ((and (pair? (cddr binding)) ; (let loop ((pi 1.0) (+ pi 1))...)
(or (not (eq? head 'do))
(pair? (cdddr binding))))
(lint-format "~A binding is messed up: ~A" caller head binding)
#f)
(else
- (if (and *report-shadowed-variables*
- (var-member (car binding) env))
- (lint-format "~A variable ~A in ~S shadows an earlier declaration" caller head (car binding) binding))
+ (if (and (eq? caller (car binding))
+ (let ((fv (var-member caller env)))
+ (and (var? fv)
+ (memq (var-ftype fv) '(define lambda let define* lambda*)))))
+ (lint-format "~A variable ~A in ~S shadows the current function?" caller head caller binding)
+ (if (and *report-shadowed-variables* ; (let ((x 1)) (+ (let ((x 2)) (+ x 1)) x))
+ (var-member (car binding) env))
+ (lint-format "~A variable ~A in ~S shadows an earlier declaration" caller head (car binding) binding)))
#t)))
(define (check-char-cmp caller op form)
@@ -4741,7 +4764,7 @@
(and (pair? x)
(eq? (car x) 'char->integer))))
(cdr form)))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (< (char->integer x) 95) -> (char<? x #\_)
(lists->string form
`(,(case op ((=) 'char=?) ((>) 'char>?) ((<) 'char<?) ((>=) 'char>=?) (else 'char<=?))
,@(map (lambda (arg)
@@ -4925,7 +4948,7 @@
(lists->string form
`(,(hash-table-ref reversibles head)
,(cadr arg2) ,(+ arg1 (caddr arg2)))))))
- (if (and (eq? (car arg2) '+)
+ (if (and (eq? (car arg2) '+) ; (< 256 (+ fltdur 50868)) -> (> fltdur -50612)
(integer? arg1)
(integer? (caddr arg2)))
(lint-format "perhaps ~A" caller
@@ -4940,31 +4963,51 @@
(apply >= form))
(and (equal? (car form) (cadr form))
(not (side-effect? (car form) env))))
- (lint-format "these ~A indices make no sense: ~A" caller head ff)))
+ (lint-format "these ~A indices make no sense: ~A" caller head ff))) ; (copy x y 1 0)
(define (other-case c)
((if (char-upper-case? c) char-downcase char-upcase) c))
(define (check-boolean-affinity caller form env)
;; does built-in boolean func's arg make sense
- (if (and (= (length form) 2)
- (not (symbol? (cadr form)))
- (not (= line-number last-simplify-boolean-line-number)))
+ (when (= (length form) 2)
+
+ (unless (or (and (symbol? (cadr form))
+ (not (keyword? (cadr form))))
+ (= line-number last-simplify-boolean-line-number))
(let ((expr (simplify-boolean form () () env)))
(if (not (equal? expr form))
- (lint-format "perhaps ~A" caller (lists->string form expr)))
- (if (and (pair? (cadr form))
- (symbol? (caadr form)))
- (let ((rt (if (eq? (caadr form) 'quote)
- (->simple-type (cadadr form))
- (return-type (caadr form) env)))
- (head (car form)))
- (if (subsumes? head rt)
- (lint-format "~A is always #t" caller (truncated-list->string form))
- (if (not (or (memq rt '(#t #f values))
- (any-compatible? head rt)))
- (lint-format "~A is always #f" caller (truncated-list->string form)))))))))
-
+ (lint-format "perhaps ~A" caller (lists->string form expr)) ; (char? '#\a) -> #t
+ (if (code-constant? (cadr form))
+ (lint-format "perhaps ~A" caller (lists->string form (eval form)))))))
+
+ (if (and (symbol? (cadr form)) ; (number? pi) -> #t
+ (not (keyword? (cadr form)))
+ (not (var-member (cadr form) env)))
+ (let ((val (checked-eval form)))
+ (if (not (eq? val :checked-eval-error))
+ (lint-format "perhaps ~A" caller (lists->string form val)))))
+
+ (when (and (pair? (cadr form))
+ (symbol? (caadr form)))
+ (let ((rt (if (eq? (caadr form) 'quote)
+ (->simple-type (cadadr form))
+ (return-type (caadr form) env)))
+ (head (car form)))
+ (if (subsumes? head rt)
+ (lint-format "~A is always #t" caller (truncated-list->string form)) ; (char? '#\a) is always #t
+ (if (not (or (memq rt '(#t #f values))
+ (any-compatible? head rt)))
+ (lint-format "~A is always #f" caller (truncated-list->string form)))))))) ; (number? (make-list 1)) is always #f
+
+ (define combinable-cxrs (let ((h (make-hash-table)))
+ (for-each (lambda (c)
+ (hash-table-set! h c (let ((name (symbol->string c)))
+ (substring name 1 (- (length name) 1)))))
+ '(car cdr caar cadr cddr cdar caaar caadr caddr cdddr cdaar cddar cadar cdadr cadddr cddddr))
+ h))
+ ;; not combinable: caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar
+
(define (combine-cxrs form)
(let ((cxr? (lambda (s)
(and (pair? (cdr s))
@@ -4973,21 +5016,45 @@
(and (cxr? form)
(let* ((arg1 (cadr form))
(arg2 (and arg1 (cxr? arg1) (cadr arg1)))
- (arg3 (and arg2 (cxr? arg2) (cadr arg2)))
- (innards (lambda (c)
- (case c
- ((car) "a") ((cdr) "d") ((caar) "aa") ((cadr) "ad") ((cddr) "dd") ((cdar) "da")
- ((caaar) "aaa") ((caadr) "aad") ((caddr) "add") ((cdddr) "ddd")
- ((cdaar) "daa") ((cddar) "dda") ((cdadr) "dad") ((cadar) "ada")
- ((cddddr) "dddd") ((cadddr) "addd")))))
- (values (string-append (innards (car form))
- (innards (car arg1))
- (if arg2 (innards (car arg2)) "")
- (if arg3 (innards (car arg3)) ""))
+ (arg3 (and arg2 (cxr? arg2) (cadr arg2))))
+ (values (string-append (hash-table-ref combinable-cxrs (car form))
+ (hash-table-ref combinable-cxrs (car arg1))
+ (if arg2 (hash-table-ref combinable-cxrs (car arg2)) "")
+ (if arg3 (hash-table-ref combinable-cxrs (car arg3)) ""))
(cadr (or arg3 arg2 arg1)))))))
-
- (define combinable-cxrs '(car cdr caar cadr cddr cdar caaar caadr caddr cdddr cdaar cddar cadar cdadr cadddr cddddr))
- ;; caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar
+#|
+ ;; this builds the lists below:
+ (let ((ci ())
+ (ic ()))
+ (for-each
+ (lambda (c)
+ (let ((name (reverse (substring (symbol->string c) 1 (- (length (symbol->string c)) 1)))))
+ (do ((sum 0)
+ (len (length name))
+ (i 0 (+ i 1))
+ (bit 0 (+ bit 2)))
+ ((= i len)
+ (set! ci (cons (cons c sum) ci))
+ (set! ic (cons (cons sum c) ic)))
+ (set! sum (+ sum (expt 2 (if (char=? (name i) #\a) bit (+ bit 1))))))))
+ '(car cdr caar cadr cddr cdar caaar caadr caddr cdddr cdaar cddar cadar cdadr cadddr cddddr
+ caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar))
+ (list (reverse ci) (reverse ic)))
+|#
+ (define cxr->int (hash-table '(car . 1) '(cdr . 2)
+ '(caar . 5) '(cadr . 6) '(cddr . 10) '(cdar . 9)
+ '(caaar . 21) '(caadr . 22) '(caddr . 26) '(cdddr . 42) '(cdaar . 37) '(cddar . 41) '(cadar . 25) '(cdadr . 38)
+ '(cadddr . 106) '(cddddr . 170) '(caaaar . 85) '(caaadr . 86) '(caadar . 89) '(caaddr . 90) '(cadaar . 101) '(cadadr . 102)
+ '(caddar . 105) '(cdaaar . 149) '(cdaadr . 150) '(cdadar . 153) '(cdaddr . 154) '(cddaar . 165) '(cddadr . 166) '(cdddar . 169)))
+ (define int->cxr (hash-table '(1 . car) '(2 . cdr)
+ '(5 . caar) '(6 . cadr) '(10 . cddr) '(9 . cdar)
+ '(21 . caaar) '(22 . caadr) '(26 . caddr) '(42 . cdddr) '(37 . cdaar) '(41 . cddar) '(25 . cadar) '(38 . cdadr)
+ '(106 . cadddr) '(170 . cddddr) '(85 . caaaar) '(86 . caaadr) '(89 . caadar) '(90 . caaddr) '(101 . cadaar) '(102 . cadadr)
+ '(105 . caddar) '(149 . cdaaar) '(150 . cdaadr) '(153 . cdadar) '(154 . cdaddr) '(165 . cddaar) '(166 . cddadr) '(169 . cdddar)))
+ (define (match-cxr c1 c2)
+ (hash-table-ref int->cxr (logand (or (hash-table-ref cxr->int c1) 0)
+ (or (hash-table-ref cxr->int c2) 0))))
+
(define (mv-range producer env)
(if (symbol? producer)
@@ -5013,7 +5080,7 @@
(catch #t
(lambda ()
(let ((val (eval (copy form :readable))))
- (lint-format "perhaps ~A" caller (lists->string form val))))
+ (lint-format "perhaps ~A" caller (lists->string form val)))) ; (eq? #(0) #(0)) -> #f
(lambda args
#t))))
@@ -5047,16 +5114,21 @@
(not (and (pair? (caddr tree))
(eq? (caaddr tree) #_{apply_values})))
(qq-tree? (cadr (caddr tree)))
- (if (and (pair? (cadr tree))
- (eq? (caadr tree) #_{apply_values}))
- (qq-tree? (cadadr tree))
- (qq-tree? (cadr tree))))
+ (let ((applying (and (pair? (cadr tree))
+ (eq? (caadr tree) #_{apply_values}))))
+ (qq-tree? ((if applying cadadr cadr) tree))))
(or (qq-tree? (car tree))
(qq-tree? (cdr tree)))))))
+
(define special-case-functions
- (let ((h (make-hash-table)))
+ (let ((special-case-table (make-hash-table)))
+ (define (hash-special key value)
+ (if (hash-table-ref special-case-table key)
+ (format *stderr* "~A already has a value: ~A~%" key (hash-table-ref special-case-table key)))
+ (hash-table-set! special-case-table key value))
+
;; ---------------- member and assoc ----------------
(let ()
(define (sp-memx caller head form env)
@@ -5079,7 +5151,7 @@
(let ((func (list-ref form 3)))
(if (symbol? func)
(if (memq func '(eq? eqv? equal?)) ; (member x y eq?) -> (memq x y)
- (let ((op (if (eq? head 'member)
+ (let ((op (if (eq? head 'member) ; (member (car x) entries equal?) -> (member (car x) entries)
(case func ((eq?) 'memq) ((eqv?) 'memv) (else 'member))
(case func ((eq?) 'assq) ((eqv?) 'assv) (else 'assoc)))))
(lint-format "perhaps ~A" caller (lists->string form `(,op ,(cadr form) ,(caddr form)))))
@@ -5088,10 +5160,10 @@
(not (eq? 'boolean? (car sig)))
(not (and (pair? (car sig))
(memq 'boolean? (car sig)))))
- (lint-format "~A is a questionable ~A function" caller func head))))
+ (lint-format "~A is a questionable ~A function" caller func head)))) ; (member 1 x abs)
;; func not a symbol
(if (and (pair? func)
- (= (length func) 3)
+ (= (length func) 3) ; (member 'a x (lambda (a b c) (eq? a b)))
(eq? (car func) 'lambda)
(pair? (cadr func))
(pair? (caddr func)))
@@ -5107,7 +5179,7 @@
(pair? (cdr (caddr eq)))
(pair? (cdr args))
(eq? (cadr args) (cadr (caddr eq))))
- (lint-format "member might perhaps be ~A"
+ (lint-format "member might perhaps be ~A" ; (member 'a x (lambda (a b) (eq? a (car b))))
caller
(if (or (eq? func 'eq?)
(eq? (car (caddr func)) 'eq?))
@@ -5121,7 +5193,7 @@
(items (caddr form)))
(let ((current-eqf (case head ((memq assq) 'eq?) ((memv assv) 'eqv?) (else 'equal?)))
- (selector-eqf (eqf selector env))
+ (selector-eqf (car (eqf selector env)))
(one-item (and (memq head '(memq memv member)) (list-one? items))))
;; one-item assoc doesn't simplify cleanly
@@ -5131,7 +5203,7 @@
(if (or (symbol? target)
(and (pair? target)
(not (eq? (car target) 'quote))))
- (set! target (list 'quote target)))
+ (set! target (list 'quote target))) ; ; (member x (list "asdf")) -> (string=? x "asdf") -- maybe equal? here?
(lint-format "perhaps ~A" caller (lists->string form `(,(cadr iter-eqf) ,selector ,target))))
;; not one-item
@@ -5144,12 +5216,12 @@
(or (and (constant? (car lst))
(fnc (car lst) (cdr lst)))
(duplicate-constants? (cdr lst) fnc))))))
- (if (and (symbol? (car selector-eqf))
- (not (eq? (car selector-eqf) current-eqf)))
+ (if (and (symbol? selector-eqf) ; (memq 1.0 x): perhaps memq -> memv
+ (not (eq? selector-eqf current-eqf)))
(lint-format "~A: perhaps ~A -> ~A" caller (truncated-list->string form) head
(if (memq head '(memq memv member))
- (case (car selector-eqf) ((eq?) 'memq) ((eqv?) 'memv) ((equal?) 'member))
- (case (car selector-eqf) ((eq?) 'assq) ((eqv?) 'assv) ((equal?) 'assoc)))))
+ (case selector-eqf ((eq?) 'memq) ((eqv?) 'memv) ((equal?) 'member))
+ (case selector-eqf ((eq?) 'assq) ((eqv?) 'assv) ((equal?) 'assoc)))))
;; --------------------------------
;; check for head mismatch with items
@@ -5164,7 +5236,7 @@
(set! baddy ((if (eq? (car items) 'list) duplicate-constants? duplicates?)
elements (symbol->value head))))
(lambda args #f))
- (if (pair? baddy)
+ (if (pair? baddy) ; (member x (list "asd" "abc" "asd"))
(lint-format "duplicated entry ~S in ~A" caller (car baddy) items)))
(when (proper-list? elements)
@@ -5195,7 +5267,7 @@
(begin
(if (and (eq? (car element) 'quote)
(pair? (cdr element)))
- (lint-format "stray quote? ~A" caller form))
+ (lint-format "stray quote? ~A" caller form)) ; (memq x '(a 'b c))
(set! maxf #t))
(let ((type (if (symbol? element)
'eq?
@@ -5216,19 +5288,19 @@
(set! maxf type)))))))
(case maxf
((eq?)
- (if (not (memq head '(memq assq)))
+ (if (not (memq head '(memq assq))) ; (member (car op) '(x y z))
(lint-format "~A could be ~A in ~A" caller
head
(if (memq head '(memv member)) 'memq 'assq)
form)))
((eqv?)
- (if (not (memq head '(memv assv)))
+ (if (not (memq head '(memv assv))) ; (memq (strname 0) '(#\{ #\[ #\()))
(lint-format "~A ~Aould be ~A in ~A" caller
head
(if (memq head '(memq assq)) "sh" "c")
(if (memq head '(memq member)) 'memv 'assv)
form)))
- ((equal? #t)
+ ((equal? #t) ; (memq (car op) '("a" #()))
(if (not (memq head '(member assoc)))
(lint-format "~A should be ~A in ~A" caller
head
@@ -5236,27 +5308,29 @@
form)))))))
;; --------------------------------
- (if (and (= (length elements) 2)
+ (if (and (= (length elements) 2) ; (memq expr '(#t #f))
(memq #t elements)
(memq #f elements))
(lint-format "perhaps ~A" caller (lists->string form `(boolean? ,selector))))))
;; not (memv x '(0 0.0)) -> (zero? x) because x might not be a number
- (let ((memx (memq head '(memq memv member))))
- (case (car items)
- ((map)
+ (case (car items)
+ ((map)
+ (let ((memx (memq head '(memq memv member))))
(when (and memx (= (length items) 3))
(let ((mapf (cadr items))
(map-items (caddr items)))
- (cond ((eq? mapf 'car)
+ (cond ((eq? mapf 'car) ; (memq x (map car y)) -> (assq x y)
(lint-format "perhaps use assoc: ~A" caller
(lists->string form `(,(case current-eqf ((eq?) 'assq) ((eqv?) 'assv) ((equal?) 'assoc))
,selector ,map-items))))
+
((eq? selector #t)
- (if (eq? mapf 'null?)
+ (if (eq? mapf 'null?) ; (memq #t (map null? items)) -> (memq () items)
(lint-format "perhaps ~A" caller
(lists->string form `(memq () ,map-items)))
- (let ((b (if (eq? mapf 'b) 'c 'b)))
+ (let ((b (if (eq? mapf 'b) 'c 'b)))
+ ;; (memq #t (map cadr items)) -> (member #t items (lambda (a b) (cadr b)))
(lint-format "perhaps avoid 'map: ~A" caller
(lists->string form `(member #t ,map-items (lambda (a ,b) (,mapf ,b))))))))
@@ -5265,31 +5339,36 @@
(eq? mapf 'string->symbol)
(not (and (pair? map-items)
(eq? (car map-items) 'quote))))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller
+ ;; (memq (string->symbol x) (map string->symbol y)) -> (member x y string=?)
(lists->string form `(member ,(cadr selector) ,map-items string=?))))
- (else
+
+ (else
+ ;; (member x (map b items)) -> (member x items (lambda (a c) (equal? a (b c))))
(let ((b (if (eq? mapf 'b) 'c 'b))) ; a below can't collide because eqf won't return 'a
(lint-format "perhaps avoid 'map: ~A" caller
(lists->string form `(member ,selector ,map-items
- (lambda (a ,b) (,current-eqf a (,mapf ,b))))))))))))
- ((string->list) ; (memv c (string->list s)) -> (char-position c s)
- (lint-format "perhaps ~A" caller
- (lists->string form `(char-position ,(cadr form) ,@(cdr items)))))
-
- ((cons)
- (if (not (pair? selector))
- (lint-format "perhaps avoid 'cons: ~A" caller
- (lists->string form `(or (,current-eqf ,selector ,(cadr items))
- (,head ,selector ,(caddr items)))))))
- ((append)
- (if (and (not (pair? selector))
- (= (length items) 3)
- (pair? (cadr items))
- (eq? (caadr items) 'list)
- (null? (cddadr items)))
- (lint-format "perhaps ~A" caller
- (lists->string form `(or (,current-eqf ,selector ,(cadadr items))
- (,head ,selector ,(caddr items)))))))))))))
+ (lambda (a ,b) (,current-eqf a (,mapf ,b)))))))))))))
+
+ ((string->list) ; (memv c (string->list s)) -> (char-position c s)
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(char-position ,(cadr form) ,@(cdr items)))))
+
+ ((cons) ; (member x (cons y z)) -> (or (equal? x y) (member x z))
+ (if (not (pair? selector))
+ (lint-format "perhaps avoid 'cons: ~A" caller
+ (lists->string form `(or (,current-eqf ,selector ,(cadr items))
+ (,head ,selector ,(caddr items)))))))
+
+ ((append) ; (member x (append (list x) y)) -> (or (equal? x x) (member x y))
+ (if (and (not (pair? selector))
+ (= (length items) 3)
+ (pair? (cadr items))
+ (eq? (caadr items) 'list)
+ (null? (cddadr items)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(or (,current-eqf ,selector ,(cadadr items))
+ (,head ,selector ,(caddr items))))))))))))
(when (and (memq head '(memq memv))
(pair? items)
(eq? (car items) 'quote)
@@ -5322,13 +5401,13 @@
(if bad
(lint-format (if (and (pair? bad)
(eq? (car bad) 'unquote))
- (values "stray comma? ~A" caller)
+ (values "stray comma? ~A" caller) ; (memq x '(a (unquote b) c))
(values "pointless list member: ~S in ~A" caller bad))
- ;; quoted item here is caught above
- form))))))))
+ ;; quoted item here is caught above ; (memq x '(a (+ 1 2) 3))
+ form))))))))
(for-each (lambda (f)
- (hash-table-set! h f sp-memx))
+ (hash-special f sp-memx))
'(memq assq memv assv member assoc)))
;; ---------------- car, cdr, etc ----------------
@@ -5338,15 +5417,15 @@
((lambda* (cxr arg)
(when cxr
(set! last-simplify-cxr-line-number line-number)
- (cond ((< (length cxr) 5)
+ (cond ((< (length cxr) 5) ; (car (cddr x)) -> (caddr x)
(lint-format "perhaps ~A" caller
(lists->string form `(,(symbol "c" cxr "r") ,arg))))
;; if it's car|cdr followed by cdr's, use list-ref|tail
- ((not (char-position #\a cxr))
+ ((not (char-position #\a cxr)) ; (cddddr (cddr x)) -> (list-tail x 6)
(lint-format "perhaps ~A" caller (lists->string form `(list-tail ,arg ,(length cxr)))))
- ((not (char-position #\a (substring cxr 1)))
+ ((not (char-position #\a (substring cxr 1))) ; (car (cddddr (cddr x))) -> (list-ref x 6)
(lint-format "perhaps ~A" caller (lists->string form `(list-ref ,arg ,(- (length cxr) 1)))))
(else (set! last-simplify-cxr-line-number -1)))))
@@ -5354,10 +5433,12 @@
(when (pair? (cadr form))
(let ((arg (cadr form)))
+
(when (eq? head 'car)
(case (car arg)
((list-tail) ; (car (list-tail x y)) -> (list-ref x y)
(lint-format "perhaps ~A" caller (lists->string form `(list-ref ,(cadr arg) ,(caddr arg)))))
+
((memq memv member assq assv assoc)
(if (pair? (cdr arg)) ; (car (memq x ...)) is either x or (car #f) -> error
(lint-format "~A is ~A, or an error" caller (truncated-list->string form) (cadr arg))))))
@@ -5375,21 +5456,31 @@
(pair? (cdr arg2))
(pair? (cadr arg2)))))
(lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; (cdr (or (assoc n oi) (list n y))) -> (cond ((assoc n oi) => cdr) (else (list y)))
`(cond (,arg1 => ,head)
(else ,(case (car arg2)
((quote) ((symbol->value head) (cadr arg2)))
((cons) (caddr arg2))
((error throw) arg2)
(else `(list ,@(cddr arg2)))))))))))
+ (if (and (pair? arg) ; (cdr '(a)) -> ()
+ (eq? (car arg) 'quote)
+ (pair? (cdr arg))
+ (pair? (cadr arg))
+ (not (var-member head env)))
+ (let ((val (checked-eval form)))
+ (if (not (eq? val :checked-eval-error))
+ (lint-format "perhaps ~A -> ~A~A" caller
+ (object->string form)
+ (if (or (pair? val) (symbol? val)) "'" "")
+ (object->string val)))))
+
(if (and (memq head '(car cdr))
(eq? (car arg) 'cons))
- (lint-format "(~A~A) is the same as ~A"
+ (lint-format "(~A~A) is the same as ~A" ; (car (cons 1 2)) is the same as 1
caller head
(truncated-list->string arg)
- (if (eq? head 'car)
- (truncated-list->string (cadr arg))
- (truncated-list->string (caddr arg)))))
+ (truncated-list->string ((if (eq? head 'car) cadr caddr) arg))))
(when (memq head '(car cadr caddr cadddr))
(if (memq (car arg) '(string->list vector->list)) ; (car (string->list x)) -> (string-ref x 0)
@@ -5411,8 +5502,11 @@
(list-ref _1_ (- (length _1_)
,(case head ((car) 1) ((cadr) 2) ((caddr) 3) (else 4))))))))))))))
(for-each (lambda (f)
- (hash-table-set! h f sp-crx))
+ (hash-special (car f) sp-crx))
combinable-cxrs))
+ ;; not combinable cxrs:
+ ;; caaaar caaadr caadar caaddr cadaar cadadr caddar
+ ;; cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar
;; ---------------- set-car! ----------------
(let ()
@@ -5425,7 +5519,7 @@
((list-tail) ; (set-car! (list-tail x y) z) -> (list-set! x y z)
(lint-format "perhaps ~A" caller (lists->string form `(list-set! ,(cadr target) ,(caddr target) ,(caddr form)))))
- ((cdr cddr cdddr cddddr)
+ ((cdr cddr cdddr cddddr) ; (set-car! (cddr (cdddr x)) y) -> (list-set! x 5 y)
(set! last-simplify-cxr-line-number line-number)
(lint-format "perhaps ~A" caller
(lists->string form
@@ -5439,7 +5533,7 @@
`(list-set! ,(cadr target)
,(cdr-count (car target))
,(caddr form)))))))))))
- (hash-table-set! h 'set-car! sp-set-car!))
+ (hash-special 'set-car! sp-set-car!))
;; ---------------- not ----------------
(let ()
@@ -5447,11 +5541,11 @@
(if (and (pair? (cdr form))
(pair? (cadr form)))
(if (eq? (caadr form) 'not)
- (let ((str (truncated-list->string (cadadr form))))
+ (let ((str (truncated-list->string (cadadr form)))) ; (not (not x)) -> (and x #t)
(lint-format "if you want a boolean, (not (not ~A)) -> (and ~A #t)" 'paranoia str str))
(let ((sig (arg-signature (caadr form) env)))
(if (and (pair? sig)
- (if (pair? (car sig))
+ (if (pair? (car sig)) ; (not (+ x y))
(not (memq 'boolean? (car sig)))
(not (memq (car sig) '(#t values boolean?)))))
(lint-format "~A can't be true (~A never returns #f)" caller (truncated-list->string form) (caadr form))))))
@@ -5459,10 +5553,10 @@
(if (not (= line-number last-simplify-boolean-line-number))
(let ((val (simplify-boolean form () () env)))
(set! last-simplify-boolean-line-number line-number)
- (if (not (equal? form val))
+ (if (not (equal? form val)) ; (not (and (> x 2) (not z))) -> (or (<= x 2) z)
(lint-format "perhaps ~A" caller (lists->string form val))))))
- (hash-table-set! h 'not sp-not))
+ (hash-special 'not sp-not))
;; ---------------- and/or ----------------
(let ()
@@ -5470,17 +5564,17 @@
(if (not (= line-number last-simplify-boolean-line-number))
(let ((val (simplify-boolean form () () env)))
(set! last-simplify-boolean-line-number line-number)
- (if (not (equal? form val))
+ (if (not (equal? form val)) ; (and (not x) (not y)) -> (not (or x y))
(lint-format "perhaps ~A" caller (lists->string form val)))))
(if (pair? (cdr form))
(do ((p (cdr form) (cdr p)))
((null? (cdr p)))
(if (and (pair? (car p))
(eq? (caar p) 'if)
- (= (length (car p)) 3))
+ (= (length (car p)) 3)) ; (and (member n cvars) (if (pair? open) (not (member n open))) (not (eq? n open)))
(lint-format "one-armed if might cause confusion here: ~A" caller form)))))
- (hash-table-set! h 'and sp-and)
- (hash-table-set! h 'or sp-and))
+ (hash-special 'and sp-and)
+ (hash-special 'or sp-and))
;; ---------------- = ----------------
(let ()
@@ -5492,18 +5586,18 @@
(or (and (number? (car lst))
(not (rational? (car lst)))
(not (member (car lst) '(0.0 1.0) =)))
- (any-real? (cdr lst))))))
+ (any-real? (cdr lst)))))) ; (= x 1.5)
(lint-format "= can be troublesome with floats: ~A" caller (truncated-list->string form)))
(let ((cleared-form (cons = (remove-if (lambda (x) (not (number? x))) (cdr form)))))
(if (and (> (length cleared-form) 2)
- (not (checked-eval cleared-form)))
+ (not (checked-eval cleared-form))) ; (= 1 y 2)
(lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
(when (= len 3)
(let ((arg1 (cadr form))
(arg2 (caddr form)))
- ;; (= (+ x 1) (+ y 1)) and various equivalents happens very rarely
+ ;; (= (+ x a) (+ y a)) and various equivalents happen very rarely (only in test suites it appears)
(let ((var (or (and (memv arg1 '(0 1))
(pair? arg2)
(eq? (car arg2) 'length)
@@ -5515,16 +5609,16 @@
;; we never seem to have var-member/initial-value/history here to distinguish types
;; and a serious attempt to do so was a bust.
(if var
- (if (or (eqv? arg1 0)
+ (if (or (eqv? arg1 0) ; (= (length x) 0) -> (null? x)
(eqv? arg2 0))
(lint-format "perhaps (assuming ~A is a list), ~A" caller var
(lists->string form `(null? ,var)))
- (if (symbol? var)
+ (if (symbol? var) ; (= (length x) 1) -> (and (pair? x) (null? (cdr x)))
(lint-format "perhaps (assuming ~A is a list), ~A" caller var
(lists->string form `(and (pair? ,var) (null? (cdr ,var))))))))))
(unrelop caller '= form))
(check-char-cmp caller '= form)))
- (hash-table-set! h '= sp-=))
+ (hash-special '= sp-=))
;; ---------------- < > <= >= ----------------
(let ()
@@ -5534,30 +5628,30 @@
(not (number? x)))
(cdr form)))))
(if (and (> (length cleared-form) 2)
- (not (checked-eval cleared-form)))
+ (not (checked-eval cleared-form))) ; (< x 1 2 0 y)
(lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
(if (= (length form) 3)
(unrelop caller head form)
(when (> (length form) 3)
- (if (and (memq head '(< >))
+ (if (and (memq head '(< >)) ; (< x y x) -> #f
(repeated-member? (cdr form) env))
(lint-format "perhaps ~A" caller (truncated-lists->string form #f))
(if (and (memq head '(<= >=))
(repeated-member? (cdr form) env))
- (let ((last-arg (cadr form))
- (new-args (list (cadr form))))
- (do ((lst (cddr form) (cdr lst)))
- ((null? lst)
- (if (repeated-member? new-args env)
- (lint-format "perhaps ~A" caller (truncated-lists->string form `(= ,@(lint-remove-duplicates (reverse new-args) env))))
- (if (< (length new-args) (length (cdr form)))
- (lint-format "perhaps ~A" caller
- (truncated-lists->string form (or (null? (cdr new-args))
- `(= ,@(reverse new-args))))))))
- (unless (equal? (car lst) last-arg)
- (set! last-arg (car lst))
- (set! new-args (cons last-arg new-args)))))))))
+ (do ((last-arg (cadr form))
+ (new-args (list (cadr form)))
+ (lst (cddr form) (cdr lst)))
+ ((null? lst)
+ (if (repeated-member? new-args env) ; (<= x y x z x) -> (= x y z)
+ (lint-format "perhaps ~A" caller (truncated-lists->string form `(= ,@(lint-remove-duplicates (reverse new-args) env))))
+ (if (< (length new-args) (length (cdr form)))
+ (lint-format "perhaps ~A" caller ; (<= x x y z) -> (= x y z)
+ (truncated-lists->string form (or (null? (cdr new-args))
+ `(= ,@(reverse new-args))))))))
+ (unless (equal? (car lst) last-arg)
+ (set! last-arg (car lst))
+ (set! new-args (cons last-arg new-args))))))))
(cond ((not (= (length form) 3)))
@@ -5565,7 +5659,7 @@
(or (< (cadr form) 0)
(and (zero? (cadr form))
(eq? head '>)))
- (pair? (caddr form))
+ (pair? (caddr form)) ; (> 0 (string-length x))
(hash-table-ref non-negative-ops (caaddr form)))
(lint-format "~A can't be negative: ~A" caller (caaddr form) (truncated-list->string form)))
@@ -5573,14 +5667,14 @@
(or (< (caddr form) 0)
(and (zero? (caddr form))
(eq? head '<)))
- (pair? (cadr form))
+ (pair? (cadr form)) ; (< (string-length x) 0)
(hash-table-ref non-negative-ops (caadr form)))
(lint-format "~A can't be negative: ~A" caller (caadr form) (truncated-list->string form)))
((and (pair? (cadr form))
(eq? (caadr form) 'length))
(let ((arg (cadadr form)))
- (when (symbol? arg)
+ (when (symbol? arg) ; (>= (length x) 0) -> (list? x)
;; see comment above about distinguishing types! (twice I've wasted my time)
(if (eqv? (caddr form) 0)
(lint-format "perhaps~A ~A" caller
@@ -5592,7 +5686,7 @@
((>) `(pair? ,arg))
((>=) `(list? ,arg)))))
(if (and (eqv? (caddr form) 1)
- (not (eq? head '>)))
+ (not (eq? head '>))) ; (<= (length x) 1) -> (or (null? x) (null? (cdr x)))
(lint-format "perhaps (assuming ~A is a proper list), ~A" caller arg
(lists->string form
(case head
@@ -5603,7 +5697,7 @@
((and (pair? (caddr form))
(eq? (caaddr form) 'length))
(let ((arg (cadr (caddr form))))
- (when (symbol? arg)
+ (when (symbol? arg) ; (>= 0 (length x)) -> (null? x)
(if (eqv? (cadr form) 0)
(lint-format "perhaps~A ~A" caller
(if (eq? head '>) "" (format #f " (assuming ~A is a proper list)," arg))
@@ -5614,7 +5708,7 @@
((>) `(and (pair? ,arg) (not (proper-list? ,arg))))
((>=) `(null? ,arg)))))
(if (and (eqv? (cadr form) 1)
- (not (eq? head '<)))
+ (not (eq? head '<))) ; (> 1 (length x)) -> (null? x)
(lint-format "perhaps (assuming ~A is a proper list), ~A" caller arg
(lists->string form
(case head
@@ -5624,21 +5718,21 @@
((>=) `(or (null? ,arg) (null? (cdr ,arg))))))))))))
((and (eq? head '<)
(eqv? (caddr form) 1)
- (pair? (cadr form))
+ (pair? (cadr form)) ; (< (vector-length x) 1) -> (equal? x #())
(memq (caadr form) '(string-length vector-length)))
(lint-format "perhaps ~A" caller (lists->string form `(,(if (eq? (caadr form) 'string-length) 'string=? 'equal?)
,(cadadr form)
,(if (eq? (caadr form) 'string-length) "" #())))))
((and (eq? head '>)
(eqv? (cadr form) 1)
- (pair? (caddr form))
+ (pair? (caddr form)) ; (> 1 (string-length x)) -> (string=? x "")
(memq (caaddr form) '(string-length vector-length)))
(lint-format "perhaps ~A" caller (lists->string form `(,(if (eq? (caaddr form) 'string-length) 'string=? 'equal?)
,(cadr (caddr form))
,(if (eq? (caaddr form) 'string-length) "" #())))))
((and (memq head '(<= >=))
(or (and (eqv? (caddr form) 0)
- (pair? (cadr form))
+ (pair? (cadr form)) ; (<= (string-length m) 0) -> (= (string-length m) 0)
(hash-table-ref non-negative-ops (caadr form)))
(and (eqv? (cadr form) 0)
(pair? (caddr form))
@@ -5649,12 +5743,12 @@
(eqv? (caddr form) 0)))
`(= ,@(cdr form))))))
((and (eqv? (caddr form) 256)
- (pair? (cadr form))
+ (pair? (cadr form)) ; (< (char->integer key) 256) -> #t
(eq? (caadr form) 'char->integer))
(lint-format "perhaps ~A" caller
(lists->string form (and (memq head '(< <=)) #t))))
- ((or (and (eqv? (cadr form) 0) ; (> (numerator x) 0) -> (> x 0)
+ ((or (and (eqv? (cadr form) 0) ; (> (numerator x) 0) -> (> x 0)
(pair? (caddr form))
(eq? (caaddr form) 'numerator))
(and (eqv? (caddr form) 0)
@@ -5669,7 +5763,7 @@
;; could change (> x 0) to (positive? x) and so on, but the former is clear and ubiquitous
(for-each (lambda (f)
- (hash-table-set! h f sp-<))
+ (hash-special f sp-<))
'(< > <= >=))) ; '= handled above
;; ---------------- char< char> etc ----------------
@@ -5680,13 +5774,13 @@
(remove-if (lambda (x)
(not (char? x)))
(cdr form)))))
- (if (and (> (length cleared-form) 2)
+ (if (and (> (length cleared-form) 2) ; (char>? x #\a #\b y)
(not (checked-eval cleared-form)))
(lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
- (if (and (eq? head 'char-ci=?) ; (char-ci=? x #\return)
+ (if (and (eq? head 'char-ci=?) ; (char-ci=? x #\return)
(pair? (cdr form))
(pair? (cddr form))
- (null? (cdddr form))
+ (null? (cdddr form)) ; (char-ci=? x #\return)
(or (and (char? (cadr form))
(char=? (cadr form) (other-case (cadr form))))
(and (char? (caddr form))
@@ -5704,7 +5798,7 @@
(set! op (car a)))))))))
(every? casef (cdr form))))
(lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; (char=? #\a (char-downcase x)) -> (char-ci=? #\a x)
`(char-ci=? ,@(map (lambda (a)
(if (and (pair? a)
(memq (car a) '(char-upcase char-downcase)))
@@ -5712,9 +5806,9 @@
a))
(cdr form))))))))
(for-each (lambda (f)
- (hash-table-set! h f sp-char<))
+ (hash-special f sp-char<))
'(char<? char>? char<=? char>=? char=? char-ci<? char-ci>? char-ci<=? char-ci>=? char-ci=?)))
-
+
;; ---------------- string< string> etc ----------------
(let ()
@@ -5723,20 +5817,20 @@
(remove-if (lambda (x)
(not (string? x)))
(cdr form)))))
- (if (and (> (length cleared-form) 2)
+ (if (and (> (length cleared-form) 2) ; (string>? "a" x "b" y)
(not (checked-eval cleared-form)))
(lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
(if (and (> (length form) 2)
- (every? (let ((op #f)) ; (string=? x (string-downcase y)) -> (string-ci=? x y)
- (lambda (a)
- (and (pair? a)
- (memq (car a) '(string-downcase string-upcase))
- (if op
- (eq? op (car a))
- (set! op (car a))))))
- (cdr form)))
- (lint-format "perhaps ~A" caller
+ (let ((casef (let ((op #f)) ; (string=? x (string-downcase y)) -> (string-ci=? x y)
+ (lambda (a)
+ (and (pair? a)
+ (memq (car a) '(string-downcase string-upcase))
+ (if op
+ (eq? op (car a))
+ (set! op (car a))))))))
+ (every? casef (cdr form))))
+ (lint-format "perhaps ~A" caller ; (string=? (string-downcase x) (string-downcase y)) -> (string-ci=? x y)
(lists->string form
(let ((op (case head
((string=?) 'string-ci=?)
@@ -5757,7 +5851,7 @@
(memq (car a) '(copy string-copy))
(null? (cddr a))))
(cdr form))
- (let cleaner ((args (cdr form)) (new-args ()))
+ (let cleaner ((args (cdr form)) (new-args ())) ; (string=? "" (string-copy "")) -> (string=? "" "")
(if (not (pair? args))
(lint-format "perhaps ~A" caller (lists->string form `(,head ,@(reverse new-args))))
(let ((a (car args)))
@@ -5788,7 +5882,7 @@
(begin
(set! s1 (caddr form))
(set! s2 (cadr form)))))
- (if (and s1 ; (string=? (substring refdes-alias 0 1) "S")
+ (if (and s1 ; (string=? (substring r 0 1) "S")
(pair? s2)
(eq? (car s2) 'substring)
(= (length s2) 4)
@@ -5797,7 +5891,7 @@
(lint-format "perhaps ~A" caller
(lists->string form `(char=? (string-ref ,(cadr s2) 0) ,(string-ref s1 0))))))))
- (if (every? (lambda (a)
+ (if (every? (lambda (a) ; (string=? "#" (string (string-ref s 0))) -> (char=? #\# (string-ref s 0))
(or (and (string? a)
(= (length a) 1))
(and (pair? a)
@@ -5812,7 +5906,7 @@
(cadr a)))
(cdr form)))))))
(for-each (lambda (f)
- (hash-table-set! h f sp-string<))
+ (hash-special f sp-string<))
'(string<? string>? string<=? string>=? string=? string-ci<? string-ci>? string-ci<=? string-ci>=? string-ci=?)))
;; ---------------- length ----------------
@@ -5820,61 +5914,69 @@
(define (sp-length caller head form env)
(when (pair? (cdr form))
(if (pair? (cadr form))
- (let ((arg (cadr form)))
+ (let ((arg (cadr form))
+ (arg-args (cdadr form)))
(case (car arg)
((string->list vector->list)
- (if (null? (cddr arg)) ; string->list has start:end etc
- (lint-format "perhaps ~A" caller (lists->string form `(length ,(cadr arg))))
- (if (pair? (cdddr arg))
- (if (and (integer? (cadddr arg))
- (integer? (caddr arg)))
- (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (max 0 (- (cadddr arg) (caddr arg))))
- (lint-format "perhaps ~A" caller (lists->string form `(- ,(cadddr arg) ,(caddr arg)))))
- (lint-format "perhaps ~A" caller (lists->string form `(- (length ,(cadr arg)) ,(caddr arg)))))))
+ (if (null? (cdr arg-args)) ; string->list has start:end etc ; (length (string->list x)) -> (length x)
+ (lint-format "perhaps ~A" caller (lists->string form `(length ,(car arg-args))))
+ (if (pair? (cddr arg-args))
+ (if (and (integer? (caddr arg-args)) ; (length (vector->list x 1)) -> (- (length x) 1)
+ (integer? (cadr arg-args)))
+ (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (max 0 (- (caddr arg-args) (cadr arg-args))))
+ (lint-format "perhaps ~A" caller (lists->string form `(- ,(caddr arg-args) ,(cadr arg-args)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(- (length ,(car arg-args)) ,(cadr arg-args)))))))
((reverse reverse! list->vector list->string let->list)
- (lint-format "perhaps ~A" caller (lists->string form `(length ,(cadr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(length ,(car arg-args)))))
- ((cons)
- (lint-format "perhaps ~A" caller (lists->string form `(+ (length ,(caddr arg)) 1))))
+ ((cons) ; (length (cons item items)) -> (+ (length items) 1)
+ (lint-format "perhaps ~A" caller (lists->string form `(+ (length ,(cadr arg-args)) 1))))
- ((make-list)
- (lint-format "perhaps ~A" caller (lists->string form (cadr arg))))
+ ((make-list) ; (length (make-list 3)) -> 3
+ (lint-format "perhaps ~A" caller (lists->string form (car arg-args))))
- ((list)
+ ((list) ; (length (list 'a 'b 'c)) -> 3
(lint-format "perhaps ~A" caller (lists->string form (- (length arg) 1))))
- ((append)
+ ((append) ; (length (append x y)) -> (+ (length x) (length y))
(if (= (length arg) 3)
- (lint-format "perhaps ~A" caller (lists->string form `(+ (length ,(cadr arg)) (length ,(caddr arg)))))))
+ (lint-format "perhaps ~A" caller (lists->string form `(+ (length ,(car arg-args)) (length ,(cadr arg-args)))))))
- ((quote)
- (if (list? (cadr arg))
- (lint-format "perhaps ~A" caller (lists->string form (length (cadr arg))))))))
+ ((quote) ; (length '(1 2 3)) -> 3
+ (if (list? (car arg-args))
+ (lint-format "perhaps ~A" caller (lists->string form (length (car arg-args))))))))
+
;; not pair cadr
- (if (code-constant? (cadr form))
+ (if (code-constant? (cadr form)) ; (length 0) -> #f
(lint-format "perhaps ~A -> ~A" caller
(truncated-list->string form)
(length ((if (and (pair? (cadr form))
(eq? (caadr form) 'quote))
cadadr cadr)
form)))))))
- (hash-table-set! h 'length sp-length))
+ (hash-special 'length sp-length))
;; ---------------- zero? positive? negative? ----------------
(let ()
(define (sp-zero? caller head form env)
(when (pair? (cdr form))
(let ((arg (cadr form)))
+
+ (if (and (real? arg) ; (zero? 0) -> #t
+ (null? (cddr form))
+ (not (var-member head env)))
+ (lint-format "perhaps ~A" caller (lists->string form (eval form))))
+
(when (pair? arg)
- (if (and (eq? head 'negative?)
+ (if (and (eq? head 'negative?) ; (negative? (string-length s))")
(hash-table-ref non-negative-ops (car arg)))
- (lint-format "~A can't be negative: ~A" caller head (truncated-list->string form)))
+ (lint-format "~A can't be negative: ~A" caller (caadr form) (truncated-list->string form)))
(case (car arg)
((-)
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (zero? (- x)) -> (zero? x)
(lists->string form
(let ((op '((zero? = zero?) (positive? > negative?) (negative? < positive?))))
(if (null? (cddr arg))
@@ -5890,40 +5992,47 @@
(if (eq? head 'zero)
(lint-format "denominator can't be zero: ~A" caller form)))
- ((string-length)
+ ((string-length) ; (zero? (string-length x)) -> (string=? x "")
(if (eq? head 'zero?)
(lint-format "perhaps ~A" caller (lists->string form `(string=? ,(cadadr form) "")))))
- ((vector-length)
+ ((vector-length) ; (zero? (vector-length c)) -> (equal? c #())
(if (eq? head 'zero?)
(lint-format "perhaps ~A" caller (lists->string form `(equal? ,(cadadr form) #())))))
- ((length)
+ ((length) ; (zero? (length routes)) -> (null? routes)
(if (eq? head 'zero?)
(lint-format "perhaps (assuming ~A is list) use null? instead of length: ~A" caller (cadr arg)
(lists->string form `(null? ,(cadr arg)))))))))))
;; (zero? (logand...)) is nearly always preceded by not and handled elsewhere
(for-each (lambda (f)
- (hash-table-set! h f sp-zero?))
+ (hash-special f sp-zero?))
'(zero? positive? negative?)))
;; ---------------- / ----------------
(let ()
(define (sp-/ caller head form env)
- (when (pair? (cdr form))
- (if (and (null? (cddr form))
- (number? (cadr form))
- (zero? (cadr form)))
- (lint-format "attempt to invert zero: ~A" caller (truncated-list->string form))
- (if (and (pair? (cddr form))
- (memv 0 (cddr form)))
- (lint-format "attempt to divide by 0: ~A" caller (truncated-list->string form))))))
- (hash-table-set! h '/ sp-/))
+ (cond ((not (pair? (cdr form))))
+
+ ((and (null? (cddr form))
+ (number? (cadr form))
+ (zero? (cadr form))) ; (/ 0)
+ (lint-format "attempt to invert zero: ~A" caller (truncated-list->string form)))
+
+ ((and (pair? (cddr form)) ; (/ x y 2 0)
+ (memv 0 (cddr form)))
+ (lint-format "attempt to divide by 0: ~A" caller (truncated-list->string form)))
+
+ (else
+ (let ((len (assq 'length (cdr form))))
+ (if len (lint-format "~A will cause division by 0 if ~A is empty" caller len (cadr len)))))))
+
+ (hash-special '/ sp-/))
;; ---------------- copy ----------------
(let ()
(define (sp-copy caller head form env)
- (cond ((and (pair? (cdr form))
+ (cond ((and (pair? (cdr form)) ; (copy (copy x)) could be (copy x)
(or (number? (cadr form))
(boolean? (cadr form))
(char? (cadr form))
@@ -5933,34 +6042,34 @@
(equal? (cadr form) (caddr form)))))
(lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form)))
- ((and (pair? (cdr form))
+ ((and (pair? (cdr form)) ; (copy (owlet)) could be (owlet)
(equal? (cadr form) '(owlet)))
(lint-format "~A could be (owlet): owlet is copied internally" caller form))
((= (length form) 5)
(check-start-and-end caller 'copy (cdddr form) form env))))
- (hash-table-set! h 'copy sp-copy))
+ (hash-special 'copy sp-copy))
;; ---------------- string-copy ----------------
- (hash-table-set!
- h 'string-copy
- (lambda (caller head form env)
- (if (and (pair? (cdr form))
- (pair? (cadr form))
- (memq (caadr form) '(copy string-copy string make-string string-upcase string-downcase
- string-append list->string symbol->string number->string)))
- (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form)))))
+ (let ()
+ (define (sp-string-copy caller head form env)
+ (if (and (pair? (cdr form)) ; (string-copy (string-copy x)) could be (string-copy x)
+ (pair? (cadr form))
+ (memq (caadr form) '(copy string-copy string make-string string-upcase string-downcase
+ string-append list->string symbol->string number->string)))
+ (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form))))
+ (hash-special 'string-copy sp-string-copy))
;; ---------------- string-down|upcase ----------------
(let ()
(define (sp-string-upcase caller head form env)
(if (and (pair? (cdr form))
- (string? (cadr form)))
+ (string? (cadr form))) ; (string-downcase "SPEAK") -> "speak"
(lint-format "perhaps ~A" caller (lists->string form
((if (eq? head 'string-upcase) string-upcase string-downcase)
(cadr form))))))
- (hash-table-set! h 'string-upcase sp-string-upcase)
- (hash-table-set! h 'string-downcase sp-string-upcase))
+ (hash-special 'string-upcase sp-string-upcase)
+ (hash-special 'string-downcase sp-string-upcase))
;; ---------------- string ----------------
(let ()
@@ -5970,25 +6079,27 @@
(char<=? #\space x #\~))) ; #\0xx chars here look dumb
(cdr form))
(lint-format "~A could be ~S" caller (truncated-list->string form) (apply string (cdr form)))
- (if (and (pair? (cdr form)) ; (string (string-ref x 0)) -> (substring x 0 1)
+ (if (and (pair? (cdr form)) ; (string (string-ref x 0)) -> (substring x 0 1)
(pair? (cadr form)))
(if (and (eq? (caadr form) 'string-ref)
(null? (cddr form)))
- (let ((arg (cadr form)))
- (if (integer? (caddr arg))
+ (let ((arg (cdadr form)))
+ (if (integer? (cadr arg)) ; (string (string-ref x 0)) -> (substring x 0 1)
(lint-format "perhaps ~A" caller
(lists->string form
- `(substring ,(cadr arg) ,(caddr arg) ,(+ 1 (caddr arg)))))))
+ `(substring ,(car arg) ,(cadr arg) ,(+ 1 (cadr arg)))))))
(if (and (not (null? (cddr form)))
(memq (caadr form) '(char-upcase char-downcase))
(every? (lambda (p)
(eq? (caadr form) (car p)))
(cddr form)))
+ ;; (string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2))) ->
+ ;; (string-downcase (string (string-ref x 1) (string-ref x 2)))
(lint-format "perhaps ~A" caller
(lists->string form `(,(if (eq? (caadr form) 'char-upcase) 'string-upcase 'string-downcase)
(string ,@(map cadr (cdr form)))))))))))
;; repeated args as in vector/list (sp-list below) got no hits
- (hash-table-set! h 'string sp-string))
+ (hash-special 'string sp-string))
;; ---------------- string? ----------------
(let ()
@@ -5996,71 +6107,81 @@
(if (and (pair? (cdr form))
(pair? (cadr form))
(memq (caadr form) '(format number->string)))
- (if (eq? (caadr form) 'format)
+ (if (eq? (caadr form) 'format) ; (string? (number->string x)) -> #t
(lint-format "format returns either #f or a string, so ~A" caller (lists->string form (cadr form)))
(lint-format "number->string always returns a string, so ~A" caller (lists->string form #t)))
(check-boolean-affinity caller form env)))
- (hash-table-set! h 'string? sp-string?))
+ (hash-special 'string? sp-string?))
;; ---------------- number? ----------------
(let ()
(define (sp-number? caller head form env)
(if (and (pair? (cdr form))
(pair? (cadr form))
- (eq? (caadr form) 'string->number))
+ (eq? (caadr form) 'string->number)) ; (number? (string->number x)) -> (string->number x)
(lint-format "string->number returns either #f or a number, so ~A" caller (lists->string form (cadr form)))
(check-boolean-affinity caller form env)))
- (hash-table-set! h 'number? sp-number?))
+ (hash-special 'number? sp-number?))
+
+ ;; ---------------- exact? inexact? infinite? nan? ----------------
+ (let ()
+ (define (sp-exact? caller head form env)
+ (if (and (pair? (cdr form))
+ (number? (cadr form)))
+ (check-boolean-affinity caller form env)))
+ (for-each (lambda (f)
+ (hash-special f sp-exact?))
+ '(exact? inexact? infinite? nan?)))
;; ---------------- symbol? etc ----------------
(let ()
(define (sp-symbol? caller head form env)
(check-boolean-affinity caller form env))
(for-each (lambda (f)
- (hash-table-set! h f sp-symbol?))
- '(symbol? rational? real? complex? float? keyword? gensym? byte-vector? proper-list?
- char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? c-object?
- output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?)))
+ (hash-special f sp-symbol?))
+ '(symbol? rational? real? complex? float? keyword? gensym? byte-vector? proper-list? sequence? constant?
+ char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? c-object?
+ output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?)))
;; ---------------- pair? list? ----------------
(let ()
(define (sp-pair? caller head form env)
(check-boolean-affinity caller form env)
- (if (and (pair? (cdr form))
+ (if (and (pair? (cdr form)) ; (pair? (member x y)) -> (member x y)
(pair? (cadr form))
(memq (caadr form) '(memq memv member assq assv assoc procedure-signature)))
(lint-format "~A returns either #f or a pair, so ~A" caller (caadr form)
- (lists->string form (cadr form)))))
+ (lists->string form (cadr form)))))
(for-each (lambda (f)
- (hash-table-set! h f sp-pair?))
+ (hash-special f sp-pair?))
'(pair? list?)))
;; ---------------- integer? ----------------
(let ()
(define (sp-integer? caller head form env)
(check-boolean-affinity caller form env)
- (if (and (pair? (cdr form))
+ (if (and (pair? (cdr form)) ; (integer? (char-position x y)) -> (char-position x y)
(pair? (cadr form))
(memq (caadr form) '(char-position string-position)))
(lint-format "~A returns either #f or an integer, so ~A" caller (caadr form)
(lists->string form (cadr form)))))
- (hash-table-set! h 'integer? sp-integer?))
+ (hash-special 'integer? sp-integer?))
;; ---------------- null? ----------------
(let ()
(define (sp-null? caller head form env)
(check-boolean-affinity caller form env)
- (if (and (pair? (cdr form))
+ (if (and (pair? (cdr form)) ; (null? (string->list x)) -> (zero? (length x))
(pair? (cadr form))
(memq (caadr form) '(vector->list string->list let->list)))
(lint-format "perhaps ~A" caller
(lists->string form `(zero? (length ,(cadadr form)))))))
- (hash-table-set! h 'null? sp-null?))
+ (hash-special 'null? sp-null?))
;; ---------------- odd? even? ----------------
(let ()
(define (sp-odd? caller head form env)
- (if (and (pair? (cdr form))
+ (if (and (pair? (cdr form)) ; (odd? (- x 1)) -> (even? x)
(pair? (cadr form))
(memq (caadr form) '(+ -))
(= (length (cadr form)) 3))
@@ -6069,40 +6190,54 @@
(int-arg (or (and (integer? arg1) arg1)
(and (integer? arg2) arg2))))
(if int-arg
- (lint-format "perhaps ~A" caller
- (lists->string form
- (if (and (integer? arg1)
- (integer? arg2))
- (eval form)
- `(,(if (eq? (eq? head 'even?) (even? int-arg)) 'even? 'odd?)
- ,(if (integer? arg1) arg2 arg1)))))))))
- (hash-table-set! h 'odd? sp-odd?)
- (hash-table-set! h 'even? sp-odd?))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (if (and (integer? arg1)
+ (integer? arg2))
+ (eval form)
+ `(,(if (eq? (eq? head 'even?) (even? int-arg)) 'even? 'odd?)
+ ,(if (integer? arg1) arg2 arg1)))))))))
+ (hash-special 'odd? sp-odd?)
+ (hash-special 'even? sp-odd?))
;; ---------------- string-ref ----------------
- (hash-table-set!
- h 'string-ref
- (lambda (caller head form env)
- (when (and (= (length form) 3)
- (pair? (cadr form)))
- (let ((target (cadr form)))
- (case (car target)
- ((substring)
- (if (= (length target) 3)
- (lint-format "perhaps ~A" caller (lists->string form `(string-ref ,(cadr target) (+ ,(caddr form) ,(caddr target)))))))
-
- ((symbol->string)
- (if (and (integer? (caddr form))
- (pair? (cadr target))
- (eq? (caadr target) 'quote)
- (symbol? (cadadr target)))
- (lint-format "perhaps ~A" caller (lists->string form (string-ref (symbol->string (cadadr target)) (caddr form))))))
-
- ((make-string)
- (if (and (integer? (cadr target))
- (integer? (caddr form))
- (> (cadr target) (caddr form)))
- (lint-format "perhaps ~A" caller (lists->string form (if (= (length target) 3) (caddr target) #\space))))))))))
+ (let ()
+ (define (sp-string-ref caller head form env)
+ (when (= (length form) 3)
+
+ (if (equal? (cadr form) "")
+ (lint-format "~A is an error" caller form)
+ (when (every? code-constant? (cdr form)) ; (string-ref "abc" 0) -> #\a
+ (catch #t
+ (lambda ()
+ (let ((val (eval form)))
+ (lint-format "perhaps ~A" caller (lists->string form val))))
+ (lambda args
+ (lint-format "~A: ~A" caller
+ (object->string form)
+ (apply format #f (cadr args)))))))
+
+ (when (pair? (cadr form))
+ (let ((target (cadr form)))
+ (case (car target)
+ ((substring) ; (string-ref (substring x 1) 2) -> (string-ref x (+ 2 1))
+ (if (= (length target) 3)
+ (lint-format "perhaps ~A" caller (lists->string form `(string-ref ,(cadr target) (+ ,(caddr form) ,(caddr target)))))))
+
+ ((symbol->string) ; (string-ref (symbol->string 'abs) 1) -> #\b
+ (if (and (integer? (caddr form))
+ (pair? (cadr target))
+ (eq? (caadr target) 'quote)
+ (symbol? (cadadr target)))
+ (lint-format "perhaps ~A" caller (lists->string form (string-ref (symbol->string (cadadr target)) (caddr form))))))
+
+ ((make-string) ; (string-ref (make-string 3 #\a) 1) -> #\a
+ (if (and (integer? (cadr target))
+ (integer? (caddr form))
+ (> (cadr target) (caddr form)))
+ (lint-format "perhaps ~A" caller (lists->string form (if (= (length target) 3) (caddr target) #\space))))))))))
+
+ (hash-special 'string-ref sp-string-ref))
;; ---------------- vector-ref etc ----------------
(let ()
@@ -6110,6 +6245,24 @@
(unless (= line-number last-checker-line-number)
(when (= (length form) 3)
(let ((seq (cadr form)))
+
+ (when (code-constant? (cadr form))
+ (if (eqv? (length (cadr form)) 0)
+ (lint-format "~A is an error" caller form)
+ (when (every? code-constant? (cddr form)) ; (vector-ref #(1 2) 0) -> 1
+ (catch #t
+ (lambda ()
+ (let ((val (eval form)))
+ (lint-format "perhaps ~A -> ~A~A" caller
+ (truncated-list->string form)
+ (if (or (pair? val)
+ (symbol? val))
+ "'" "")
+ (object->string val))))
+ (lambda args
+ (lint-format "~A: ~A" caller
+ (object->string form)
+ (apply format #f (cadr args))))))))
(when (pair? seq)
(if (and (memq (car seq) '(vector-ref int-vector-ref float-vector-ref list-ref hash-table-ref let-ref))
(= (length seq) 3)) ; (vector-ref (vector-ref x i) j) -> (x i j)
@@ -6128,10 +6281,10 @@
(lint-format "this doesn't make much sense: ~A" caller form)))
(when (eq? head 'list-ref)
(if (eq? (car seq) 'quote)
- (if (proper-list? (cadr seq))
+ (if (proper-list? (cadr seq)) ; (list-ref '(#t #f) (random 2)) -> (vector-ref #(#t #f) (random 2))
(lint-format "perhaps use a vector: ~A" caller
(lists->string form `(vector-ref ,(apply vector (cadr seq)) ,(caddr form)))))
- (let ((index (caddr form)))
+ (let ((index (caddr form))) ; (list-ref (cdddr f) 2) -> (list-ref f 5)
(if (and (memq (car seq) '(cdr cddr cdddr))
(or (integer? index)
(and (pair? index)
@@ -6149,7 +6302,7 @@
`(- ,(cadr index) ,noff)))))))))))))))
(set! last-checker-line-number line-number)))
(for-each (lambda (f)
- (hash-table-set! h f sp-vector-ref))
+ (hash-special f sp-vector-ref))
'(vector-ref list-ref hash-table-ref let-ref int-vector-ref float-vector-ref)))
@@ -6161,14 +6314,14 @@
(index (caddr form))
(val (cadddr form)))
- (cond ((and (pair? val) ; (vector-set! x 0 (vector-ref x 0))
+ (cond ((and (pair? val) ; (vector-set! x 0 (vector-ref x 0))
(= (length val) 3)
(eq? target (cadr val))
(equal? index (caddr val))
(memq (car val) '(vector-ref list-ref hash-table-ref string-ref let-ref float-vector-ref int-vector-ref)))
(lint-format "redundant ~A: ~A" caller head (truncated-list->string form)))
- ((code-constant? target) ; (vector-set! #(0 1 2) 1 3)??
+ ((code-constant? target) ; (vector-set! #(0 1 2) 1 3)??
(lint-format "~A is a constant that is discarded; perhaps ~A" caller target (lists->string form val)))
((not (pair? target)))
@@ -6190,62 +6343,129 @@
(lists->string form
`(list-set! ,(cadr target) ,(+ (caddr form) (cdr-count (car target))) ,(cadddr form)))))))))
(for-each (lambda (f)
- (hash-table-set! h f sp-vector-set!))
+ (hash-special f sp-vector-set!))
'(vector-set! list-set! hash-table-set! float-vector-set! int-vector-set! string-set! let-set!)))
;; ---------------- object->string ----------------
- (hash-table-set!
- h 'object->string
- (lambda (caller head form env)
+ (let ()
+ (define (sp-object->string caller head form env)
(when (pair? (cdr form))
- (if (and (pair? (cadr form))
+ (if (and (pair? (cadr form)) ; (object->string (object->string x)) could be (object->string x)
(eq? (caadr form) 'object->string))
(lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form))
(if (pair? (cddr form))
(let ((arg2 (caddr form)))
- (if (and (code-constant? arg2)
- (not (memq arg2 '(#f #t :readable)))) ; #f and #t are display|write choice, :readable = ~W
- (lint-format "bad second argument: ~A" caller arg2))))))))
+ (if (and (code-constant? arg2) ; (object->string x :else)
+ (not (memq arg2 '(#f #t :readable)))) ; #f and #t are display|write choice, :readable = ~W
+ (lint-format "bad second argument: ~A" caller arg2)))))))
+
+ (hash-special 'object->string sp-object->string))
+ (define (all-caps-warning arg)
+ (and (string? arg)
+ (or (string-position "ERROR" arg)
+ (string-position "WARNING" arg))))
+
;; ---------------- display ----------------
- (hash-table-set!
- h 'display
- (lambda (caller head form env)
- (if (pair? (cdr form))
- (let ((arg (cadr form))
- (port (if (pair? (cddr form))
- (caddr form)
- ())))
- (cond ((and (string? arg)
- (or (string-position "ERROR" arg)
- (string-position "WARNING" arg)))
- (lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
-
- ((not (and (pair? arg)
- (pair? (cdr arg)))))
+ (let ()
+ (define (sp-display caller head form env)
+ (when (pair? (cdr form))
+ (let ((arg (cadr form))
+ (port (if (pair? (cddr form))
+ (caddr form)
+ ())))
+ (cond ((all-caps-warning arg)
+ (lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
+
+ ((not (and (pair? arg)
+ (pair? (cdr arg)))))
+
+ ((and (eq? (car arg) 'format) ; (display (format #f str x)) -> (format () str x)
+ (not (cadr arg)))
+ (lint-format "perhaps ~A" caller (lists->string form `(format ,port ,@(cddr arg)))))
+
+ ((and (eq? (car arg) 'apply) ; (display (apply format #f str x) p) -> (apply format p str x)
+ (eq? (cadr arg) 'format)
+ (pair? (cddr arg))
+ (not (caddr arg)))
+ (lint-format "perhaps ~A" caller (lists->string form `(apply format ,port ,@(cdddr arg)))))
+
+ ((and (pair? port)
+ (eq? (car port) 'current-output-port))
+ (lint-format "(current-output-port) is the default port for display: ~A" caller form))))))
+
+ (hash-special 'display sp-display))
+
+ ;; ---------------- flush-output-port, newline, close-output-port ----------------
+ (let ()
+ (define (sp-flush-output-port caller head form env)
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (eq? (caadr form) 'current-output-port))
+ (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form)))
+ (hash-special 'flush-output-port sp-flush-output-port)
+ (hash-special 'close-output-port sp-flush-output-port)
+ (hash-special 'newline sp-flush-output-port))
+
+ ;; ---------------- write-char, write-byte, write ----------------
+ (let ()
+ (define (sp-write-char caller head form env)
+ (when (pair? (cdr form))
+ (if (and (pair? (cddr form))
+ (pair? (caddr form))
+ (eq? (caaddr form) 'current-output-port))
+ (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form))
+ (if (and (eq? head 'write-byte)
+ (integer? (cadr form))
+ (not (<= 0 (cadr form) 255)))
+ (lint-format "write-byte argument must be (<= 0 byte 255): ~A" caller form)
+ (if (and (eq? head 'write-char)
+ (eqv? (cadr form) #\newline))
+ (lint-format "perhaps ~A" caller (lists->string form `(newline ,@(cddr form))))))))
+ (hash-special 'write-char sp-write-char)
+ (hash-special 'write-byte sp-write-char)
+ (hash-special 'write sp-write-char))
+
+ ;; ---------------- read, port-filename, port-line-number, read-char, read-byte ----------------
+ (let ()
+ (define (sp-read caller head form env)
+ (when (and (pair? (cdr form))
+ (null? (cddr form)))
+ (if (and (pair? (cadr form))
+ (eq? (caadr form) 'current-input-port))
+ (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form)
+ (if (and (eq? head 'port-filename)
+ (memq (cadr form) '(*stdin* *stdout* *stderr*)))
+ (lint-format "~A: ~S" caller form
+ (case (cadr form) ((*stdin*) "*stdin*") ((*stdout*) "*stdout*") ((*stderr*) "*stderr*")))))))
+ (for-each (lambda (c)
+ (hash-special c sp-read))
+ '(read port-filename port-line-number read-char read-byte peek-char close-input-port)))
+
+ ;; ---------------- char-alphabetic? char-lower-case? char-numeric? char-upper-case? char-whitespace? etc ----------------
+ (let ()
+ (define (sp-char-numeric caller head form env)
+ (if (and (not (var-member (car form) env))
+ (pair? (cdr form))
+ (null? (cddr form))
+ (char? (cadr form)))
+ (lint-format "perhaps ~A" caller (lists->string form (eval form)))))
+ (for-each (lambda (c)
+ (hash-special c sp-char-numeric))
+ '(char-alphabetic? char-lower-case? char-numeric? char-upper-case? char-whitespace? char-upcase char-downcase)))
- ((and (eq? (car arg) 'format)
- (not (cadr arg)))
- (lint-format "perhaps ~A" caller (lists->string form `(format ,port ,@(cddr arg)))))
-
- ((and (eq? (car arg) 'apply)
- (eq? (cadr arg) 'format)
- (pair? (cddr arg))
- (not (caddr arg)))
- (lint-format "perhaps ~A" caller (lists->string form `(apply format ,port ,@(cdddr arg))))))))))
-
;; ---------------- make-vector etc ----------------
(let ()
(define (sp-make-vector caller head form env)
;; type of initial value (for make-float|int-vector) is checked elsewhere
(if (and (= (length form) 4)
- (eq? head 'make-vector))
- (lint-format "make-vector no longer has a fourth argument: ~A~%" caller form))
+ (eq? head 'make-vector)) ; (make-vector 3 0 #t)
+ (lint-format "make-vector no longer has a fourth argument: ~A" caller form))
(if (>= (length form) 3)
(case (caddr form)
((#<unspecified>)
- (if (eq? head 'make-vector)
+ (if (eq? head 'make-vector) ; (make-vector 3 #<unspecified>)
(lint-format "#<unspecified> is the default initial value in ~A" caller form)))
((0)
(if (not (eq? head 'make-vector))
@@ -6257,12 +6477,12 @@
(when (and (pair? (cdr form))
(integer? (cadr form))
(zero? (cadr form)))
- (if (pair? (cddr form))
+ (if (pair? (cddr form)) ; (make-vector 0 0.0)
(lint-format "initial value is pointless here: ~A" caller form))
(lint-format "perhaps ~A" caller (lists->string form #()))))
(for-each (lambda (f)
- (hash-table-set! h f sp-make-vector))
+ (hash-special f sp-make-vector))
'(make-vector make-int-vector make-float-vector)))
;; ---------------- make-string make-byte-vector ----------------
@@ -6271,11 +6491,11 @@
(when (and (pair? (cdr form))
(integer? (cadr form))
(zero? (cadr form)))
- (if (pair? (cddr form))
+ (if (pair? (cddr form)) ; (make-byte-vector 0 0)
(lint-format "initial value is pointless here: ~A" caller form))
(lint-format "perhaps ~A" caller (lists->string form "")))) ; #u8() but (equal? #u8() "") -> #t so lint combines these clauses!
(for-each (lambda (f)
- (hash-table-set! h f sp-make-string))
+ (hash-special f sp-make-string))
'(make-string make-byte-vector)))
;; ---------------- make-list ----------------
@@ -6284,10 +6504,10 @@
(when (and (pair? (cdr form))
(integer? (cadr form))
(zero? (cadr form)))
- (if (pair? (cddr form))
+ (if (pair? (cddr form)) ; (make-list 0 #f)
(lint-format "initial value is pointless here: ~A" caller form))
(lint-format "perhaps ~A" caller (lists->string form ()))))
- (hash-table-set! h 'make-list sp-make-list))
+ (hash-special 'make-list sp-make-list))
;; ---------------- reverse string->list etc ----------------
(let ()
@@ -6295,10 +6515,9 @@
;; not string->number -- no point in copying a number and it's caught below
(when (pair? (cdr form))
- (if (and (code-constant? (cadr form))
- (not (memq head '(list->string list->vector string->list))))
+ (if (code-constant? (cadr form))
(let ((seq (checked-eval form)))
- (if (not (eq? seq :checked-eval-error))
+ (if (not (eq? seq :checked-eval-error)) ; (symbol->string 'abs) -> "abs"
(lint-format "perhaps ~A -> ~A~A" caller
(truncated-list->string form)
(if (pair? seq) "'" "")
@@ -6306,23 +6525,23 @@
(object->string seq :readable)
(object->string seq))))))
- (let ((inverses '((reverse . reverse)
- (reverse! . reverse!)
- ;; reverse and reverse! are not completely interchangable:
- ;; (reverse (cons 1 2)): (2 . 1)
- ;; (reverse! (cons 1 2)): error: reverse! argument, (1 . 2), is a pair but should be a proper list
- (list->vector . vector->list)
- (vector->list . list->vector)
- (symbol->string . string->symbol)
- (string->symbol . symbol->string)
- (list->string . string->list)
- (string->list . list->string)
- (number->string . string->number))))
-
- (when (and (pair? (cadr form))
- (pair? (cdadr form)))
+ (when (and (pair? (cadr form))
+ (pair? (cdadr form)))
+ (let ((inverses '((reverse . reverse)
+ (reverse! . reverse!)
+ ;; reverse and reverse! are not completely interchangable:
+ ;; (reverse (cons 1 2)): (2 . 1)
+ ;; (reverse! (cons 1 2)): error: reverse! argument, (1 . 2), is a pair but should be a proper list
+ (list->vector . vector->list)
+ (vector->list . list->vector)
+ (symbol->string . string->symbol)
+ (string->symbol . symbol->string)
+ (list->string . string->list)
+ (string->list . list->string)
+ (number->string . string->number))))
(let ((inv-op (assq head inverses))
(arg (cadr form))
+ (arg-args (cdadr form))
(arg-of-arg (cadadr form))
(func-of-arg (caadr form)))
(if (pair? inv-op) (set! inv-op (cdr inv-op)))
@@ -6338,15 +6557,15 @@
((and (eq? head 'list->string) ; (list->string (make-list x y)) -> (make-string x y)
(eq? func-of-arg 'make-list))
- (lint-format "perhaps ~A" caller (lists->string form `(make-string ,@(cdr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(make-string , at arg-args))))
((and (eq? head 'string->list) ; (string->list (string x y)) -> (list x y)
(eq? func-of-arg 'string))
- (lint-format "perhaps ~A" caller (lists->string form `(list ,@(cdr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(list , at arg-args))))
((and (eq? head 'list->vector) ; (list->vector (make-list ...)) -> (make-vector ...)
(eq? func-of-arg 'make-list))
- (lint-format "perhaps ~A" caller (lists->string form `(make-vector ,@(cdr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(make-vector , at arg-args))))
((and (eq? head 'list->vector) ; (list->vector (string->list x)) -> (copy x (make-vector (length x)))
(eq? func-of-arg 'string->list))
@@ -6363,81 +6582,73 @@
((and (eq? head 'vector->list) ; (vector->list (make-vector ...)) -> (make-list ...)
(eq? func-of-arg 'make-vector))
- (lint-format "perhaps ~A" caller (lists->string form `(make-list ,@(cdr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(make-list , at arg-args))))
((and (eq? head 'vector->list) ; (vector->list (vector ...)) -> (list ...)
(eq? func-of-arg 'vector))
- (lint-format "perhaps ~A" caller (lists->string form `(list ,@(cdr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(list , at arg-args))))
((and (eq? head 'vector->list) ; (vector->list (vector-copy ...)) -> (vector->list ...)
(eq? func-of-arg 'vector-copy))
- (lint-format "perhaps ~A" caller (lists->string form `(vector->list ,@(cdr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(vector->list , at arg-args))))
((and (memq func-of-arg '(reverse reverse! copy))
- (pair? (cadr arg)) ; (list->string (reverse (string->list x))) -> (reverse x)
- (eq? (caadr arg) inv-op))
- (lint-format "perhaps ~A" caller (lists->string form `(,(if (eq? func-of-arg 'reverse!) 'reverse func-of-arg) ,(cadadr arg)))))
+ (pair? arg-of-arg) ; (list->string (reverse (string->list x))) -> (reverse x)
+ (eq? (car arg-of-arg) inv-op))
+ (lint-format "perhaps ~A" caller (lists->string form `(,(if (eq? func-of-arg 'reverse!) 'reverse func-of-arg) ,(cadr arg-of-arg)))))
((and (memq head '(reverse reverse!)) ; (reverse (string->list x)) -> (string->list (reverse x)) -- often redundant
(memq func-of-arg '(string->list vector->list sort!)))
- (if (eq? func-of-arg 'sort!) ; (reverse (sort! x <)) -> (sort x >)
- (if (and (pair? (cdr arg))
- (pair? (cddr arg)))
- (cond ((hash-table-ref reversibles (caddr arg))
- => (lambda (op)
- (lint-format "possibly ~A" caller (lists->string form `(sort! ,(cadr arg) ,op)))))))
- (if (null? (cddr arg))
- (lint-format "perhaps less consing: ~A" caller
- (lists->string form `(,func-of-arg (reverse ,arg-of-arg)))))))
-
- ((and (pair? (cadr arg))
+ (cond ((not (eq? func-of-arg 'sort!))
+ (if (null? (cdr arg-args))
+ (lint-format "perhaps less consing: ~A" caller
+ (lists->string form `(,func-of-arg (reverse ,arg-of-arg))))))
+ ((and (pair? arg-args) ; (reverse (sort! x <)) -> (sort x >)
+ (pair? (cdr arg-args))
+ (hash-table-ref reversibles (cadr arg-args)))
+ => (lambda (op)
+ (lint-format "possibly ~A" caller (lists->string form `(sort! ,arg-of-arg ,op)))))))
+
+ ((and (pair? arg-of-arg)
(memq func-of-arg '(cdr cddr cdddr cddddr list-tail))
(case head
- ((list->string) (eq? (caadr arg) 'string->list))
- ((list->vector) (eq? (caadr arg) 'vector->list))
+ ((list->string) (eq? (car arg-of-arg) 'string->list))
+ ((list->vector) (eq? (car arg-of-arg) 'vector->list))
(else #f)))
(let ((len-diff (if (eq? func-of-arg 'list-tail)
- (caddr arg)
+ (cadr arg-args)
(cdr-count func-of-arg))))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (list->string (cdr (string->list x))) -> (substring x 1)
(lists->string form (if (eq? head 'list->string)
- `(substring ,(cadadr arg) ,len-diff)
- `(copy ,(cadadr arg) (make-vector (- (length ,(cadadr arg)) ,len-diff))))))))
+ `(substring ,(cadr arg-of-arg) ,len-diff)
+ `(copy ,(cadr arg-of-arg) (make-vector (- (length ,(cadr arg-of-arg)) ,len-diff))))))))
((and (memq head '(list->vector list->string))
- (eq? func-of-arg 'sort!)
- (pair? (cadr arg))
- (eq? (caadr arg) (if (eq? head 'list->vector) 'vector->list 'string->list)))
- (lint-format "perhaps ~A" caller (lists->string form `(sort! ,(cadadr arg) ,(caddr arg)))))
+ (eq? func-of-arg 'sort!) ; (list->vector (sort! (vector->list x) y)) -> (sort! x y)
+ (pair? arg-of-arg)
+ (eq? (car arg-of-arg) (if (eq? head 'list->vector) 'vector->list 'string->list)))
+ (lint-format "perhaps ~A" caller (lists->string form `(sort! ,(cadr arg-of-arg) ,(cadr arg-args)))))
((and (memq head '(list->vector list->string))
(or (memq func-of-arg '(list cons))
(quoted-undotted-pair? arg)))
(let ((maker (if (eq? head 'list->vector) 'vector 'string)))
- (cond ((eq? func-of-arg 'list)
- (if (var-member maker env)
+ (case func-of-arg
+ ((list)
+ (if (var-member maker env) ; (list->string (list x y z)) -> (string x y z)
+ (lint-format "~A could be simplified, but you've shadowed '~A" caller (truncated-list->string form) maker)
+ (lint-format "perhaps ~A" caller (lists->string form `(,maker , at arg-args)))))
+
+ ((cons)
+ (if (any-null? (cadr arg-args))
+ (if (var-member maker env) ; (list->string (cons x ())) -> (string x)
(lint-format "~A could be simplified, but you've shadowed '~A" caller (truncated-list->string form) maker)
- (lint-format "perhaps ~A" caller (lists->string form `(,maker ,@(cdr arg))))))
- ((eq? func-of-arg 'cons)
- (if (any-null? (caddr arg))
- (if (var-member maker env)
- (lint-format "~A could be simplified, but you've shadowed '~A" caller (truncated-list->string form) maker)
- (lint-format "perhaps ~A" caller (lists->string form `(,maker ,(cadr arg)))))))
- ((or (null? (cddr form))
- (and (integer? (caddr form))
- (or (null? (cdddr form))
- (integer? (cadddr form)))))
- (lint-format "perhaps ~A" caller
- (lists->string form (apply (if (eq? head 'list->vector) vector string) (cadr arg))))))))
+ (lint-format "perhaps ~A" caller (lists->string form `(,maker ,arg-of-arg)))))))))
((and (memq head '(list->string list->vector)) ; (list->string (reverse x)) -> (reverse (apply string x))
(memq func-of-arg '(reverse reverse!)))
(lint-format "perhaps ~A" caller (lists->string form `(reverse (,head ,arg-of-arg)))))
- ((and (memq head '(string->list vector->list))
- (= (length form) 4))
- (check-start-and-end caller head (cddr form) form env))
-
((and (eq? head 'string->symbol) ; (string->symbol (string-append...)) -> (symbol ...)
(or (memq func-of-arg '(string-append append))
(and (eq? func-of-arg 'apply)
@@ -6445,24 +6656,24 @@
(lint-format "perhaps ~A" caller
(lists->string form
(if (eq? func-of-arg 'apply)
- `(apply symbol ,@(cddr arg))
- `(symbol ,@(cdr arg))))))
+ `(apply symbol ,@(cdr arg-args))
+ `(symbol , at arg-args)))))
- ((and (eq? head 'string->symbol)
+ ((and (eq? head 'string->symbol) ; (string->symbol (if (not (null? x)) x "abc")) -> (if (not (null? x)) (string->symbol x) 'abc)
(eq? func-of-arg 'if)
- (or (string? (caddr arg))
- (string? (cadddr arg)))
- (not (or (equal? (caddr arg) "") ; this is actually an error -- should we complain?
- (equal? (cadddr arg) ""))))
+ (or (string? (cadr arg-args))
+ (string? (caddr arg-args)))
+ (not (or (equal? (cadr arg-args) "") ; this is actually an error -- should we complain?
+ (equal? (caddr arg-args) ""))))
(lint-format "perhaps ~A" caller
(lists->string form
- (if (string? (caddr arg))
- (if (string? (cadddr arg))
- `(if ,(cadr arg) ',(string->symbol (caddr arg)) ',(string->symbol (cadddr arg)))
- `(if ,(cadr arg) ',(string->symbol (caddr arg)) (string->symbol ,(cadddr arg))))
- `(if ,(cadr arg) (string->symbol ,(caddr arg)) ',(string->symbol (cadddr arg)))))))
+ (if (string? (cadr arg-args))
+ (if (string? (caddr arg-args))
+ `(if ,arg-of-arg ',(string->symbol (cadr arg-args)) ',(string->symbol (caddr arg-args)))
+ `(if ,arg-of-arg ',(string->symbol (cadr arg-args)) (string->symbol ,(caddr arg-args))))
+ `(if ,arg-of-arg (string->symbol ,(cadr arg-args)) ',(string->symbol (caddr arg-args)))))))
- ((case head
+ ((case head ; (reverse (reverse! x)) could be (copy x)
((reverse) (eq? func-of-arg 'reverse!))
((reverse!) (eq? func-of-arg 'reverse))
(else #f))
@@ -6472,24 +6683,13 @@
(eq? func-of-arg 'reverse)
(eq? inv-op (car arg-of-arg)))
(lint-format "perhaps ~A" caller (lists->string form `(reverse ,(cadr arg-of-arg)))))))))
-
- (unless (pair? (cadr form))
- (let ((arg (cadr form)))
- (if (and (eq? head 'string->list)
- (string? arg)
- (or (null? (cddr form))
- (and (integer? (caddr form))
- (or (null? (cdddr form))
- (integer? (cadddr form))))))
- (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (apply string->list (cdr form))))))
- (when (pair? (cddr form))
+ (when (pair? (cddr form)) ; (string->list x y y) is ()
(when (and (memq head '(vector->list string->list))
- (pair? (cdddr form))
- (equal? (caddr form) (cadddr form)))
- (lint-format "leaving aside errors, ~A is ()" caller (truncated-list->string form)))
+ (pair? (cdddr form)))
+ (check-start-and-end caller head (cddr form) form env))
- (when (and (eq? head 'number->string)
+ (when (and (eq? head 'number->string) ; (number->string saturation 10)
(eqv? (caddr form) 10))
(lint-format "10 is the default radix for number->string: ~A" caller (truncated-list->string form))))
@@ -6503,85 +6703,94 @@
(cadr form)
(truncated-list->string form))))
(when (pair? (cadr form))
- (let ((arg (cadr form)))
- (when (and (pair? (cdr arg))
- (pair? (cadr arg)))
- (if (and (memq (car arg) '(cdr list-tail)) ; (reverse (cdr (reverse lst))) = all but last of lst -> copy to len-1
- (memq (caadr arg) '(reverse reverse!))
- (symbol? (cadadr arg)))
+ (let ((arg (cadr form))
+ (arg-op (caadr form))
+ (arg-args (cdadr form))
+ (arg-arg (and (pair? (cdadr form)) (cadadr form))))
+ (when (and (pair? arg-args)
+ (pair? arg-arg))
+ (if (and (memq arg-op '(cdr list-tail)) ; (reverse (cdr (reverse lst))) = all but last of lst -> copy to len-1
+ (memq (car arg-arg) '(reverse reverse!))
+ (symbol? (cadr arg-arg)))
(lint-format "perhaps ~A" caller
- (lists->string form `(copy ,(cadadr arg) (make-list (- (length ,(cadadr arg)) ,(if (eq? (car arg) 'cdr) 1 (caddr arg))))))))
-
- (if (and (eq? (car arg) 'append) ; (reverse (append (reverse b) res)) = (append (reverse res) b)
- (eq? (caadr arg) 'reverse)
- (pair? (cddr arg))
- (null? (cdddr arg)))
- (lint-format "perhaps ~A" caller (lists->string form `(append (reverse ,(caddr arg)) ,(cadadr arg))))))
+ (lists->string form `(copy ,(cadr arg-arg)
+ (make-list (- (length ,(cadr arg-arg)) ,(if (eq? arg-op 'cdr) 1 (cadr arg-args))))))))
+
+ (if (and (eq? arg-op 'append) ; (reverse (append (reverse b) res)) = (append (reverse res) b)
+ (eq? (car arg-arg) 'reverse)
+ (pair? (cdr arg-args))
+ (null? (cddr arg-args)))
+ (lint-format "perhaps ~A" caller (lists->string form `(append (reverse ,(cadr arg-args)) ,(cadr arg-arg))))))
(when (and (= (length arg) 3)
- (pair? (caddr arg)))
- (if (and (eq? (car arg) 'map) ; (reverse (map abs (sort! x <))) -> (map abs (sort! x >))
- (eq? (caaddr arg) 'sort!))
- (cond ((hash-table-ref reversibles (caddr (caddr arg)))
- => (lambda (op)
- (lint-format "possibly ~A" caller (lists->string form `(,(car arg) ,(cadr arg)
- (sort! ,(cadr (caddr arg)) ,op))))))))
+ (pair? (cadr arg-args)))
+ (cond ((and (eq? arg-op 'map) ; (reverse (map abs (sort! x <))) -> (map abs (sort! x >))
+ (eq? (caadr arg-args) 'sort!)
+ (hash-table-ref reversibles (caddr (cadr arg-args))))
+ => (lambda (op)
+ (lint-format "possibly ~A" caller (lists->string form `(,arg-op ,arg-arg (sort! ,(cadadr arg-args) ,op)))))))
;; (reverse (apply vector (sort! x <))) doesn't happen (nor does this map case, but it's too pretty to leave out)
- (if (and (eq? (car arg) 'cons) ; (reverse (cons x (reverse lst))) -- adds x to end -- (append lst (list x))
- (memq (car (caddr arg)) '(reverse reverse!)))
- (lint-format "perhaps ~A" caller (lists->string form `(append ,(cadr (caddr arg)) (list ,(cadr arg)))))))))))))
+ (if (and (eq? arg-op 'cons) ; (reverse (cons x (reverse lst))) -- adds x to end -- (append lst (list x))
+ (memq (caadr arg-args) '(reverse reverse!)))
+ (lint-format "perhaps ~A" caller (lists->string form `(append ,(cadadr arg-args) (list ,arg-arg))))))))))))
(for-each (lambda (f)
- (hash-table-set! h f sp-reverse))
+ (hash-special f sp-reverse))
'(reverse reverse! list->vector vector->list list->string string->list symbol->string string->symbol number->string)))
;; ---------------- char->integer string->number etc ----------------
(let ()
(define (sp-char->integer caller head form env)
- (let ((inverses '((char->integer . integer->char)
- (integer->char . char->integer)
- (symbol->keyword . keyword->symbol)
- (keyword->symbol . symbol->keyword)
- (string->number . number->string))))
- (when (pair? (cdr form))
- (let ((arg (cadr form)))
- (if (and (pair? arg)
- (pair? (cdr arg))
- (eq? (car arg) (cond ((assq head inverses) => cdr))))
- (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr arg))
- (case head
- ((integer->char)
- (if (let walk ((tree (cdr form)))
- (if (pair? tree)
- (and (walk (car tree))
- (walk (cdr tree)))
- (or (code-constant? tree)
- (not (side-effect? tree env)))))
- (let ((chr (checked-eval form)))
- (if (char? chr)
- (lint-format "perhaps ~A" caller (lists->string form chr))))))
-
- ((string->number)
- (if (and (pair? (cddr form))
- (integer? (caddr form)) ; type error is checked elsewhere
- (not (<= 2 (caddr form) 16)))
- (lint-format "string->number radix should be between 2 and 16: ~A" caller form)
- (if (and (pair? arg)
- (eq? (car arg) 'string)
- (pair? (cdr arg))
- (null? (cddr form))
- (null? (cddr arg)))
- (lint-format "perhaps ~A" caller
- (lists->string form `(- (char->integer ,(cadr arg)) (char->integer #\0)))))))
-
- ((symbol->keyword)
+ (when (pair? (cdr form))
+ (let ((inverses '((char->integer . integer->char)
+ (integer->char . char->integer)
+ (symbol->keyword . keyword->symbol)
+ (keyword->symbol . symbol->keyword)
+ (string->number . number->string)))
+ (arg (cadr form)))
+ (if (and (pair? arg)
+ (pair? (cdr arg)) ; (string->number (number->string x)) could be x
+ (eq? (car arg) (cond ((assq head inverses) => cdr))))
+ (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr arg))
+ (case head
+ ((integer->char)
+ (if (let walk ((tree (cdr form)))
+ (if (pair? tree)
+ (and (walk (car tree))
+ (walk (cdr tree)))
+ (or (code-constant? tree)
+ (not (side-effect? tree env)))))
+ (let ((chr (checked-eval form))) ; (integer->char (+ (char->integer #\space) 215)) -> #\xf7
+ (if (char? chr)
+ (lint-format "perhaps ~A" caller (lists->string form chr))))))
+
+ ((string->number)
+ (if (and (pair? (cddr form))
+ (integer? (caddr form)) ; type error is checked elsewhere
+ (not (<= 2 (caddr form) 16))) ; (string->number "123" 21)
+ (lint-format "string->number radix should be between 2 and 16: ~A" caller form)
(if (and (pair? arg)
- (eq? (car arg) 'string->symbol))
- (lint-format "perhaps ~A" caller (lists->string form `(make-keyword ,(cadr arg))))))))))))
-
+ (eq? (car arg) 'string)
+ (pair? (cdr arg))
+ (null? (cddr form))
+ (null? (cddr arg))) ; (string->number (string num-char)) -> (- (char->integer num-char) (char->integer #\0))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(- (char->integer ,(cadr arg)) (char->integer #\0)))))))
+
+ ((symbol->keyword)
+ (if (and (pair? arg) ; (symbol->keyword (string->symbol x)) -> (make-keyword x)
+ (eq? (car arg) 'string->symbol))
+ (lint-format "perhaps ~A" caller (lists->string form `(make-keyword ,(cadr arg))))
+ (if (quoted-symbol? arg)
+ (lint-format "perhaps ~A" caller (lists->string form (symbol->keyword (cadr arg)))))))
+
+ ((keyword->symbol)
+ (if (keyword? arg)
+ (lint-format "perhaps ~A -> '~A" caller (object->string form) (object->string (keyword->symbol arg))))))))))
+
(for-each (lambda (f)
- (hash-table-set! h f sp-char->integer))
+ (hash-special f sp-char->integer))
'(char->integer integer->char symbol->keyword keyword->symbol string->number)))
;; ---------------- string-append ----------------
@@ -6592,29 +6801,29 @@
(combined #f))
(when (or (any? string? args)
(member 'string args (lambda (a b) (and (pair? b) (eq? (car b) a)))))
- (let ((nargs ())) ; look for (string...) (string...) in the arg list and combine
- (do ((p args (cdr p)))
- ((null? p)
- (set! args (reverse nargs)))
- (cond ((not (pair? (cdr p)))
- (set! nargs (cons (car p) nargs)))
-
- ((and (pair? (car p))
- (eq? (caar p) 'string)
- (pair? (cadr p))
- (eq? (caadr p) 'string))
- (set! nargs (cons `(string ,@(cdar p) ,@(cdadr p)) nargs))
- (set! combined #t)
- (set! p (cdr p)))
-
- ((and (string? (car p))
- (string? (cadr p)))
- (set! nargs (cons (string-append (car p) (cadr p)) nargs))
- (set! combined #t)
- (set! p (cdr p)))
-
- (else (set! nargs (cons (car p) nargs)))))))
-
+ (do ((nargs ()) ; look for (string...) (string...) in the arg list and combine
+ (p args (cdr p)))
+ ((null? p)
+ (set! args (reverse nargs)))
+ (cond ((not (pair? (cdr p)))
+ (set! nargs (cons (car p) nargs)))
+
+ ((and (pair? (car p))
+ (eq? (caar p) 'string)
+ (pair? (cadr p))
+ (eq? (caadr p) 'string))
+ (set! nargs (cons `(string ,@(cdar p) ,@(cdadr p)) nargs))
+ (set! combined #t)
+ (set! p (cdr p)))
+
+ ((and (string? (car p))
+ (string? (cadr p)))
+ (set! nargs (cons (string-append (car p) (cadr p)) nargs))
+ (set! combined #t)
+ (set! p (cdr p)))
+
+ (else (set! nargs (cons (car p) nargs))))))
+
(cond ((null? args) ; (string-append) -> ""
(lint-format "perhaps ~A" caller (lists->string form "")))
@@ -6633,14 +6842,14 @@
(char? (cadr a)))))
args)
(catch #t
- (lambda ()
+ (lambda () ; (string-append (string #\C) "ZLl*()def") -> "CZLl*()def"
(let ((val (if (not (any? pair? args))
(apply string-append args)
(eval (cons 'string-append args)))))
(lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
(lambda args #f)))
- ((every? (lambda (c) ; (string-append (make-string 3 #\a) (make-string 2 #\b)) -> (format #f "~NC~NC" 3 #\a 2 #\b)
+ ((every? (lambda (c) ; (string-append (make-string 3 #\a) (make-string 2 #\b)) -> (format #f "~NC~NC" 3 #\a 2 #\b)
(and (pair? c)
(eq? (car c) 'make-string)
(pair? (cdr c))
@@ -6651,29 +6860,29 @@
`(format #f ,(apply string-append (make-list (abs (length (cdr form))) "~NC"))
,@(map (lambda (c) (values (cadr c) (caddr c))) (cdr form))))))
- ((not (equal? args (cdr form)))
+ ((not (equal? args (cdr form))) ; (string-append x (string-append y z)) -> (string-append x y z)
(lint-format "perhaps ~A" caller (lists->string form `(string-append , at args)))))
(set! last-checker-line-number line-number))))
- (hash-table-set! h 'string-append sp-string-append))
+ (hash-special 'string-append sp-string-append))
;; ---------------- vector-append ----------------
(let ()
(define (sp-vector-append caller head form env)
(unless (= line-number last-checker-line-number)
(let ((args (remove-all #() (splice-if (lambda (x) (eq? x 'vector-append)) (cdr form)))))
- (cond ((null? args)
+ (cond ((null? args) ; (vector-append) -> #()
(lint-format "perhaps ~A" caller (lists->string form #())))
- ((null? (cdr args))
+ ((null? (cdr args)) ; (vector-append x) -> (copy x)
(lint-format "perhaps ~A" caller (lists->string form `(copy ,(car args)))))
- ((every? vector? args)
+ ((every? vector? args) ; (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)
(lint-format "perhaps ~A" caller (lists->string form (apply vector-append args))))
- ((not (equal? args (cdr form)))
+ ((not (equal? args (cdr form))) ; (vector-append x (vector-append y z)) -> (vector-append x y z)
(lint-format "perhaps ~A" caller (lists->string form `(vector-append , at args)))))
(set! last-checker-line-number line-number))))
- (hash-table-set! h 'vector-append sp-vector-append))
+ (hash-special 'vector-append sp-vector-append))
;; ---------------- cons ----------------
(let ()
@@ -6730,7 +6939,7 @@
(if (and (pair? (caddr chain))
(memq (caaddr chain) '(cons list)))
(loop (cons (cadr chain) args) (caddr chain)))))))))))
- (hash-table-set! h 'cons sp-cons))
+ (hash-special 'cons sp-cons))
;; ---------------- append ----------------
(let ()
@@ -6793,7 +7002,7 @@
(lint-format "append does not copy its last argument, so ~A is dangerous" caller form))))
(case len1
- ((0) ; (append) -> ()
+ ((0) ; (append) -> ()
(lint-format "perhaps ~A" caller (lists->string form ())))
((1) ; (append x) -> x
(lint-format "perhaps ~A" caller (lists->string form (car new-args))))
@@ -6827,7 +7036,7 @@
(null? (cdddr arg1)))
(lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadr arg1) (cons ,(caddr arg1) ,arg2)))))
- ;; not sure about this: reports the un-qq'd form
+ ;; not sure about this: reports the un-qq'd form (and never happens)
((and (eq? (car arg1) #_{list})
(not (qq-tree? arg1)))
(set! last-checker-line-number -1)
@@ -6848,14 +7057,14 @@
`(cons ',(caadr arg1) ,arg2)
`(cons ,(caadr arg1) ,arg2)))))
- ((not (equal? (cdr form) new-args))
+ ((not (equal? (cdr form) new-args)) ; (append () '(1 2) 1) -> (append '(1 2) 1)
(lint-format "perhaps ~A" caller (lists->string form `(append , at new-args)))))))
(else
(cond ((every? (lambda (item)
(and (pair? item)
(or (eq? (car item) 'list)
(quoted-undotted-pair? item))))
- new-args)
+ new-args) ; (append '(1) (append '(2) '(3)) '(4)) -> (list 1 2 3 4)
(lint-format "perhaps ~A" caller (lists->string form (apply append->list new-args))))
((and (pair? (car new-args)) ; (append (list x) y (list z)) -> (cons x (append y (list z)))?
@@ -6867,19 +7076,20 @@
(and (pair? n-1)
(eq? (car n-1) 'list)
(pair? (cdr n-1))
- (null? (cddr n-1))))
+ (null? (cddr n-1)))) ; (append x (list y) z) -> (append x (cons y z))
(lint-format "perhaps ~A" caller
(lists->string form
`(append ,@(copy new-args (make-list (- len1 2)))
(cons ,(cadr (list-ref new-args (- len1 2)))
,(list-ref new-args (- len1 1)))))))
- ((not (equal? (cdr form) new-args))
+
+ ((not (equal? (cdr form) new-args)) ; (append x y (append)) -> (append x y ())
(lint-format "perhaps ~A" caller (lists->string form `(append , at new-args)))))))
(if (and (= made-suggestion suggestion)
(not (equal? (cdr form) new-args)))
(lint-format "perhaps ~A" caller (lists->string form `(append , at new-args)))))))))
- (hash-table-set! h 'append sp-append))
+ (hash-special 'append sp-append))
;; ---------------- apply ----------------
(let ()
@@ -6887,7 +7097,7 @@
(when (pair? (cdr form))
(let ((len (length form))
(suggestion made-suggestion))
- (if (= len 2)
+ (if (= len 2) ; (apply f) -> (f)
(lint-format "perhaps ~A" caller (lists->string form (list (cadr form))))
(if (not (or (<= len 2) ; it might be (apply)...
(symbol? (cadr form))
@@ -6904,20 +7114,21 @@
(let ((func (symbol->value f *e*)))
(if (procedure? func)
(let ((ary (arity func)))
- (when (pair? ary)
+ (when (pair? ary) ; (apply real? 1 3 rest)
(if (> (- len 3) (cdr ary)) ; last apply arg might be var=()
(lint-format "too many arguments for ~A: ~A" caller f form))
(if (and (= len 3)
(= (car ary) 1)
- (= (cdr ary) 1))
+ (= (cdr ary) 1)) ; (apply car x) -> (car (car x))
(lint-format "perhaps ~A" caller (lists->string form `(,f (car ,(caddr form)))))))))))
(let ((last-arg (form (- len 1))))
(if (and (not (list? last-arg))
- (code-constant? last-arg))
+ (code-constant? last-arg)) ; (apply + 1)
(lint-format "last argument should be a list: ~A" caller (truncated-list->string form))
(if (= len 3)
- (let ((args (caddr form)))
+ (let ((args (caddr form))
+ (cdr-args (and (pair? (caddr form)) (cdaddr form))))
(if (identity? f) ; (apply (lambda (x) x) y) -> (car y)
(lint-format "perhaps (assuming ~A is a list of one element) ~A" caller args
(lists->string form `(car ,args)))
@@ -6934,72 +7145,72 @@
((or (not (pair? args))
(case (car args)
((list) ; (apply f (list a b)) -> (f a b)
- (lint-format "perhaps ~A" caller (lists->string form `(,f ,@(cdr args)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(,f , at cdr-args))))
((quote) ; (apply eq? '(a b)) -> (eq? 'a 'b)
(and (= suggestion made-suggestion)
- (lint-format "perhaps ~A" caller (lists->string form `(,f ,@(distribute-quote (cadr args)))))))
+ (lint-format "perhaps ~A" caller (lists->string form `(,f ,@(distribute-quote (car cdr-args)))))))
((cons) ; (apply f (cons a b)) -> (apply f a b)
(lint-format "perhaps ~A" caller
(lists->string form
- (if (and (pair? (caddr args))
- (eq? (caaddr args) 'cons))
- `(apply ,f ,(cadr args) ,@(cdaddr args))
- `(apply ,f ,@(cdr args))))))
+ (if (and (pair? (cadr cdr-args))
+ (eq? (caadr cdr-args) 'cons))
+ `(apply ,f ,(car cdr-args) ,@(cdadr cdr-args))
+ `(apply ,f , at cdr-args)))))
((append) ; (apply f (append (list ...)...)) -> (apply f ... ...)
- (and (pair? (cadr args))
- (eq? (caadr args) 'list)
+ (and (pair? (car cdr-args))
+ (eq? (caar cdr-args) 'list)
(lint-format "perhaps ~A" caller
- (lists->string form `(apply ,f ,@(cdadr args)
- ,(if (null? (cddr args)) ()
- (if (null? (cdddr args)) (caddr args)
- `(append ,@(cddr args)))))))))
+ (lists->string form `(apply ,f ,@(cdar cdr-args)
+ ,(if (null? (cdr cdr-args)) ()
+ (if (null? (cddr cdr-args)) (cadr cdr-args)
+ `(append ,@(cdr cdr-args)))))))))
((reverse reverse!) ; (apply vector (reverse x)) -> (reverse (apply vector x))
(and (memq f '(string vector int-vector float-vector))
- (lint-format "perhaps ~A" caller (lists->string form `(reverse (apply ,f ,(cadr args)))))))
+ (lint-format "perhaps ~A" caller (lists->string form `(reverse (apply ,f ,(car cdr-args)))))))
((make-list) ; (apply string (make-list x y)) -> (make-string x y)
(if (memq f '(string vector))
(lint-format "perhaps ~A" caller
(lists->string form
`(,(if (eq? f 'string) 'make-string 'make-vector)
- ,@(cdr args))))))
+ , at cdr-args)))))
((map)
(case f
((string-append) ; (apply string-append (map ...))
- (if (eq? (cadr args) 'symbol->string)
+ (if (eq? (car cdr-args) 'symbol->string)
(lint-format "perhaps ~A" caller ; (apply string-append (map symbol->string ...))
- (lists->string form `(format #f "~{~A~}" ,(caddr args))))
- (if (simple-lambda? (cadr args))
- (let ((body (caddr (cadr args))))
+ (lists->string form `(format #f "~{~A~}" ,(cadr cdr-args))))
+ (if (simple-lambda? (car cdr-args))
+ (let ((body (caddar cdr-args)))
(if (and (pair? body)
(eq? (car body) 'string-append)
(= (length body) 3)
(or (and (string? (cadr body))
- (eq? (caddr body) (caadr (cadr args))))
+ (eq? (caddr body) (caadar cdr-args)))
(and (string? (caddr body))
- (eq? (cadr body) (caadr (cadr args))))))
+ (eq? (cadr body) (caadar cdr-args)))))
(let ((str (string-append "~{"
(if (string? (cadr body)) (cadr body) "~A")
(if (string? (caddr body)) (caddr body) "~A")
"~}")))
(lint-format "perhaps ~A" caller
- (lists->string form `(format #f ,str ,(caddr args))))))))))
+ (lists->string form `(format #f ,str ,(cadr cdr-args))))))))))
((string) ; (apply string (map char-downcase x)) -> (string-downcase (apply string x))
- (if (memq (cadr args) '(char-upcase char-downcase))
- (lint-format "perhaps, assuming ~A is a list, ~A" caller (caddr args)
- (lists->string form `(,(if (eq? (cadr args) 'char-upcase)
+ (if (memq (car cdr-args) '(char-upcase char-downcase))
+ (lint-format "perhaps, assuming ~A is a list, ~A" caller (cadr cdr-args)
+ (lists->string form `(,(if (eq? (car cdr-args) 'char-upcase)
'string-upcase 'string-downcase)
- (apply string ,(caddr args)))))))
+ (apply string ,(cadr cdr-args)))))))
((append) ; (apply append (map vector->list args)) -> (vector->list (apply append args))
- (and (eq? (cadr args) 'vector->list)
- (lint-format "perhaps ~A" caller (lists->string form `(vector->list (apply append ,@(cddr args)))))))
+ (and (eq? (car cdr-args) 'vector->list)
+ (lint-format "perhaps ~A" caller (lists->string form `(vector->list (apply append ,@(cdr cdr-args)))))))
(else #f)))
;; (apply append (map...)) is very common but changing it to
@@ -7018,10 +7229,10 @@
`(apply ,f
,@(copy args (make-list (- (length args) 2)) 1)
,(cadr last-arg))))
- (if (not (tree-member #_{apply_values} (cdr args)))
+ (if (not (tree-member #_{apply_values} cdr-args))
(lint-format "perhaps ~A" caller
(lists->string form
- `(,f ,@(un_{list} (cdr args))))))))))))))
+ `(,f ,@(un_{list} cdr-args)))))))))))))
(begin ; len > 3
(when (and (pair? last-arg)
(eq? (car last-arg) 'list) ; (apply f y z (list a b)) -> (f y z a b)
@@ -7040,30 +7251,30 @@
(if (and (= suggestion made-suggestion)
(symbol? (cadr form)))
(let ((ary (arg-arity (cadr form) env)))
- (if (and (pair? ary)
+ (if (and (pair? ary) ; (apply make-string tcnt initializer) -> (make-string tcnt (car initializer))
(= (cdr ary) (- len 2)))
(lint-format "perhaps ~A" caller
(lists->string form `(,@(copy (cdr form) (make-list (- len 2))) (car ,(list-ref form (- len 1))))))))))))
- (hash-table-set! h 'apply sp-apply))
+ (hash-special 'apply sp-apply))
;; ---------------- format ----------------
(let ()
(define (sp-format caller head form env)
(if (< (length form) 3)
(begin
- (cond ((< (length form) 2)
+ (cond ((< (length form) 2) ; (format)
(lint-format "~A has too few arguments: ~A" caller head (truncated-list->string form)))
- ((and (pair? (cadr form))
+ ((and (pair? (cadr form)) ; (format (format #f str))
(eq? (caadr form) 'format))
(lint-format "redundant format: ~A" caller (truncated-list->string form)))
- ((and (code-constant? (cadr form))
+ ((and (code-constant? (cadr form)) ; (format 1)
(not (string? (cadr form))))
(lint-format "format with one argument takes a string: ~A" caller (truncated-list->string form)))
- ((and (string? (cadr form)) ; (format "str") -> str
+ ((and (string? (cadr form)) ; (format "str") -> str
(eq? head 'format) ; not snd-display
(not (char-position #\~ (cadr form))))
(lint-format "perhaps ~A" caller (lists->string form (cadr form)))))
@@ -7086,74 +7297,72 @@
(dirs 0)
(pos (char-position #\~ str)))
(when pos
- (let ((len (length str))
- (tilde-time #t))
- (do ((i (+ pos 1) (+ i 1)))
- ((>= i len))
- (let ((c (string-ref str i)))
- (if tilde-time
- (begin
- (when (and (= curlys 0)
- (not (memv c '(#\~ #\T #\t #\& #\% #\^ #\| #\newline #\}))) ; ~* consumes an arg
- (not (call-with-exit
- (lambda (return)
- (do ((k i (+ k 1)))
- ((= k len) #f)
- ;; this can be confused by pad chars in ~T
- (if (not (or (char-numeric? (string-ref str k))
- (char=? (string-ref str k) #\,)))
- (return (char-ci=? (string-ref str k) #\t))))))))
- ;; the possibilities are endless, so I'll stick to the simplest
- (if (not (vector-ref format-control-char (char->integer c)))
- (lint-format "unrecognized format directive: ~C in ~S, ~S" caller c str form))
- (set! dirs (+ dirs 1))
-
- ;; ~n so try to figure out how many args are needed (this is not complete)
- (when (char-ci=? c #\n)
- (let ((j (+ i 1)))
- (if (>= j len)
- (lint-format "missing format directive: ~S" caller str)
- (begin
- ;; if ,n -- add another, if then not T, add another
- (if (char=? (string-ref str j) #\,)
- (cond ((>= (+ j 1) len)
- (lint-format "missing format directive: ~S" caller str))
- ((char-ci=? (string-ref str (+ j 1)) #\n)
- (set! dirs (+ dirs 1))
- (set! j (+ j 2)))
- ((char-numeric? (string-ref str (+ j 1)))
- (set! j (+ j 2)))
- (else (set! j (+ j 1)))))
- (if (>= j len)
- (lint-format "missing format directive: ~S" caller str)
- (if (not (char-ci=? (string-ref str j) #\t))
- (set! dirs (+ dirs 1)))))))))
-
- (set! tilde-time #f)
- (case c
- ((#\{) (set! curlys (+ curlys 1)))
- ((#\}) (set! curlys (- curlys 1)))
- ((#\^ #\|)
- (if (zero? curlys)
- (lint-format "~A has ~~~C outside ~~{~~}?" caller str c))))
- (if (and (< (+ i 2) len)
- (member (substring str i (+ i 3)) '("%~&" "^~^" "|~|" "&~&" "\n~\n") string=?))
- (lint-format "~A in ~A could be ~A" caller
- (substring str (- i 1) (+ i 3))
- str
- (substring str (- i 1) (+ i 1)))))
- (begin
- (set! pos (char-position #\~ str i))
- (if pos
- (begin
- (set! tilde-time #t)
- (set! i pos))
- (set! i len))))))
-
+ (do ((len (length str))
+ (tilde-time #t)
+ (i (+ pos 1) (+ i 1)))
+ ((>= i len)
+ (if tilde-time ; (format #f "asdf~")
+ (lint-format "~A control string ends in tilde: ~A" caller head (truncated-list->string form))))
(if tilde-time
- (lint-format "~A control string ends in tilde: ~A" caller head (truncated-list->string form)))))
+ (let ((c (string-ref str i)))
+ (when (and (= curlys 0)
+ (not (memv c '(#\~ #\T #\t #\& #\% #\^ #\| #\newline #\}))) ; ~* consumes an arg
+ (not (call-with-exit
+ (lambda (return)
+ (do ((k i (+ k 1)))
+ ((= k len) #f)
+ ;; this can be confused by pad chars in ~T
+ (if (not (or (char-numeric? (string-ref str k))
+ (char=? (string-ref str k) #\,)))
+ (return (char-ci=? (string-ref str k) #\t))))))))
+ ;; the possibilities are endless, so I'll stick to the simplest
+ (if (not (vector-ref format-control-char (char->integer c))) ; (format #f "~H" 1)
+ (lint-format "unrecognized format directive: ~C in ~S, ~S" caller c str form))
+ (set! dirs (+ dirs 1))
+
+ ;; ~n so try to figure out how many args are needed (this is not complete)
+ (when (char-ci=? c #\n)
+ (let ((j (+ i 1)))
+ (if (>= j len) ; (format p "~A~A" x)
+ (lint-format "missing format directive: ~S" caller str)
+ (begin
+ ;; if ,n -- add another, if then not T, add another
+ (cond ((not (char=? (string-ref str j) #\,)))
+ ((>= (+ j 1) len)
+ (lint-format "missing format directive: ~S" caller str))
+ ((char-ci=? (string-ref str (+ j 1)) #\n)
+ (set! dirs (+ dirs 1))
+ (set! j (+ j 2)))
+ ((char-numeric? (string-ref str (+ j 1)))
+ (set! j (+ j 2)))
+ (else (set! j (+ j 1))))
+ (if (>= j len)
+ (lint-format "missing format directive: ~S" caller str)
+ (if (not (char-ci=? (string-ref str j) #\t))
+ (set! dirs (+ dirs 1)))))))))
+
+ (set! tilde-time #f)
+ (case c
+ ((#\{) (set! curlys (+ curlys 1)))
+ ((#\}) (set! curlys (- curlys 1)))
+ ((#\^ #\|)
+ (if (zero? curlys) ; (format #f "~^")
+ (lint-format "~A has ~~~C outside ~~{~~}?" caller str c))))
+ (if (and (< (+ i 2) len)
+ (member (substring str i (+ i 3)) '("%~&" "^~^" "|~|" "&~&" "\n~\n") string=?))
+ (lint-format "~A in ~A could be ~A" caller ; (format #f "~%~&")
+ (substring str (- i 1) (+ i 3))
+ str
+ (substring str (- i 1) (+ i 1)))))
+ (begin
+ (set! pos (char-position #\~ str i))
+ (if pos
+ (begin
+ (set! tilde-time #t)
+ (set! i pos))
+ (set! i len))))))
- (if (not (= curlys 0))
+ (if (not (= curlys 0)) ; (format #f "~{~A" 1)
(lint-format "~A has ~D unmatched ~A~A: ~A"
caller head
(abs curlys)
@@ -7163,17 +7372,13 @@
dirs))))
(when (and (eq? head 'format)
- (string? (cadr form)))
+ (string? (cadr form))) ; (format "s")
(lint-format "please include the port argument to format, perhaps ~A" caller `(format () ,@(cdr form))))
- (if (any? (lambda (arg)
- (and (string? arg)
- (or (string-position "ERROR" arg)
- (string-position "WARNING" arg))))
- (cdr form))
+ (if (any? all-caps-warning (cdr form))
(lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
- (if (and (eq? (cadr form) 't)
+ (if (and (eq? (cadr form) 't) ; (format t " ")
(not (var-member 't env)))
(lint-format "'t in ~A should probably be #t" caller (truncated-list->string form)))
@@ -7183,15 +7388,15 @@
(let ((ndirs (count-directives control-string caller form))
(nargs (if (list? args) (length args) 0)))
(let ((pos (char-position #\null control-string)))
- (if (and pos (< pos (length control-string)))
+ (if (and pos (< pos (length control-string))) ; (format #f "~a\x00b" x)
(lint-format "#\\null in a format control string will confuse both lint and format: ~S in ~A" caller control-string form)))
(if (not (or (= ndirs nargs)
(tree-memq 'values form)))
- (lint-format "~A has ~A arguments: ~A"
+ (lint-format "~A has ~A arguments: ~A" ; (format #f "~nT" 1 2)
caller head
(if (> ndirs nargs) "too few" "too many")
(truncated-list->string form))
- (if (and (not (cadr form))
+ (if (and (not (cadr form)) ; (format #f "123")
(zero? ndirs)
(not (char-position #\~ control-string)))
(lint-format "~A could be ~S, (format is a no-op here)" caller (truncated-list->string form) (caddr form))))))
@@ -7202,7 +7407,7 @@
(if (pair? a)
(case (car a)
((number->string)
- (if (null? (cddr a))
+ (if (null? (cddr a)) ; (format #f "~A" (number->string x))
(lint-format "format arg ~A could be ~A" caller a (cadr a))
(if (and (pair? (cddr a))
(integer? (caddr a))
@@ -7213,28 +7418,24 @@
(case (caddr a) ((2) "B") ((8) "O") (else "X"))
(cadr a))))))
- ((symbol->string)
+ ((symbol->string) ; (format #f "~A" (symbol->string 'x))
(lint-format "format arg ~A could be ~A" caller a (cadr a)))
- ((make-string)
+ ((make-string) ; (format #f "~A" (make-string len c))
(lint-format "format arg ~A could use the format directive ~~NC and change the argument to ... ~A ~A ..." caller a
(cadr a) (if (char? (caddr a)) (format #f "~W" (caddr a)) (caddr a))))
- ((string-append)
+ ((string-append) ; (format #f "~A" (string-append x y))
(lint-format "format appends strings, so ~A seems wasteful" caller a)))))
args)))))
- (hash-table-set! h 'format sp-format))
+ (hash-special 'format sp-format))
;; ---------------- error ----------------
- (hash-table-set!
- h 'error
- (lambda (caller head form env)
- (if (any? (lambda (arg)
- (and (string? arg)
- (or (string-position "ERROR" arg)
- (string-position "WARNING" arg))))
- (cdr form))
- (lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))))
+ (let ()
+ (define (sp-error caller head form env)
+ (if (any? all-caps-warning (cdr form))
+ (lint-format "There's no need to shout: ~A" caller (truncated-list->string form))))
+ (hash-special 'error sp-error))
;; ---------------- sort! ----------------
(let ()
@@ -7248,9 +7449,9 @@
(if (and (pair? sig)
(not (eq? 'boolean? (car sig)))
(not (and (pair? (car sig))
- (memq 'boolean? (car sig)))))
+ (memq 'boolean? (car sig))))) ; (sort! x abs)
(lint-format "~A is a questionable sort! function" caller func))))))))
- (hash-table-set! h 'sort! sp-sort))
+ (hash-special 'sort! sp-sort))
;; ---------------- substring ----------------
(let ()
@@ -7258,14 +7459,14 @@
(if (every? code-constant? (cdr form))
(catch #t
(lambda ()
- (let ((val (eval form)))
+ (let ((val (eval form))) ; (substring "abracadabra" 2 7) -> "racad"
(lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
(lambda (type info)
(lint-format "~A -> ~A" caller (truncated-list->string form) (apply format #f info))))
(let ((str (cadr form)))
- (when (string? str) ; (substring "++++++" 0 2) -> (make-string 2 #\+)
+ (when (string? str) ; (substring "++++++" 0 2) -> (make-string 2 #\+)
(let ((len (length str)))
(when (and (> len 0)
(string=? str (make-string len (string-ref str 0))))
@@ -7281,7 +7482,7 @@
`(make-string ,chars ,(string-ref str 0))))))))
(when (pair? (cddr form))
(when (null? (cdddr form))
- (when (and (pair? str)
+ (when (and (pair? str) ; (substring (substring x 1) 2) -> (substring x 3)
(eq? (car str) 'substring)
(null? (cdddr str)))
(lint-format "perhaps ~A" caller
@@ -7292,12 +7493,12 @@
`(substring ,(cadr str) (+ ,(caddr str) ,(caddr form)))))))
;; end indices are complicated -- since this rarely happens, not worth the trouble
- (if (eqv? (caddr form) 0)
+ (if (eqv? (caddr form) 0) ; (substring x 0) -> (copy x)
(lint-format "perhaps clearer: ~A" caller (lists->string form `(copy ,str)))))
(when (pair? (cdddr form))
(let ((end (cadddr form)))
- (if (equal? (caddr form) end)
+ (if (equal? (caddr form) end) ; (substring x (+ y 1) (+ y 1)) is ""
(lint-format "leaving aside errors, ~A is \"\"" caller form))
(when (and (pair? str)
@@ -7305,13 +7506,13 @@
(eq? (car str) 'string-append)
(= (length str) 3))
(let ((in-arg2 (caddr str)))
- (if (and (pair? in-arg2)
+ (if (and (pair? in-arg2) ; (substring (string-append str (make-string len #\space)) 0 len) -> (copy str (make-string len #\space))
(eq? (car in-arg2) 'make-string)
(equal? (cadddr form) (cadr in-arg2)))
(lint-format "perhaps ~A" caller
(lists->string form `(copy ,(cadr str) (make-string ,(cadddr form) ,(caddr in-arg2))))))))
- (if (and (pair? end) ; (substring x start (length|string-length x)) -> (substring s start)
+ (if (and (pair? end) ; (substring x start (length|string-length x)) -> (substring s start)
(memq (car end) '(string-length length))
(equal? (cadr end) str))
(lint-format "perhaps ~A" caller (lists->string form (copy form (make-list 3))))
@@ -7322,11 +7523,11 @@
(equal? `(string-length ,str) (var-initial-value v))
(not (any? (lambda (p)
(set!? p env))
- (var-history v))))
+ (var-history v)))) ; if len is still (string-length x), (substring x 1 len) -> (substring x 1)
(lint-format "perhaps, if ~A is still ~A, ~A" caller end (var-initial-value v)
(lists->string form (copy form (make-list 3))))))))))))))
- (hash-table-set! h 'substring sp-substring))
+ (hash-special 'substring sp-substring))
;; ---------------- list, *vector ----------------
(let ((seq-maker (lambda (seq)
@@ -7345,25 +7546,24 @@
(let ((len (length form))
(val (and (pair? (cdr form))
(cadr form))))
- (when (and (> len 2)
+ (when (and (> len 4)
(every? (lambda (a) (equal? a val)) (cddr form)))
- (if (code-constant? val)
- (if (> len 4)
- (lint-format "perhaps ~A~A" caller
- (lists->string form
- (if (eqv? (seq-default head) val)
- `(,(seq-maker head) ,(- len 1))
- `(,(seq-maker head) ,(- len 1) ,val)))
- (if (and (sequence? val)
- (not (null? val)))
- (format #f "~%~NCor wrap (copy ~S) in a function and call that ~A times"
- lint-left-margin #\space
- val (- len 1))
- "")))
+ (if (code-constant? val) ; (vector 12 12 12 12 12 12) -> (make-vector 6 12)
+ (lint-format "perhaps ~A~A" caller
+ (lists->string form
+ (if (eqv? (seq-default head) val)
+ `(,(seq-maker head) ,(- len 1))
+ `(,(seq-maker head) ,(- len 1) ,val)))
+ (if (and (sequence? val)
+ (not (null? val)))
+ (format #f "~%~NCor wrap (copy ~S) in a function and call that ~A times"
+ lint-left-margin #\space
+ val (- len 1))
+ ""))
(if (pair? val)
(if (or (side-effect? val env)
- (memq (car val) makers))
- (if (> (tree-leaves val) 2)
+ (hash-table-ref makers (car val)))
+ (if (> (tree-leaves val) 3)
;; I think we need to laboriously repeat the function call here:
;; (let ((a 1) (b 2) (c 3))
;; (define f (let ((ctr 0)) (lambda (x y z) (set! ctr (+ ctr 1)) (+ x y ctr (* 2 z)))))
@@ -7376,31 +7576,31 @@
`(let ((_1_ (lambda () ,val)))
(,head ,@(make-list (- len 1) '(_1_)))))))
;; if seq copy else
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (vector (car x) (car x) (car x) (car x)) -> (make-vector 4 (car x))
(lists->string form `(,(seq-maker head) ,(- len 1) ,val)))))))))
- (for-each (lambda (f) (hash-table-set! h f sp-list)) '(list vector int-vector float-vector byte-vector)))
+ (for-each (lambda (f) (hash-special f sp-list)) '(list vector int-vector float-vector byte-vector)))
;; ---------------- list-tail ----------------
(let ()
(define (sp-list-tail caller head form env)
(if (= (length form) 3)
- (if (eqv? (caddr form) 0)
+ (if (eqv? (caddr form) 0) ; (list-tail x 0) -> x
(lint-format "perhaps ~A" caller (lists->string form (cadr form)))
(if (and (pair? (cadr form))
(eq? (caadr form) 'list-tail))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (list-tail (list-tail x 1) 2) -> (list-tail x 3)
(lists->string form
(if (and (integer? (caddr form))
(integer? (caddr (cadr form))))
`(list-tail ,(cadadr form) ,(+ (caddr (cadr form)) (caddr form)))
`(list-tail ,(cadadr form) (+ ,(caddr (cadr form)) ,(caddr form))))))))))
- (hash-table-set! h 'list-tail sp-list-tail))
+ (hash-special 'list-tail sp-list-tail))
;; ---------------- eq? ----------------
(let ()
(define (sp-eq? caller head form env)
- (if (< (length form) 3)
+ (if (< (length form) 3) ; (eq?)
(lint-format "eq? needs 2 arguments: ~A" caller (truncated-list->string form))
(let* ((arg1 (cadr form))
(arg2 (caddr form))
@@ -7413,10 +7613,10 @@
(eval-constant-expression caller form)
(if (or (eq? (car eq1) 'equal?)
- (eq? (car eq2) 'equal?))
+ (eq? (car eq2) 'equal?)) ; (eq? #(0) #(0))
(lint-format "eq? should be equal?~A in ~S" caller (if specific-op (format #f " or ~A" specific-op) "") form)
(if (or (eq? (car eq1) 'eqv?)
- (eq? (car eq2) 'eqv?))
+ (eq? (car eq2) 'eqv?)) ; (eq? x 1.5)
(lint-format "eq? should be eqv?~A in ~S" caller (if specific-op (format #f " or ~A" specific-op) "") form)))
(let ((expr 'unset))
@@ -7448,9 +7648,9 @@
(eq? (return-type (car arg1) env) 'boolean?))
(set! expr arg1)))
- (if (not (eq? expr 'unset))
+ (if (not (eq? expr 'unset)) ; (eq? x '()) -> (null? x)
(lint-format "perhaps ~A" caller (lists->string form expr)))))))
- (hash-table-set! h 'eq? sp-eq?))
+ (hash-special 'eq? sp-eq?))
;; ---------------- eqv? equal? ----------------
(let ()
@@ -7472,7 +7672,7 @@
(eval-constant-expression caller form)
(if (or (useless-copy? arg1)
- (useless-copy? arg2))
+ (useless-copy? arg2)) ; (equal? (vector-copy #(a b c)) #(a b c)) -> (equal? #(a b c) #(a b c))
(lint-format "perhaps ~A" caller
(lists->string form
`(,head ,(if (useless-copy? arg1) (cadr arg1) arg1)
@@ -7481,17 +7681,17 @@
(= (length (cadr form)) 1))
(let ((s2 (caddr form)))
(if (pair? s2)
- (if (eq? (car s2) 'string)
+ (if (eq? (car s2) 'string) ; (equal? "[" (string r)) -> (char=? #\[ r)
(lint-format "perhaps ~A" caller
(lists->string form `(char=? ,(string-ref (cadr form) 0) ,(cadr s2))))
(if (and (eq? (car s2) 'substring)
- (= (length s2) 4)
+ (= (length s2) 4) ; (equal? "^" (substring s 0 1)) -> (char=? #\^ (string-ref s 0))
(eqv? (list-ref s2 2) 0)
(eqv? (list-ref s2 3) 1))
(lint-format "perhaps ~A" caller
(lists->string form `(char=? ,(string-ref (cadr form) 0) (string-ref ,(cadr s2) 0)))))))))
- (if (and (not (eq? (cadr eq1) (cadr eq2)))
+ (if (and (not (eq? (cadr eq1) (cadr eq2))) ; (eqv? ":" (string-ref s 0))
(memq (cadr eq1) '(char=? string=?))
(memq (cadr eq2) '(char=? string=?)))
(lint-format "this can't be right: ~A" caller form))
@@ -7502,7 +7702,7 @@
(cond ((or (eq? (car eq1) 'equal?)
(eq? (car eq2) 'equal?))
(if (eq? head 'equal?)
- (if specific-op
+ (if specific-op ; equal? could be string=? in (equal? (string x) (string-append y z))
(lint-format "~A could be ~A in ~S" caller head specific-op form))
(lint-format "~A should be equal?~A in ~S" caller head
(if specific-op (format #f " or ~A" specific-op) "")
@@ -7511,7 +7711,7 @@
((or (eq? (car eq1) 'eqv?)
(eq? (car eq2) 'eqv?))
(if (eq? head 'eqv?)
- (if specific-op
+ (if specific-op ; (eqv? (integer->char x) #\null)
(lint-format "~A could be ~A in ~S" caller head specific-op form))
(lint-format "~A ~A be eqv?~A in ~S" caller head
(if (eq? head 'eq?) "should" "could")
@@ -7521,29 +7721,29 @@
((not (or (eq? (car eq1) 'eq?)
(eq? (car eq2) 'eq?))))
- ((not (and arg1 arg2))
+ ((not (and arg1 arg2)) ; (eqv? x #f) -> (not x)
(lint-format "~A could be not: ~A" caller head (lists->string form `(not ,(or arg1 arg2)))))
((or (any-null? arg1)
- (any-null? arg2))
+ (any-null? arg2)) ; (eqv? x ()) -> (null? x)
(lint-format "~A could be null?: ~A" caller head
(lists->string form
(if (any-null? arg1)
`(null? ,arg2)
`(null? ,arg1)))))
- (else
+ (else ; (eqv? x 'a)
(lint-format "~A could be eq?~A in ~S" caller head
(if specific-op (format #f " or ~A" specific-op) "")
form))))))
- (hash-table-set! h 'eqv? sp-eqv?)
- (hash-table-set! h 'equal? sp-eqv?))
+ (hash-special 'eqv? sp-eqv?)
+ (hash-special 'equal? sp-eqv?))
;; ---------------- map for-each ----------------
(let ()
(define (sp-map caller head form env)
(let* ((len (length form))
(args (- len 2)))
- (if (< len 3)
+ (if (< len 3) ; (map (lambda (v) (vector-ref v 0)))
(lint-format "~A missing argument~A in: ~A"
caller head
(if (= len 2) "" "s")
@@ -7552,7 +7752,7 @@
(ary #f))
;; if zero or one args, the map/for-each is either a no-op or a function call
- (if (any? any-null? (cddr form))
+ (if (any? any-null? (cddr form)) ; (map abs ())
(lint-format "this ~A has no effect (null arg)" caller (truncated-list->string form))
(if (and (not (tree-memq 'values form)) ; e.g. flatten in s7.html
(any? (lambda (p)
@@ -7566,7 +7766,7 @@
((cons)
(any-null? (caddr p)))
(else #f))))
- (cddr form)))
+ (cddr form))) ; (for-each display (list a)) -> (display a)
(lint-format "perhaps ~A" caller
(lists->string form
(let ((args (map (lambda (a)
@@ -7597,7 +7797,7 @@
(and (eq? (caaddr form) 'list)
(every? code-constant? (cdaddr form)))))
(catch #t
- (lambda ()
+ (lambda () ; (map symbol->string '(a b c d)) -> '("a" "b" "c" "d")
(let ((val (eval form)))
(lint-format "perhaps ~A" caller (lists->string form (list 'quote val)))))
(lambda args #f))))
@@ -7621,11 +7821,11 @@
(lists->string form
`(make-list (abs (length ,(caddr form))) ,(car body)))))))))
(if (pair? ary)
- (if (< args (car ary))
+ (if (< args (car ary)) ; (map (lambda (a b) a) '(1 2))
(lint-format "~A has too few arguments in: ~A"
caller head
(truncated-list->string form))
- (if (> args (cdr ary))
+ (if (> args (cdr ary)) ; (map abs '(1 2) '(3 4))
(lint-format "~A has too many arguments in: ~A"
caller head
(truncated-list->string form)))))
@@ -7633,7 +7833,7 @@
(lambda (obj)
(if (and (pair? obj)
(memq (car obj) '(vector->list string->list let->list)))
- (lint-format* caller
+ (lint-format* caller ; (vector->list #(1 2)) could be simplified to: #(1 2)
(truncated-list->string obj)
" could be simplified to: "
(truncated-list->string (cadr obj))
@@ -7642,11 +7842,11 @@
(when (eq? head 'map)
(when (and (memq func '(char-downcase char-upcase))
- (pair? (caddr form))
+ (pair? (caddr form)) ; (map char-downcase (string->list str)) -> (string->list (string-downcase str))
(eq? (caaddr form) 'string->list))
(lint-format "perhaps ~A" caller (lists->string form `(string->list (,(if (eq? func 'char-upcase) 'string-upcase 'string-downcase)
,(cadr (caddr form)))))))
- (when (identity? func) ; to check f here as var is more work
+ (when (identity? func) ; to check f here as var is more work ; (map (lambda (x) x) lst) -> lst
(lint-format "perhaps ~A" caller (lists->string form (caddr form)))))
(let ((arg1 (caddr form)))
@@ -7658,7 +7858,7 @@
(let ((string-case (eq? (caadr arg1) 'string->list))
(len-diff (if (eq? (car arg1) 'list-tail)
(caddr arg1)
- (cdr-count (car arg1)))))
+ (cdr-count (car arg1))))) ; (cdr (vector->list v)) -> (make-shared-vector v (- (length v) 1) 1)
(lint-format "~A accepts ~A arguments, so perhaps ~A" caller head
(if string-case 'string 'vector)
(lists->string arg1 (if string-case
@@ -7667,7 +7867,7 @@
(when (and (eq? head 'for-each)
(pair? (cadr form))
(eq? (caadr form) 'lambda)
- (pair? (cdadr form))
+ (pair? (cdadr form)) ; (for-each (lambda (x) (+ (abs x) 1)) lst)
(not (any? (lambda (x) (side-effect? x env)) (cddadr form))))
(lint-format "pointless for-each: ~A" caller (truncated-list->string form)))
@@ -7676,7 +7876,7 @@
(when (pair? seq)
(case (car seq)
- ((cons)
+ ((cons) ; (for-each display (cons msgs " "))
(if (and (pair? (cdr seq))
(pair? (cddr seq))
(code-constant? (caddr seq)))
@@ -7689,9 +7889,8 @@
(let* ((seq-func (cadr seq))
(arg-name (find-unique-name func seq-func)))
- (if (symbol? func)
+ (if (symbol? func) ; (map f (map g h)) -> (map (lambda (_1_) (f (g _1_))) h) -- dubious
(if (symbol? seq-func)
- ;; (map f (map g h)) -> (map (lambda (x) (f (g x))) h) -- dubious...
(lint-format "perhaps ~A" caller
(lists->string form `(,head (lambda (,arg-name)
(,func (,seq-func ,arg-name)))
@@ -7717,7 +7916,7 @@
(caadr func) (cddr func)))
,(caddr seq)))))))))))))
;; repetitive code...
- (when (eq? head 'for-each) ; args = 1 above
+ (when (eq? head 'for-each) ; args = 1 above ; (for-each display (list a)) -> (format () "~A" a)
(let ((func (cadr form)))
(if (memq func '(display write newline write-char write-string))
(lint-format "perhaps ~A" caller
@@ -7771,49 +7970,44 @@
(gather-format (display->format d)))
body)
- (when (= arg-ctr 1)
+ (when (= arg-ctr 1) ; (for-each (lambda (x) (display x)) args) -> (format () "~{~A~}" args)
(lint-format "perhaps ~A" caller
(lists->string form `(format ,op ,(string-append "~{" ctrl-string "~}") ,seq)))))))))
)))))))))
(for-each (lambda (f)
- (hash-table-set! h f sp-map))
+ (hash-special f sp-map))
'(map for-each)))
;; ---------------- magnitude ----------------
- (hash-table-set!
- h 'magnitude
- (lambda (caller head form env)
- (if (and (= (length form) 2)
- (memq (->lint-type (cadr form)) '(integer? rational? real?)))
- (lint-format "perhaps use abs here: ~A" caller form))))
-
- ;; (hash-table-set! h 'modulo (lambda (caller head form env) (format *stderr* "~A~%" form)))
- ;; (modulo (- 512 (modulo offset 512)) 512)
- ;; (modulo (char->integer (string-ref seed j)) 255)
-
+ (let ()
+ (define (sp-magnitude caller head form env)
+ (if (and (= (length form) 2) ; (magnitude 2/3)
+ (memq (->lint-type (cadr form)) '(integer? rational? real?)))
+ (lint-format "perhaps use abs here: ~A" caller form)))
+ (hash-special 'magnitude sp-magnitude))
;; ---------------- open-input-file open-output-file ----------------
(let ()
(define (sp-open-input-file caller head form env)
(if (and (pair? (cdr form))
(pair? (cddr form))
- (string? (caddr form))
+ (string? (caddr form)) ; (open-output-file x "fb+")
(not (memv (string-ref (caddr form) 0) '(#\r #\w #\a)))) ; b + then e m c x if gcc
(lint-format "unexpected mode: ~A" caller form)))
(for-each (lambda (f)
- (hash-table-set! h f sp-open-input-file))
+ (hash-special f sp-open-input-file))
'(open-input-file open-output-file)))
;; ---------------- values ----------------
(let ()
(define (sp-values caller head form env)
(cond ((member 'values (cdr form) (lambda (a b)
- (and (pair? b)
+ (and (pair? b) ; (values 2 (values 3 4) 5) -> (values 2 3 4 5)
(eq? (car b) 'values))))
(lint-format "perhaps ~A" caller (lists->string form `(values ,@(splice-if (lambda (x) (eq? x 'values)) (cdr form))))))
((= (length form) 2)
(lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; (values ({list} 'x ({apply_values} y))) -> (cons 'x y)
(if (and (pair? (cadr form))
(eq? (caadr form) #_{list})
(not (qq-tree? (cadr form))))
@@ -7826,14 +8020,14 @@
(qq-tree? a)))
(cdr form))))
(lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; (values ({list} 'x y) a) -> (values (list 'x y) a)
`(values ,@(map (lambda (a)
(if (and (pair? a)
(eq? (car a) #_{list}))
(un_{list} a)
a))
(cdr form))))))))
- (hash-table-set! h 'values sp-values))
+ (hash-special 'values sp-values))
;; ---------------- call-with-values ----------------
(let ()
@@ -7863,23 +8057,23 @@
(truncated-list->string producer)
((if (> (car consumed-values) (car produced-values)) car cadr) produced-values)))))
- (cond ((not (pair? producer))
+ (cond ((not (pair? producer)) ; (call-with-values log c)
(if (and (symbol? producer)
(not (memq (return-type producer ()) '(#t #f values))))
(lint-format "~A does not return multiple values" caller producer)
(lint-format "perhaps ~A" caller (lists->string form `(,consumer (,producer))))))
- ((not (eq? (car producer) 'lambda))
+ ((not (eq? (car producer) 'lambda)) ; (call-with-values (eval p env) (eval c env)) -> ((eval c env) ((eval p env)))
(lint-format "perhaps ~A" caller (lists->string form `(,consumer (,producer)))))
- ((pair? (cadr producer))
+ ((pair? (cadr producer)) ; (call-with-values (lambda (x) 0) list)
(lint-format "~A requires too many arguments" caller (truncated-list->string producer)))
- ((symbol? (cadr producer))
+ ((symbol? (cadr producer)) ; (call-with-values (lambda x 0) list)
(lint-format "~A's parameter ~A will always be ()" caller (truncated-list->string producer) (cadr producer)))
- ((and (pair? (cddr producer))
- (null? (cdddr producer)))
+ ((and (pair? (cddr producer)) ; (call-with-values (lambda () (read-char p)) cons)
+ (null? (cdddr producer))) ; (call-with-values (lambda () (values 1 2 3)) list) -> (list 1 2 3)
(let ((body (caddr producer)))
(if (or (code-constant? body)
(and (pair? body)
@@ -7894,7 +8088,7 @@
`(,consumer ,body)))))))
(else (lint-format "perhaps ~A" caller (lists->string form `(,consumer (,producer)))))))))
- (hash-table-set! h 'call-with-values sp-call/values))
+ (hash-special 'call-with-values sp-call/values))
;; ---------------- multiple-value-bind ----------------
(let ()
@@ -7914,7 +8108,7 @@
`(begin , at body)))))
(unless (symbol? vars) ; else any number of values is ok
- (let ((vals (mv-range producer env))
+ (let ((vals (mv-range producer env)) ; (multiple-value-bind (a b) (values 1 2 3) b)
(args (length vars)))
(if (and (pair? vals)
(not (<= (car vals) args (cadr vals))))
@@ -7923,7 +8117,7 @@
(truncated-list->string producer)
((if (< args (car vals)) car cadr) vals)))
- (if (and (pair? producer)
+ (if (and (pair? producer) ; (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))
(symbol? (car producer))
(not (memq (return-type (car producer) ()) '(#t #f values))))
(lint-format "~A does not return multiple values" caller (car producer))
@@ -7936,7 +8130,7 @@
(equal? (arity (symbol->value (caar body))) (cons args args)))
`(,(caar body) ,producer)
`((lambda ,vars , at body) ,producer)))))))))))
- (hash-table-set! h 'multiple-value-bind sp-mvb))
+ (hash-special 'multiple-value-bind sp-mvb))
;; ---------------- let-values ----------------
(let ()
@@ -7947,13 +8141,13 @@
(let ((call (caadr form)))
(if (and (pair? call)
(pair? (cdr call)))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (let-values (((x) (values 1))) x) -> ((lambda (x) x) (values 1))
(lists->string form
`((lambda ,(car call)
,@(cddr form))
,(cadr call))))))
(if (every? pair? (cadr form))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) ...
(lists->string
form
`(with-let
@@ -7966,16 +8160,15 @@
,(cadr v)))
(cadr form))))
,@(cddr form))))))))
- (hash-table-set! h 'let-values sp-let-values))
+ (hash-special 'let-values sp-let-values))
;; ---------------- let*-values ----------------
- (hash-table-set!
- h 'let*-values
+ (hash-special 'let*-values
(lambda (caller head form env)
(if (and (pair? (cdr form))
(pair? (cadr form)))
(lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; (let*-values (((a) (f x))) (+ a b)) -> (let ((a (f x))) (+ a b))
(let loop ((var-data (cadr form)))
(let ((v (car var-data)))
(if (and (pair? (car v)) ; just one var
@@ -7988,14 +8181,13 @@
`((lambda ,(car v) ,(loop (cdr var-data))) ,(cadr v)))))))))))
;; ---------------- define-values ----------------
- (hash-table-set!
- h 'define-values
+ (hash-special 'define-values
(lambda (caller head form env)
(when (pair? (cdr form))
(if (null? (cadr form))
(lint-format "~A is pointless" caller (truncated-list->string form))
(when (pair? (cddr form))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (define-values (x y) (values 3 2)) -> (varlet (curlet) ((lambda (x y) (curlet)) (values 3 2)))
(cond ((symbol? (cadr form))
(lists->string form `(define ,(cadr form) (list ,(caddr form)))))
@@ -8017,30 +8209,30 @@
((2)
(let ((arg (cadr form)))
(if (not (pair? arg))
- (if (not (symbol? arg))
+ (if (not (symbol? arg)) ; (eval 32)
(lint-format "this eval is pointless; perhaps ~A" caller (lists->string form arg)))
(case (car arg)
- ((quote)
+ ((quote) ; (eval 'x)
(lint-format "perhaps ~A" caller (lists->string form (cadr arg))))
- ((string->symbol)
+ ((string->symbol) ; (eval (string->symbol "x")) -> x
(if (string? (cadr arg))
(lint-format "perhaps ~A" caller (lists->string form (string->symbol (cadr arg))))))
((with-input-from-string call-with-input-string)
- (if (and (pair? (cdr arg))
+ (if (and (pair? (cdr arg)) ; (eval (call-with-input-string port read)) -> (eval-string port)
(pair? (cddr arg))
(eq? (caddr arg) 'read))
(lint-format "perhaps ~A" caller (lists->string form `(eval-string ,(cadr arg))))))
((read)
- (if (and (= (length arg) 2)
+ (if (and (= (length arg) 2) ; (eval (read (open-input-string expr))) -> (eval-string expr)
(pair? (cadr arg))
(eq? (caadr arg) 'open-input-string))
(lint-format "perhaps ~A" caller (lists->string form `(eval-string ,(cadadr arg))))))
((list)
- (if (every? (lambda (p)
+ (if (every? (lambda (p) ; (eval (list '* 2 x)) -> (* 2 (eval x))
(or (symbol? p)
(code-constant? p)))
(cdr arg))
@@ -8059,12 +8251,12 @@
(e (caddr form)))
(if (and (pair? arg)
(eq? (car arg) 'quote))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (eval 'x env) -> (env 'x)
(lists->string form
(if (symbol? (cadr arg))
`(,e ,arg)
`(with-let ,e ,@(unbegin (cadr arg)))))))))))
- (hash-table-set! h 'eval sp-eval))
+ (hash-special 'eval sp-eval))
;; ---------------- fill! etc ----------------
(let ()
@@ -8072,36 +8264,47 @@
(if (= (length form) 5)
(check-start-and-end caller head (cdddr form) form env)))
(for-each (lambda (f)
- (hash-table-set! h f sp-fill!))
+ (hash-special f sp-fill!))
'(fill! string-fill! list-fill! vector-fill!)))
;; ---------------- write-string ----------------
- (hash-table-set!
- h 'write-string
- (lambda (caller head form env)
- (if (= (length form) 4)
- (check-start-and-end caller 'write-string (cddr form) form env))))
+ (let ()
+ (define (sp-write-string caller head form env)
+ (cond ((= (length form) 4)
+ (check-start-and-end caller 'write-string (cddr form) form env))
+ ((and (pair? (cdr form))
+ (pair? (cddr form))
+ (pair? (caddr form))
+ (eq? (caaddr form) 'current-output-port))
+ (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form))
+ ((equal? (cadr form) (string #\newline))
+ (lint-format "perhaps ~A" caller (lists->string form `(newline ,@(cddr form)))))))
+ (hash-special 'write-string sp-write-string))
;; ---------------- read-line ----------------
- (hash-table-set!
- h 'read-line
- (lambda (caller head form env)
+ (let ()
+ (define (sp-read-line caller head form env)
(if (and (= (length form) 3)
(code-constant? (caddr form))
- (not (boolean? (caddr form))))
- (lint-format "the third argument should be boolean (#f=default, #t=include trailing newline): ~A" caller form))))
-
+ (not (boolean? (caddr form)))) ; (read-line in-port 'concat)
+ (lint-format "the third argument should be boolean (#f=default, #t=include trailing newline): ~A" caller form)
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (eq? (caadr form) 'current-input-port))
+ (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form))))
+ (hash-special 'read-line sp-read-line))
+
;; ---------------- string-length ----------------
(let ()
(define (sp-string-length caller head form env)
(when (= (length form) 2)
- (if (string? (cadr form))
+ (if (string? (cadr form)) ; (string-length "asdf") -> 4
(lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (string-length (cadr form)))
- (if (and (pair? (cadr form))
+ (if (and (pair? (cadr form)) ; (string-length (make-string 3)) -> 3
(eq? (caadr form) 'make-string))
(lint-format "perhaps ~A" caller (lists->string form (cadadr form)))))))
- (hash-table-set! h 'string-length sp-string-length))
+ (hash-special 'string-length sp-string-length))
;; ---------------- vector-length ----------------
(let ()
@@ -8111,11 +8314,11 @@
(lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (vector-length (cadr form)))
(let ((arg (cadr form)))
(if (pair? arg)
- (if (eq? (car arg) 'make-vector)
+ (if (eq? (car arg) 'make-vector) ; (vector-length (make-vector 10)) -> 10
(lint-format "perhaps ~A" caller (lists->string form (cadr arg)))
(if (memq (car arg) '(copy vector-copy))
(lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; (vector-length (vector-copy arr start end)) -> (- end start)
(if (null? (cddr arg))
`(vector-length ,(cadr arg))
(if (eq? (car arg) 'copy)
@@ -8125,7 +8328,7 @@
`(vector-length ,(cadr arg))
(cadddr arg))))
`(- ,end ,start)))))))))))))
- (hash-table-set! h 'vector-length sp-vector-length))
+ (hash-special 'vector-length sp-vector-length))
;; ---------------- dynamic-wind ----------------
(let ()
@@ -8148,7 +8351,7 @@
(set! empty 1))
(unless (side-effect? last-expr env)
(if (null? (cdddr init))
- (set! empty 1))
+ (set! empty 1)) ; (dynamic-wind (lambda () (s7-version)) (lambda () (list)) (lambda () #f))
(lint-format "this could be omitted: ~A in ~A" caller last-expr init))))))
(if (and (pair? body)
@@ -8170,14 +8373,13 @@
(if (null? (cdddr end))
(set! empty (+ empty 1)))
(lint-format "this could be omitted: ~A in ~A" caller last-expr end)))
- (if (= empty 2)
+ (if (= empty 2) ; (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)) -> #()
(lint-format "this dynamic-wind is pointless, ~A" caller
(lists->string form (if (null? (cdddr body)) (caddr body) `(begin ,@(cddr body))))))))))))
- (hash-table-set! h 'dynamic-wind sp-dw))
+ (hash-special 'dynamic-wind sp-dw))
;; ---------------- *s7* ----------------
- (hash-table-set!
- h '*s7*
+ (hash-special '*s7*
(let ((s7-fields (let ((h (make-hash-table)))
(for-each (lambda (f)
(hash-table-set! h f #t))
@@ -8193,13 +8395,12 @@
(let ((arg (cadr form)))
(if (and (pair? arg)
(eq? (car arg) 'quote)
- (symbol? (cadr arg))
+ (symbol? (cadr arg)) ; (*s7* 'vector-print-length)
(not (hash-table-ref s7-fields (cadr arg))))
(lint-format "unknown *s7* field: ~A" caller arg)))))))
;; ---------------- throw ----------------
- (hash-table-set!
- h 'throw
+ (hash-special 'throw
(lambda (caller head form env)
(if (pair? (cdr form))
(let* ((tag (cadr form))
@@ -8208,12 +8409,11 @@
(lint-format "~A tag ~S is unreliable (catch uses eq? to match tags)" caller 'throw tag))))))
;; ---------------- make-hash-table ----------------
- (hash-table-set!
- h 'make-hash-table
+ (hash-special 'make-hash-table
(lambda (caller head form env)
(if (= (length form) 3)
(let ((func (caddr form)))
- (if (and (symbol? func)
+ (if (and (symbol? func) ; (make-hash-table eq? symbol-hash)
(not (memq func '(eq? eqv? equal? morally-equal? char=? char-ci=? string=? string-ci=? =))))
(lint-format "make-hash-table function, ~A, is not a hash function" caller func))))))
@@ -8224,22 +8424,32 @@
(procedure-with-setter? . dilambda?)
(make-random-state . random-state))))
- (define (sp-deprecate caller head form env)
+ (define (sp-deprecate caller head form env) ; (make-random-state 123 432)
(lint-format "~A is deprecated; use ~A" caller head (cond ((assq head deprecated-ops) => cdr))))
(for-each (lambda (op)
- (hash-table-set! h (car op) sp-deprecate))
+ (hash-special (car op) sp-deprecate))
deprecated-ops))
;; ---------------- eq null eqv equal ----------------
(let ()
(define (sp-null caller head form env)
- (if (not (var-member head env))
+ (if (not (var-member head env)) ; (if (null (cdr x)) 0)
(lint-format "misspelled '~A? in ~A?" caller head form)))
(for-each (lambda (f)
- (hash-table-set! h f sp-null))
+ (hash-special f sp-null))
'(null eq eqv equal))) ; (null (cdr...))
+ ;; ---------------- set-car set-cdr list-set vector-set string-set ----------------
+ (let ()
+ (define (sp-set caller head form env)
+ (if (not (var-member head env)) ; (list-set x 1 y)
+ (lint-format "misspelled '~A! in ~A?" caller head form)))
+ (for-each (lambda (f)
+ (hash-special f sp-set))
+ '(set-car set-cdr list-set vector-set string-set)))
+ ;; set and sort occur a million times, but aren't interesting
+
;; ---------------- string-index ----------------
(let ()
(define (sp-string-index caller head form env)
@@ -8250,9 +8460,9 @@
(let ((sig (arg-signature (caddr form) env)))
(and (pair? sig)
(eq? (car sig) 'char?)))))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (string-index path #\/) -> (char-position #\/ path)
(lists->string form `(char-position ,(caddr form) ,(cadr form) ,@(cdddr form))))))
- (hash-table-set! h 'string-index sp-string-index))
+ (hash-special 'string-index sp-string-index))
;; ---------------- cons* ----------------
(let ()
@@ -8261,16 +8471,16 @@
(case (length form)
((2) (lint-format "perhaps ~A" caller (lists->string form (cadr form))))
((3) (lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; cons* x y) -> (cons x y)
(if (any-null? (caddr form))
`(list ,(cadr form))
`(cons ,@(cdr form))))))
((4) (lint-format "perhaps ~A" caller
- (lists->string form
+ (lists->string form ; (cons* (symbol->string v) " | " (w)) -> (cons (symbol->string v) (cons " | " (w)))
(if (any-null? (cadddr form))
`(list ,(cadr form) ,(caddr form))
`(cons ,(cadr form) (cons ,@(cddr form))))))))))
- (hash-table-set! h 'cons* sp-cons*))
+ (hash-special 'cons* sp-cons*))
;; ---------------- the-environment etc ----------------
(let ((other-names '((the-environment . curlet)
@@ -8315,6 +8525,7 @@
(hashtable? . hash-table?) ; Bigloo
(hashtable-size . hash-table-entries)
(hashtable-get . hash-table-ref)
+ (hashtable-set! . hash-table-set!)
(hashtable-put! . hash-table-set!)
(hash-for-each . for-each)
(exact-integer? . integer?)
@@ -8333,17 +8544,16 @@
(define (sp-other-names caller head form env)
(if (not (var-member head env))
- (let ((counts (hash-table-ref other-names-counts head)))
- (when (< (or counts 0) 2)
- (hash-table-set! other-names-counts head (+ (or counts 0) 1))
+ (let ((counts (or (hash-table-ref other-names-counts head) 0)))
+ (when (< counts 2)
+ (hash-table-set! other-names-counts head (+ counts 1))
(lint-format "~A is probably ~A in s7" caller head (cdr (assq head other-names)))))))
(for-each (lambda (f)
- (hash-table-set! h (car f) sp-other-names))
+ (hash-special (car f) sp-other-names))
other-names))
- (hash-table-set!
- h '1+
+ (hash-special '1+
(lambda (caller head form env)
(if (not (var-member '1+ env))
(lint-format "perhaps ~A" caller (lists->string form `(+ ,(cadr form) 1))))))
@@ -8353,30 +8563,27 @@
(if (not (var-member '-1+ env))
(lint-format "perhaps ~A" caller (lists->string form `(- ,(cadr form) 1)))))
- (hash-table-set! h '-1+ sp-1-)
- (hash-table-set! h '1- sp-1-))
+ (hash-special '-1+ sp-1-)
+ (hash-special '1- sp-1-))
;; ---------------- push! pop! ----------------
- (hash-table-set!
- h 'push!
+ (hash-special 'push!
(lambda (caller head form env) ; not predefined
(if (= (length form) 3)
(set-set (caddr form) caller form env))))
- (hash-table-set!
- h 'pop!
+ (hash-special 'pop!
(lambda (caller head form env) ; also not predefined
(if (= (length form) 2)
(set-set (cadr form) caller form env))))
;; ---------------- receive ----------------
- (hash-table-set!
- h 'receive
+ (hash-special 'receive
(lambda (caller head form env) ; this definition comes from Guile
(if (and (> (length form) 3)
(not (var-member 'receive env)))
- ((hash-table-ref h 'call-with-values)
+ ((hash-table-ref special-case-table 'call-with-values)
caller 'call-with-values
`(call-with-values
(lambda () ,(caddr form))
@@ -8384,40 +8591,42 @@
env))))
;; ---------------- and=> ----------------
- (hash-table-set!
- h 'and=>
- (lambda (caller head form env)
+ (hash-special 'and=>
+ (lambda (caller head form env) ; (and=> (ref w k) v) -> (cond ((ref w k) => v) (else #f))
(when (and (= (length form) 3)
(not (var-member 'and=> env)))
(lint-format "perhaps ~A" caller (lists->string form `(cond (,(cadr form) => ,(caddr form)) (else #f)))))))
;; ---------------- and-let* ----------------
- (hash-table-set!
- h 'and-let*
- (lambda (caller head form env)
- (when (and (> (length form) 2)
- (not (var-member 'and-let* env)))
- (let loop ((bindings (cadr form)))
- (cond ((pair? bindings)
- (if (binding-ok? caller 'and-let* (car bindings) env #f)
- (loop (cdr bindings))))
- ((not (null? bindings))
- (lint-format "~A variable list is not a proper list? ~S" caller 'and-let* bindings))
- ((and (pair? (cadr form)) ; (and-let* ((x (f y))) (abs x)) -> (cond ((f y) => abs))
- (null? (cdadr form))
- (pair? (cddr form)))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (if (and (null? (cdddr form))
- (pair? (caddr form))
- (pair? (cdaddr form))
- (null? (cddr (caddr form)))
- (eq? (caaadr form) (cadr (caddr form))))
- `(cond (,(cadar (cadr form)) => ,(caaddr form)))
- `(cond (,(cadar (cadr form)) => (lambda (,(caaadr form)) ,@(cddr form)))))))))))))
- h))
-
+ (let ()
+ (define (sp-and-let caller head form env)
+ (when (and (> (length form) 2)
+ (not (var-member 'and-let* env)))
+ (let loop ((bindings (cadr form)))
+ (cond ((pair? bindings)
+ (if (binding-ok? caller 'and-let* (car bindings) env #f)
+ (loop (cdr bindings))))
+ ((not (null? bindings))
+ (lint-format "~A variable list is not a proper list? ~S" caller 'and-let* bindings))
+ ((and (pair? (cadr form)) ; (and-let* ((x (f y))) (abs x)) -> (cond ((f y) => abs))
+ (null? (cdadr form))
+ (pair? (cddr form)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form ; (and-let* ((x (f y))) (abs x)) -> (cond ((f y) => abs))
+ (if (and (null? (cdddr form))
+ (pair? (caddr form))
+ (pair? (cdaddr form))
+ (null? (cddr (caddr form)))
+ (eq? (caaadr form) (cadr (caddr form))))
+ `(cond (,(cadar (cadr form)) => ,(caaddr form)))
+ `(cond (,(cadar (cadr form)) => (lambda (,(caaadr form)) ,@(cddr form))))))))))))
+ (hash-special 'and-let* sp-and-let))
+
+ special-case-table))
+ ;; end special-case-functions
+ ;; ----------------------------------------
+
(define (unused-parameter? x) #t)
(define (unused-set-parameter? x) #t)
@@ -8458,31 +8667,32 @@
(pair? (cddr form)))
(format #f "~D " argn)
""))
- (let ((op (if (and (eq? checker 'real?)
- (eq? uop 'number?))
- 'complex?
- uop)))
- (if (and (or arg (not (eq? checker 'output-port?)))
+ (when (and (or arg (not (eq? checker 'output-port?)))
(not (and (eq? checker 'string?)
(pair? arg)
- (eq? (car arg) 'format))) ; don't try to untangle the format non-string case
+ (eq? (car arg) 'format)
+ (not (null? (cadr arg))))) ; other case involves a symbol that is an output-port
(not (and (pair? arg)
(eq? (car arg) 'length)))) ; same for length
- (if (and (pair? op)
- (member checker op any-compatible?))
- (if (and *report-sloppy-assoc*
- (not (var-member :catch env)))
- (lint-format* caller
- (string-append "in " (truncated-list->string form) ", ")
- (string-append (symbol->string head) "'s argument " (prettify-arg-number arg-number))
- (string-append "should be " (prettify-checker-unq checker) ", ")
- (string-append "but " (truncated-list->string arg) " might also be "
- (object->string (car (remove-if (lambda (o) (any-compatible? checker o)) op))))))
- (lint-format* caller
- (string-append "in " (truncated-list->string form) ", ")
- (string-append (symbol->string head) "'s argument " (prettify-arg-number arg-number))
- (string-append "should be " (prettify-checker-unq checker) ", ")
- (string-append "but " (truncated-list->string arg) " is " (prettify-checker op)))))))
+ (let ((op (if (and (eq? checker 'real?)
+ (eq? uop 'number?))
+ 'complex?
+ uop)))
+ (if (and (pair? op)
+ (member checker op any-compatible?))
+ (if (and *report-sloppy-assoc*
+ (not (var-member :catch env)))
+ (lint-format* caller ; (round (char-position #\a "asb"))
+ (string-append "in " (truncated-list->string form) ", ")
+ (string-append (symbol->string head) "'s argument " (prettify-arg-number arg-number))
+ (string-append "should be " (prettify-checker-unq checker) ", ")
+ (string-append "but " (truncated-list->string arg) " might also be "
+ (object->string (car (remove-if (lambda (o) (any-compatible? checker o)) op))))))
+ (lint-format* caller ; (string-ref (char-position #\a "asb") 1)
+ (string-append "in " (truncated-list->string form) ", ")
+ (string-append (symbol->string head) "'s argument " (prettify-arg-number arg-number))
+ (string-append "should be " (prettify-checker-unq checker) ", ")
+ (string-append "but " (truncated-list->string arg) " is " (prettify-checker op)))))))
(when *report-func-as-arg-arity-mismatch*
(let ((v (var-member head env)))
@@ -8639,7 +8849,7 @@
(pair? (car arg)))
(let ((rtn (return-type (caar arg) env)))
(if (memq rtn '(boolean? real? integer? rational? number? complex? float? keyword? symbol? null? char?))
- (lint-format* caller
+ (lint-format* caller ; (cons ((pair? x) 2) y)
(string-append (symbol->string head) "'s argument ")
(string-append (truncated-list->string arg) " looks odd: ")
(string-append (object->string (caar arg)) " returns " (symbol->string rtn))
@@ -8649,12 +8859,12 @@
(symbol? checker)) ; otherwise ignore type check on this argument (#t -> anything goes)
(if arg
(if (eq? checker 'unused-parameter?)
- (lint-format* caller
+ (lint-format* caller ; (define (f5 a . b) a) (f5 1 2)
(string-append (symbol->string head) "'s parameter " (number->string arg-number))
" is not used, but a value is passed: "
(truncated-list->string arg))
(if (eq? checker 'unused-set-parameter?)
- (lint-format* caller
+ (lint-format* caller ; (define (f21 x y) (set! x 3) (+ y 1)) (f21 (+ z 1) z)
(string-append (symbol->string head) "'s parameter " (number->string arg-number))
"'s value is not used, but a value is passed: "
(truncated-list->string arg)))))
@@ -8741,13 +8951,13 @@
(when (and (pair? (cdr arg))
(pair? (cadr arg))
(eq? (caadr arg) 'lambda))
- (let ((f (cadr arg)))
- (when (and (pair? (cdr f))
- (pair? (cadr f))
- (symbol? (caadr f))
- (null? (cdadr f)))
+ (let ((f (cdadr arg)))
+ (when (and (pair? f)
+ (pair? (car f))
+ (symbol? (caar f))
+ (null? (cdar f)))
(define c-walk
- (let ((rtn (caadr f)))
+ (let ((rtn (caar f)))
(lambda (tree)
(if (pair? tree)
(if (eq? (car tree) rtn)
@@ -8755,7 +8965,7 @@
(begin
(c-walk (car tree))
(for-each (lambda (x) (if (pair? x) (c-walk x))) (cdr tree))))))))
- (for-each c-walk (cddr f))))))
+ (for-each c-walk (cdr f))))))
((values)
(cond ((not (positive? (length arg))))
@@ -8822,7 +9032,7 @@
h)))
(lambda (caller form vals env)
(define (report-trouble)
- (lint-format* caller
+ (lint-format* caller ; (let ((x (read-byte)) (y (read-byte))) (- x y))
(string-append "order of evaluation of " (object->string (car form)) "'s ")
(string-append (if (memq (car form) '(let letrec do)) "bindings" "arguments") " is unspecified, ")
(string-append "so " (truncated-list->string form) " is trouble")))
@@ -8954,8 +9164,9 @@
(if (pair? vals)
(set! call-args (+ call-args -1 (cadr vals)))))))))
(cdr form))
- (if (and (< call-args req)
- (not (tree-memq 'values (cdr form))))
+ (if (not (or (>= call-args req)
+ (tree-memq 'values (cdr form))
+ (tree-memq 'dilambda (fdata 'initial-value))))
(lint-format "~A needs ~D argument~A: ~A"
caller head
req (if (> req 1) "s" "")
@@ -9165,787 +9376,617 @@
(if (eq? name (var-name (car e1)))
lst
(cons (car e1) lst)))))
-
- (define (report-usage caller head vars env)
- ;; report unused or set-but-unreferenced variables, then look at the overall history
-
- (define (all-types-agree v)
- (let ((base-type (->lint-type (var-initial-value v)))
- (vname (var-name v)))
- (and (every? (lambda (p)
- (or (not (and (pair? p)
- (eq? (car p) 'set!)
- (eq? vname (cadr p))))
- (let ((nt (->lint-type (caddr p))))
- (or (subsumes? base-type nt)
- (and (subsumes? nt base-type)
- (set! base-type nt))
- (and (memq nt '(pair? null? proper-list?))
- (memq base-type '(pair? null? proper-list?))
- (set! base-type 'list?))))))
- (var-history v))
- base-type)))
-
- (when (and (not (eq? head 'begin)) ; begin can redefine = set a variable
- (pair? vars)
- (proper-list? vars))
- (do ((cur vars (cdr cur))
- (rst (cdr vars) (cdr rst)))
- ((null? rst))
- (let ((vn (var-name (car cur))))
- (if (not (memq vn '(:lambda :dilambda)))
- (let ((repeat (var-member vn rst)))
- (when repeat
- (let ((type (if (eq? (var-definer repeat) 'parameter) 'parameter 'variable)))
- (if (eq? (var-definer (car cur)) 'define)
- (lint-format "~A ~A ~A is redefined ~A" caller head type vn
- (if (equal? head "")
- (if (not (tree-memq vn (var-initial-value (car cur))))
- "at the top level."
- (format #f "at the top level. Perhaps use set! instead: ~A"
- (truncated-list->string `(set! ,vn ,(var-initial-value (car cur))))))
- (format #f "in the ~A body. Perhaps use set! instead: ~A"
- head (truncated-list->string `(set! ,vn ,(var-initial-value (car cur)))))))
- (lint-format "~A ~A ~A is declared twice" caller head type vn)))))))))
-
- (let ((old-line-number line-number))
-
- (for-each
- (lambda (local-var)
- (let ((vname (var-name local-var))
- (otype (if (eq? (var-definer local-var) 'parameter) 'parameter 'variable)))
-
- ;; translate to dilambda fixing arg if necessary and mention generic set!
- (let ((init (var-initial-value local-var)))
- (when (and (pair? init)
- (eq? (car init) 'define)
- (pair? (cadr init)))
- (let* ((vstr (symbol->string vname))
- (len (length vstr)))
- (when (> len 4)
- (let ((setv #f)
- (newv #f))
- (if (string=? (substring vstr 0 4) "get-")
- (let ((sv (symbol "set-" (substring vstr 4))))
- (set! setv (or (var-member sv vars)
- (var-member sv env)))
- (set! newv (string->symbol (substring vstr 4))))
- (if (string=? (substring vstr (- len 4)) "-ref")
- (let ((sv (symbol (substring vstr 0 (- len 4)) "-set!")))
- (set! setv (or (var-member sv vars)
- (var-member sv env)))
- (set! newv (string->symbol (substring vstr 0 (- len 4)))))
- (let ((pos (string-position "-get-" vstr)))
- (when pos ; this doesn't happen very often, others: Get-, -ref-, -set!- are very rare
- (let ((sv (let ((s (copy vstr))) (set! (s (+ pos 1)) #\s) (string->symbol s))))
- (set! setv (or (var-member sv vars)
- (var-member sv env)))
- (set! newv (symbol (substring vstr 0 pos)
- (substring vstr (+ pos 4))))))))) ; +4 to include #\-
- (when (and setv
- (not (var-member newv vars))
- (not (var-member newv env)))
- (let ((getter init)
- (setter (var-initial-value setv)))
- (when (and (pair? setter)
- (eq? (car setter) 'define)
- (pair? (cadr setter)))
- (let ((getargs (cdadr getter))
- (setargs (cdadr setter)))
- (unless (null? setargs)
- (if (or (eq? newv getargs)
- (and (pair? getargs)
- (memq newv getargs)))
- (let ((unique (find-unique-name getter newv)))
- (set! getter (tree-subst unique newv getter))
- (set! getargs (cdadr getter))))
- (if (or (eq? newv setargs)
- (and (pair? setargs)
- (memq newv setargs)))
- (let ((unique (find-unique-name setter newv)))
- (set! setter (tree-subst unique newv setter))
- (set! setargs (cdadr setter))))
- (let ((getdots (if (null? getargs) "" " ..."))
- (setdots (if (or (not (pair? setargs)) (null? (cdr setargs))) "" " ..."))
- (setvalue (and (proper-list? setargs)
- (list-ref setargs (- (length setargs) 1)))))
- (if setvalue
- (format outport "~NC~A: perhaps use dilambda and generalized set! for ~A and ~A:~%~
+
+ (define report-usage
+ (let ((unwrap-cxr (hash-table '(caar car) '(cadr cdr) '(cddr cdr) '(cdar car)
+ '(caaar caar car) '(caadr cadr cdr) '(caddr cddr cdr) '(cdddr cddr cdr)
+ '(cdaar caar car) '(cddar cdar car) '(cadar cadr car) '(cdadr cadr cdr)
+ '(cadddr cdddr cddr cdr) '(cddddr cdddr cddr cdr) '(caaaar caaar caar car) '(caaadr caadr cadr cdr)
+ '(caadar cadar cdar car) '(caaddr caddr cddr cdr) '(cadaar cdaar caar car) '(cadadr cdadr cadr cdr)
+ '(caddar cddar cdar car) '(cdaaar caaar caar car) '(cdaadr caadr cadr cdr) '(cdadar cadar cdar car)
+ '(cdaddr caddr cddr cdr) '(cddaar cdaar caar car) '(cddadr cdadr cadr cdr) '(cdddar cddar cdar car))))
+
+ (lambda (caller head vars env)
+ ;; report unused or set-but-unreferenced variables, then look at the overall history
+ ;; vars used before defined are kind of a mess -- history has #f for the (unknown) enclosing form
+ ;; and any definition wipes out the accumulated pre-def uses -- this should be by closed-body and
+ ;; ignore local defines (i.e. really only define[x] propagates backwards) -- changing this is
+ ;; tricky (fools current unused func arg + value message for example).
+
+ (define (all-types-agree v)
+ (let ((base-type (->lint-type (var-initial-value v)))
+ (vname (var-name v)))
+ (let ((typef (lambda (p)
+ (or (not (and (pair? p)
+ (eq? (car p) 'set!)
+ (eq? vname (cadr p))))
+ (let ((nt (->lint-type (caddr p))))
+ (or (subsumes? base-type nt)
+ (and (subsumes? nt base-type)
+ (set! base-type nt))
+ (and (memq nt '(pair? null? proper-list?))
+ (memq base-type '(pair? null? proper-list?))
+ (set! base-type 'list?))))))))
+ (and (every? typef (var-history v))
+ base-type))))
+
+ (when (and (not (eq? head 'begin)) ; begin can redefine = set a variable
+ (pair? vars)
+ (proper-list? vars))
+ (do ((cur vars (cdr cur))
+ (rst (cdr vars) (cdr rst)))
+ ((null? rst))
+ (let ((vn (var-name (car cur))))
+ (if (not (memq vn '(:lambda :dilambda)))
+ (let ((repeat (var-member vn rst)))
+ (when repeat
+ (let ((type (if (eq? (var-definer repeat) 'parameter) 'parameter 'variable)))
+ (if (eq? (var-definer (car cur)) 'define)
+ (lint-format "~A ~A ~A is redefined ~A" caller head type vn
+ (if (equal? head "")
+ (if (not (tree-memq vn (var-initial-value (car cur))))
+ "at the top level."
+ (format #f "at the top level. Perhaps use set! instead: ~A"
+ (truncated-list->string `(set! ,vn ,(var-initial-value (car cur))))))
+ (format #f "in the ~A body. Perhaps use set! instead: ~A"
+ head (truncated-list->string `(set! ,vn ,(var-initial-value (car cur)))))))
+ (lint-format "~A ~A ~A is declared twice" caller head type vn)))))))))
+
+ (let ((old-line-number line-number)
+ (outer-form (cond ((var-member :let env) => var-initial-value) (else #f))))
+
+ (for-each
+ (lambda (local-var)
+ (let ((vname (var-name local-var))
+ (otype (if (eq? (var-definer local-var) 'parameter) 'parameter 'variable)))
+
+ ;; (let ((x 0)...) ... (set! x 1)...) -> move the set! value to let init value
+ ;; car body as set! is handled in let-walker etc
+ (when (and (pair? outer-form)
+ (positive? (var-set local-var))
+ (memq (car outer-form) '(let let*))
+ (list? (cadr outer-form))
+ (not (side-effect? (var-initial-value local-var) env)))
+ (let ((nxt (let ((len (length (var-history local-var))))
+ (and (> len 1)
+ (list-ref (var-history local-var) (- len 2))))))
+ (when (and (pair? nxt)
+ (eq? (car nxt) 'set!)
+ (eq? (cadr nxt) vname)
+ (code-constant? (caddr nxt)) ; so vname is not involved etc
+ (not (tree-memq vname (caddr outer-form))) ; not redundant with next -- need to exclude this case
+ (let ((f (member vname (cdddr outer-form) tree-memq)))
+ (and (pair? f)
+ (eq? (car f) nxt))))
+ (lint-format "perhaps change ~A's initial value to ~A, and remove ~A in ~A" caller
+ vname (caddr nxt) nxt (truncated-list->string outer-form)))))
+
+ ;; if's possible for an unused function to have ref=1, null cdr history, but it appears to
+ ;; always involve curlet exports and the like.
+
+ ;; do all refs to an unset var go through the same function (at some level)
+ (when (and (zero? (var-set local-var))
+ (> (var-ref local-var) 1))
+ (let ((hist (var-history local-var)))
+ (when (and (pair? hist)
+ (pair? outer-form) ; if outer-form is #f, local-var is probably a top-level var
+ (not (and (memq (car outer-form) '(let let*)) ; not a named-let parameter
+ (symbol? (cadr outer-form)))))
+ (let ((first (car hist))) ; all but the initial binding have to match this
+ (when (pair? first)
+ (let ((op (car first)))
+ (when (and (symbol? op)
+ (not (eq? op 'unquote))
+ (not (hash-table-ref makers op))
+ (not (eq? vname op)) ; not a function (this kind if repetition is handled elsewhere)
+ (pair? (cdr hist))
+ (pair? (cddr hist))
+ (pair? (cdr first))
+ (not (side-effect? first env))
+ (every? (lambda (a)
+ (or (eq? a vname)
+ (code-constant? a)))
+ (cdr first))
+ (or (code-constant? (var-initial-value local-var))
+ (= (tree-count1 vname first 0) 1))
+ (every? (lambda (a)
+ (and (pair? a)
+ (or (equal? first a)
+ (and (eq? (hash-table-ref reversibles (car first)) (car a))
+ (equal? (cdr first) (reverse (cdr a))))
+ (set! op (match-cxr op (car a))))))
+ (if (eq? otype 'parameter)
+ (cdr hist)
+ (copy (cdr hist) (make-list (- (length hist) 2))))))
+ (let* ((new-op (or op (car first)))
+ (set-target (let walker ((tree outer-form)) ; check for new-op dilambda as target of set!
+ (and (pair? tree)
+ (or (and (eq? (car tree) 'set!)
+ (pair? (cdr tree))
+ (pair? (cadr tree))
+ (eq? (caadr tree) new-op))
+ (walker (car tree))
+ (walker (cdr tree)))))))
+ (unless set-target
+ (if (eq? otype 'parameter)
+ (if (> (var-ref local-var) 2)
+ (lint-format "parameter ~A is always accessed (~A times) via ~S" caller
+ vname (var-ref local-var) `(,new-op ,@(cdr first))))
+ (lint-format* caller
+ (symbol->string vname)
+ " is not set, and is always accessed via "
+ (object->string `(,new-op ,@(cdr first)))
+ " so its binding could probably be "
+ ;; "probably" here because the accesses could have hidden protective assumptions
+ ;; i.e. full accessor is not valid at point of let binding
+ (object->string `(,vname (,new-op ,@(tree-subst (var-initial-value local-var) vname (cdr first)))))
+ " in "
+ (truncated-list->string outer-form))))))))))))
+
+ ;; translate to dilambda fixing arg if necessary and mention generic set!
+ (let ((init (var-initial-value local-var)))
+ (when (and (pair? init)
+ (eq? (car init) 'define)
+ (pair? (cadr init)))
+ (let* ((vstr (symbol->string vname))
+ (len (length vstr)))
+ (when (> len 4)
+ (let ((setv #f)
+ (newv #f))
+ (if (string=? (substring vstr 0 4) "get-")
+ (let ((sv (symbol "set-" (substring vstr 4))))
+ (set! setv (or (var-member sv vars)
+ (var-member sv env)))
+ (set! newv (string->symbol (substring vstr 4))))
+ (if (string=? (substring vstr (- len 4)) "-ref")
+ (let ((sv (symbol (substring vstr 0 (- len 4)) "-set!")))
+ (set! setv (or (var-member sv vars)
+ (var-member sv env)))
+ (set! newv (string->symbol (substring vstr 0 (- len 4)))))
+ (let ((pos (string-position "-get-" vstr)))
+ (when pos ; this doesn't happen very often, others: Get-, -ref-, -set!- are very rare
+ (let ((sv (let ((s (copy vstr))) (set! (s (+ pos 1)) #\s) (string->symbol s))))
+ (set! setv (or (var-member sv vars)
+ (var-member sv env)))
+ (set! newv (symbol (substring vstr 0 pos)
+ (substring vstr (+ pos 4))))))))) ; +4 to include #\-
+ (when (and setv
+ (not (var-member newv vars))
+ (not (var-member newv env)))
+ (let ((getter init)
+ (setter (var-initial-value setv)))
+ (when (and (pair? setter)
+ (eq? (car setter) 'define)
+ (pair? (cadr setter)))
+ (let ((getargs (cdadr getter))
+ (setargs (cdadr setter)))
+ (unless (null? setargs)
+ (if (or (eq? newv getargs)
+ (and (pair? getargs)
+ (memq newv getargs)))
+ (let ((unique (find-unique-name getter newv)))
+ (set! getter (tree-subst unique newv getter))
+ (set! getargs (cdadr getter))))
+ (if (or (eq? newv setargs)
+ (and (pair? setargs)
+ (memq newv setargs)))
+ (let ((unique (find-unique-name setter newv)))
+ (set! setter (tree-subst unique newv setter))
+ (set! setargs (cdadr setter))))
+ (let ((getdots (if (null? getargs) "" " ..."))
+ (setdots (if (or (not (pair? setargs)) (null? (cdr setargs))) "" " ..."))
+ (setvalue (and (proper-list? setargs)
+ (list-ref setargs (- (length setargs) 1)))))
+ (if setvalue
+ (format outport "~NC~A: perhaps use dilambda and generalized set! for ~A and ~A:~%~
~NCreplace (~A~A) with (~A~A) and (~A~A ~A) with (set! (~A~A) ~A)~%~
~NC~A~%"
- lint-left-margin #\space
- caller
- vname (var-name setv)
- (+ lint-left-margin 4) #\space
- vname getdots newv getdots
- (var-name setv) setdots setvalue
- newv setdots setvalue
- (+ lint-left-margin 4) #\space
- (lint-pp `(define ,newv (dilambda
- (lambda ,getargs ,@(cddr getter))
- (lambda ,setargs ,@(cddr setter))))))))))))))))))
- ;; bad variable names
- (cond ((hash-table-ref syntaces vname)
- (lint-format "~A ~A named ~A is asking for trouble" caller head otype vname))
-
- ((eq? vname 'l)
- (lint-format "\"l\" is a really bad variable name" caller))
-
- ((and *report-built-in-functions-used-as-variables*
- (hash-table-ref built-in-functions vname))
- (lint-format "~A ~A named ~A is asking for trouble" caller
- (if (and (pair? (var-scope local-var))
- (null? (cdr (var-scope local-var)))
- (symbol? (car (var-scope local-var))))
- (car (var-scope local-var))
- head)
- otype vname))
-
- (else (check-for-bad-variable-name caller vname)))
-
- (unless (memq vname '(:lambda :dilambda))
- (if (and (eq? otype 'variable)
- (or *report-unused-top-level-functions*
- (not (eq? caller top-level:))))
- (let ((scope (var-scope local-var))) ; might be #<undefined>?
- (if (pair? scope) (set! scope (remove vname scope)))
-
- (when (and (pair? scope)
- (null? (cdr scope))
- (symbol? (car scope))
- (not (var-member (car scope) (let search ((e env))
- (if (null? e)
- env
- (if (eq? (caar e) vname)
- e
- (search (cdr e))))))))
- (format outport "~NC~A~A is ~A only in ~A~%"
- lint-left-margin #\space
- (if (eq? caller top-level:)
- "top-level: "
- "")
- vname
- (if (memq (var-ftype local-var) '(define lambda define* lambda*)) "called" "used")
- (car scope)))))
-
- (if (and (eq? (var-ftype local-var) 'define-expansion)
- (not (eq? caller top-level:)))
- (format outport "~NCdefine-expansion for ~A is not at the top-level, so it is ignored~%"
- lint-left-margin #\space
- vname))
-
- (when (and *report-function-stuff*
- (memq (var-ftype local-var) '(define lambda define* lambda*))
- (pair? (caddr (var-initial-value local-var))))
- (let ((cur (hash-table-ref equable-closures (caaddr (var-initial-value local-var)))))
- (if (pair? cur)
- (hash-table-set! equable-closures (caaddr (var-initial-value local-var)) (remove local-var cur)))))
-
- ;; redundant vars are hard to find -- tons of false positives
-
- (if (zero? (var-ref local-var))
- (when (and (or (not (equal? head ""))
- *report-unused-top-level-functions*)
- (or *report-unused-parameters*
- (not (eq? otype 'parameter))))
- (if (positive? (var-set local-var))
- (let ((sets (map (lambda (call)
- (if (and (pair? call)
- (not (eq? (var-definer local-var) 'do))
- (eq? (car call) 'set!)
- (eq? (cadr call) vname))
- call
- (values)))
- (var-history local-var))))
- (if (pair? sets)
- (if (null? (cdr sets))
- (lint-format "~A set, but not used: ~A" caller
- vname (truncated-list->string (car sets)))
- (lint-format "~A set, but not used: ~{~S~^ ~}" caller
- vname sets))
- (lint-format "~A set, but not used: ~A from ~A" caller
- vname (truncated-list->string (var-initial-value local-var)) (var-definer local-var))))
+ lint-left-margin #\space
+ caller
+ vname (var-name setv)
+ (+ lint-left-margin 4) #\space
+ vname getdots newv getdots
+ (var-name setv) setdots setvalue
+ newv setdots setvalue
+ (+ lint-left-margin 4) #\space
+ (lint-pp `(define ,newv (dilambda
+ (lambda ,getargs ,@(cddr getter))
+ (lambda ,setargs ,@(cddr setter))))))))))))))))))
+ ;; bad variable names
+ (cond ((hash-table-ref syntaces vname)
+ (lint-format "~A ~A named ~A is asking for trouble" caller head otype vname))
- ;; not ref'd or set
- (if (not (memq vname '(documentation signature iterator? defanimal)))
- (let ((val (if (pair? (var-history local-var)) (car (var-history local-var)) (var-initial-value local-var)))
- (def (var-definer local-var)))
- (let-temporarily ((line-number (if (eq? caller top-level:) -1 line-number)))
- ;; eval confuses this message (eval '(+ x 1)), no other use of x [perhaps check :let initial-value = outer-form]
- ;; so does let-ref syntax: (apply (*e* 'g1)...) will miss this reference to g1
- (if (symbol? def)
- (if (eq? otype 'parameter)
- (lint-format "~A not used" caller vname)
- (lint-format* caller
- (string-append (object->string vname) " not used, initially: ")
- (string-append (truncated-list->string val) " from " (symbol->string def))))
- (lint-format* caller
- (string-append (object->string vname) " not used, value: ")
- (truncated-list->string val))))))))
- ;; not zero var-ref
- (let ((arg-type #f))
-
- (when (and (not (memq (var-definer local-var) '(parameter named-let named-let*)))
- (pair? (var-history local-var))
- (or (zero? (var-set local-var))
- (set! arg-type (all-types-agree local-var))))
- (let ((vtype (or arg-type ; this can't be #f unless no sets so despite appearances there's no contention here
- (eq? caller top-level:) ; might be a global var where init value is largely irrelevant
- (->lint-type (var-initial-value local-var))))
- (lit? (code-constant? (var-initial-value local-var))))
-
- (do ((clause (var-history local-var) (cdr clause)))
- ((null? (cdr clause))) ; ignore the initial value which depends on a different env
- (let ((call (car clause)))
- (if (pair? call) (set! line-number (pair-line-number call)))
-
- (when (pair? call)
- (let ((func (car call))
- (call-arg1 (and (pair? (cdr call)) (cadr call))))
-
- ;; check for assignments into constants
- (if (and lit?
- (indirect-set? vname func call-arg1))
- (lint-format "~A's value, ~A, is a literal constant, so this set! is trouble: ~A" caller
- vname (var-initial-value local-var) (truncated-list->string call)))
-
- (when (symbol? vtype)
- (when (and (not (eq? caller top-level:))
- (not (memq vtype '(boolean? #t values)))
- (memq func '(if when unless)) ; look for (if x ...) where x is never #f, this happens a dozen or so times
- (or (eq? (cadr call) vname)
- (and (pair? (cadr call))
- (eq? (caadr call) 'not)
- (eq? (cadadr call) vname))))
- (lint-format "~A is never #f, so ~A" caller
- vname
- (lists->string
- call
- (if (eq? vname (cadr call))
- (case func
- ((if) (caddr call))
- ((when) (if (pair? (cdddr call)) `(begin ,@(cddr call)) (caddr call)))
- ((unless) #<unspecified>))
- (case func
- ((if) (if (pair? (cdddr call)) (cadddr call)))
- ((when) #<unspecified>)
- ((unless) (if (pair? (cdddr call)) `(begin ,@(cddr call)) (caddr call))))))))
+ ((eq? vname 'l)
+ (lint-format "\"l\" is a really bad variable name" caller))
+
+ ((and *report-built-in-functions-used-as-variables*
+ (hash-table-ref built-in-functions vname))
+ (lint-format "~A ~A named ~A is asking for trouble" caller
+ (if (and (pair? (var-scope local-var))
+ (null? (cdr (var-scope local-var)))
+ (symbol? (car (var-scope local-var))))
+ (car (var-scope local-var))
+ head)
+ otype vname))
+
+ (else (check-for-bad-variable-name caller vname)))
+
+ (unless (memq vname '(:lambda :dilambda))
+ (if (and (eq? otype 'variable)
+ (or *report-unused-top-level-functions*
+ (not (eq? caller top-level:))))
+ (let ((scope (var-scope local-var))) ; might be #<undefined>?
+ (if (pair? scope) (set! scope (remove vname scope)))
+
+ (when (and (pair? scope)
+ (null? (cdr scope))
+ (symbol? (car scope))
+ (not (var-member (car scope) (let search ((e env))
+ (if (null? e)
+ env
+ (if (eq? (caar e) vname)
+ e
+ (search (cdr e))))))))
+ (format outport "~NC~A~A is ~A only in ~A~%"
+ lint-left-margin #\space
+ (if (eq? caller top-level:)
+ "top-level: "
+ "")
+ vname
+ (if (memq (var-ftype local-var) '(define lambda define* lambda*)) "called" "used")
+ (car scope)))))
+
+ (if (and (eq? (var-ftype local-var) 'define-expansion)
+ (not (eq? caller top-level:)))
+ (format outport "~NCdefine-expansion for ~A is not at the top-level, so it is ignored~%"
+ lint-left-margin #\space
+ vname))
+
+ ;; look for port opened but not closed
+ ;; (let ((p (open-output-file str))) (display 32 p) x)
+ (when (and (pair? outer-form)
+ (not (tree-memq vname (list-ref outer-form (- (length outer-form) 1))))) ; vname never returned from outer-form??
+ (let ((hist (var-history local-var))
+ (open-set '(open-input-string open-input-file open-output-string open-output-file))
+ (open-form #f))
+ (when (and (any? (lambda (tree)
+ (and (pair? tree)
+ (or (and (memq (car tree) open-set)
+ (pair? (cdr tree))
+ (not (memq vname (cdr tree))))
+ (and (eq? (car tree) 'set!)
+ (pair? (cdr tree))
+ (eq? (cadr tree) vname)
+ (pair? (cddr tree))
+ (pair? (caddr tree))
+ (memq (caaddr tree) open-set)))
+ (set! open-form tree)))
+ hist)
+ (not (tree-set-member '(close-input-port close-output-port close-port close current-output-port current-input-port) hist)))
+ (lint-format "in ~A~% perhaps ~A is opened via ~A, but never closed" caller
+ (truncated-list->string outer-form)
+ vname open-form))))
+
+ ;; redundant vars are hard to find -- tons of false positives
+
+ (if (zero? (var-ref local-var))
+ (when (and (or (not (equal? head ""))
+ *report-unused-top-level-functions*)
+ (or *report-unused-parameters*
+ (not (eq? otype 'parameter))))
+ (if (positive? (var-set local-var))
+ (let ((sets (map (lambda (call)
+ (if (and (pair? call)
+ (not (eq? (var-definer local-var) 'do))
+ (eq? (car call) 'set!)
+ (eq? (cadr call) vname))
+ call
+ (values)))
+ (var-history local-var))))
+ (if (pair? sets)
+ (if (null? (cdr sets))
+ (lint-format "~A set, but not used: ~A" caller
+ vname (truncated-list->string (car sets)))
+ (lint-format "~A set, but not used: ~{~S~^ ~}" caller
+ vname sets))
+ (lint-format "~A set, but not used: ~A from ~A" caller
+ vname (truncated-list->string (var-initial-value local-var)) (var-definer local-var))))
+
+ ;; not ref'd or set
+ (if (not (memq vname '(documentation signature iterator? defanimal)))
+ (let ((val (if (pair? (var-history local-var)) (car (var-history local-var)) (var-initial-value local-var)))
+ (def (var-definer local-var)))
+ (let-temporarily ((line-number (if (eq? caller top-level:) -1 line-number)))
+ ;; eval confuses this message (eval '(+ x 1)), no other use of x [perhaps check :let initial-value = outer-form]
+ ;; so does let-ref syntax: (apply (*e* 'g1)...) will miss this reference to g1
+ (if (symbol? def)
+ (if (eq? otype 'parameter)
+ (lint-format "~A not used" caller vname)
+ (lint-format* caller
+ (string-append (object->string vname) " not used, initially: ")
+ (string-append (truncated-list->string val) " from " (symbol->string def))))
+ (lint-format* caller
+ (string-append (object->string vname) " not used, value: ")
+ (truncated-list->string val))))))))
+ ;; not zero var-ref
+ (let ((arg-type #f))
+
+ (when (and (not (memq (var-definer local-var) '(parameter named-let named-let*)))
+ (pair? (var-history local-var))
+ (or (zero? (var-set local-var))
+ (set! arg-type (all-types-agree local-var))))
+ (let ((vtype (or arg-type ; this can't be #f unless no sets so despite appearances there's no contention here
+ (eq? caller top-level:) ; might be a global var where init value is largely irrelevant
+ (->lint-type (var-initial-value local-var))))
+ (lit? (code-constant? (var-initial-value local-var))))
+
+ (do ((clause (var-history local-var) (cdr clause)))
+ ((null? (cdr clause))) ; ignore the initial value which depends on a different env
+ (let ((call (car clause)))
+ (if (pair? call) (set! line-number (pair-line-number call)))
- ;; check for incorrect types in function calls
- (unless (memq vtype '(boolean? null?)) ; null? here avoids problems with macros that call set!
- (let ((p (memq vname (cdr call))))
- (when (pair? p)
- (let ((sig (arg-signature func env))
- (pos (- (length call) (length p))))
- (when (and (pair? sig)
- (< pos (length sig)))
- (let ((desired-type (list-ref sig pos)))
- (if (not (compatible? vtype desired-type))
- (lint-format "~A is ~A, but ~A in ~A wants ~A" caller
- vname (prettify-checker-unq vtype)
- func (truncated-list->string call)
- (prettify-checker desired-type))))))))
-
- (let ((suggest made-suggestion))
- ;; check for pointless vtype checks
- (when (and (hash-table-ref bools func)
- (not (eq? vname func)))
-
- (when (or (eq? vtype func)
- (and (compatible? vtype func)
- (not (subsumes? vtype func))))
- (lint-format "~A is ~A, so ~A is #t" caller vname (prettify-checker-unq vtype) call))
-
- (unless (compatible? vtype func)
- (lint-format "~A is ~A, so ~A is #f" caller vname (prettify-checker-unq vtype) call)))
+ (when (pair? call)
+ (let ((func (car call))
+ (call-arg1 (and (pair? (cdr call)) (cadr call))))
- (case func
- ;; need a way to mark exported variables so they won't be checked in this process
- ;; case can happen here, but it never seems to trigger a type error
- ((eq? eqv? equal?)
- ;; (and (pair? x) (eq? x #\a)) etc
- (when (or (and (code-constant? call-arg1)
- (not (compatible? vtype (->lint-type call-arg1))))
- (and (code-constant? (caddr call))
- (not (compatible? vtype (->lint-type (caddr call))))))
- (lint-format "~A is ~A, so ~A is #f" caller vname (prettify-checker-unq vtype) call)))
-
- ((and or)
- (when (let amidst? ((lst call))
- (and (pair? lst)
- (pair? (cdr lst))
- (or (eq? (car lst) vname)
- (amidst? (cdr lst))))) ; don't clobber possible trailing vname (returned by expression)
- (lint-format "~A is ~A, so ~A~%" caller ; (let ((x 1)) (and x (< x 1))) -> (< x 1)
- vname (prettify-checker-unq vtype)
- (lists->string call
- (simplify-boolean (remove vname call) () () vars)))))
- ((not)
- (if (eq? vname (cadr call))
- (lint-format "~A is ~A, so ~A" caller
- vname (prettify-checker-unq vtype)
- (lists->string call #f))))
-
- ((/) (if (and (number? (var-initial-value local-var))
- (zero? (var-initial-value local-var))
- (zero? (var-set local-var))
- (memq vname (cddr call)))
- (lint-format "~A is ~A, so ~A is an error" caller
- vname (var-initial-value local-var)
- call))))
+ ;; check for assignments into constants
+ (if (and lit?
+ (indirect-set? vname func call-arg1))
+ (lint-format "~A's value, ~A, is a literal constant, so this set! is trouble: ~A" caller
+ vname (var-initial-value local-var) (truncated-list->string call)))
- ;; the usual eqx confusion
- (when (and (= suggest made-suggestion)
- (memq vtype '(char? number? integer? real? float? rational? complex?)))
- (if (memq func '(eq? equal?))
- (lint-format "~A is ~A, so ~A ~A be eqv? in ~A" caller
- vname (prettify-checker-unq vtype) func
- (if (eq? func 'eq?) "should" "could")
- call))
- ;; check other boolean exprs
- (when (and (zero? (var-set local-var))
- (number? (var-initial-value local-var))
- (eq? vname call-arg1)
- (null? (cddr call))
- (hash-table-ref booleans func))
- (let ((val (catch #t
- (lambda ()
- ((symbol->value func (rootlet)) (var-initial-value local-var)))
- (lambda args
- 'error))))
- (if (boolean? val)
- (lint-format "~A is ~A, so ~A is ~A" caller vname (var-initial-value local-var) call val))))))
-
- ;; implicit index checks -- these are easily fooled by macros
- (when (and (memq vtype '(vector? float-vector? int-vector? string? list? byte-vector?))
- (pair? (cdr call)))
- (when (eq? func vname)
- (let ((init (var-initial-value local-var)))
- (if (not (compatible? 'integer? (->lint-type call-arg1)))
- (lint-format "~A is ~A, but the index ~A is ~A" caller
- vname (prettify-checker-unq vtype)
- call-arg1 (prettify-checker (->lint-type call-arg1))))
+ (when (symbol? vtype)
+ (when (and (not (eq? caller top-level:))
+ (not (memq vtype '(boolean? #t values)))
+ (memq func '(if when unless)) ; look for (if x ...) where x is never #f, this happens a dozen or so times
+ (or (eq? (cadr call) vname)
+ (and (pair? (cadr call))
+ (eq? (caadr call) 'not)
+ (eq? (cadadr call) vname))))
+ (lint-format "~A is never #f, so ~A" caller
+ vname
+ (lists->string
+ call
+ (if (eq? vname (cadr call))
+ (case func
+ ((if) (caddr call))
+ ((when) (if (pair? (cdddr call)) `(begin ,@(cddr call)) (caddr call)))
+ ((unless) #<unspecified>))
+ (case func
+ ((if) (if (pair? (cdddr call)) (cadddr call)))
+ ((when) #<unspecified>)
+ ((unless) (if (pair? (cdddr call)) `(begin ,@(cddr call)) (caddr call))))))))
+
+ ;; check for incorrect types in function calls
+ (unless (memq vtype '(boolean? null?)) ; null? here avoids problems with macros that call set!
+ (let ((p (memq vname (cdr call))))
+ (when (pair? p)
+ (let ((sig (arg-signature func env))
+ (pos (- (length call) (length p))))
+ (when (and (pair? sig)
+ (< pos (length sig)))
+ (let ((desired-type (list-ref sig pos)))
+ (if (not (compatible? vtype desired-type))
+ (lint-format "~A is ~A, but ~A in ~A wants ~A" caller
+ vname (prettify-checker-unq vtype)
+ func (truncated-list->string call)
+ (prettify-checker desired-type))))))))
- (if (integer? call-arg1)
- (if (negative? call-arg1)
- (lint-format "~A's index ~A is negative" caller vname call-arg1)
- (if (zero? (var-set local-var))
- (let ((lim (cond ((code-constant? init)
- (length init))
-
- ((memq (car init) '(vector float-vector int-vector string list byte-vector))
- (- (length init) 1))
-
- (else
- (and (pair? (cdr init))
- (integer? (cadr init))
- (memq (car init) '(make-vector make-float-vector make-int-vector
- make-string make-list make-byte-vector))
- (cadr init))))))
- (if (and (real? lim)
- (>= call-arg1 lim))
- (lint-format "~A has length ~A, but index is ~A" caller vname lim call-arg1))))))))
-
- (when (eq? func 'implicit-set)
- ;; ref is already checked in other history entries
- (let ((ref-type (case vtype
- ((float-vector?) 'real?) ; not 'float? because ints are ok here
- ((int-vector? byte-vector?) 'integer)
- ((string?) 'char?)
- (else #f))))
- (if ref-type
- (let ((val-type (->lint-type (caddr call))))
- (if (not (compatible? val-type ref-type))
- (lint-format "~A wants ~A, but the value in ~A is ~A" caller
- vname (prettify-checker-unq ref-type)
- `(set! ,@(cdr call))
- (prettify-checker val-type)))))
- ))))))
- ))) ; do loop through clauses
-
- ;; check for duplicated calls involving local-var
- (when (and (> (var-ref local-var) 8)
- (zero? (var-set local-var))
- (eq? (var-ftype local-var) #<undefined>))
- (let ((h (make-hash-table)))
- (for-each (lambda (call)
- (if (and (pair? call)
- (not (eq? (car call) vname)) ; ignore functions for now
- (not (side-effect? call env)))
- (hash-table-set! h call (+ 1 (or (hash-table-ref h call) 0)))))
- (var-history local-var))
- (let ((repeats ()))
- (for-each (lambda (call)
- (if (and (> (cdr call) (max 3 (/ 20 (tree-leaves (car call))))) ; was 5
- (not (memq (caar call) '(make-vector make-float-vector)))
- (or (null? (cddar call))
- (every? (lambda (p)
- (or (not (symbol? p))
- (eq? p vname)))
- (cdar call))))
- (set! repeats (cons (string-append (truncated-list->string (car call)) " occurs ")
- (cons (string-append (object->string (cdr call)) " times"
- (if (pair? repeats) ", " ""))
- repeats)))))
- h)
- (if (pair? repeats)
- (apply lint-format*
- caller
- (string-append (object->string vname) " is not set, but ")
- repeats)))))
-
- ;; check for function parameters whose values never change and are not just symbols
- (when (and (> (var-ref local-var) 3)
- (zero? (var-set local-var))
- (memq (var-ftype local-var) '(define lambda))
- (pair? (var-arglist local-var))
- (let loop ((calls (var-history local-var))) ; if func passed as arg, ignore it
- (or (null? calls)
- (null? (cdr calls))
- (and (pair? (car calls))
- (not (memq (var-name local-var) (cdar calls)))
- (loop (cdr calls))))))
- (let ((pars (map list (proper-list (var-arglist local-var)))))
- (do ((clauses (var-history local-var) (cdr clauses)))
- ((null? (cdr clauses))) ; ignore the initial value
- (if (and (pair? (car clauses))
- (eq? (caar clauses) (var-name local-var)))
- (for-each (lambda (arg par) ; collect all arguments for each parameter
- (if (not (member arg (cdr par))) ; we haven't seen this argument yet, so
- (set-cdr! par (cons arg (cdr par))))) ; add it to the list for this parameter
- (cdar clauses)
+ (let ((suggest made-suggestion))
+ ;; check for pointless vtype checks
+ (when (and (hash-table-ref bools func)
+ (not (eq? vname func)))
+
+ (when (or (eq? vtype func)
+ (and (compatible? vtype func)
+ (not (subsumes? vtype func))))
+ (lint-format "~A is ~A, so ~A is #t" caller vname (prettify-checker-unq vtype) call))
+
+ (unless (compatible? vtype func)
+ (lint-format "~A is ~A, so ~A is #f" caller vname (prettify-checker-unq vtype) call)))
+
+ (case func
+ ;; need a way to mark exported variables so they won't be checked in this process
+ ;; case can happen here, but it never seems to trigger a type error
+ ((eq? eqv? equal?)
+ ;; (and (pair? x) (eq? x #\a)) etc
+ (when (or (and (code-constant? call-arg1)
+ (not (compatible? vtype (->lint-type call-arg1))))
+ (and (code-constant? (caddr call))
+ (not (compatible? vtype (->lint-type (caddr call))))))
+ (lint-format "~A is ~A, so ~A is #f" caller vname (prettify-checker-unq vtype) call)))
+
+ ((and or)
+ (when (let amidst? ((lst call))
+ (and (pair? lst)
+ (pair? (cdr lst))
+ (or (eq? (car lst) vname)
+ (amidst? (cdr lst))))) ; don't clobber possible trailing vname (returned by expression)
+ (lint-format "~A is ~A, so ~A" caller ; (let ((x 1)) (and x (< x 1))) -> (< x 1)
+ vname (prettify-checker-unq vtype)
+ (lists->string call
+ (simplify-boolean (remove vname call) () () vars)))))
+ ((not)
+ (if (eq? vname (cadr call))
+ (lint-format "~A is ~A, so ~A" caller
+ vname (prettify-checker-unq vtype)
+ (lists->string call #f))))
+
+ ((/) (if (and (number? (var-initial-value local-var))
+ (zero? (var-initial-value local-var))
+ (zero? (var-set local-var))
+ (memq vname (cddr call)))
+ (lint-format "~A is ~A, so ~A is an error" caller
+ vname (var-initial-value local-var)
+ call))))
+
+ ;; the usual eqx confusion
+ (when (and (= suggest made-suggestion)
+ (memq vtype '(char? number? integer? real? float? rational? complex?)))
+ (if (memq func '(eq? equal?))
+ (lint-format "~A is ~A, so ~A ~A be eqv? in ~A" caller
+ vname (prettify-checker-unq vtype) func
+ (if (eq? func 'eq?) "should" "could")
+ call))
+ ;; check other boolean exprs
+ (when (and (zero? (var-set local-var))
+ (number? (var-initial-value local-var))
+ (eq? vname call-arg1)
+ (null? (cddr call))
+ (hash-table-ref booleans func))
+ (let ((val (catch #t
+ (lambda ()
+ ((symbol->value func (rootlet)) (var-initial-value local-var)))
+ (lambda args
+ 'error))))
+ (if (boolean? val)
+ (lint-format "~A is ~A, so ~A is ~A" caller vname (var-initial-value local-var) call val))))))
+
+ ;; implicit index checks -- these are easily fooled by macros
+ (when (and (memq vtype '(vector? float-vector? int-vector? string? list? byte-vector?))
+ (pair? (cdr call)))
+ (when (eq? func vname)
+ (let ((init (var-initial-value local-var)))
+ (if (not (compatible? 'integer? (->lint-type call-arg1)))
+ (lint-format "~A is ~A, but the index ~A is ~A" caller
+ vname (prettify-checker-unq vtype)
+ call-arg1 (prettify-checker (->lint-type call-arg1))))
+
+ (if (integer? call-arg1)
+ (if (negative? call-arg1)
+ (lint-format "~A's index ~A is negative" caller vname call-arg1)
+ (if (zero? (var-set local-var))
+ (let ((lim (cond ((code-constant? init)
+ (length init))
+
+ ((memq (car init) '(vector float-vector int-vector string list byte-vector))
+ (- (length init) 1))
+
+ (else
+ (and (pair? (cdr init))
+ (integer? (cadr init))
+ (memq (car init) '(make-vector make-float-vector make-int-vector
+ make-string make-list make-byte-vector))
+ (cadr init))))))
+ (if (and (real? lim)
+ (>= call-arg1 lim))
+ (lint-format "~A has length ~A, but index is ~A" caller vname lim call-arg1))))))))
+
+ (when (eq? func 'implicit-set)
+ ;; ref is already checked in other history entries
+ (let ((ref-type (case vtype
+ ((float-vector?) 'real?) ; not 'float? because ints are ok here
+ ((int-vector? byte-vector?) 'integer)
+ ((string?) 'char?)
+ (else #f))))
+ (if ref-type
+ (let ((val-type (->lint-type (caddr call))))
+ (if (not (compatible? val-type ref-type))
+ (lint-format "~A wants ~A, but the value in ~A is ~A" caller
+ vname (prettify-checker-unq ref-type)
+ `(set! ,@(cdr call))
+ (prettify-checker val-type)))))
+ ))))))
+ ))) ; do loop through clauses
+
+ ;; check for duplicated calls involving local-var
+ (when (and (> (var-ref local-var) 8)
+ (zero? (var-set local-var))
+ (eq? (var-ftype local-var) #<undefined>))
+ (let ((h (make-hash-table)))
+ (for-each (lambda (call)
+ (when (and (pair? call)
+ (not (eq? (car call) vname)) ; ignore functions for now
+ (not (side-effect? call env)))
+ (hash-table-set! h call (+ 1 (or (hash-table-ref h call) 0)))
+ (cond ((hash-table-ref unwrap-cxr (car call))
+ => (lambda (lst)
+ (for-each (lambda (c)
+ (hash-table-set! h (cons c (cdr call)) (+ 1 (or (hash-table-ref h (cons c (cdr call))) 0))))
+ lst))))))
+ (var-history local-var))
+ (let ((repeats ()))
+ (for-each (lambda (call)
+ (if (and (> (cdr call) (max 3 (/ 20 (tree-leaves (car call))))) ; was 5
+ (not (memq (caar call) '(make-vector make-float-vector)))
+ (or (null? (cddar call))
+ (every? (lambda (p)
+ (or (not (symbol? p))
+ (eq? p vname)))
+ (cdar call))))
+ (set! repeats (cons (string-append (truncated-list->string (car call)) " occurs ")
+ (cons (string-append (object->string (cdr call)) " times"
+ (if (pair? repeats) ", " ""))
+ repeats)))))
+ h)
+ (if (pair? repeats)
+ (apply lint-format*
+ caller
+ (string-append (object->string vname) " is not set, but ")
+ repeats)))))
+
+ ;; check for function parameters whose values never change and are not just symbols
+ (when (and (> (var-ref local-var) 3)
+ (zero? (var-set local-var))
+ (memq (var-ftype local-var) '(define lambda))
+ (pair? (var-arglist local-var))
+ (let loop ((calls (var-history local-var))) ; if func passed as arg, ignore it
+ (or (null? calls)
+ (null? (cdr calls))
+ (and (pair? (car calls))
+ (not (memq (var-name local-var) (cdar calls)))
+ (loop (cdr calls))))))
+ (let ((pars (map list (proper-list (var-arglist local-var)))))
+ (do ((clauses (var-history local-var) (cdr clauses)))
+ ((null? (cdr clauses))) ; ignore the initial value
+ (if (and (pair? (car clauses))
+ (eq? (caar clauses) (var-name local-var)))
+ (for-each (lambda (arg par) ; collect all arguments for each parameter
+ (if (not (member arg (cdr par))) ; we haven't seen this argument yet, so
+ (set-cdr! par (cons arg (cdr par))))) ; add it to the list for this parameter
+ (cdar clauses)
+ pars)))
+ (for-each (lambda (p)
+ (if (and (pair? (cdr p))
+ (null? (cddr p)) ; so all calls, this parameter has the same value
+ (not (symbol? (cadr p))))
+ (lint-format "~A's '~A parameter is always ~S (~D calls)" caller
+ (var-name local-var) (car p) (cadr p) (var-ref local-var))))
pars)))
- (for-each (lambda (p)
- (if (and (pair? (cdr p))
- (null? (cddr p)) ; so all calls, this parameter has the same value
- (not (symbol? (cadr p))))
- (lint-format "~A's '~A parameter is always ~S (~D calls)" caller
- (var-name local-var) (car p) (cadr p) (var-ref local-var))))
- pars)))
- )))) ; end (if zero var-ref)
-
- ;; vars with multiple incompatible ascertainable types don't happen much and obvious type errors are extremely rare
- )))
- vars)
- (set! line-number old-line-number)))
-
-
- ;; ----------------------------------------
- ;; preloading built-in definitions, and looking for them here found less than a dozen (list-ref, list-tail, and boolean?)
-
- (define (code-equal? p1 p2 matches e1 e2)
-
- (define (match-vars r1 r2 mat)
- (and (pair? r1)
- (pair? r2)
- (pair? (cdr r1))
- (pair? (cdr r2))
- ((if (and (pair? (cadr r1))
- (pair? (cadr r2))
- (memq (caadr r1) '(let let* letrec letrec* do lambda lambda*
- define define-constant define-macro define-bacro define-expansion
- define* define-macro* define-bacro*)))
- code-equal? structures-equal?)
- (cadr r1) (cadr r2) mat e1 e2)
- (cons (car r1) (car r2))))
-
- (let ((f1 (car p1))
- (f2 (car p2)))
- (and (eq? f1 f2)
- (let ((rest1 (cdr p1))
- (rest2 (cdr p2)))
- (and (pair? rest1)
- (pair? rest2)
- (call-with-exit
- (lambda (return)
- (case f1
- ((let)
- (let ((name ()))
- (if (symbol? (car rest1)) ; named let -- match funcs too
- (if (symbol? (car rest2))
- (begin
- (set! name (list (cons (car rest1) (car rest2))))
- (set! rest1 (cdr rest1))
- (set! rest2 (cdr rest2)))
- (return #f))
- (if (symbol? (car rest2))
- (return #f)))
- (and (= (length (car rest1)) (length (car rest2)))
- (let ((new-matches (append (map (lambda (var1 var2)
- (or (match-vars var1 var2 matches)
- (return #f)))
- (car rest1)
- (car rest2))
- name ; append will splice out nil
- matches)))
- (structures-equal? (cdr rest1) (cdr rest2) ; refs in values are to outer matches
- new-matches e1 e2)))))
- ((let*) ; refs move with the vars
- (and (= (length (car rest1)) (length (car rest2)))
- (let ((new-matches matches))
- (for-each (lambda (var1 var2)
- (cond ((match-vars var1 var2 new-matches) =>
- (lambda (v)
- (set! new-matches (cons v new-matches))))
- (else (return #f))))
- (car rest1)
- (car rest2))
- (structures-equal? (cdr rest1) (cdr rest2) new-matches e1 e2))))
-
- ((do) ; matches at init are outer, but at step are inner
- (and (= (length (car rest1)) (length (car rest2)))
- (let ((new-matches matches))
- (for-each (lambda (var1 var2)
- (cond ((match-vars var1 var2 matches) =>
- (lambda (v)
- (set! new-matches (cons v new-matches))))
- (else (return #f))))
- (car rest1)
- (car rest2))
- (for-each (lambda (var1 var2)
- (unless (structures-equal? (cddr var1) (cddr var2) new-matches e1 e2)
- (return #f)))
- (car rest1)
- (car rest2))
- (structures-equal? (cdr rest1) (cdr rest2) new-matches e1 e2))))
-
- ((letrec letrec*) ; ??? refs are local I think
- (and (= (length (car rest1)) (length (car rest2)))
- (let ((new-matches (append (map (lambda (var1 var2)
- (cons (car var1) (car var2)))
- (car rest1)
- (car rest2))
- matches)))
- (for-each (lambda (var1 var2)
- (unless (structures-equal? (cadr var1) (cadr var2) new-matches e1 e2)
- (return #f)))
- (car rest1)
- (car rest2))
- (structures-equal? (cdr rest1) (cdr rest2) new-matches e1 e2))))
-
- ((lambda)
- (if (symbol? (car rest1))
- (and (symbol? (car rest2))
- (structures-equal? (cdr rest1) (cdr rest2)
- (cons (cons (car rest1) (car rest2)) matches) e1 e2))
- (and (eqv? (length (car rest1)) (length (car rest2))) ; (car rest2) might be a symbol, dotted lists ok here
- (let ((new-matches (append (map cons (proper-list (car rest1)) (proper-list (car rest2)))
- matches)))
- (structures-equal? (cdr rest1) (cdr rest2) new-matches e1 e2)))))
-
- ((define define-constant define-macro define-bacro define-expansion)
- (if (symbol? (car rest1))
- (and (symbol? (car rest2))
- (let ((new-matches (cons (cons (car rest1) (car rest2)) matches)))
- (and (structures-equal? (cdr rest1) (cdr rest2) new-matches e1 e2)
- new-matches)))
- (and (eqv? (length (car rest1)) (length (car rest2))) ; (car rest2) might be a symbol, dotted lists ok here
- (let ((new-matches (append (map cons (proper-list (car rest1)) (proper-list (car rest2)))
- matches)))
- (structures-equal? (cdr rest1) (cdr rest2) new-matches e1 e2))
- (cons (cons (caar rest1) (caar rest2)) matches))))
- ;; for define we add the new name to matches before walking the body (shadow is immediate),
- ;; but then the new name is added to matches and returned (see below)
-
- ((lambda*)
- (if (symbol? (car rest1))
- (and (symbol? (car rest2))
- (structures-equal? (cdr rest1) (cdr rest2)
- (cons (cons (car rest1) (car rest2)) matches)
- e1 e2))
- (and (eqv? (length (car rest1)) (length (car rest2))) ; (car rest2) might be a symbol, dotted lists ok here
- (let ((new-matches (map (lambda (a b)
- (if (or (pair? a) ; if default, both must have the same value
- (pair? b))
- (if (not (and (pair? a)
- (pair? b)
- (equal? (cadr a) (cadr b))))
- (return #f)
- (cons (car a) (car b)))
- (cons a b)))
- (proper-list (car rest1)) (proper-list (car rest2)))))
- (structures-equal? (cdr rest1) (cdr rest2)
- (append new-matches matches)
- e1 e2)))))
-
- ((define* define-macro* define-bacro*)
- (if (symbol? (car rest1))
- (and (symbol? (car rest2))
- (let ((new-matches (cons (cons (car rest1) (car rest2)) matches)))
- (and (structures-equal? (cdr rest1) (cdr rest2) new-matches e1 e2)
- new-matches)))
- (and (eqv? (length (car rest1)) (length (car rest2))) ; (car rest2) might be a symbol, dotted lists ok here
- (let ((new-matches (map (lambda (a b)
- (if (or (pair? a) ; if default, both must have the same value
- (pair? b))
- (if (not (and (pair? a)
- (pair? b)
- (equal? (cadr a) (cadr b))))
- (return #f)
- (cons (car a) (car b)))
- (cons a b)))
- (proper-list (car rest1)) (proper-list (car rest2)))))
- (structures-equal? (cdr rest1) (cdr rest2)
- (append new-matches new-matches)
- e1 e2))
- (cons (cons (caar rest1) (caar rest2)) matches))))
-
- (else #f))))))))) ; can't happen I hope
-
- (define (structures-equal? p1 p2 matches e1 e2)
- (if (pair? p1)
- (and (pair? p2)
- (if (eq? (car p1) 'quote)
- (and (eq? (car p2) 'quote)
- (equal? (cdr p1) (cdr p2)))
- (and (if (not (and (pair? (car p1))
- (pair? (car p2))))
- (structures-equal? (car p1) (car p2) matches e1 e2)
- (case (caar p1)
- ((let let* letrec letrec* do lambda lambda*)
- (code-equal? (car p1) (car p2) matches e1 e2))
-
- ((define define-constant define-macro define-bacro define-expansion define* define-macro* define-bacro*)
- (let ((mat (code-equal? (car p1) (car p2) matches e1 e2)))
- (and (pair? mat)
- (set! matches mat))))
-
- ;; this ignores possible reversible equivalence (i.e. (< x 0) is the same as (> 0 x)
- ;; (structures-equal? (car p1) (car p2) matches e1 e2)))
-
- ;; check for reversible equivalence
- ;; half-humorous problem: infinite loop here switching back and forth!
- ;; so I guess we have to check cdar by hand
- ;; we could also check for not+notable here, but lint will complain
- ;; about that elsewhere, causing this check to be ignored.
- (else (or (structures-equal? (car p1) (car p2) matches e1 e2)
- (and (eq? (hash-table-ref reversibles (caar p1)) (caar p2))
- (not (any? (lambda (p) (side-effect? p e1)) (cdar p1))) ; (+ (oscil g) (oscil g x)) is not reversible!
- (do ((a (cdar p1) (cdr a))
- (b (reverse (cdar p2)) (cdr b)))
- ((or (null? a)
- (null? b)
- (not (structures-equal? a b matches e1 e2)))
- (and (null? a)
- (null? b)))))))))
- (structures-equal? (cdr p1) (cdr p2) matches e1 e2))))
- (let ((match (assq p1 matches)))
- (if match
- (or (and (eq? (cdr match) :unset)
- (set-cdr! match p2))
- (equal? (cdr match) p2))
- (if (symbol? p1)
- (and (eq? p1 p2)
- (or (eq? e1 e2)
- (eq? (assq p1 e1) (assq p2 e2))))
- (equal? p1 p2))))))
-
-
- ;; code-equal? and structures-equal? called in function-match and each other
-
- (define (function-match caller form env)
-
- (define func-min-cutoff 6)
- (define func-max-cutoff 120)
-
- (define (proper-list* lst)
- ;; return lst as a proper list (might have defaults, keywords etc)
- (if (or (not (pair? lst))
- (eq? (car lst) :allow-other-keys))
- ()
- (if (eq? (car lst) :rest)
- (cdr lst)
- (cons ((if (pair? (car lst)) caar car) lst)
- (if (pair? (cdr lst))
- (proper-list* (cdr lst))
- (if (null? (cdr lst))
- ()
- (list (cdr lst))))))))
-
- (let ((leaves (tree-leaves form)))
+ )))) ; end (if zero var-ref)
+
+ ;; vars with multiple incompatible ascertainable types don't happen much and obvious type errors are extremely rare
+
+ (when (and *report-clobbered-function-return-value*
+ (positive? (var-set local-var)))
+ (let ((start (var-initial-value local-var)))
+ (let ((func #f)
+ (retcons? (and (pair? start)
+ (let ((v (var-member (car start) env)))
+ (and (var? v)
+ (eq? (var-retcons v) #t))))))
+ (for-each (lambda (f)
+ (when (pair? f)
+ (case (car f)
+ ((set!)
+ (set! retcons? (and (pair? (cdr f))
+ (eq? (cadr f) vname)
+ (pair? (cddr f))
+ (pair? (caddr f))
+ (let ((v (var-member (caaddr f) env)))
+ (and (var? v)
+ (eq? #t (var-retcons v))
+ (set! func f))))))
+ ((string-set! list-set! vector-set! set-car! set-cdr!)
+ (if (and retcons?
+ (eq? (cadr f) vname))
+ (lint-format "~A returns a constant sequence, but ~A appears to clobber it" caller
+ func f))))))
+ (reverse (var-history local-var))))))
+ )))
+ vars)
+ (set! line-number old-line-number)))))
- (when (<= func-min-cutoff leaves func-max-cutoff)
- (let ((new-form (if (pair? (car form)) form (list form)))
- (name-args #f)
- (name-args-len :unset)
- (e2 ()))
-
- (let ((v (var-member caller env)))
- (when (and (var? v)
- (memq (var-ftype v) '(define lambda define* lambda*))
- (or (eq? form (cddr (var-initial-value v))) ; only check args if this is the complete body
- (and (null? (cdddr (var-initial-value v)))
- (eq? form (caddr (var-initial-value v))))))
- (set! e2 (var-env v))
- (if (symbol? (var-arglist v))
- (begin
- (set! name-args-len #f)
- (set! name-args (list (var-arglist v))))
- (begin
- (set! name-args-len (length (var-arglist v)))
- (set! name-args (map (lambda (arg)
- (if (symbol? arg)
- arg
- (values)))
- (proper-list* (var-arglist v))))))))
-
- (let ((find-code-match
- (let ((e1 ())
- (cutoff (max func-min-cutoff (- leaves 12))))
- (lambda (v)
- (and (not (memq (var-name v) '(:lambda :dilambda)))
- (memq (var-ftype v) '(define lambda define* lambda*))
- (not (eq? caller (var-name v)))
- (let ((body (cddr (var-initial-value v)))
- (args (var-arglist v)))
- (set! e1 (var-env v))
-
- (let ((args-len (length args)))
- (when (or (eq? name-args-len :unset)
- (equal? args-len name-args-len)
- (and (integer? args-len)
- (integer? name-args-len)
- (not (negative? (* args-len name-args-len)))))
-
- (unless (var-leaves v)
- (set! (var-leaves v) (tree-leaves body))
- (set! (var-match-list v) (if (symbol? args)
- (list (cons args :unset))
- (map (lambda (arg)
- (if (symbol? arg)
- (cons arg :unset)
- (values)))
- (proper-list* args)))))
-
- ;; var-leaves is size of func (v) body
- ;; leaves is size of form which we want to match with func
- ;; func-min-cutoff avoids millions of uninteresting matches
-
- (and (<= cutoff (var-leaves v) leaves)
- (let ((match-list (do ((p (var-match-list v) (cdr p)))
- ((null? p)
- (var-match-list v))
- (set-cdr! (car p) :unset))))
- (and (structures-equal? body new-form
- (cons (cons (var-name v) caller) match-list) e1 e2)
- ;; if the functions are recursive, we also need those names matched, hence the extra entry
- ;; but we treat match-list below as just the args, so add the func names at the call,
- ;; but this can be fooled if we're playing games with eq? basically -- the function
- ;; names should only match if used as functions.
-
- (not (member :unset match-list (lambda (a b) (eq? (cdr b) :unset))))
- (let ((new-args (map cdr match-list)))
- (if (and (equal? new-args name-args)
- (equal? args-len name-args-len))
- (lint-format "~A could be ~A" caller caller `(define ,caller ,(var-name v)))
- (lint-format "perhaps ~A" caller (lists->string form `(,(var-name v) , at new-args))))
- #t))))))))))))
-
- (do ((vs (or (hash-table-ref equable-closures (caar new-form)) ()) (cdr vs)))
- ;; instead of hashing on car as above, hash on composite of cars+base statements
- ((or (null? vs)
- (find-code-match (car vs))))))))))
-
(define (find-call sym body)
(call-with-exit
@@ -10051,7 +10092,7 @@
(case len
((1) (lint-format "this ~A is pointless" caller f))
((2) (lint-format "perhaps ~A" caller (lists->string f (cadr f))))
- ((3) (lint-format "perhaps ~A" caller (lists->string f `(if ,(cadr f) ,(caddr f)))))
+ ((3) (lint-format "perhaps ~A" caller (lists->string f `(if ,(cadr f) ,(caddr f))))) ; (begin (and x (display y)) (log z)) -> (if x (display y))
(else (lint-format "perhaps ~A" caller (lists->string f `(if ,(cadr f) (and ,@(cddr f)))))))))
((or)
@@ -10071,7 +10112,8 @@
(let ((last-expr (list-ref f (- (length f) 1))))
(if (side-effect? last-expr env)
(if (pair? last-expr)
- (check-returns caller last-expr env))
+ (check-returns caller last-expr env))
+ ;; (begin (if x (begin (display x) z)) z)
(lint-format "this is pointless~A: ~A in ~A" caller
(local-line-number last-expr)
(truncated-list->string last-expr)
@@ -10087,6 +10129,7 @@
(side-effect? returned env)))
(if (pair? returned)
(check-returns caller returned env))
+ ;; (begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x)
(lint-format "~A: result ~A~A is not used" caller
(truncated-list->string f)
(truncated-list->string returned)
@@ -10104,6 +10147,7 @@
(if (and (pair? (cdr tree))
(or (not (boolean? (cadr tree)))
(pair? (cddr tree))))
+ ;; (begin (call-with-exit (lambda (quit) (if (< x 0) (quit (+ x 1))) (display x))) (+ x 2))
(lint-format "th~A call-with-exit return value~A will be ignored: ~A" caller
(if (pair? (cddr tree))
(values "ese" "s")
@@ -10112,17 +10156,17 @@
(for-each walk tree)))))))
((map)
- (if (pair? (cdr f))
+ (if (pair? (cdr f)) ; (begin (map g123 x) x)
(lint-format "map could be for-each: ~A" caller (truncated-list->string `(for-each ,@(cdr f))))))
((reverse!)
- (if (pair? (cdr f))
+ (if (pair? (cdr f)) ; (let ((x (list 23 1 3))) (reverse! x) x)
(lint-format "~A might leave ~A in an undefined state; perhaps ~A" caller (car f) (cadr f)
`(set! ,(cadr f) ,f))))
((format)
(if (and (pair? (cdr f))
- (eq? (cadr f) #t))
+ (eq? (cadr f) #t)) ; (let () (format #t "~A" x) x)
(lint-format "perhaps use () with format since the string value is discarded:~% ~A"
caller `(format () ,@(cddr f)))))))))
@@ -10136,8 +10180,8 @@
(memq (var-definer v) '(call/cc call-with-current-continuation call-with-exit))
(memq (car form) '(error throw))))))
- (define (lint-walk-body caller head body env)
+ (define (lint-walk-body caller head body env)
(when (pair? body)
(when (and (pair? (car body))
(pair? (cdar body)))
@@ -10173,6 +10217,7 @@
(pair? (cdr fbody))
(string? (car fbody)))
(set! fbody (cdr fbody)))
+ ;; (... (define* (f1 a b) (+ a b)) (f1 :c 1)) -> (... (let ((a :c) (b 1)) (+ a b)))
(lint-format "perhaps ~A" caller
(lists->string `(... , at body)
(if (= (tree-count2 fname body 0) 2)
@@ -10185,7 +10230,6 @@
;; look for non-function defines at the start of the body and use let(*) instead
;; we're in a closed body here, so the define can't propagate backwards
-
(let ((first-expr (car body)))
;; another case: f(args) (let(...)set! arg < no let>)
(when (and (eq? (car first-expr) 'define)
@@ -10194,34 +10238,36 @@
;;(not (tree-car-member (cadr first-expr) (caddr first-expr)))
;;(not (tree-set-car-member '(lambda lambda*) (caddr first-expr)))
(not (and (pair? (caddr first-expr))
- (memq (caaddr first-expr) '(lambda lambda*)))))
+ (memq (caaddr first-expr) '(lambda lambda*))))
+ (> (length body) 2))
;; this still is not ideal -- we need to omit let+lambda as well
- (let ((names ())
- (letx 'let)
- (vars&vals ()))
- (do ((p body (cdr p)))
- ((not (and (pair? p)
- (let ((expr (car p)))
- (and (pair? expr)
- (eq? (car expr) 'define)
- (symbol? (cadr expr))
- (pair? (cddr expr))
- ;;(not (tree-set-car-member '(lambda lambda*) (caddr expr)))))
- (not (and (pair? (caddr expr))
- (memq (caaddr expr) '(lambda lambda*))))))))
- (lint-format "perhaps ~A" caller
- (lists->string `(... , at body)
- `(... (,letx ,(reverse vars&vals)
- ...)))))
- ;; define acts like letrec(*), not let -- reference to name in lambda body is current name
- (let ((expr (car p)))
- (set! vars&vals (cons (if (< (tree-leaves (cddr expr)) 12)
- (cdr expr)
- (list (cadr expr) '...))
- vars&vals))
- (if (tree-set-member names (cddr expr))
- (set! letx 'let*))
- (set! names (cons (cadr expr) names))))))))
+ (do ((names ())
+ (letx 'let)
+ (vars&vals ())
+ (p body (cdr p)))
+ ((not (and (pair? p)
+ (let ((expr (car p)))
+ (and (pair? expr)
+ (eq? (car expr) 'define)
+ (symbol? (cadr expr)) ; not (define (f ...))
+ (pair? (cddr expr))
+ (not (and (pair? (caddr expr)) ; not (define f (lambda...))
+ (memq (caaddr expr) '(lambda let lambda* let* letrec letrec*))))))))
+ ;; (... (define x 3) 32) -> (... (let ((x 3)) ...))
+ (if (pair? vars&vals)
+ (lint-format "perhaps ~A" caller
+ (lists->string `(... , at body)
+ `(... (,letx ,(reverse vars&vals)
+ ...))))))
+ ;; define acts like letrec(*), not let -- reference to name in lambda body is current name
+ (let ((expr (cdar p)))
+ (set! vars&vals (cons (if (< (tree-leaves (cdr expr)) 12)
+ expr
+ (list (car expr) '...))
+ vars&vals))
+ (if (tree-set-member names (cdr expr))
+ (set! letx 'let*))
+ (set! names (cons (car expr) names)))))))
(let ((len (length body)))
(when (> len 2) ; ... (define (x...)...) (x ...) -> (let (...) ...) or named let -- this happens a lot!
@@ -10258,112 +10304,164 @@
(eqv? (length (cdadr n-1)) (length (cdr call))))
(let ((new-call `(let , at named ,(map list (cdadr n-1) (cdr call)) ,@(cddr n-1))))
(lint-format "perhaps embed ~A: ~A" caller new-var
- (lists->string outer-form `(... ,(tree-subst new-call call n))))))))))))))
-
- ;; needs to check outer let also -- and maybe complain? [outer = form: we're already closed?]
- ;; bounds of closable context might be dependent on body length
- ;; (let ((outer-form (cond ((var-member :let env) => var-initial-value) (else #f)))
- ;; if used just once, move to that point in the expr+1? -- need to point it out somehow?
-
- (when (and (> len 2)
- (not (tree-memq 'curlet (list-ref body (- len 1)))))
- (do ((q body (cdr q))
- (k 0 (+ k 1)))
- ((null? q))
- (let ((expr (car q)))
- (when (and (pair? expr)
- (eq? (car expr) 'define)
- (pair? (cdr expr))
- (pair? (cddr expr))
- (null? (cdddr expr)))
- (let ((name (and (symbol? (cadr expr)) (cadr expr))))
- (when name
- (let ((last-ref k))
- (do ((p (cdr q) (cdr p))
- (i (+ k 1) (+ i 1)))
- ((null? p)
- (if (and (< k last-ref (+ k 2))
+ (lists->string outer-form `(... ,(tree-subst new-call call n)))))))))))))
+
+ (let ((suggest made-suggestion))
+ (unless (tree-memq 'curlet (list-ref body (- len 1)))
+ (do ((q body (cdr q))
+ (k 0 (+ k 1)))
+ ((null? q))
+ (let ((expr (car q)))
+ (when (and (pair? expr)
+ (eq? (car expr) 'define)
+ (pair? (cdr expr))
+ (pair? (cddr expr))
+ (null? (cdddr expr)))
+ (let ((name (and (symbol? (cadr expr)) (cadr expr))))
+ (when name
+ (do ((last-ref k)
+ (p (cdr q) (cdr p))
+ (i (+ k 1) (+ i 1)))
+ ((null? p)
+ (if (and (< k last-ref (+ k 2))
(pair? (list-ref body (+ k 1))))
- (let ((end-dots (if (< last-ref (- len 1)) '(...) ()))
- (letx (if (tree-member name (cddr expr)) 'letrec 'let))
- (use-expr (list-ref body (+ k 1)))
- (seen-earlier (or (var-member name env)
- (do ((s body (cdr s)))
- ((or (eq? s q)
- (and (pair? (car s))
- (tree-memq name (car s))))
- (not (eq? s q)))))))
- (cond (seen-earlier)
-
- ((not (eq? (car use-expr) 'define))
- (let-temporarily ((target-line-length 120))
- (lint-format "the scope of ~A could be reduced: ~A" caller name
- (truncated-lists->string `(... ,expr ,use-expr , at end-dots)
- `(... (,letx ((,name ,(caddr expr)))
- ,use-expr)
- , at end-dots)))))
- ((eq? (cadr use-expr) name)
- (lint-format "use set! to redefine ~A: ~A" caller name
- (lists->string `(... ,use-expr , at end-dots)
- `(... (set! ,name ,(caddr use-expr)) , at end-dots))))
- ((pair? (cadr use-expr))
- (if (symbol? (caadr use-expr))
+ (let ((end-dots (if (< last-ref (- len 1)) '(...) ()))
+ (letx (if (tree-member name (cddr expr)) 'letrec 'let))
+ (use-expr (list-ref body (+ k 1)))
+ (seen-earlier (or (var-member name env)
+ (do ((s body (cdr s)))
+ ((or (eq? s q)
+ (and (pair? (car s))
+ (tree-memq name (car s))))
+ (not (eq? s q)))))))
+ (cond (seen-earlier)
+
+ ((not (eq? (car use-expr) 'define))
(let-temporarily ((target-line-length 120))
- (lint-format "perhaps move ~A into ~A's closure: ~A" caller name (caadr use-expr)
- (truncated-lists->string `(... ,expr ,use-expr , at end-dots)
- `(... (define ,(caadr use-expr)
- (,letx ((,name ,(caddr expr)))
- (lambda ,(cdadr use-expr)
- ,@(cddr use-expr))))
- , at end-dots))))))
- ((and (symbol? (cadr use-expr))
- (pair? (cddr use-expr)))
- (let-temporarily ((target-line-length 120))
- (if (and (pair? (caddr use-expr))
- (eq? (caaddr use-expr) 'lambda))
- (lint-format "perhaps move ~A into ~A's closure: ~A" caller name (cadr use-expr)
- (truncated-lists->string `(... ,expr ,use-expr , at end-dots)
- `(... (define ,(cadr use-expr)
- (,letx ((,name ,(caddr expr)))
- ,(caddr use-expr)))
- , at end-dots)))
+ ;; (... (define f14 (lambda (x y) (if (positive? x) (+ x y) y))) (+ (f11 1 2) (f14 1 2))) ->
+ ;; (... (let ((f14 (lambda (x y) (if (positive? x) (+ x y) y)))) (+ (f11 1 2) (f14 1 2))))
(lint-format "the scope of ~A could be reduced: ~A" caller name
(truncated-lists->string `(... ,expr ,use-expr , at end-dots)
- `(... (define ,(cadr use-expr)
- (,letx ((,name ,(caddr expr)))
- ,(caddr use-expr)))
- , at end-dots))))))))
- (when (and (> len 3)
- (< k last-ref (+ k 3)) ; larger cases happen very rarely -- 3 or 4 altogether
- (pair? (list-ref body (+ k 1)))
- (pair? (list-ref body (+ k 2))))
- (let ((end-dots (if (< last-ref (- len 1)) '(...) ()))
- (letx (if (tree-member name (cddr expr)) 'letrec 'let))
- (seen-earlier (or (var-member name env)
- (do ((s body (cdr s)))
- ((or (eq? s q)
- (and (pair? (car s))
- (tree-memq name (car s))))
- (not (eq? s q)))))))
- (unless seen-earlier
- (let ((use-expr1 (list-ref body (+ k 1)))
- (use-expr2 (list-ref body (+ k 2))))
- (if (not (or (tree-set-member '(define lambda) use-expr1)
- (tree-set-member '(define lambda) use-expr2)))
- (lint-format "the scope of ~A could be reduced: ~A" caller name
- (let-temporarily ((target-line-length 120))
- (truncated-lists->string `(... ,expr ,use-expr1 ,use-expr2 , at end-dots)
- `(... (,letx ((,name ,(caddr expr)))
- ,use-expr1
- ,use-expr2)
- , at end-dots)))))))))))
- (when (tree-memq name (car p))
- (set! last-ref i))))))))))))
-
+ `(... (,letx ((,name ,(caddr expr)))
+ ,use-expr)
+ , at end-dots)))))
+ ((eq? (cadr use-expr) name)
+ ;; (let () (display 33) (define x 2) (define x (+ x y)) (display 43)) ->
+ ;; (... (set! x (+ x y)) ...)
+ (lint-format "use set! to redefine ~A: ~A" caller name
+ (lists->string `(... ,use-expr , at end-dots)
+ `(... (set! ,name ,(caddr use-expr)) , at end-dots))))
+ ((pair? (cadr use-expr))
+ (if (symbol? (caadr use-expr))
+ (let-temporarily ((target-line-length 120))
+ ;; (let () (display 32) (define x 2) (define (f101 y) (+ x y)) (display 41) (f101 2)) ->
+ ;; (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...)
+ (lint-format "perhaps move ~A into ~A's closure: ~A" caller name (caadr use-expr)
+ (truncated-lists->string `(... ,expr ,use-expr , at end-dots)
+ `(... (define ,(caadr use-expr)
+ (,letx ((,name ,(caddr expr)))
+ (lambda ,(cdadr use-expr)
+ ,@(cddr use-expr))))
+ , at end-dots))))))
+ ((and (symbol? (cadr use-expr))
+ (pair? (cddr use-expr)))
+ (let-temporarily ((target-line-length 120))
+ (if (and (pair? (caddr use-expr))
+ (eq? (caaddr use-expr) 'lambda))
+ ;; (let () (display 34) (define x 2) (define f101 (lambda (y) (+ x y))) (display 41) (f101 2))
+ ;; (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...)
+ (lint-format "perhaps move ~A into ~A's closure: ~A" caller name (cadr use-expr)
+ (truncated-lists->string `(... ,expr ,use-expr , at end-dots)
+ `(... (define ,(cadr use-expr)
+ (,letx ((,name ,(caddr expr)))
+ ,(caddr use-expr)))
+ , at end-dots)))
+ ;; (... (define lib (r file)) (define exports (caddr lib)) ...) ->
+ ;; (... (define exports (let ((lib (r file))) (caddr lib))) ...)
+ (lint-format "the scope of ~A could be reduced: ~A" caller name
+ (truncated-lists->string `(... ,expr ,use-expr , at end-dots)
+ `(... (define ,(cadr use-expr)
+ (,letx ((,name ,(caddr expr)))
+ ,(caddr use-expr)))
+ , at end-dots))))))))
+ (when (and (> len 3)
+ (< k last-ref (+ k 3)) ; larger cases happen very rarely -- 3 or 4 altogether
+ (pair? (list-ref body (+ k 1)))
+ (pair? (list-ref body (+ k 2))))
+ (let ((end-dots (if (< last-ref (- len 1)) '(...) ()))
+ (letx (if (tree-member name (cddr expr)) 'letrec 'let))
+ (seen-earlier (or (var-member name env)
+ (do ((s body (cdr s)))
+ ((or (eq? s q)
+ (and (pair? (car s))
+ (tree-memq name (car s))))
+ (not (eq? s q)))))))
+ (unless seen-earlier
+ (let ((use-expr1 (list-ref body (+ k 1)))
+ (use-expr2 (list-ref body (+ k 2))))
+ (if (not (or (tree-set-member '(define lambda) use-expr1)
+ (tree-set-member '(define lambda) use-expr2)))
+ ;; (... (define f101 (lambda (y) (+ x y))) (display 41) (f101 2)) ->
+ ;; (... (let ((f101 (lambda (y) (+ x y)))) (display 41) (f101 2)))
+ (lint-format "the scope of ~A could be reduced: ~A" caller name
+ (let-temporarily ((target-line-length 120))
+ (truncated-lists->string `(... ,expr ,use-expr1 ,use-expr2 , at end-dots)
+ `(... (,letx ((,name ,(caddr expr)))
+ ,use-expr1
+ ,use-expr2)
+ , at end-dots)))))))))))
+ (when (tree-memq name (car p))
+ (set! last-ref i)))))))))
+
+ (when (= suggest made-suggestion)
+ ;; look for define+binding-expr at end and combine
+ (do ((prev-f #f)
+ (fs body (cdr fs)))
+ ((not (pair? fs)))
+ (let ((f (car fs)))
+ ;; define can come after the use, and in an open body can be equivalent to set!:
+ ;; (let () (if x (begin (define y 12) (do ((i 0 (+ i 1))) ((= i y)) (f i))) (define y 21)) y)
+ ;; (let () (define (f x) (+ y x)) (if z (define y 12) (define y 1)) (f 12))
+ ;; so we can't do this check in walk-open-body
+ ;;
+ ;; define + do -- if cadr prev-f not used in do inits, fold into do, else use let
+ ;; the let case is semi-redundant (it's already reported elsewhere)
+ (when (and (pair? prev-f)
+ (pair? f)
+ (eq? (car prev-f) 'define)
+ (symbol? (cadr prev-f))
+ (not (hash-table-ref other-identifiers (cadr prev-f))) ; (cadr prev-f) already ref'd, so it's a member of env
+ (or (null? (cdr fs))
+ (not (tree-memq (cadr prev-f) (cdr fs)))))
+ (if (eq? (car f) 'do)
+ ;; (... (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))) ...) -> (do ((i (f x) (+ i 1))) ((= i 3)) (display (+ z i)))
+ (lint-format "perhaps ~A" caller
+ (lists->string `(... ,prev-f ,f ...)
+ (if (any? (lambda (p)
+ (tree-memq (cadr prev-f) (cadr p)))
+ (cadr f))
+ (if (and (eq? (cadr prev-f) (cadr (caadr f)))
+ (null? (cdadr f)))
+ `(do ((,(caaadr f) ,(caddr prev-f) ,(caddr (caadr f)))) ,@(cddr f))
+ `(let (,(cdr prev-f)) ,f))
+ `(do (,(cdr prev-f)
+ ,@(cadr f))
+ ,@(cddr f)))))
+ ;; just changing define -> let seems officious, though it does reduce (cadr prev-f)'s scope
+ (if (and (or (and (eq? (car f) 'let)
+ (not (tree-memq (cadr prev-f) (cadr f))))
+ (eq? (car f) 'let*))
+ (not (symbol? (cadr f))))
+ (lint-format "perhaps ~A" caller
+ (lists->string
+ `(... ,prev-f ,f ,@(if (null? (cdr fs)) () '(...)))
+ `(... (,(car f) (,(cdr prev-f) ,@(cadr f)) ...) ,@(if (null? (cdr fs)) () '(...))))))))
+ (set! prev-f f))))))))
+
;; definer as last in body is rare outside let-syntax, and tricky -- only one clear optimizable case found
(lint-walk-open-body caller head body env))
-
-
+
+
(define (lint-walk-open-body caller head body env)
;; walk a body (a list of forms, the value of the last of which might be returned)
@@ -10380,14 +10478,10 @@
(repeat-arg 0)
(dpy-f #f)
(dpy-start #f)
+ (rewrote-already #f)
(len (length body)))
(if (eq? head 'do) (set! len (+ len 1))) ; last form in do body is not returned
- (when (and (pair? body)
- *report-function-stuff*
- (not (null? (cdr body))))
- (function-match caller body env))
-
(do ((fs body (cdr fs))
(ctr 0 (+ ctr 1)))
((not (pair? fs)))
@@ -10405,6 +10499,7 @@
;; if already in env, check shadowing request
(if (and *report-shadowed-variables*
(var-member vname env))
+ ;; (let ((f33 33)) (define f33 4) (g f33 1))
(lint-format "~A variable ~A in ~S shadows an earlier declaration" caller head vname f))))
;; mid-body defines happen by the million, so resistance is futile
@@ -10426,8 +10521,17 @@
(let ((test1 (cadr prev-f))
(test2 (cadr f)))
- (let ((equal-tests ; test1 = test2
+ ;; (if A...) (if (not A)...) happens very rarely -- only two rewritable hits
+ (let ((equal-tests ; test1 = test2 [check for side-effects already]
(lambda ()
+
+ (if (and (pair? (caddr prev-f))
+ (escape? (caddr prev-f) env))
+ ;; (begin (if x (error 'oops)) (if x y)) -> begin: x is #f in (if x y) -- this never happens
+ (lint-format "~A is #f in ~A" caller
+ test2 (truncated-list->string f)))
+
+ ;; (... (if (and A B) (f C)) (if (and B A) (g E) (h F)) ...) -> (... (if (and A B) (begin (f C) (g E)) (begin (h F))) ...)
(lint-format "perhaps ~A" caller
(lists->string
`(... ,prev-f ,f ...)
@@ -10459,6 +10563,7 @@
(lambda ()
(if (null? (cddr test2))
(set! test2 (cadr test2)))
+ ;; (... (if A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))) ...)
(lint-format "perhaps ~A" caller
(lists->string `(... ,prev-f ,f ...)
(if (or (null? (cdddr prev-f))
@@ -10480,6 +10585,7 @@
(lambda ()
(if (null? (cddr test1))
(set! test1 (cadr test1)))
+ ;; (... (if (and A B) (f C)) (if A (g E)) ...) -> (... (when A (when B (f C)) (g E)))
(lint-format "perhaps ~A" caller
(lists->string `(... ,prev-f ,f ...)
(if (or (null? (cdddr f))
@@ -10576,6 +10682,7 @@
(null? (cdddr f)))
(or (eq? (car prev-f) 'when)
(null? (cdddr prev-f))))
+ ;; (... (if (and A B) (f C)) (when (and B C) (g E)) ...) -> (... (when B (when A (f C)) (when C (g E))))
(lint-format "perhaps ~A" caller
(let ((outer-test (if (null? (cdr intersection))
(car intersection)
@@ -10620,58 +10727,60 @@
(= ctr (- len 1))) ; this assumes we're not returning the last value?
(when (and (> repeats 2)
(not (hash-table-ref syntaces (car prev-f)))) ; macros should be ok here if args are constants
- (let ((fs-end (if (not feq) fs (cdr fs))))
-
- (if (zero? repeat-arg) ; simple case -- all exprs are identical
- (let ((step 'i))
- (if (tree-member step prev-f)
- (set! step (find-unique-name prev-f)))
- (lint-format "perhaps ~A... ->~%~NC(do ((~A 0 (+ ~A 1))) ((= ~A ~D)) ~A)" caller
- (truncated-list->string prev-f)
- pp-left-margin #\space
- step step step (+ repeats 1)
- prev-f))
-
- (let ((args ())
- (constants? #t)
- (func-name (car prev-f))
- (new-arg (if (tree-member 'arg prev-f)
- (find-unique-name prev-f)
- 'arg)))
- (do ((p start-repeats (cdr p)))
- ((eq? p fs-end))
- (set! args (cons (list-ref (car p) repeat-arg) args))
- (if constants? (set! constants? (code-constant? (car args)))))
-
- (let ((func (if (and (= repeat-arg 1)
- (null? (cddar start-repeats)))
- func-name
- `(lambda (,new-arg)
- ,(let ((call (copy prev-f)))
- (list-set! call repeat-arg new-arg)
- call)))))
- (if constants?
- (lint-format "perhaps ~A... ->~%~NC(for-each ~S '(~{~S~^ ~}))" caller
- (truncated-list->string (car start-repeats))
- pp-left-margin #\space
- func
- (map unquoted (reverse args)))
- (let ((v (var-member func-name env)))
- (if (or (and (var? v)
- (memq (var-ftype v) '(define define* lambda lambda*)))
- (procedure? (symbol->value func-name *e*)))
- (lint-format "perhaps ~A... ->~%~NC(for-each ~S (vector ~{~S~^ ~}))" caller
- ;; vector rather than list because it is easier on the GC (list copies in s7)
- (truncated-list->string (car start-repeats))
- pp-left-margin #\space
- func
- (reverse args))
- (if (not (or (var? v)
- (macro? (symbol->value func-name *e*))))
- (lint-format "assuming ~A is not a macro, perhaps ~A" caller
- func-name
- (lists->string (list '... (car start-repeats) '...)
- `(for-each ,func (vector ,@(reverse args))))))))))))))
+ (if (zero? repeat-arg) ; simple case -- all exprs are identical
+ (let ((step 'i))
+ (if (tree-member step prev-f)
+ (set! step (find-unique-name prev-f)))
+ (lint-format "perhaps ~A... ->~%~NC(do ((~A 0 (+ ~A 1))) ((= ~A ~D)) ~A)" caller
+ (truncated-list->string prev-f)
+ pp-left-margin #\space
+ step step step (+ repeats 1)
+ prev-f))
+
+ (let ((fs-end (if (not feq) fs (cdr fs)))
+ (args ())
+ (constants? #t)
+ (func-name (car prev-f))
+ (new-arg (if (tree-member 'arg prev-f)
+ (find-unique-name prev-f)
+ 'arg)))
+ (do ((p start-repeats (cdr p)))
+ ((eq? p fs-end))
+ (set! args (cons (list-ref (car p) repeat-arg) args))
+ (if constants? (set! constants? (code-constant? (car args)))))
+
+ (let ((func (if (and (= repeat-arg 1)
+ (null? (cddar start-repeats)))
+ func-name
+ `(lambda (,new-arg)
+ ,(let ((call (copy prev-f)))
+ (list-set! call repeat-arg new-arg)
+ call)))))
+ (if constants?
+ (lint-format "perhaps ~A... ->~%~NC(for-each ~S '(~{~S~^ ~}))" caller
+ (truncated-list->string (car start-repeats))
+ pp-left-margin #\space
+ func
+ (map unquoted (reverse args)))
+ (let ((v (var-member func-name env)))
+ (if (or (and (var? v)
+ (memq (var-ftype v) '(define define* lambda lambda*)))
+ (procedure? (symbol->value func-name *e*)))
+ ;; (let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3) (write-byte 4)) ->
+ ;; (for-each write-byte '(0 1 2 3 4))
+ (lint-format "perhaps ~A... ->~%~NC(for-each ~S (vector ~{~S~^ ~}))" caller
+ ;; vector rather than list because it is easier on the GC (list copies in s7)
+ (truncated-list->string (car start-repeats))
+ pp-left-margin #\space
+ func
+ (reverse args))
+ (if (not (or (var? v)
+ (macro? (symbol->value func-name *e*))))
+ ;; (let () (writ 0) (writ 1) (writ 2) (writ 3) (writ (* x 2))) -> (for-each writ (vector 0 1 2 3 (* x 2)))
+ (lint-format "assuming ~A is not a macro, perhaps ~A" caller
+ func-name
+ (lists->string (list '... (car start-repeats) '...)
+ `(for-each ,func (vector ,@(reverse args)))))))))))))
(set! repeats 0)
(set! repeat-arg 0)
(set! start-repeats fs)))
@@ -10686,7 +10795,7 @@
(if (symbol? f)
(set-ref f caller f env))
(set! f-len 0)))
-
+
;; set-car! + set-cdr! here is usually "clever" code assuming eq?ness, so we can't rewrite it using cons
;; but copy does not create a new cons... [if at end of body, the return values will differ]
(when (= f-len prev-len 3)
@@ -10708,56 +10817,108 @@
(if (= ctr (- len 1)) "" "...")
`(copy ,(cadr ncar) ,(cadr f))))))
+ ;; successive if's that can be combined into case
+ ;; else in last if could be accommodated as well
+ (when (and (not rewrote-already)
+ (eq? f-func 'if)
+ (eq? (car prev-f) 'if)
+ (pair? (cadr f))
+ (pair? (cadr prev-f))
+ (= (length f) 3)
+ (= (length prev-f) 3)
+ (memq (caadr prev-f) '(eq? eqv? = char=?)) ; not memx
+ (memq (caadr f) '(eq? eqv? = char=?)))
+ (let ((a1 (cadadr prev-f))
+ (a2 (caddr (cadr prev-f)))
+ (b1 (cadadr f))
+ (b2 (caddr (cadr f)))) ; other possibilities are never hit
+ (when (and (equal? a1 b1)
+ (code-constant? a2)
+ (code-constant? b2)
+ (not (tree-change-member (list a1) (cddr prev-f)))) ; or any symbol in a1?
+ (set! rewrote-already #t)
+ ;; (... (if (= x 1) (display y)) (if (= x 2) (f y)) ...) -> (case x ((1) (display y)) ((2) (f y)) ((3) (display z)))
+ (lint-format "perhaps ~A" caller
+ (lists->string `(... ,prev-f ,f ...)
+ `(case ,a1
+ ((,(unquoted a2)) ,@(unbegin (caddr prev-f)))
+ ((,(unquoted b2)) ,@(unbegin (caddr f)))
+ ,@(do ((more ())
+ (nfs (cdr fs) (cdr nfs)))
+ ((let ((nf (if (pair? nfs) (car nfs) ())))
+ (not (and (pair? nf)
+ (eq? (car nf) 'if)
+ (= (length nf) 3)
+ (pair? (cadr nf))
+ (memq (caadr nf) '(eq? eqv? = char=?))
+ (equal? a1 (cadadr nf))
+ (code-constant? (caddr (cadr nf))))))
+ ;; maybe add (not (tree-change-member (list a1) (cddr last-f)))
+ ;; but it never is needed
+ (reverse more))
+ (if (pair? nfs)
+ (set! more (cons (cons (list (unquoted (caddr (cadar nfs))))
+ (unbegin (caddar nfs)))
+ more))))))))))
(when (and (eq? f-func 'set!)
(eq? (car prev-f) 'set!))
(let ((arg1 (caddr prev-f))
(arg2 (caddr f))
(settee (cadr f)))
- (if (eq? settee (cadr prev-f))
- (cond ((not (and (pair? arg2) ; (set! x 0) (set! x 1) -> "this could be omitted: (set! x 0)"
- (tree-unquoted-member settee arg2)))
- (if (not (or (side-effect? arg1 env)
- (side-effect? arg2 env)))
- (lint-format "this could be omitted: ~A" caller prev-f)))
-
- ((and (pair? arg1) ; (set! x (cons 1 z)) (set! x (cons 2 x)) -> (set! x (cons 2 (cons 1 z)))
- (pair? arg2)
- (eq? (car arg1) 'cons)
- (eq? (car arg2) 'cons)
- (eq? settee (caddr arg2))
- (not (eq? settee (cadr arg2))))
- (lint-format "perhaps ~A ~A -> ~A" caller
- prev-f f
- `(set! ,settee (cons ,(cadr arg2) (cons ,@(cdr arg1))))))
-
- ((and (pair? arg1) ; (set! x (append x y)) (set! x (append x z)) -> (set! x (append x y z))
- (pair? arg2)
- (eq? (car arg1) 'append)
- (eq? (car arg2) 'append)
- (eq? settee (cadr arg1))
- (eq? settee (cadr arg2))
- (not (tree-memq settee (cddr arg1)))
- (not (tree-memq settee (cddr arg2))))
- (lint-format "perhaps ~A ~A -> ~A" caller
- prev-f f
- `(set! ,settee (append ,settee ,@(cddr arg1) ,@(cddr arg2)))))
-
- ((and (= (tree-count1 settee arg2 0) 1) ; (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))
- (or (not (pair? arg1))
- (< (tree-leaves arg1) 5)))
- (lint-format "perhaps ~A ~A ->~%~NC~A" caller
- prev-f f pp-left-margin #\space
- (object->string `(set! ,settee ,(tree-subst arg1 settee arg2))))))
-
- (if (and (symbol? (cadr prev-f)) ; (set! x (A)) (set! y (A)) -> (set! x (A)) (set! y x)
- (pair? arg1) ; maybe more trouble than it's worth
- (equal? arg1 arg2)
- (not (eq? (car arg1) 'quote))
- (hash-table-ref no-side-effect-functions (car arg1))
- (not (tree-unquoted-member (cadr prev-f) arg1))
- (not (side-effect? arg1 env))
- (not (maker? arg1)))
- (lint-format "perhaps ~A" caller (lists->string f `(set! ,settee ,(cadr prev-f)))))))))
+
+ (if (and (or (and (equal? settee arg1) ; (set! x y) (set! y x)
+ (equal? arg2 (cadr prev-f)))
+ (and (equal? settee (cadr prev-f)) ; (set! x y) (set! x y)
+ (equal? arg1 arg2)))
+ (not (tree-equal-member settee arg2)))
+ (lint-format "this pair of set!s looks odd: ~A" caller
+ `(... ,prev-f ,f ...)))
+
+ (cond ((not (eq? settee (cadr prev-f)))
+ (if (and (symbol? (cadr prev-f)) ; (set! x (A)) (set! y (A)) -> (set! x (A)) (set! y x)
+ (pair? arg1) ; maybe more trouble than it's worth
+ (equal? arg1 arg2)
+ (not (eq? (car arg1) 'quote))
+ (hash-table-ref no-side-effect-functions (car arg1))
+ (not (tree-unquoted-member (cadr prev-f) arg1))
+ (not (side-effect? arg1 env))
+ (not (maker? arg1)))
+ (lint-format "perhaps ~A" caller (lists->string f `(set! ,settee ,(cadr prev-f))))))
+
+ ((not (and (pair? arg2) ; (set! x 0) (set! x 1) -> "this could be omitted: (set! x 0)"
+ (tree-unquoted-member settee arg2)))
+ (if (not (or (side-effect? arg1 env)
+ (side-effect? arg2 env)))
+ (lint-format "this could be omitted: ~A" caller prev-f)))
+
+ ((and (pair? arg1) ; (set! x (cons 1 z)) (set! x (cons 2 x)) -> (set! x (cons 2 (cons 1 z)))
+ (pair? arg2)
+ (eq? (car arg1) 'cons)
+ (eq? (car arg2) 'cons)
+ (eq? settee (caddr arg2))
+ (not (eq? settee (cadr arg2))))
+ (lint-format "perhaps ~A ~A -> ~A" caller
+ prev-f f
+ `(set! ,settee (cons ,(cadr arg2) (cons ,@(cdr arg1))))))
+
+ ((and (pair? arg1) ; (set! x (append x y)) (set! x (append x z)) -> (set! x (append x y z))
+ (pair? arg2)
+ (eq? (car arg1) 'append)
+ (eq? (car arg2) 'append)
+ (eq? settee (cadr arg1))
+ (eq? settee (cadr arg2))
+ (not (tree-memq settee (cddr arg1)))
+ (not (tree-memq settee (cddr arg2))))
+ (lint-format "perhaps ~A ~A -> ~A" caller
+ prev-f f
+ `(set! ,settee (append ,settee ,@(cddr arg1) ,@(cddr arg2)))))
+
+ ((and (= (tree-count1 settee arg2 0) 1) ; (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))
+ (or (not (pair? arg1))
+ (< (tree-leaves arg1) 5)))
+ (lint-format "perhaps ~A ~A ->~%~NC~A" caller
+ prev-f f pp-left-margin #\space
+ (object->string `(set! ,settee ,(tree-subst arg1 settee arg2)))))))))
(if (< ctr (- len 1))
(begin ; f is not the last form, so its value is ignored
@@ -10770,9 +10931,11 @@
(eq? (var-initial-value v) :call/cc))))))
(cdr f)))
(if (= ctr (- len 2))
+ ;; (let () (error 'oops "an error") #t)
(lint-format "~A makes this pointless: ~A" caller
(truncated-list->string f)
(truncated-list->string (cadr fs)))
+ ;; (begin (stop) (exit 6) (print 4) (stop))
(lint-format "~A makes the rest of the body unreachable: ~A" caller
(truncated-list->string f)
(truncated-list->string (list '... (cadr fs) '...)))))
@@ -10787,12 +10950,14 @@
((display write write-char write-byte)
(if (and (equal? f (cadr prev-f))
(not (side-effect? f env)))
+ ;; (cond ((= x y) y) (else (begin (display x) x)))
(lint-format "~A returns its first argument, so this could be omitted: ~A" caller
(car prev-f) (truncated-list->string f))))
((vector-set! float-vector-set! int-vector-set! byte-vector-set!
string-set! list-set! hash-table-set! let-set! set-car! set-cdr!)
(if (equal? f (list-ref prev-f (- (length prev-f) 1)))
+ ;; (begin (vector-set! x 0 (* y 2)) (* y 2))
(lint-format "~A returns the new value, so this could be omitted: ~A" caller
(car prev-f) (truncated-list->string f)))
(if (and (pair? f)
@@ -10818,6 +10983,7 @@
(not (pair? (cddddr prev-f)))
(not (pair? (cdddr f)))
(not (side-effect? (caddr f) env)))))
+ ;; (let ((x (list 1 2))) (set-car! x 3) (car x))
(lint-format "~A returns the new value, so this could be omitted: ~A" caller
(car prev-f) (truncated-list->string f))))
@@ -10852,6 +11018,7 @@
(caddr prev-f)))
((= (tree-count2 f body 0) 2)
+ ;; (let () (define (f1 x) (+ x 1)) f1) -> (lambda (x) ...)
(lint-format "perhaps omit ~A, and change ~A" caller
f
(lists->string `(,(car prev-f) ,(cadr prev-f) ...)
@@ -10899,6 +11066,7 @@
(set! dctr (+ dctr 1))
(gather-format (display->format d))
(when (eq? d dpy-last) ; op can be null => send to (current-output-port), return #f or #<unspecified>
+ ;; (begin (display x) (newline) (display y) (newline)) -> (format () "~A~%~A~%" x y)
(lint-format "perhaps ~A" caller (lists->string `(... , at exprs)
`(format ,op ,ctrl-string ,@(reverse args))))
(done)))
@@ -10932,69 +11100,89 @@
(pair? (cdr f)))
(if (and (pair? (cadr f))
(memq f-func '(define define* define-macro define-constant define-macro* define-expansion define-bacro define-bacro*)))
- (set-ref (caadr f) caller #f env)
+ (set-ref (caadr f) caller f env)
(if (memq f-func '(defmacro defmacro*))
- (set-ref (cadr f) caller #f env))))
+ (set-ref (cadr f) caller f env))))
))
(set! lint-mid-form old-mid-form)
(set! lint-current-form old-current-form)))
env)
- (define (check-sequence-constant function-name last)
- (let ((seq (if (not (pair? last))
- last
- (and (eq? (car last) 'quote)
- (pair? (cdr last)) ; (quote . 1)
- (cadr last)))))
- (if (and (sequence? seq)
- (> (length seq) 0))
- (begin
- (lint-format "returns ~A constant: ~A~S" function-name
- (if (pair? seq)
- (values "a list" "'" seq)
- (values (prettify-checker-unq (->lint-type last)) "" seq)))
- (throw 'sequence-constant-done)) ; just report one constant -- the full list is annoying
- (when (pair? last)
- (case (car last)
-
- ((begin let let* letrec letrec* when unless with-baffle with-let)
- (when (pair? (cdr last))
- (let ((len (length last)))
- (when (positive? len)
- (check-sequence-constant function-name (list-ref last (- len 1)))))))
-
- ((if)
- (when (and (pair? (cdr last))
- (pair? (cddr last)))
- (check-sequence-constant function-name (caddr last))
- (if (pair? (cdddr last))
- (check-sequence-constant function-name (cadddr last)))))
-
- ((cond)
- (for-each (lambda (c)
- (if (and (pair? c)
- (pair? (cdr c)))
- (check-sequence-constant function-name (list-ref c (- (length c) 1)))))
- (cdr last)))
-
- ((case)
- (when (and (pair? (cdr last))
- (pair? (cddr last)))
- (for-each (lambda (c)
- (if (and (pair? c)
- (pair? (cdr c)))
- (check-sequence-constant function-name (list-ref c (- (length c) 1)))))
- (cddr last))))
-
- ((do)
- (if (and (pair? (cdr last))
- (pair? (cddr last))
- (pair? (caddr last))
- (pair? (cdaddr last)))
- (check-sequence-constant function-name (list-ref (caddr last) (- (length (caddr last)) 1))))))))))
+ (define (return-walker last func)
+ (if (not (pair? last))
+ (func last)
+ (case (car last)
+
+ ((begin let let* letrec letrec* when unless with-baffle with-let)
+ (when (pair? (cdr last))
+ (let ((len (length last)))
+ (when (positive? len)
+ (return-walker (list-ref last (- len 1)) func)))))
+
+ ((if)
+ (when (and (pair? (cdr last))
+ (pair? (cddr last)))
+ (return-walker (caddr last) func)
+ (if (pair? (cdddr last))
+ (return-walker (cadddr last) func))))
+
+ ((cond)
+ (for-each (lambda (c)
+ (if (and (pair? c)
+ (pair? (cdr c)))
+ (return-walker (list-ref c (- (length c) 1)) func)))
+ (cdr last)))
+
+ ((case)
+ (when (and (pair? (cdr last))
+ (pair? (cddr last)))
+ (for-each (lambda (c)
+ (if (and (pair? c)
+ (pair? (cdr c)))
+ (return-walker (list-ref c (- (length c) 1)) func)))
+ (cddr last))))
+
+ ((do)
+ (if (and (pair? (cdr last))
+ (pair? (cddr last))
+ (pair? (caddr last))
+ (pair? (cdaddr last)))
+ (return-walker (list-ref (caddr last) (- (length (caddr last)) 1)) func)))
+
+ ((set!)
+ (if (and (pair? (cdr last))
+ (pair? (cddr last)))
+ (func (caddr last))))
+
+ (else (func last)) ; includes quote
+
+ ;; call-with-exit et al also or|and
+ ;; or|and -- call return-walker on each entry?
+ ;; call-with-exit: walker on last on body, and scan for return func, walker on arg(s...)->values?
+
+ )))
+ (define (check-sequence-constant function-name last)
+ (return-walker last
+ (lambda (in-seq)
+ (when (or (not (pair? in-seq))
+ (eq? (car in-seq) 'quote))
+ (let ((seq (if (and (pair? in-seq)
+ (pair? (cdr in-seq))) ; (quote . 1)??
+ (cadr in-seq)
+ in-seq)))
+ (when (and (sequence? seq)
+ (not (zero? (length seq))))
+ (lint-format "returns ~A constant: ~A~S" function-name ; (define-macro (m a) `(+ 1 a))
+ (if (pair? seq)
+ (values "a list" "'" seq)
+ (values (prettify-checker-unq (->lint-type in-seq)) "" seq)))
+ (throw 'sequence-constant-done))))))) ; just report one constant -- the full list is annoying
+
+ (define lint-function-body #f) ; a momentary kludge??
+
(define (lint-walk-function-body definer function-name args body env)
;; walk function body, with possible doc string at the start
(when (and (pair? body)
@@ -11020,15 +11208,23 @@
(or (eq? (cadar body) args)
(and (pair? args)
(memq (cadar body) args))))
+ ;; (define (f21 x y) (set! x 3) (+ y 1))
(lint-format "perhaps ~A" function-name
(lists->string (car body) `(let ((,(cadar body) ,(caddar body))) ...))))
;; as first in let of body, maybe a half-dozen
- (catch 'sequence-constant-done
- (lambda ()
- (check-sequence-constant function-name (list-ref body (- (length body) 1))))
- (lambda args #f))
-
+ (let ((tag 'yup))
+ (catch 'sequence-constant-done
+ (lambda ()
+ (check-sequence-constant function-name (list-ref body (- (length body) 1))) ; some of these are innocuous -- lambda forms in midst of outer body etc
+ (set! tag 'nope))
+ (lambda args #f))
+ (if (eq? tag 'yup)
+ (let ((v (var-member function-name env)))
+ (if (var? v)
+ (set! (var-retcons v) #t)))))
+
+ (set! lint-function-body body)
(lint-walk-body function-name definer body env))
(define (lint-walk-function definer function-name args body form env)
@@ -11082,6 +11278,7 @@
(hash-table-ref reversibles (caar bval))))
(if (and (null? args) ; perhaps this can be extended to any equal args
(null? (cdar bval)))
+ ;; (define (getservent) (getserv)) -> (define getservent getserv)
(lint-format "~A could probably be ~A" function-name
(truncated-list->string form)
(truncated-list->string `(define ,function-name ,cval)))))))
@@ -11098,9 +11295,10 @@
(null? (cdddar bval)))
(and (pair? args)
(equal? (cddar bval) (proper-list args)))))
+ ;; (define (f1 . x) (apply + x)) -> (define f1 +)
(lint-format "~A could be (define ~A ~A)" function-name function-name function-name (cadar bval)))
- ((and (memq (caar bval) combinable-cxrs)
+ ((and (hash-table-ref combinable-cxrs (caar bval))
(pair? (cadar bval)))
((lambda* (cr arg)
(and cr
@@ -11110,7 +11308,9 @@
(eq? (car args) arg)
(let ((f (symbol "c" cr "r")))
(if (eq? f function-name)
+ ;; (define (cadddr l) (caddr (cdr l)))
(lint-format "this redefinition of ~A is pointless (use (with-let (unlet)...) or #_~A)" definer function-name function-name)
+ ;; (define (f1 x) (cdr (car x))) -> (define f1 cdar)
(lint-format "~A could be (define ~A ~A)" function-name function-name function-name f)))))
(combine-cxrs (car bval))))
@@ -11184,7 +11384,7 @@
(if (null? args)
(begin
(if (memq definer '(define* lambda* defmacro* define-macro* define-bacro*))
- (lint-format "~A could be ~A"
+ (lint-format "~A could be ~A" ; (define* (f1) 32)
function-name definer
(symbol (substring (symbol->string definer) 0 (- (length (symbol->string definer)) 1)))))
(let ((cur-env (if fvar (cons fvar env) env)))
@@ -11201,24 +11401,24 @@
(lint-format "strange ~A parameter list ~A" function-name definer args)
env)
(let ((args-as-vars (if (symbol? args) ; this is getting arg names to add to the environment
- (list (make-var :name args :definer 'parameter))
- (map
- (lambda (arg)
- (if (symbol? arg)
- (if (memq arg '(:rest :allow-other-keys))
- (values) ; omit :rest and :allow-other-keys
- (make-var :name arg :definer 'parameter))
- (if (not (and (pair? arg)
- (= (length arg) 2)
- (memq definer '(define* lambda* defmacro* define-macro* define-bacro* definstrument define*-public))))
- (begin
- (lint-format "strange parameter for ~A: ~S" function-name definer arg)
- (values))
- (begin
- (if (not (cadr arg))
- (lint-format "the default argument value is #f in ~A ~A" function-name definer arg))
- (make-var :name (car arg) :definer 'parameter)))))
- (proper-list args)))))
+ (list (make-var :name args :definer 'parameter))
+ (map (lambda (arg)
+ (if (symbol? arg)
+ (if (memq arg '(:rest :allow-other-keys))
+ (values) ; omit :rest and :allow-other-keys
+ (make-var :name arg :definer 'parameter))
+ (if (not (and (pair? arg)
+ (= (length arg) 2)
+ (memq definer '(define* lambda* defmacro* define-macro* define-bacro* definstrument define*-public))))
+ (begin
+ (lint-format "strange parameter for ~A: ~S" function-name definer arg)
+ (values))
+ (begin
+ (if (not (or (cadr arg) ; (define* (f4 (a #f)) a)
+ (eq? definer 'define*-public))) ; who knows?
+ (lint-format "the default argument value is #f in ~A ~A" function-name definer arg))
+ (make-var :name (car arg) :definer 'parameter)))))
+ (proper-list args)))))
(let* ((cur-env (cons (make-var :name :let
:initial-value form
@@ -11299,6 +11499,7 @@
(and (boolean? (cadr c2))
(null? (cddr c2))
(not (equal? (cadr c1) (cadr c2)))
+ ;; (cond ((= 3 (length eq)) (caddr eq)) (else #f)) -> (and (= 3 (length eq)) (caddr eq))
(lint-format "perhaps ~A" caller
(lists->string form
(if (cadr c2)
@@ -11444,7 +11645,7 @@
(and (hash-table-ref no-side-effect-functions (car tree))
(or (not (hash-table-ref syntaces (car tree)))
(memq (car tree) '(if begin cond or and unless when)))
- (not (memq (car tree) makers))
+ (not (hash-table-ref makers (car tree)))
(list? (cdr tree))
(every? all-ok? (cdr tree))))))
(if (not (or (eq? (car tree) 'quote) (member tree constant-exprs)))
@@ -11583,6 +11784,7 @@
(quoted-null? (cadar a)))
(list (list (caar a) ()))
a)))
+ ;; (define (f61 x) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0))) -> (define (f61 y) (if (positive? y) (f61 (- y 1)) 0))
(lint-format "~A ~A" caller
(if (null? a) "perhaps" "a toss-up -- perhaps")
(lists->string form
@@ -11623,40 +11825,39 @@
(define (check-definee caller sym form env)
- (let ((val (cddr form)))
- (cond ((keyword? sym) ; (define :x 1)
- (lint-format "keywords are constants ~A" caller sym))
-
- ((and (eq? sym 'pi) ; (define pi (atan 0 -1))
- (member (car val) '((atan 0 -1)
- (acos -1)
- (* 2 (acos 0))
- (* 4 (atan 1))
- (* 4 (atan 1 1)))))
- (lint-format "~A is one of its many names, but pi is a predefined constant in s7" caller (car val)))
-
- ((constant? sym) ; (define most-positive-fixnum 432)
- (lint-format "~A is a constant in s7: ~A" caller sym form))
-
- ((eq? sym 'quote)
- (lint-format "either a stray quote, or a real bad idea: ~A" caller (truncated-list->string form)))
-
- ((pair? sym)
- (check-definee caller (car sym) form env))
-
- ((let ((v (var-member sym env)))
- (and (var? v)
- (eq? (var-definer v) 'define-constant)
- (not (equal? (caddr form) (var-initial-value v)))))
- => (lambda (v)
- (let ((line (if (and (pair? (var-initial-value v))
- (positive? (pair-line-number (var-initial-value v))))
- (format #f "(line ~D): " (pair-line-number (var-initial-value v)))
- "")))
- (lint-format "~A in ~A is already a constant, defined ~A~A" caller sym
- (truncated-list->string form)
- line
- (truncated-list->string (var-initial-value v)))))))))
+ (cond ((keyword? sym) ; (define :x 1)
+ (lint-format "keywords are constants ~A" caller sym))
+
+ ((and (eq? sym 'pi) ; (define pi (atan 0 -1))
+ (member (caddr form) '((atan 0 -1)
+ (acos -1)
+ (* 2 (acos 0))
+ (* 4 (atan 1))
+ (* 4 (atan 1 1)))))
+ (lint-format "~A is one of its many names, but pi is a predefined constant in s7" caller (caddr form)))
+
+ ((constant? sym) ; (define most-positive-fixnum 432)
+ (lint-format "~A is a constant in s7: ~A" caller sym form))
+
+ ((eq? sym 'quote)
+ (lint-format "either a stray quote, or a real bad idea: ~A" caller (truncated-list->string form)))
+
+ ((pair? sym)
+ (check-definee caller (car sym) form env))
+
+ ((let ((v (var-member sym env)))
+ (and (var? v)
+ (eq? (var-definer v) 'define-constant)
+ (not (equal? (caddr form) (var-initial-value v)))))
+ => (lambda (v)
+ (let ((line (if (and (pair? (var-initial-value v))
+ (positive? (pair-line-number (var-initial-value v))))
+ (format #f "(line ~D): " (pair-line-number (var-initial-value v)))
+ "")))
+ (lint-format "~A in ~A is already a constant, defined ~A~A" caller sym
+ (truncated-list->string form)
+ line
+ (truncated-list->string (var-initial-value v))))))))
(define binders (let ((h (make-hash-table)))
(for-each
@@ -11690,10 +11891,10 @@
(check-definee caller sym form env)
(if (memq head '(define define-constant define-envelope
- define-public define*-public defmacro-public define-inlinable
- define-integrable define^))
+ define-public define*-public defmacro-public define-inlinable
+ define-integrable define^))
(let ((len (length form)))
- (if (not (= len 3))
+ (if (not (= len 3)) ; (define a b c)
(lint-format "~A has ~A value~A?"
caller (truncated-list->string form)
(if (< len 3)
@@ -11705,15 +11906,15 @@
env
(begin
(if (and (null? (cdr val))
- (equal? sym (car val)))
+ (equal? sym (car val))) ; (define a a)
(lint-format "this ~A is either not needed, or is an error: ~A" caller head (truncated-list->string form)))
(if (not (pair? (car val)))
(begin
- (if (not (memq caller '(module cond-expand)))
- (cond ((hash-table-ref other-identifiers sym)
- => (lambda (p)
- (lint-format "~A is used before it is defined: ~A" caller sym form)))))
+ (cond ((and (not (memq caller '(module cond-expand)))
+ (hash-table-ref other-identifiers sym))
+ => (lambda (p)
+ (lint-format "~A is used before it is defined: ~A" caller sym form))))
(cons (make-var :name sym :initial-value (car val) :definer head) env))
(let ((e (lint-walk (if (and (pair? (car val))
@@ -11737,22 +11938,22 @@
(replace-redundant-named-let caller form sym (cadr val) (caddr val))))
;; (define x (letrec ((y (lambda...))) (lambda (...) (y...)))) -> (define (x...)...)
- (let* ((let-form (caddr form))
- (var (and (pair? (cadr let-form))
- (null? (cdadr let-form)) ; just one var in let/rec
- (caadr let-form))))
- ;; let-form here can be (lambda...) or (let|letrec ... lambda)
+ (let* ((let-form (cdaddr form))
+ (var (and (pair? (car let-form))
+ (null? (cdar let-form)) ; just one var in let/rec
+ (caar let-form))))
+ ;; let-form here can be cdr of (lambda...) or (let|letrec ... lambda)
(when (and (pair? var)
(symbol? (car var))
- (pair? (cddr let-form))
- (pair? (caddr let-form))
- (null? (cdddr let-form)) ; just one form in the let/rec
+ (pair? (cdr let-form))
+ (pair? (cadr let-form))
+ (null? (cddr let-form)) ; just one form in the let/rec
(pair? (cdr var))
(pair? (cadr var))
(pair? (cdadr var))
(eq? (caadr var) 'lambda) ; var is lambda
(proper-list? (cadadr var))) ; it has no rest arg
- (let ((body (caddr let-form)))
+ (let ((body (cadr let-form)))
(when (and (eq? (car body) 'lambda) ; let/rec body is lambda calling var
(proper-list? (cadr body)) ; rest args are a headache
(pair? (caddr body))) ; (lambda (...) (...) where car is letrec func name
@@ -11774,10 +11975,6 @@
`(define (,sym ,@(cadr body))
,(tree-subst new-call call
(caddr body)))))))))))))
- (when (and *report-function-stuff*
- (pair? (caddr (var-initial-value (car e)))))
- (hash-table-set! equable-closures (caaddr (var-initial-value (car e)))
- (cons (car e) (or (hash-table-ref equable-closures (caaddr (var-initial-value (car e)))) ()))))
e))))))) ; symbol? sym
;; not (symbol? sym)
@@ -11786,27 +11983,51 @@
(not (pair? (car sym)))) ; pair would indicate a curried func or something equally stupid
(let ((outer-args (cdr sym))
(outer-name (car sym)))
-
+
(cond ((not *report-forward-functions*))
;; need to ignore macro usages here -- this happens ca 20000 times!
((hash-table-ref other-identifiers (car sym))
=> (lambda (p)
(lint-format "~A is used before it is defined" caller (car sym)))))
+
+ (if (and *report-boolean-functions-misbehaving*
+ (symbol? (car sym))
+ (not (memq head '(lambda lambda*))) ; how to catch this case? -- this appears to be ignored
+ (char=? #\? ((reverse (symbol->string (car sym))) 0)))
+ (catch 'one-is-enough
+ (lambda ()
+ (return-walker (list-ref val (- (length val) 1))
+ (lambda (last)
+ (when (or (and (code-constant? last)
+ (not (boolean? last))
+ (not (and (pair? last)
+ (eq? (car last) 'quote)
+ (boolean? (cadr last)))))
+ (and (pair? last)
+ (let ((sig (arg-signature (car last) env)))
+ (and (pair? sig)
+ (if (pair? (car sig))
+ (not (tree-set-member '(boolean? #t values) (car sig)))
+ (not (memq (car sig) '(boolean? #t values))))))))
+ (lint-format "~A looks boolean, but it can return ~A" caller (car sym) (truncated-list->string last))
+ (throw 'one-is-enough)))))
+ (lambda args #f)))
(check-definee caller (car sym) form env)
(when (pair? (car val))
(when (eq? (caar val) 'let)
(when (pair? (cadar val))
- (let ((inner-vars (cadar val)))
- (do ((p outer-args (cdr p)))
- ((not (pair? p)))
- (cond ((assq (car p) inner-vars) =>
- (lambda (v)
- (if (eq? (cadr v) (car p))
- (lint-format "in ~A this let binding is pointless: ~A" caller
- (truncated-list->string form)
- v))))))))
+ (do ((inner-vars (cadar val))
+ (p outer-args (cdr p)))
+ ((not (pair? p)))
+ (cond ((assq (car p) inner-vars) =>
+ (lambda (v)
+ (if (eq? (cadr v) (car p))
+ ;; (define (f70 a b) (let ((a a) (b b)) (+ a b)))
+ (lint-format "in ~A this let binding is pointless: ~A" caller
+ (truncated-list->string form)
+ v)))))))
;; define + redundant named-let -- sometimes rewrites to define*
(when (and (symbol? (cadar val))
@@ -11850,6 +12071,8 @@
`(begin ,@(tree-subst outer-name inner-name inner-body)))
`(let ,(map list inner-args (cdr call))
, at inner-body)))))
+ ;; (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))
(lint-format "perhaps ~A" caller
(lists->string form
`(,head ,sym
@@ -11908,7 +12131,7 @@
(if (and (pair? call)
(pair? (cdr call))
(not (eq? par (cadr call))))
- (lint-format* caller
+ (lint-format* caller ; (define (f50 abs) (abs -1))
(string-append (object->string outer-name) "'s parameter " (symbol->string par))
(string-append " is called " (truncated-list->string call))
": find a less confusing parameter name!"))))))
@@ -11935,7 +12158,6 @@
(when (pair? body)
(case (car body)
((#_{list})
-
(when (and (quoted-symbol? (cadr body))
(proper-list? outer-args))
(if (and (equal? (cddr body) outer-args)
@@ -11955,14 +12177,14 @@
(lists->string form `(define (,outer-name , at outer-args)
(,(cadadr body) ,@(map unquoted (cddr body)))))))))
(let ((pargs (args->proper-list outer-args)))
- (do ((p (cdr body) (cdr p)))
- ((null? p))
- (if (and (pair? (car p))
- (eq? (caar p) 'quote)
- (pair? (cdar p))
- (pair? (cadar p))
- (tree-set-member pargs (cadar p)))
- (lint-format "missing comma? ~A" caller form)))))
+ (for-each (lambda (p)
+ (if (and (pair? p)
+ (eq? (car p) 'quote)
+ (pair? (cdr p))
+ (pair? (cadr p))
+ (tree-set-member pargs (cadr p)))
+ (lint-format "missing comma? ~A" caller form)))
+ (cdr body))))
((quote)
;; extra comma (unquote) is already caught elsewhere
@@ -12033,6 +12255,7 @@
env)
(let ((getter (cadr form))
(setter (caddr form)))
+ (check-call caller 'dilambda form env)
(lint-walk caller setter env)
(let ((e (lint-walk caller getter env))) ; goes to lint-walk-function -> :lambda as first in e
(if (and (pair? e)
@@ -12059,20 +12282,20 @@
(if (eq? head 'lambda*) ; (lambda* ()...) -> (lambda () ...)
(lint-format "lambda* could be lambda ~A" caller form))
(begin ; args is a pair ; (lambda (a a) ...)
- (let ((val (cddr form)))
- (if (and (pair? (car val))
- (eq? (caar val) 'let)
- (pair? (cadar val)))
- (let ((inner-vars (cadar val)))
- (do ((p (cadr form) (cdr p)))
- ((not (pair? p)))
- (cond ((assq (car p) inner-vars) =>
- (lambda (v)
- (if (eq? (cadr v) (car p))
- (lint-format "in ~A this let binding is pointless: ~A" caller
- (truncated-list->string form)
- v)))))))))
-
+ (let ((val (caddr form)))
+ (if (and (pair? val)
+ (eq? (car val) 'let)
+ (pair? (cadr val)))
+ (do ((inner-vars (cadr val))
+ (p (cadr form) (cdr p)))
+ ((not (pair? p)))
+ (cond ((assq (car p) inner-vars) =>
+ (lambda (v)
+ (if (eq? (cadr v) (car p))
+ (lint-format "in ~A this let binding is pointless: ~A" caller
+ (truncated-list->string form)
+ v))))))))
+
(if (repeated-member? (proper-list args) env)
(lint-format "~A parameter is repeated: ~A" caller head (truncated-list->string args)))
(if (eq? head 'lambda*) ; (lambda* (a :b) ...)
@@ -12090,18 +12313,21 @@
(not (memq (car body) '(and or))))))
((equal? args (cdr body))
+ ;; (lambda (a b) (> a b)) -> >
(lint-format "perhaps ~A" caller (lists->string form (car body))))
((equal? (reverse args) (cdr body))
(let ((rf (hash-table-ref reversibles (car body))))
+ ;; (lambda (a b) (> b a)) -> <
(if rf (lint-format "perhaps ~A" caller (lists->string form rf)))))
((and (= arglen 1)
- (memq (car body) combinable-cxrs))
+ (hash-table-ref combinable-cxrs (car body)))
((lambda* (cr arg) ; lambda* not lambda because combine-cxrs might return just #f
(and cr
(< (length cr) 5)
(eq? (car args) arg)
+ ;; (lambda (x) (cdr (cdr (car x)))) -> cddar
(lint-format "perhaps ~A" caller
(lists->string form (symbol "c" cr "r")))))
(combine-cxrs body))))))))
@@ -12122,6 +12348,7 @@
(or (eq? args (caddr body))
(and (pair? args)
(equal? (cddr body) (proper-list args)))))
+ ;; (lambda args (apply + args)) -> +
(lint-format "perhaps ~A" caller (lists->string form (cadr body))))))
(lint-walk-function head caller args (cddr form) form env)
@@ -12141,9 +12368,11 @@
env)
(let ((settee (cadr form))
(setval (caddr form)))
+ (if (symbol? setval)
+ (set-ref setval caller form env))
(let ((result (lint-walk caller setval env)))
(if (symbol? settee)
- (if (constant? settee)
+ (if (constant? settee) ; (set! pi 3)
(lint-format "can't set! ~A (it is a constant)" caller (truncated-list->string form))
(let ((v (var-member settee env)))
(if (and (var? v)
@@ -12156,10 +12385,11 @@
(truncated-list->string form)
line
(truncated-list->string (var-initial-value v)))))))
- (if (not (pair? settee))
+ (if (not (pair? settee)) ; (set! 3 1)
(lint-format "can't set! ~A" caller (truncated-list->string form))
(begin
(if (memq (car settee) '(vector-ref list-ref string-ref hash-table-ref))
+ ;; (set! (vector-ref v 0) 3)
(lint-format "~A as target of set!~A" caller (car settee) (truncated-list->string form)))
(lint-walk caller settee env) ; this counts as a reference since it's by reference so to speak
@@ -12176,6 +12406,7 @@
(arg-type (->lint-type setval)))
(when (and (symbol? checker)
(not (compatible? checker arg-type)))
+ ;; (set! (print-length) "asd")
(lint-format "~A: new value should be a~A ~A: ~S: ~A"
caller (car settee)
(if (char=? (string-ref (format #f "~A" checker) 0) #\i) "n" "")
@@ -12190,7 +12421,7 @@
(symbol? settee))
(set-ref settee caller `(implicit-set ,@(cdr form)) env)))
- (if (equal? (cadr form) setval) ; not settee here!
+ (if (equal? (cadr form) setval) ; not settee here! ; (set! a a)
(lint-format "pointless set! ~A" caller (truncated-list->string form)))
(when (and (pair? setval)
@@ -12204,7 +12435,19 @@
(if (eq? settee (cadddr setval))
(lint-format "perhaps ~A" caller
(lists->string form `(if ,(cadr setval) (set! ,settee ,(caddr setval)))))))))
-
+
+ ((cond) ; (set! x (cond (z w) (else x))) -> (if z (set! x w)) -- this never happens
+ (if (and (= (length setval) 3)
+ (memq (caaddr setval) '(#t else))
+ (null? (cddr (caddr setval)))
+ (null? (cddadr setval)))
+ (if (eq? (cadr (caddr setval)) (cadr form))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(if ,(caadr setval) (set! ,(cadr form) ,(cadadr setval)))))
+ (if (eq? (cadadr setval) (cadr form))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(if (not ,(caadr setval)) (set! ,(cadr form) ,(cadr (caddr setval))))))))))
+
((or) ; (set! x (or x y)) -> (if (not x) (set! x y))
(if (and (= (length setval) 3) ; the other case here is not improved by using 'if
(eq? settee (cadr setval)))
@@ -12238,7 +12481,7 @@
(unless (or (>= quote-warnings 20)
(and (symbol? arg)
(not (keyword? arg))))
- (set! quote-warnings (+ quote-warnings 1))
+ (set! quote-warnings (+ quote-warnings 1)) ; (char? '#\a)
(lint-format "quote is not needed here: ~A~A" caller ; this is by far the most common message from lint
(truncated-list->string form)
(if (= quote-warnings 20) "; will ignore this error henceforth." ""))))))))
@@ -12247,6 +12490,16 @@
;; ---------------- if ----------------
(let ()
+ (define definers (let ((h (make-hash-table)))
+ (for-each (lambda (d)
+ (hash-table-set! h d #t))
+ '(define define* define-constant lambda lambda* curlet require load eval eval-string
+ define-macro define-macro* define-bacro define-bacro* define-expansion
+ definstrument defanimal define-envelope
+ define-values define-module define-method
+ define-syntax define-public define-inlinable define-integrable define^))
+ h))
+
(define (if-walker caller form env)
(let ((len (length form)))
(if (> len 4)
@@ -12259,7 +12512,9 @@
(expr (simplify-boolean (cadr form) () () env))
(suggestion made-suggestion)
(true-op (and (pair? (caddr form)) (caaddr form)))
- (false-op (and (= len 4) (pair? (cadddr form)) (car (cadddr form)))))
+ (true-rest (and (pair? (caddr form)) (cdaddr form)))
+ (false-op (and (= len 4) (pair? (cadddr form)) (car (cadddr form))))
+ (false-rest (and (= len 4) (pair? (cadddr form)) (cdr (cadddr form)))))
(if (eq? false #<unspecified>)
(lint-format "this #<unspecified> is redundant: ~A" caller form))
@@ -12296,15 +12551,14 @@
(member (cadadr test) (car p))))
(if (pair? p)
(and-forgetful form 'if2 (cadr test) (car p) env)))))))))
-
- ;(format *stderr* "~A~%" form)
+
(when (and (pair? true)
(pair? false)
(not (memq true-op (list 'quote {list})))
(not (any-macro? true-op env))
(or (not (hash-table-ref syntaces true-op))
(memq true-op '(let let* set! and or begin)))
- (pair? (cdr true)))
+ (pair? true-rest))
(define (tree-subst-eq new old tree)
;; tree-subst above substitutes every occurence of 'old with 'new, so we check
@@ -12335,19 +12589,20 @@
(differ-in-one (car p) (car q)))
(list p (list (car p) (car q))))))))))
(if (pair? diff)
- (unless (or (and (equal? true-op (caadr diff)) ; (if x (+ y 1) (- y 1)) -- are we trying to keep really simple stuff out?
+ (unless (or (and (equal? true-op (caadr diff)) ; (if x (+ y 1) (- y 1)) -- are we trying to keep really simple stuff out?
(or (hash-table-ref syntaces true-op)
(hash-table-ref syntaces false-op))
- (any? pair? (cdr true))) ; (if x (set! y (+ x 1)) (set! y 1))
- (and (eq? true-op 'set!) ; (if x (set! y w) (set! z w))
- (equal? (caar diff) (cadr true))))
+ (any? pair? true-rest)) ; (if x (set! y (+ x 1)) (set! y 1))
+ (and (eq? true-op 'set!) ; (if x (set! y w) (set! z w))
+ (equal? (caar diff) (car true-rest))))
(let ((subst-loc (car diff)))
;; for let/let* if tree-subst position can't affect the test, just subst, else save test first
;; named let diff in args gets no hits
(if (memq true-op '(let let*))
- (if (not (or (symbol? (cadr true)) ; assume named let is moving an if outside the loop
- (eq? subst-loc (cdr true)))) ; avoid confusion about the vars list
- (let ((vars (cadr true)))
+ (if (not (or (symbol? (car true-rest)) ; assume named let is moving an if outside the loop
+ (eq? subst-loc true-rest))) ; avoid confusion about the vars list
+ (let ((vars (car true-rest)))
+ ;; (if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y)) -> (let ((y ((if x abs log) x))) (display z) y)
(lint-format "perhaps ~A" caller
(lists->string form
(if (and (pair? vars)
@@ -12360,29 +12615,30 @@
,(tree-subst-eq `(if _1_ ,@(cadr diff)) subst-loc true)))))))
;; also not any-macro? (car true|false) probably
+ ;; (if x (set! y #t) (set! y #f)) -> (set! y x)
(lint-format "perhaps ~A" caller
(lists->string form
(cond ((eq? true-op (caadr diff)) ; very common!
- ;; (if x (f y) (g y)) -> ((if x f g) y)
+ ;; (if x (f y) (g y)) -> ((if x f g) y)
;; but f and g can't be or/and unless there are no expressions
;; I now like all of these -- originally found them odd: CL influence!
(if (equal? true-op test)
- `((or ,test ,false-op) ,@(cdr true))
- `((if ,test ,true-op ,false-op) ,@(cdr true))))
+ `((or ,test ,false-op) , at true-rest)
+ `((if ,test ,true-op ,false-op) , at true-rest)))
((and (eq? (caadr diff) #t)
(not (cadadr diff)))
- ;; (if x (set! y #t) (set! y #f)) -> (set! y x)
+ ;; (if x (set! y #t) (set! y #f)) -> (set! y x)
(tree-subst-eq test subst-loc true))
((and (not (caadr diff))
(eq? (cadadr diff) #t))
- ;; (if x (set! y #f) (set! y #t)) -> (set! y (not x))
+ ;; (if x (set! y #f) (set! y #t)) -> (set! y (not x))
(tree-subst-eq (simplify-boolean `(not ,expr) () () env)
subst-loc true))
((equal? (caadr diff) test)
- ;; (if x (set! y x) (set! y 21)) -> (set! y (or x 21))
+ ;; (if x (set! y x) (set! y 21)) -> (set! y (or x 21))
(tree-subst-eq (simplify-boolean `(or ,@(cadr diff)) () () env)
subst-loc true))
@@ -12391,7 +12647,7 @@
(and (pair? lst)
(or (eq? a lst)
(list-memq a (cdr lst))))))
- ;; (if x (set! y z) (set! y w)) -> (set! y (if x z w))
+ ;; (if x (set! y z) (set! y w)) -> (set! y (if x z w))
;; true op moved out, if expr moved in
;; (if A (and B C) (and B D)) -> (and B (if A C D))
;; here differ-in-one means that preceding/trailing stuff must subst-loc exactly
@@ -12432,9 +12688,9 @@
(when (and (eq? true-op false-op)
(not (eq? true-op 'values))
(or (not (eq? true-op 'set!))
- (equal? (cadr true) (cadr false))))
- (let ((headdiff (let differ-in-headers ((p (cdr true))
- (q (cdr false))
+ (equal? (car true-rest) (car false-rest))))
+ (let ((headdiff (let differ-in-headers ((p true-rest)
+ (q false-rest)
(c 0)
(rp ())
(rq ()))
@@ -12454,6 +12710,7 @@
(tq (if (null? (cdaddr headdiff))
(caaddr headdiff)
`(,op ,@(caddr headdiff)))))
+ ;; (if A (+ B B E C) (+ D D E C)) -> (+ (if A (+ B B) (+ D D)) E C)
(lint-format "perhaps ~A" caller
(lists->string form
`(,true-op
@@ -12475,6 +12732,7 @@
(= (length iff) 3)
(eq? (car iff) 'if)))
(set! last-if-line-number line-number)
+ ;; (if a b (if c d (if e f g))) -> (cond (a b) (c d) (e f) (else g))
(lint-format "perhaps use cond: ~A" caller
(lists->string form
`(cond ,@(do ((iff form (cadddr iff))
@@ -12493,6 +12751,7 @@
(if (never-false test)
(lint-format "if test is never false: ~A" caller (truncated-list->string form))
(if (and (never-true test) true) ; complain about (if #f #f) later
+ ;; (if #f x y)
(lint-format "if test is never true: ~A" caller (truncated-list->string form))))
(cond ((side-effect? test env))
@@ -12522,21 +12781,46 @@
(equal? test `(not ,false))) ; (if (not x) y x) -> (or x y)
(lint-format "perhaps ~A" caller
(lists->string form (simplify-boolean `(or ,false ,true) () () env)))))
-
+
+ (when (and (pair? true)
+ (eq? true-op 'cond)
+ (not (eq? false-op 'cond))
+ (not (boolean? false))) ; these cases are handled elsewhere via or/and
+ ;; (if A (cond...) B) -> (cond ((not A) B) ...)
+ ;; if no false and cond is one-shot => this can be optimized to (cond ((and (not A) C) => ...))
+ (lint-format "perhaps ~A" caller
+ (let ((nexpr (simplify-boolean (list 'not expr) () () env))
+ (nfalse (if (eq? false 'no-false)
+ (if (eq? form lint-mid-form)
+ ()
+ '(#<unspecified>))
+ (list (if (and (pair? false)
+ (> (tree-leaves false) 100))
+ (if (pair? (car false))
+ (list (list (caar false) '...))
+ (list (car false) '...))
+ false)))))
+ (lists->string form `(cond (,nexpr , at nfalse) , at true-rest)))))
+
+ ;; true-op = case happens a lot, but never in a way that (not expr)->false can be combined in the case
+
(when (= len 4)
(when (and (pair? true)
(eq? true-op 'if))
- (let ((true-test (cadr true))
- (true-true (caddr true)))
+ (let ((true-test (car true-rest))
+ (true-true (cadr true-rest)))
(if (= (length true) 4)
- (let ((true-false (cadddr true)))
+ (let ((true-false (caddr true-rest)))
(if (equal? expr (simplify-boolean `(not ,true-test) () () env))
+ ;; (if a (if (not a) B C) A) -> (if a C A)
(lint-format "perhaps ~A" caller
(lists->string form `(if ,expr ,true-false ,false))))
(if (equal? expr true-test)
+ ;; (if x (if x z w) y) -> (if x z y)
(lint-format "perhaps ~A" caller
(lists->string form `(if ,expr ,true-true ,false))))
(if (equal? false true-false)
+ ;; (if a (if b B A) A) -> (if (and a b) B A)
(lint-format "perhaps ~A" caller
(lists->string form
(simplify-boolean
@@ -12545,6 +12829,7 @@
`(if (and ,expr ,true-test) ,true-true ,false))
() () env)))
(if (equal? false true-true)
+ ;; (if a (if b A B) A) -> (if (and a (not b)) B A)
(lint-format "perhaps ~A" caller
(lists->string form
(simplify-boolean
@@ -12552,62 +12837,63 @@
`(and ,expr (not ,true-test) ,true-false)
`(if (and ,expr (not ,true-test)) ,true-false ,false))
() () env)))))
-
+
;; (if a (if b d e) (if c d e)) -> (if (if a b c) d e)? reversed does not happen.
;; (if a (if b d) (if c d)) -> (if (if a b c) d)
;; (if a (if b d e) (if (not b) d e)) -> (if (eq? (not a) (not b)) d e)
(when (and (pair? false)
(eq? false-op 'if)
(= (length false) 4)
- (not (equal? true-test (cadr false)))
- (equal? (cddr true) (cddr false)))
- (let ((false-test (cadr false)))
+ (not (equal? true-test (car false-rest)))
+ (equal? (cdr true-rest) (cdr false-rest)))
+ (let ((false-test (car false-rest)))
(lint-format "perhaps ~A" caller
(lists->string form
(cond ((and (pair? true-test)
(eq? (car true-test) 'not)
(equal? (cadr true-test) false-test))
`(if (not (eq? (not ,expr) ,true-test))
- ,@(cddr true)))
-
+ ,@(cdr true-rest)))
+
((and (pair? false-test)
(eq? (car false-test) 'not)
(equal? true-test (cadr false-test)))
`(if (eq? (not ,expr) ,false-test)
- ,@(cddr true)))
-
+ ,@(cdr true-rest)))
+
((> (+ (tree-leaves expr)
(tree-leaves true-test)
(tree-leaves false-test))
12)
`(let ((_1_ (if ,expr ,true-test ,false-test)))
- (if _1_ ,@(cddr true))))
-
+ (if _1_ ,@(cdr true-rest))))
+
(else
- `(if (if ,expr ,true-test ,false-test) ,@(cddr true)))))))))
+ `(if (if ,expr ,true-test ,false-test) ,@(cdr true-rest)))))))))
(begin ; (length true) != 4
(if (equal? expr (simplify-boolean `(not ,true-test) () () env))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (if a (if (not a) B) A) -> (if (not a) A)
(lists->string form `(if (not ,expr) ,false))))
- (if (equal? expr true-test)
+ (if (equal? expr true-test) ; (if x (if x z) w) -> (if x z w)
(lint-format "perhaps ~A" caller
(lists->string form `(if ,expr ,true-true ,false))))
- (if (equal? false true-true) ; (if a (if b A) A)
+ (if (equal? false true-true) ; (if a (if b A) A)
(lint-format "perhaps ~A" caller
(let ((nexpr (simplify-boolean `(or (not ,expr) ,true-test) () () env)))
(lists->string form `(if ,nexpr ,false)))))))))
-
+
(when (pair? false)
(case false-op
((cond) ; (if a A (cond...)) -> (cond (a A) ...)
- (lint-format "perhaps ~A" caller (lists->string form `(cond (,expr ,true) ,@(cdr false)))))
+ (lint-format "perhaps ~A" caller (lists->string form `(cond (,expr ,true) , at false-rest))))
((if)
(when (= (length false) 4)
- (let ((false-test (cadr false))
- (false-true (caddr false))
- (false-false (cadddr false)))
+ (let ((false-test (car false-rest))
+ (false-true (cadr false-rest))
+ (false-false (caddr false-rest)))
(if (equal? true false-true)
+ ;; (if a A (if b A B)) -> (if (or a b) A B)
(lint-format "perhaps ~A" caller
(if (and (pair? false-false)
(eq? (car false-false) 'if)
@@ -12625,6 +12911,7 @@
`(and (not (or ,expr ,false-test)) ,false-false)
() () env)))))
(if (equal? true false-false)
+ ;; (if a A (if b B A)) -> (if (or a (not b)) A B)
(lint-format "perhaps ~A" caller
(if true
(let ((nexpr (simplify-boolean `(or ,expr (not ,false-test)) () () env)))
@@ -12637,55 +12924,57 @@
(eq? true-op 'if)
(= (length true) 3)
(= (length false) 3)
- (equal? (cddr true) (cddr false)))
+ (equal? (cdr true-rest) (cdr false-rest)))
+ ;; (if a (if b d) (if c d)) -> (if (if a b c) d)
(lint-format "perhaps ~A" caller
(lists->string form
(if (> (+ (tree-leaves expr)
- (tree-leaves (cadr true))
- (tree-leaves (cadr false)))
+ (tree-leaves (car true-rest))
+ (tree-leaves (car false-rest)))
12)
- `(let ((_1_ (if ,expr ,(cadr true) ,(cadr false))))
- (if _1_ ,@(cddr true)))
- `(if (if ,expr ,(cadr true) ,(cadr false)) ,@(cddr true)))))))
+ `(let ((_1_ (if ,expr ,(car true-rest) ,(car false-rest))))
+ (if _1_ ,@(cdr true-rest)))
+ `(if (if ,expr ,(car true-rest) ,(car false-rest)) ,@(cdr true-rest)))))))
((map) ; (if (null? x) () (map abs x)) -> (map abs x)
(if (and (pair? test)
(eq? (car test) 'null?)
(or (null? true)
(equal? true (cadr test)))
- (equal? (cadr test) (caddr false))
- (or (null? (cdddr false))
- (not (side-effect? (cdddr false) env))))
+ (equal? (cadr test) (cadr false-rest))
+ (or (null? (cddr false-rest))
+ (not (side-effect? (cddr false-rest) env))))
(lint-format "perhaps ~A" caller (lists->string form false))))
((case)
(if (and (pair? expr)
- (cond-eqv? expr (cadr false) #t))
+ (cond-eqv? expr (car false-rest) #t))
+ ;; (if (eof-object? x) 32 (case x ((#\a) 3) (else 4))) -> (case x ((#<eof>) 32) ((#\a) 3) (else 4))
(lint-format "perhaps ~A" caller
- (lists->string form `(case ,(cadr false)
- ,(case-branch expr (cadr false) (list true))
- ,@(cddr false))))))))
+ (lists->string form `(case ,(car false-rest)
+ ,(case-branch expr (car false-rest) (list true))
+ ,@(cdr false-rest))))))))
) ; (= len 4)
(if (pair? false)
- (let ((false-test (and (pair? (cdr false)) (cadr false))))
+ (let ((false-test (and (pair? false-rest) (car false-rest))))
(if (and (eq? false-op 'if) ; (if x 3 (if (not x) 4)) -> (if x 3 4)
- (pair? (cdr false))
+ (pair? false-rest)
(not (side-effect? test env)))
(if (or (equal? test false-test)
(equal? expr false-test))
- (lint-format "perhaps ~A" caller (lists->string form `(if ,expr ,true ,@(cdddr false))))
+ (lint-format "perhaps ~A" caller (lists->string form `(if ,expr ,true ,@(cddr false-rest))))
(if (and (pair? false-test)
(eq? (car false-test) 'not)
(or (equal? test (cadr false-test))
(equal? expr (cadr false-test))))
- (lint-format "perhaps ~A" caller (lists->string form `(if ,expr ,true ,(caddr false)))))))
+ (lint-format "perhaps ~A" caller (lists->string form `(if ,expr ,true ,(cadr false-rest)))))))
(if (and (eq? false-op 'if) ; (if test0 expr (if test1 expr)) -> if (or test0 test1) expr)
- (null? (cdddr false)) ; other case is dealt with above
- (equal? true (caddr false)))
+ (null? (cddr false-rest)) ; other case is dealt with above
+ (equal? true (cadr false-rest)))
(let ((test1 (simplify-boolean `(or ,expr ,false-test) () () env)))
- (lint-format "perhaps ~A" caller (lists->string form `(if ,test1 ,true ,@(cdddr false)))))))
+ (lint-format "perhaps ~A" caller (lists->string form `(if ,test1 ,true ,@(cddr false-rest)))))))
(when (and (eq? false 'no-false) ; no false branch
(pair? true))
@@ -12699,19 +12988,19 @@
;; (if (< x y) (set! x y) -> (set! x (max x y))
(if (eq? true-op 'set!)
- (let ((settee (cadr true))
- (setval (caddr true)))
+ (let ((settee (car true-rest))
+ (setval (cadr true-rest)))
(if (and (member settee test)
(member setval test)) ; that's all there's room for
(let ((f (if (equal? settee (if (memq test-op '(< <=)) rel-arg1 rel-arg2)) 'max 'min)))
(lint-format "perhaps ~A" caller
- (lists->string form `(set! ,settee (,f ,@(cdr true))))))))
+ (lists->string form `(set! ,settee (,f , at true-rest)))))))
;; (if (<= (list-ref ind i) 32) (list-set! ind i 32)) -> (list-set! ind i (max (list-ref ind i) 32))
(if (memq true-op '(list-set! vector-set!))
- (let ((settee (cadr true))
- (index (caddr true))
- (setval (cadddr true)))
+ (let ((settee (car true-rest))
+ (index (cadr true-rest))
+ (setval (caddr true-rest)))
(let ((mx-op (if (and (equal? setval rel-arg1)
(eqv? (length rel-arg2) 3)
(equal? settee (cadr rel-arg2))
@@ -12726,29 +13015,30 @@
(lint-format "perhaps ~A" caller
(lists->string form `(,true-op ,settee ,index (,mx-op ,@(cdr test))))))))))))))
- (if (eq? (car true) 'if) ; (if test0 (if test1 expr)) -> (if (and test0 test1) expr)
- (cond ((null? (cdddr true))
- (let ((test1 (simplify-boolean `(and ,expr ,(cadr true)) () () env)))
- (lint-format "perhaps ~A" caller (lists->string form `(if ,test1 ,(caddr true))))))
-
- ((equal? expr (cadr true))
- (lint-format "perhaps ~A" caller (lists->string form true)))
-
- ((equal? (cadr true) `(not ,expr))
- (lint-format "perhaps ~A" caller
- (lists->string form (cadddr true)))))
+ (cond ((not (eq? (car true) 'if)) ; (if test0 (if test1 expr)) -> (if (and test0 test1) expr)
+ (if (memq true-op '(when unless)) ; (if test0 (when test1 expr...)) -> (when (and test0 test1) expr...)
+ (let ((test1 (simplify-boolean (if (eq? true-op 'when)
+ `(and ,expr ,(car true-rest))
+ `(and ,expr (not ,(car true-rest))))
+ () () env)))
+ ;; (if (and (< x 1) y) (when z (display z) x)) -> (when (and (< x 1) y z) (display z) x)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (if (and (pair? test1)
+ (eq? (car test1) 'not))
+ `(unless ,(cadr test1) ,@(cdr true-rest))
+ `(when ,test1 ,@(cdr true-rest))))))))
+ ((null? (cddr true-rest))
+ (let ((test1 (simplify-boolean `(and ,expr ,(car true-rest)) () () env)))
+ (lint-format "perhaps ~A" caller (lists->string form `(if ,test1 ,(cadr true-rest))))))
+
+ ((equal? expr (car true-rest))
+ (lint-format "perhaps ~A" caller (lists->string form true)))
+
+ ((equal? (car true-rest) `(not ,expr))
+ (lint-format "perhaps ~A" caller
+ (lists->string form (caddr true-rest)))))))
- (if (memq true-op '(when unless)) ; (if test0 (when test1 expr...)) -> (when (and test0 test1) expr...)
- (let ((test1 (simplify-boolean (if (eq? true-op 'when)
- `(and ,expr ,(cadr true))
- `(and ,expr (not ,(cadr true))))
- () () env)))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (if (and (pair? test1)
- (eq? (car test1) 'not))
- `(unless ,(cadr test1) ,@(cddr true))
- `(when ,test1 ,@(cddr true))))))))))
(if (and (pair? test)
(memq (car test) '(< <= > >= =)) ; (if (< x y) x y) -> (min x y)
(null? (cdddr test))
@@ -12760,23 +13050,26 @@
'min 'max)))
(lint-format "perhaps ~A" caller (lists->string form `(,f ,true ,false))))))
- (cond ((eq? expr #t)
+ (cond ((eq? expr #t) ; (if #t #f) -> #f
(lint-format "perhaps ~A" caller (lists->string form true)))
((not expr)
(if (eq? false 'no-false)
(if true ; (if #f x) as a kludgey #<unspecified>
(lint-format "perhaps ~A" caller (lists->string form #<unspecified>)))
+ ;; (if (negative? (gcd x y)) a b) -> b
(lint-format "perhaps ~A" caller (lists->string form false))))
((not (equal? true false))
(if (boolean? true)
(if (boolean? false) ; ! (if expr #t #f) turned into something less verbose
+ ;; (if x #f #t) -> (not x)
(lint-format "perhaps ~A" caller
(lists->string form (if true
expr
(simplify-boolean `(not ,expr) () () env))))
(when (= suggestion made-suggestion)
+ ;; (if x #f y) -> (and (not x) y)
(lint-format "perhaps ~A" caller
(lists->string form (if true
(if (eq? false 'no-false)
@@ -12789,6 +13082,7 @@
() () env))))))
(if (and (boolean? false)
(= suggestion made-suggestion))
+ ;; (if x y #t) -> (or (not x) y)
(lint-format "perhaps ~A" caller
(let ((nexpr (if false
(if (and (pair? expr) (eq? (car expr) 'not))
@@ -12797,6 +13091,7 @@
`(and ,expr ,true))))
(lists->string form (simplify-boolean nexpr () () env)))))))
((= len 4)
+ ;; (if x (+ y 1) (+ y 1)) -> (+ y 1)
(lint-format "if is not needed here: ~A" caller
(lists->string form (if (not (side-effect? test env))
true
@@ -12804,14 +13099,15 @@
(when (and (= suggestion made-suggestion)
(not (equal? expr test))) ; make sure the boolean simplification gets reported
+ ;; (or (not (pair? x)) (not (pair? z))) -> (not (and (pair? x) (pair? z)))
(lint-format "perhaps ~A" caller (lists->string test expr)))
(when (pair? true)
(if (and (pair? test)
- (pair? (cdr true))
- (null? (cddr true))
- (or (equal? test (cadr true))
- (equal? expr (cadr true))))
+ (pair? true-rest)
+ (null? (cdr true-rest))
+ (or (equal? test (car true-rest))
+ (equal? expr (car true-rest))))
(lint-format "perhaps ~A" caller
(lists->string form
(if (eq? false 'no-false)
@@ -12822,36 +13118,36 @@
(eq? true-op 'if)
(eq? false-op 'if)
(= (length true) (length false) 4)
- (equal? (cadr true) (cadr false)))
- (if (and (equal? (caddr true) (cadddr false)) ; (if A (if B a b) (if B b a)) -> (if (eq? (not A) (not B)) a b)
- (equal? (cadddr true) (caddr false)))
+ (equal? (car true-rest) (car false-rest)))
+ (if (and (equal? (cadr true-rest) (caddr false-rest)) ; (if A (if B a b) (if B b a)) -> (if (eq? (not A) (not B)) a b)
+ (equal? (caddr true-rest) (cadr false-rest)))
(let* ((switch #f)
(a (if (and (pair? expr)
(eq? (car expr) 'not))
(begin (set! switch #t) expr)
(simplify-boolean `(not ,expr) () () env)))
- (b (if (and (pair? (cadr true))
- (eq? (caadr true) 'not))
- (begin (set! switch (not switch)) (cadr true))
- (simplify-boolean `(not ,(cadr true)) () () env))))
+ (b (if (and (pair? (car true-rest))
+ (eq? (caar true-rest) 'not))
+ (begin (set! switch (not switch)) (car true-rest))
+ (simplify-boolean `(not ,(car true-rest)) () () env))))
(lint-format "perhaps ~A" caller
(lists->string form
(if switch
- `(if (eq? ,a ,b) ,(caddr false) ,(caddr true))
- `(if (eq? ,a ,b) ,(caddr true) ,(caddr false))))))
+ `(if (eq? ,a ,b) ,(cadr false-rest) ,(cadr true-rest))
+ `(if (eq? ,a ,b) ,(cadr true-rest) ,(cadr false-rest))))))
(unless (or (side-effect? expr env)
- (equal? (cddr true) (cddr false))) ; handled elsewhere
- (if (equal? (caddr true) (caddr false)) ; (if A (if B a b) (if B a c)) -> (if B a (if A b c))
+ (equal? (cdr true-rest) (cdr false-rest))) ; handled elsewhere
+ (if (equal? (cadr true-rest) (cadr false-rest)) ; (if A (if B a b) (if B a c)) -> (if B a (if A b c))
(lint-format "perhaps ~A" caller
(lists->string form
- `(if ,(cadr true) ,(caddr true)
- (if ,expr ,(cadddr true) ,(cadddr false)))))
- (if (equal? (cadddr true) (cadddr false)) ; (if A (if B a b) (if B c b)) -> (if B (if A a c) b)
+ `(if ,(car true-rest) ,(cadr true-rest)
+ (if ,expr ,(caddr true-rest) ,(caddr false-rest)))))
+ (if (equal? (caddr true-rest) (caddr false-rest)) ; (if A (if B a b) (if B c b)) -> (if B (if A a c) b)
(lint-format "perhaps ~A" caller
(lists->string form
- `(if ,(cadr true)
- (if ,expr ,(caddr true) ,(caddr false))
- ,(cadddr true))))))))))
+ `(if ,(car true-rest)
+ (if ,expr ,(cadr true-rest) ,(cadr false-rest))
+ ,(caddr true-rest))))))))))
;; --------
(when (and (= suggestion made-suggestion)
(not (= line-number last-if-line-number)))
@@ -12928,8 +13224,30 @@
(lint-format "perhaps place the much shorter branch first~A: ~A" caller
(local-line-number (cadr form))
(truncated-lists->string form `(if ,new-expr ,false ,true))))))))))
- ;; --------
+ ;; if+let() -> when: about a dozen hits
+ (let ((ntrue (and (pair? true) ; (if A B (let () (display x))) -> (if A B (begin (display x)))
+ (eq? true-op 'let)
+ (pair? (cdr true))
+ (null? (cadr true))
+ (not (tree-table-member definers (cddr true)))
+ (cddr true)))
+ (nfalse (and (pair? false)
+ (eq? false-op 'let)
+ (pair? (cdr false))
+ (null? (cadr false))
+ (not (tree-table-member definers (cddr false)))
+ (cddr false))))
+ (if (or ntrue nfalse)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (if (eq? false 'no-false)
+ `(when ,expr , at ntrue)
+ (if ntrue
+ (if nfalse
+ `(if ,expr (begin , at ntrue) (begin , at nfalse))
+ `(if ,expr (begin , at ntrue) ,false))
+ `(if ,expr ,true (begin , at nfalse))))))))
(when (= len 4)
;; move repeated test to top, if no inner false branches
;; (if A (if B C) (if B D)) -> (if B (if A C D))
@@ -12937,14 +13255,14 @@
(pair? false)
(eq? true-op 'if)
(eq? false-op 'if)
- (equal? (cadr true) (cadr false))
- (null? (cdddr true))
- (null? (cdddr false)))
+ (equal? (car true-rest) (car false-rest))
+ (null? (cddr true-rest))
+ (null? (cddr false-rest)))
(lint-format "perhaps ~A" caller
- (lists->string form `(if ,(cadr (caddr form))
+ (lists->string form `(if ,(car true-rest)
(if ,expr
- ,(caddr (caddr form))
- ,(caddr (cadddr form)))))))
+ ,(cadr true-rest)
+ ,(cadr false-rest))))))
;; move repeated start/end statements out of the if
(let ((ltrue (if (and (pair? true) (eq? true-op 'begin)) true (list 'begin true)))
@@ -12981,6 +13299,7 @@
(set! new-false (if (null? (cdr new-false))
(car new-false)
(cons 'begin new-false))))
+ ;; (if x (display y) (begin (set! z y) (display y))) -> (begin (if (not x) (set! z y)) (display y))
(lint-format "perhaps ~A" caller
(lists->string form
(let ((body (if (null? new-true)
@@ -12992,9 +13311,9 @@
,body
, at end))))))))))
- (when (and (= suggestion made-suggestion) ; (if (not a) A B) -> (if a B A)
+ (when (and (= suggestion made-suggestion) ; not redundant -- this will repeat the earlier suggestion in many cases
(not (= line-number last-if-line-number))
- (pair? expr)
+ (pair? expr) ; (if (not a) A B) -> (if a B A)
(eq? (car expr) 'not)
(> (tree-leaves true) (tree-leaves false)))
(lint-format "perhaps ~A" caller
@@ -13005,15 +13324,15 @@
(pair? false)
(eq? true-op 'let)
(eq? false-op 'let)
- (pair? (cadr true))
- (pair? (cadr false)))
- (let ((true-vars (map car (cadr true)))
- (false-vars (map car (cadr false)))
+ (pair? (car true-rest))
+ (pair? (car false-rest)))
+ (let ((true-vars (map car (car true-rest)))
+ (false-vars (map car (car false-rest)))
(shared-vars ()))
(for-each (lambda (v)
(if (and (memq v false-vars)
- (equal? (cadr (assq v (cadr true)))
- (cadr (assq v (cadr false)))))
+ (equal? (cadr (assq v (car true-rest)))
+ (cadr (assq v (car false-rest)))))
(set! shared-vars (cons v shared-vars))))
true-vars)
(when (pair? shared-vars)
@@ -13025,19 +13344,21 @@
(if (memq (car v) shared-vars)
(set! sv (cons v sv))
(set! ntv (cons v ntv))))
- (cadr true))
+ (car true-rest))
(set! ntv (if (or (pair? ntv)
- (pair? (cdddr true))) ; even define is safe here because outer let blocks it just as inner let used to
- `(let ,(reverse ntv) ,@(cddr true))
- (caddr true)))
+ (pair? (cddr true-rest))) ; even define is safe here because outer let blocks it just as inner let used to
+ `(let ,(reverse ntv) ,@(cdr true-rest))
+ (cadr true-rest)))
(for-each (lambda (v)
(if (not (memq (car v) shared-vars))
(set! nfv (cons v nfv))))
- (cadr false))
+ (car false-rest))
(set! nfv (if (or (pair? nfv)
- (pair? (cdddr false)))
- `(let ,(reverse nfv) ,@(cddr false))
- (caddr false)))
+ (pair? (cddr false-rest)))
+ `(let ,(reverse nfv) ,@(cdr false-rest))
+ (cadr false-rest)))
+ ;; (if (> (+ a b) 3) (let ((a x) (c y)) (* a (log c))) (let ((b z) (c y)) (+... ->
+ ;; (let ((c y)) (if (> (+ a b) 3) (let ((a x)) (* a (log c))) (let ((b z)) (+ b (log c)))))
(lint-format "perhaps ~A" caller
(lists->string form
(if (not (or (side-effect? expr env)
@@ -13046,12 +13367,13 @@
(let ((uniq (find-unique-name form)))
`(let ((,uniq ,expr))
(let ,(reverse sv)
- (if ,uniq ,ntv ,nfv)))))))))))))
-
+ (if ,uniq ,ntv ,nfv))))))))))))) ; (when (and (= suggestion made-suggestion)...))
+
(when (and *report-one-armed-if*
(eq? false 'no-false)
(or (not (integer? *report-one-armed-if*))
(> (tree-leaves true) *report-one-armed-if*)))
+ ;; (if a (begin (set! x y) z)) -> (when a (set! x y) z)
(lint-format "~A~A~A perhaps ~A" caller
(if (integer? *report-one-armed-if*)
"this one-armed if is too big"
@@ -13067,8 +13389,12 @@
(if (symbol? expr)
(set-ref expr caller form env)
(lint-walk caller expr env))
- (set! env (lint-walk caller true env))
- (if (= len 4)
+ (if (symbol? true)
+ (set-ref true caller form env)
+ (set! env (lint-walk caller true env)))
+ (if (symbol? false)
+ (if (not (eq? false 'no-false))
+ (set-ref false caller form env))
(set! env (lint-walk caller false env))))))
env))
(hash-table-set! h 'if if-walker))
@@ -13085,6 +13411,7 @@
(head (car form)))
(if (and (pair? test)
(eq? (car test) 'not))
+ ;; (when (not a) (set! x y)) -> (unless a (set! x y))
(lint-format "perhaps ~A"
caller
(truncated-lists->string form
@@ -13093,7 +13420,7 @@
,@(cddr form)))))
(if (never-false test)
(lint-format "~A test is never false: ~A" caller head (truncated-list->string form))
- (if (never-true test)
+ (if (never-true test) ; (unless #f...)
(lint-format "~A test is never true: ~A" caller head (truncated-list->string form))))
(if (symbol? test)
@@ -13122,12 +13449,14 @@
(and (pair? arg2)
(eq? (car arg2) 'not)))
(if (eq? head 'unless)
+ ;; (unless (and x (not y)) (display z)) -> (when (or (not x) y) ...)
(lint-format "perhaps ~A" caller
(lists->string form `(when ,(simplify-boolean `(not ,test) () () env) ...)))
(if (and (pair? arg1)
(eq? (car arg1) 'not)
(pair? arg2)
(eq? (car arg2) 'not))
+ ;; (when (and (not x) (not y)) (display z)) -> (unless (or x y) ...)
(lint-format "perhaps ~A" caller
(lists->string form `(unless (or ,(cadr arg1) ,(cadr arg2)) ...))))))))
(lint-walk caller test env)))
@@ -13156,6 +13485,7 @@
`(not ,test)
test)))
(simplify-boolean `(and ,outer-test ,inner-test) () () env))))
+ ;; (when (and (< x 1) y) (if z (display z))) -> (when (and (< x 1) y z) (display z))
(lint-format "perhaps ~A" caller
(lists->string form
(if (and (pair? new-test)
@@ -13183,7 +13513,7 @@
(prev-clause #f)
(all-eqv #t)
(eqv-select #f))
-
+
;; (cond (A (and B C)) (else (and B D))) et al never happens
;; also (cond (A C) (B C)) -> (if (or A B) C) [non-pair C]
;; ----------------
@@ -13235,6 +13565,8 @@
(trailer (copy first-result (make-list trailer-len) (- (length first-result) trailer-len))))
(if (= len 2)
(unless (equal? first-result (cadr else-clause)) ; handled elsewhere (all results equal -> result)
+ ;; (cond (x (for-each (lambda (x) (display (+ x a))) (f y))) (else (for-each... ->
+ ;; (for-each (lambda (x) (display (+ x a))) (if x (f y) (g y)))
(lint-format "perhaps ~A" caller
(let ((else-result (cadr else-clause)))
(let ((first-mid-len (- (length first-result) header-len trailer-len))
@@ -13250,16 +13582,17 @@
(lists->string form `(, at header (if ,(car first-clause) ,fmid ,emid) , at trailer)))))))
;; len > 2 so use cond in the revision
(let ((middle (map (lambda (c)
- (let ((test (car c))
- (result (cadr c)))
- (let ((mid-len (- (length result) header-len trailer-len)))
- (if (and else-error
- (eq? c else-clause))
- else-clause
+ (if (and else-error
+ (eq? c else-clause))
+ else-clause
+ (let ((test (car c))
+ (result (cadr c)))
+ (let ((mid-len (- (length result) header-len trailer-len)))
`(,test ,(if (= mid-len 1)
(list-ref result header-len)
`(values ,@(copy result (make-list mid-len) header-len))))))))
(cdr form))))
+ ;; (cond ((< x 1) (+ x 1)) ((< y 1) (+ x 3)) (else (+ x 2))) -> (+ x (cond ((< x 1) 1) ((< y 1) 3) (else 2)))
(lint-format "perhaps ~A" caller
(lists->string form `(, at header (cond , at middle) , at trailer))))))))
(partition-form (cdr form) (if else-error (- len 1) len)))))
@@ -13277,12 +13610,14 @@
(if (every? (lambda (c)
(eq? first-func (caadr c))) ; all result clauses are the same!?
(cddr form)) ; possibly no else, so not always a duplicate message
+ ;; (cond (X (f y z)) (Y (f y z)) (Z (f y z))) -> (if (or X Y Z) (f y z))
(lint-format "perhaps ~A" caller
(lists->string form
`(if (or ,@(map car (cdr form)))
,first-result)))
;; here we need an else clause else (apply #<unspecified> args)
(if (memq (car else-clause) '(#t else))
+ ;; (cond (X (f y z)) (else (g y z))) -> ((cond (X f) (else g)) y z)
(lint-format "perhaps ~A" caller
(lists->string form
`((cond ,@(map (lambda (c)
@@ -13299,7 +13634,8 @@
(begin
(set! all-eqv #f)
(set! has-combinations #f)
- (lint-format "cond clause ~A in ~A is not a pair?" caller clause (truncated-list->string form)))
+ ;; ; (cond 1)
+ (lint-format "cond clause ~A in ~A is not a pair?" caller clause (truncated-list->string form)))
(begin
(when all-eqv
@@ -13316,6 +13652,7 @@
(equal? (cdr clause) (cdr prev-clause)))
(if (memq (car clause) '(else #t)) ; (cond ... (x z) (else z)) -> (cond ... (else z))
(unless (side-effect? (car prev-clause) env)
+ ;; (cond (x y) (z 32) (else 32))
(lint-format* caller
"this clause could be omitted: "
(truncated-list->string prev-clause)))
@@ -13359,16 +13696,19 @@
(when (pair? sequel)
(if (eq? first-sequel #<unspecified>)
+ ;; (cond ((= x y) z) (else #<unspecified>)
(lint-format "this #<unspecified> is redundant: ~A" caller clause))
(if (and (pair? first-sequel) ; (cond (a A) (else (cond ...))) -> (cond (a A) ...)
(null? (cdr sequel))) ; similarly for if, when, and unless
(case (car first-sequel)
((cond)
+ ;; (cond ((< x 1) 2) (else (cond ((< y 3) 2) (#t 4))))
(lint-format "else clause could be folded into the outer cond: ~A" caller
(lists->string form (append (copy form (make-list ctr))
(cdr first-sequel)))))
((if)
+ ;; (cond (a A) (else (if b B)))
(lint-format "else clause could be folded into the outer cond: ~A" caller
(lists->string form
(append (copy form (make-list ctr))
@@ -13377,6 +13717,7 @@
`((,(cadr first-sequel) ,@(unbegin (caddr first-sequel)))
(else ,@(unbegin (cadddr first-sequel)))))))))
((when unless)
+ ;; (cond (a A) (else (when b B)))
(lint-format "else clause could be folded into the outer cond: ~A" caller
(lists->string form
(append (copy form (make-list ctr))
@@ -13386,61 +13727,76 @@
((not (= ctr len)))
((equal? test ''else)
+ ;; (cond (x y) ('else z))
(lint-format "odd cond clause test: is 'else supposed to be else? ~A" caller
(truncated-list->string clause)))
((and (eq? test 't)
(not (var-member 't env)))
+ ;; (cond ((= x 1) 1) (t 2)
(lint-format "odd cond clause test: is t supposed to be #t? ~A" caller
(truncated-list->string clause))))
(if (never-false expr)
(if (not (= ctr len))
+ ;; (cond ((getenv s) x) ((= y z) w))
(lint-format "cond test ~A is never false: ~A" caller (car clause) (truncated-list->string form))
(if (not (or (memq expr '(#t else))
(side-effect? test env)))
(lint-format "cond last test could be #t: ~A" caller form)))
(if (never-true expr)
+ ;; (cond ((< 3 1) 2))
(lint-format "cond test ~A is never true: ~A" caller (car clause) (truncated-list->string form))))
(unless (side-effect? test env)
- (if (and (not (memq test '(else #t)))
- (pair? sequel)
- (null? (cdr sequel)))
- (cond ((equal? test first-sequel)
- (lint-format "no need to repeat the test: ~A" caller (lists->string clause (list test))))
-
- ((and (pair? first-sequel)
- (pair? (cdr first-sequel))
- (null? (cddr first-sequel))
- (equal? test (cadr first-sequel)))
- (if (eq? (car first-sequel) 'not)
- (lint-format "perhaps replace ~A with #f" caller first-sequel)
- (lint-format "perhaps use => here: ~A" caller
- (lists->string clause (list test '=> (car first-sequel))))))
-
- ((and (eq? first-sequel #t)
- (pair? test)
- (not (memq (car test) '(or and)))
- (eq? (return-type (car test) env) 'boolean?))
- (lint-format "this #t could be omitted: ~A" caller (truncated-list->string clause)))))
+ (cond ((or (memq test '(else #t))
+ (not (pair? sequel))
+ (pair? (cdr sequel))))
+
+ ((equal? test first-sequel)
+ ;; (cond ((= x 0) x) ((= x 1) (= x 1)))
+ (lint-format "no need to repeat the test: ~A" caller (lists->string clause (list test))))
+
+ ((and (pair? first-sequel)
+ (pair? (cdr first-sequel))
+ (null? (cddr first-sequel))
+ (equal? test (cadr first-sequel)))
+ (if (eq? (car first-sequel) 'not)
+ ;; (cond ((> x 2) (not (> x 2))))
+ (lint-format "perhaps replace ~A with #f" caller first-sequel)
+ ;; (cond (x (abs x)))
+ (lint-format "perhaps use => here: ~A" caller
+ (lists->string clause (list test '=> (car first-sequel))))))
+
+ ((and (eq? first-sequel #t)
+ (pair? test)
+ (not (memq (car test) '(or and)))
+ (eq? (return-type (car test) env) 'boolean?))
+ ;; (cond ((null? x) #t) (else y))
+ (lint-format "this #t could be omitted: ~A" caller (truncated-list->string clause))))
+
(if (member test exprs)
+ ;; (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5))
(lint-format "cond test repeated: ~A" caller (truncated-list->string clause))
(set! exprs (cons test exprs))))
(if (boolean? expr)
(if (not expr)
+ ;; (cond ((< 3 1) 2))
(lint-format "cond test is always false: ~A" caller (truncated-list->string clause))
(if (not (= ctr len))
+ ;; (cond (#t 2) (x 3))
(lint-format "cond #t clause is not the last: ~A" caller (truncated-list->string form))))
(if (eq? test 'else)
(if (not (= ctr len))
+ ;; (cond (else 2) (x 3))
(lint-format "cond else clause is not the last: ~A" caller (truncated-list->string form)))
(lint-walk caller test env)))
(if (and (symbol? expr)
(not (var-member expr env))
(procedure? (symbol->value expr *e*)))
+ ;; (cond (< x 1) (else 1))
(lint-format "strange cond test: ~A in ~A is a procedure" caller expr clause))
(if (eq? result :unset)
@@ -13457,6 +13813,7 @@
((or (not (pair? (cdr sequel)))
(pair? (cddr sequel)))
+ ;; (cond (x =>))
(lint-format "cond => target is messed up: ~A" caller (truncated-list->string clause)))
(else (let ((f (cadr sequel)))
@@ -13464,6 +13821,7 @@
(let ((val (symbol->value f *e*)))
(when (procedure? val)
(if (not (aritable? val 1)) ; here values might be in test expr
+ ;; (cond (x => expt))
(lint-format "=> target (~A) may be unhappy: ~A" caller f clause))
(let ((sig (procedure-signature val)))
(if (and (pair? sig)
@@ -13473,6 +13831,7 @@
(if (not (or (memq from-type '(#f #t values))
(memq to-type '(#f #t values))
(any-compatible? to-type from-type)))
+ ;; (cond ((> x 0) => abs) (else y))
(lint-format "in ~A, ~A returns a ~A, but ~A expects ~A" caller
(truncated-list->string clause)
expr (prettify-checker-unq from-type)
@@ -13506,6 +13865,7 @@
(if has-else
(if (pair? result) ; all result clauses are the same (and not implicit)
+ ;; (cond (x #t) (else #t)) -> #t
(lint-format "perhaps ~A" caller (lists->string form
(if (null? (cdr result))
(car result)
@@ -13519,6 +13879,7 @@
(list-ref last-clause (- clen 1))))))
(if (and (pair? last-res)
(memq (car last-res) '(#t else)))
+ ;; (cond (x y) (y z (else 3)))
(lint-format "perhaps cond else clause is misplaced: ~A in ~A" caller last-res last-clause))))
(when (and (= len 2)
@@ -13546,53 +13907,55 @@
`(cond (,(cadar c1) ,@(cdr c2)) (else ,@(cdr c1)))
`(if ,(cadar c1) ,(cadr c2) ,(cadr c1)))))))))))
(when has-combinations
- (let ((new-clauses ())
- (current-clauses ()))
- (do ((clauses (cdr form) (cdr clauses)))
- ((null? clauses)
- (let ((len (length new-clauses)))
- (unless (and (= len 2) ; i.e. don't go to check-bool-cond
- (check-bool-cond caller form (cadr new-clauses) (car new-clauses) env))
- (lint-format "perhaps ~A" caller
- (lists->string
- form
- (cond (all-eqv
- (cond->case eqv-select (reverse new-clauses)))
- ((not (and (= len 2)
- (pair? (car new-clauses))
- (memq (caar new-clauses) '(else #t))
- (pair? (cadr new-clauses))
- (pair? (caadr new-clauses))
- (eq? (caaadr new-clauses) 'or)
- (null? (cdadr new-clauses))))
- `(cond ,@(reverse new-clauses)))
- ((null? (cddar new-clauses)) ; (cond (A) (B) (else C)) -> (or A B C)
- `(or ,@(cdaadr new-clauses) ,(cadar new-clauses)))
- (else `(or ,@(cdaadr new-clauses) (begin ,@(cdar new-clauses))))))))
- (set! simplifications ())
- (set! all-eqv #f)))
-
- (let* ((clause (car clauses))
- (result (cdr clause))) ; can be null in which case the test is the result
- (cond ((and (pair? simplifications)
- (assq clause simplifications))
- => (lambda (e)
- (set! clause (cons (cdr e) result)))))
- (if (and (pair? (cdr clauses))
- (equal? result (cdadr clauses)))
- (set! current-clauses (cons clause current-clauses))
- (if (pair? current-clauses)
- (begin
- (set! current-clauses (cons clause current-clauses))
- (set! new-clauses (cons
- (cons (simplify-boolean `(or ,@(map car (reverse current-clauses))) () () env)
- result)
- new-clauses))
- (set! current-clauses ()))
- (set! new-clauses (cons clause new-clauses))))))))
+ (do ((new-clauses ())
+ (current-clauses ())
+ (clauses (cdr form) (cdr clauses)))
+ ((null? clauses)
+ (let ((len2 (= (length new-clauses) 2)))
+ (unless (and len2 ; i.e. don't go to check-bool-cond
+ (check-bool-cond caller form (cadr new-clauses) (car new-clauses) env))
+ ;; (cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4)) -> (case x ((3) 3) ((2 1) 4))
+ (lint-format "perhaps ~A" caller
+ (lists->string
+ form
+ (cond (all-eqv
+ (cond->case eqv-select (reverse new-clauses)))
+ ((not (and len2
+ (pair? (car new-clauses))
+ (memq (caar new-clauses) '(else #t))
+ (pair? (cadr new-clauses))
+ (pair? (caadr new-clauses))
+ (eq? (caaadr new-clauses) 'or)
+ (null? (cdadr new-clauses))))
+ `(cond ,@(reverse new-clauses)))
+ ((null? (cddar new-clauses)) ; (cond (A) (B) (else C)) -> (or A B C)
+ `(or ,@(cdaadr new-clauses) ,(cadar new-clauses)))
+ (else `(or ,@(cdaadr new-clauses) (begin ,@(cdar new-clauses))))))))
+ (set! simplifications ())
+ (set! all-eqv #f)))
+
+ (let* ((clause (car clauses))
+ (result (cdr clause))) ; can be null in which case the test is the result
+ (cond ((and (pair? simplifications)
+ (assq clause simplifications))
+ => (lambda (e)
+ (set! clause (cons (cdr e) result)))))
+ (if (and (pair? (cdr clauses))
+ (equal? result (cdadr clauses)))
+ (set! current-clauses (cons clause current-clauses))
+ (if (pair? current-clauses)
+ (begin
+ (set! current-clauses (cons clause current-clauses))
+ (set! new-clauses (cons
+ (cons (simplify-boolean `(or ,@(map car (reverse current-clauses))) () () env)
+ result)
+ new-clauses))
+ (set! current-clauses ()))
+ (set! new-clauses (cons clause new-clauses)))))))
(when (and all-eqv
(> len (if has-else 2 1))) ; (cond (x y)) -- kinda dumb, but (if x y) isn't much shorter
+ ;; (cond ((= x 0) x) ((= x 1) (= x 1))) -> (case x ((0) x) ((1) (= x 1)))
(lint-format "perhaps use case instead of cond: ~A" caller
(lists->string form (cond->case eqv-select (cdr form)))))
@@ -13602,6 +13965,7 @@
(let ((else-clause (if (null? (cddr (caddr form)))
(cadr (caddr form))
`(begin ,@(cdr (caddr form))))))
+ ;; (cond ((a)) (else A)) -> (or (a) A)
(lint-format "perhaps ~A" caller (lists->string form `(or ,(caadr form) ,else-clause)))))
;; --------
@@ -13640,6 +14004,7 @@
(not (pair? (car clauses))))
(if (and changed
(null? clauses))
+ ;; (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5)) -> (cond ((< x 2) 3) ((> x 0) 4))
(lint-format "perhaps ~A" caller
(lists->string form `(cond ,@(reverse (map (lambda (c)
(if (not (car c)) (values) c))
@@ -13735,6 +14100,8 @@
(not (cond-eqv? (car clause) eqv-select #t)))))
(when (and (pair? clauses)
(> ctr 1))
+ ;; (cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... ->
+ ;; (if (pair? x) 3 (case x ((a) z) ((b) (* 2 z)) ((c) (display z))))
(lint-format "possibly use case at the end: ~A" caller
(lists->string form
(let ((else-case (cond->case eqv-select ; cond->case will handle the else branch
@@ -13786,6 +14153,8 @@
(when (and (pair? reps)
(> ctr 1)
(< else-leaves (* ctr (length reps) 3)))
+ ;; (cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2) (else 0)) ->
+ ;; (cond ((pair? z) 32) ((not (pair? x)) 0) ((pair? w) 12) (else 2))
(lint-format "perhaps ~A" caller
(lists->string form
(let ((not-reps
@@ -13828,6 +14197,7 @@
(if (and (not (eq? (cadr clause) '=>))
(or (pair? (cddr clause))
(= suggest made-suggestion)))
+ ;; (cond ((= x 1) 32)) -> (if (= x 1) 32)
(lint-format "perhaps ~A" caller
(lists->string form
(if (null? (cddr clause))
@@ -13844,12 +14214,13 @@
(pair? (cadr form))
(pair? (cdadr form)))
(let ((result (list-ref (cadr form) (- (length (cadr form)) 1)))
- (else-clause (list-ref form len)))
+ (else-clause (cdr (list-ref form len))))
(when (every? (lambda (c)
(and (pair? c)
(pair? (cdr c))
(equal? result (list-ref c (- (length c) 1)))))
(cddr form))
+ ;; (cond ((and (display x) x) 32) (#t 32)) -> (begin (and (display x) x) 32)
(lint-format "perhaps ~A" caller
(lists->string form
(if (= len 2) ; one is else -- this case is very common
@@ -13858,11 +14229,11 @@
((1) #f)
((2) (cadr last-clause))
(else `(begin ,@(copy (cdr last-clause) (make-list (- c1-len 1)))))))
- (else-len (length (cdr else-clause)))
+ (else-len (length else-clause))
(new-else (case else-len
((1) #f)
- ((2) (cadr else-clause))
- (else `(begin ,@(copy (cdr else-clause) (make-list (- else-len 1))))))))
+ ((2) (car else-clause))
+ (else `(begin ,@(copy else-clause (make-list (- else-len 1))))))))
`(begin
,(if (= c1-len 1)
(if new-else
@@ -13893,19 +14264,19 @@
(and (pair? (cdr last-clause))
(null? (cddr last-clause))
(boolean? (cadr last-clause)))))
- (let ((else-clause (list-ref form len))
- (next-clause (list-ref form (- len 2))))
- (when (and (pair? (cdr else-clause))
- (null? (cddr else-clause))
- (boolean? (cadr else-clause))
- (not (equal? (cdr last-clause) (cdr else-clause)))
- (pair? (cdr next-clause))
- (null? (cddr next-clause))
- (not (boolean? (cadr next-clause))))
+ (let ((else-clause (cdr (list-ref form len)))
+ (next-clause (cdr (list-ref form (- len 2)))))
+ (when (and (pair? else-clause)
+ (null? (cdr else-clause))
+ (boolean? (car else-clause))
+ (not (equal? (cdr last-clause) else-clause))
+ (pair? next-clause)
+ (null? (cdr next-clause))
+ (not (boolean? (car next-clause))))
(lint-format "perhaps ~A" caller
(lists->string form
`(,@(copy form (make-list (- len 1)))
- (else ,(if (cadr else-clause)
+ (else ,(if (car else-clause)
`(not ,(car last-clause))
(car last-clause)))))))))
;; (cond ((= x y) 2) ((= x 2) #f) (else #t)) -> (cond ((= x y) 2) (else (not (= x 2))))
@@ -13913,7 +14284,7 @@
(when (= len 3)
(let ((first-clause (cadr form))
- (else-clause (list-ref form len)))
+ (else-clause (cdr (list-ref form len))))
(when (and (or (null? (cdr first-clause))
(and (null? (cddr first-clause))
@@ -13931,22 +14302,23 @@
(simplify-boolean
`(and (not ,(car first-clause))
(or ,(car last-clause)
- ,@(if (null? (cddr else-clause))
- (cdr else-clause)
- `(begin ,@(cdr else-clause)))))
+ ,@(if (null? (cdr else-clause))
+ else-clause
+ `(begin , at else-clause))))
() () env)))
(if (and (or (null? (cdr first-clause)) ; (cond (A #t) (B C) (else #f)) -> (or A (and B C))
(eq? (cadr first-clause) #t))
- (not (cadr else-clause))
- (null? (cddr else-clause)))
+ (not (car else-clause))
+ (null? (cdr else-clause)))
(lint-format "perhaps ~A" caller
(lists->string form
`(or ,(car first-clause)
(and , at last-clause)))))))
- (when (and (equal? (cdr first-clause) (cdr else-clause)) ; a = else result
- (pair? (cdr last-clause)) ; b does exist
- (not (eq? (cadr last-clause) '=>))) ; no => in b
+ (when (and (equal? (cdr first-clause) else-clause) ; a = else result
+ (pair? (cdr last-clause)) ; b does exist
+ (not (eq? (cadr last-clause) '=>))) ; no => in b
+ ;; (cond (A a) (B b) (else a)) -> (if (or A (not B)) a b)
(lint-format "perhaps ~A" caller
(lists->string form
(let ((A (car first-clause))
@@ -14000,6 +14372,7 @@
(null? (cddr arg2))
(member (car arg2) (cdar arg1))
(= (length (cdar arg1)) 2))
+ ;; (cond ((and A B) c) (B d) (else e)) -> (cond (B (if A c d)) (else e))
(lint-format "perhaps ~A" caller
(lists->string form
`(cond (,(car arg2)
@@ -14012,10 +14385,11 @@
(pair? (car last-clause))
(null? (cdr last-clause))
(eq? (caar last-clause) 'or))
- (let ((else-clause (let ((e (list-ref form len)))
- (if (null? (cddr e))
- (cadr e)
- `(begin ,@(cdr e))))))
+ (let ((else-clause (let ((e (cdr (list-ref form len))))
+ (if (null? (cdr e))
+ (car e)
+ `(begin , at e)))))
+ ;; (cond ((A) B) ((or C D)) (else E)) -> (cond ((A) B) (else (or C D E)))
(lint-format "perhaps ~A" caller
(lists->string form
`(cond ,@(copy (cdr form) (make-list (- len 2)))
@@ -14034,19 +14408,21 @@
()
(list #<unspecified>)))))
(if (eq? (caadr last-clause) 'cond)
+ ;; (cond (A (cond (B c) (else D))) (else E)) -> (cond ((not A) E) (B c) (else D))
(lint-format "perhaps ~A" caller
(lists->string form
`(cond ,@(copy (cdr form) (make-list (- len (if has-else 2 1))))
(,new-test , at new-result)
,@(cdadr last-clause))))
(if (= (length (cadr last-clause)) 4)
- (let ((if-form (cadr last-clause)))
+ (let ((if-form (cdadr last-clause)))
+ ;; (cond (A B) (C (if D d E)) (else F)) -> (cond (A B) ((not C) F) (D d) (else E))
(lint-format "perhaps ~A" caller
(lists->string form
`(cond ,@(copy (cdr form) (make-list (- len (if has-else 2 1))))
(,new-test , at new-result)
- (,(cadr if-form) ,@(unbegin (caddr if-form)))
- (else ,@(unbegin (cadddr if-form))))))))))
+ (,(car if-form) ,@(unbegin (cadr if-form)))
+ (else ,@(unbegin (caddr if-form))))))))))
(when (> len 2) ; rewrite nested conds as one cond
(let ((lim (if has-else (- len 2) len))
(tlen (tree-leaves form)))
@@ -14072,6 +14448,8 @@
(null? (cddr (caddr p))))
`(if ,(caadr p) ,(cadadr p) ,(cadr (caddr p)))
`(cond ,@(cdr p)))))
+ ;; (cond ((= x 0) 1) ((= x 3) (cond ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))) ((< x 200) 2) (else 5)) ->
+ ;; (cond ((= x 0) 1) ((not (= x 3)) (if (< x 200) 2 5)) ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))
(lint-format "perhaps ~A" caller
(lists->string form
`(cond ,@(copy (cdr form) (make-list i))
@@ -14089,11 +14467,12 @@
;; also unlike cond, only 'else marks a default branch (not #t)
(if (< (length form) 3)
+ ;; (case 3)
(lint-format "case is messed up: ~A" caller (truncated-list->string form))
(let ((sel-type #t)
(selector (cadr form))
(suggest made-suggestion))
-
+
;; ----------------
;; if regular case + else -- just like cond above
(let ((len (- (length form) 2))) ; number of clauses
@@ -14120,6 +14499,7 @@
(not (hash-table-ref syntaces (caadr c)))
(equal? (cdadr first-clause) (cdadr c))))
(cdddr form)))
+ ;; (case x ((a) (f y z)) (else (g y z))) -> ((if (eq? x 'a) f g) y z)
(lint-format "perhaps ~A" caller ; all results share trailing args
(lists->string form
(if (and (= len 2)
@@ -14172,6 +14552,7 @@
(trailer (copy first-result (make-list trailer-len) (- (length first-result) trailer-len))))
(if (= len 2)
(unless (equal? first-result (cadr else-clause)) ; handled elsewhere (all results equal -> result)
+ ;; (case x ((1) (+ x 1)) (else (+ x 3))) -> (+ x (if (eqv? x 1) 1 3))
(lint-format "perhaps ~A" caller
(let ((else-result (cadr else-clause)))
(let ((first-mid-len (- (length first-result) header-len trailer-len))
@@ -14190,16 +14571,17 @@
(lists->string form `(, at header (if ,middle ,fmid ,emid) , at trailer)))))))
;; len > 2 so use case in the revision
(let ((middle (map (lambda (c)
- (let ((test (car c))
- (result (cadr c)))
- (let ((mid-len (- (length result) header-len trailer-len)))
- (if (and else-error
- (eq? c else-clause))
- else-clause
+ (if (and else-error
+ (eq? c else-clause))
+ else-clause
+ (let ((test (car c))
+ (result (cadr c)))
+ (let ((mid-len (- (length result) header-len trailer-len)))
`(,test ,(if (= mid-len 1)
(list-ref result header-len)
`(values ,@(copy result (make-list mid-len) header-len))))))))
(cddr form))))
+ ;; (case x ((0) (log x 2)) ((1) (log x 3)) (else (error 'oops))) -> (log x (case x ((0) 2) ((1) 3) (else (error 'oops))))
(lint-format "perhaps ~A" caller
(lists->string form `(, at header (case ,(cadr form) , at middle) , at trailer))))))))
(partition-form (cddr form) (if else-error (- len 1) len)))))))))
@@ -14223,25 +14605,34 @@
(when (and (pair? clause)
(pair? (car clause))
(pair? (cdr clause)))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (let ((test (cond ((pair? (cdar clause))
- `(memv ,(cadr form) ',(car clause)))
- ((and (symbol? (caar clause))
- (not (keyword? (caar clause))))
- `(eq? ,(cadr form) ',(caar clause)))
- ((or (keyword? (caar clause))
- (null? (caar clause)))
- `(eq? ,(cadr form) ,(caar clause)))
- ((not (boolean? (caar clause)))
- `(eqv? ,(cadr form) ,(caar clause)))
- ((caar clause)
- (cadr form))
- (else `(not ,(cadr form)))))
- (op (if (and (pair? (cdr clause))
- (pair? (cddr clause)))
- 'when 'if)))
- `(,op ,test ,@(cdr clause)))))))
+ (let ((keys (car clause)))
+ ;; (case 3 ((0) #t)) -> (if (eqv? 3 0) #t)
+ ;; (case x ((#(0)) 2)) -> (if (eqv? x #(0)) 2)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (let ((test (cond ((pair? (cdr keys))
+ `(memv ,(cadr form) ',keys))
+
+ ((and (symbol? (car keys))
+ (not (keyword? (car keys))))
+ `(eq? ,(cadr form) ',(car keys)))
+
+ ((or (keyword? (car keys))
+ (null? (car keys)))
+ `(eq? ,(cadr form) ,(car keys)))
+
+ ((not (boolean? (car keys)))
+ `(eqv? ,(cadr form) ,(car keys)))
+
+ ((car keys)
+ (cadr form))
+
+ (else `(not ,(cadr form)))))
+
+ (op (if (and (pair? (cdr clause))
+ (pair? (cddr clause)))
+ 'when 'if)))
+ `(,op ,test ,@(cdr clause))))))))
(when (and (null? (cddr clauses))
(pair? (car clauses))
(pair? (cadr clauses))
@@ -14258,6 +14649,8 @@
(if akey 'eq? 'memq)
(if akey 'eqv? 'memv))))
;; can't use '= or 'char=? here because the selector may return anything
+ ;; (case x ((#\a) 3) (else 4)) -> (if (eqv? x #\a) 3 4)
+ ;; (case x ((a) #t) (else #f)) -> (eq? x 'a)
(lint-format "perhaps ~A" caller
(lists->string form
(cond ((and (boolean? (cadar clauses))
@@ -14295,6 +14688,7 @@
`(if ,select-expr ,(cadar clauses) ,(cadadr clauses))))))))))))
(if (and (not (pair? selector))
(constant? selector))
+ ;; (case 3 ((0) #t))
(lint-format "case selector is a constant: ~A" caller (truncated-list->string form)))
(if (symbol? selector)
(set-ref selector caller form env)
@@ -14305,13 +14699,13 @@
(set! sel-type (return-type (car selector) env))
(if (and (symbol? sel-type)
(not (memq sel-type selector-types)))
+ ;; (case (list 1) ((0) #t))
(lint-format "case selector may not work with eqv: ~A" caller (truncated-list->string selector)))))
(let ((all-keys ())
(all-exprs ())
(ctr 0)
(result :unset)
- ;(end-result :unset)
(exprs-repeated #f)
(else-foldable #f)
(has-else #f)
@@ -14324,22 +14718,12 @@
(let ((keys (car clause))
(exprs (cdr clause)))
(if (null? exprs)
+ ;; (case x (0))
(lint-format "clause result is missing: ~A" caller clause))
(if (eq? result :unset)
(set! result exprs)
(if (not (equal? result exprs))
(set! result :unequal)))
-#|
- ;; about 6 real hits
- (if (eq? end-result :unset)
- (set! end-result
- (if (pair? exprs)
- (list-ref exprs (- (length exprs) 1))
- :unequal))
- (if (not (and (pair? exprs)
- (equal? end-result (list-ref exprs (- (length exprs) 1)))))
- (set! end-result :unequal)))
-|#
(if (member exprs all-exprs)
(set! exprs-repeated exprs)
@@ -14352,12 +14736,15 @@
(equal? selector (cadar exprs)))
(if (and (eq? (caar exprs) 'not)
(not (memq #f keys)))
+ ;; (case x ((0) (f x)) ((1) (not x)))
(lint-format "in ~A, perhaps replace ~A with #f" caller clause (car exprs))
+ ;; (case x ((0 1) (abs x)))
(lint-format "perhaps use => here: ~A" caller
(lists->string clause (list keys '=> (caar exprs))))))
(if (pair? keys)
(if (not (proper-list? keys))
+ ;; (case x ((0) 1) ((1) 2) ((3 . 0) 4))
(lint-format (if (null? keys)
"null case key list: ~A"
"stray dot in case case key list: ~A")
@@ -14367,60 +14754,68 @@
(if (or (vector? key)
(string? key)
(pair? key))
+ ;; (case x ((#(0)) 2))
(lint-format "case key ~S in ~S is unlikely to work (case uses eqv? but it is a ~A)" caller
key clause
(cond ((vector? key) 'vector)
((pair? key) 'pair)
(else 'string))))
(if (member key all-keys)
+ ;; (case x ((0) 1) ((1) 2) ((3 0) 4))
(lint-format "repeated case key ~S in ~S" caller key clause)
(set! all-keys (cons key all-keys)))
;; unintentional quote here, as in (case x ('a b)...) never happens and
;; is hard to distinguish from (case x ((quote a) b)...) which happens a lot
(if (not (compatible? sel-type (->lint-type key)))
+ ;; (case (string->symbol x) ((a) 1) ((2 3) 3))
(lint-format "case key ~S in ~S is pointless" caller key clause)))
keys))
(if (not (eq? keys 'else))
+ ;; (case ((1) 1) (t 2))
(lint-format "bad case key ~S in ~S" caller keys clause)
(begin
(set! has-else clause)
;; exprs: (res) or if case, ((case ...)...)
(if (not (= ctr len))
+ ;; (case x (else 2) ((0) 1))
(lint-format "case else clause is not the last: ~A"
caller
(truncated-list->string (cddr form)))
(when (and (pair? exprs)
(pair? (car exprs))
(null? (cdr exprs)))
- (case (caar exprs)
- ((case) ; just the case statement in the else clause
- (when (and (equal? selector (cadar exprs))
- (not (side-effect? selector env)))
- (set! else-foldable (cddar exprs))))
- ((if) ; just if -- if foldable, make it look like it came from case
- (when (and (equal? selector (eqv-selector (cadar exprs)))
- (cond-eqv? (cadar exprs) selector #t)
- (not (side-effect? selector env)))
- ;; else-foldable as (((keys-from-test) true-branch) (else false-branch))
- (set! else-foldable
- (if (pair? (cdddar exprs))
- `(,(case-branch (cadar exprs) selector (list (caddar exprs)))
- (else ,(car (cdddar exprs))))
- (list (case-branch (cadar exprs) selector (cddar exprs)))))))))))))
+ (let ((expr (car exprs)))
+ (case (car expr)
+ ((case) ; just the case statement in the else clause
+ (when (and (equal? selector (cadr expr))
+ (not (side-effect? selector env)))
+ (set! else-foldable (cddr expr))))
+ ((if) ; just if -- if foldable, make it look like it came from case
+ (when (and (equal? selector (eqv-selector (cadr expr)))
+ (cond-eqv? (cadr expr) selector #t)
+ (not (side-effect? selector env)))
+ ;; else-foldable as (((keys-from-test) true-branch) (else false-branch))
+ (set! else-foldable
+ (if (pair? (cdddr expr))
+ `(,(case-branch (cadr expr) selector (list (caddr expr)))
+ (else ,(car (cdddr expr))))
+ (list (case-branch (cadr expr) selector (cddr expr))))))))))))))
(lint-walk-open-body caller (car form) exprs env))))
(cddr form))
- (if (and has-else
+ (if (and has-else
(pair? result)
(not else-foldable))
(begin
+ ;; (case x (else (case x (else 1)))) -> 1
(lint-format "perhaps ~A" caller (lists->string form
(if (null? (cdr result))
(car result)
`(begin , at result))))
(set! exprs-repeated #f)))
-
+ ;; repeated result (but not all completely equal) and with else never happens
+
(when (or exprs-repeated else-foldable)
(let ((new-keys-and-exprs ())
(mergers ())
@@ -14464,6 +14859,7 @@
(if (null? new-keys-and-exprs)
(lint-format "perhaps ~A" caller
+ ;; (case x (else (case x (else 1)))) -> 1
(lists->string form
(if (or (null? else-clause) ; can this happen? (it's caught above as an error)
(null? (cdr else-clause)))
@@ -14485,6 +14881,7 @@
(let ((new-form (if (pair? else-clause)
`(case ,(cadr form) ,@(reverse new-keys-and-exprs) ,else-clause)
`(case ,(cadr form) ,@(reverse new-keys-and-exprs)))))
+ ;; (case x ((0) 32) ((1) 32)) -> (case x ((0 1) 32))
(lint-format "perhaps ~A" caller
(if (pair? mergers)
(format #f "merge keys ~{~{~A with ~A~}~^, ~}: ~A"
@@ -14496,7 +14893,42 @@
;; ---------------- do ----------------
- (let ()
+ (let ((cxars (hash-table '(car . ()) '(caar . car) '(cdar . cdr)
+ '(caaar . caar) '(cdaar . cdar) '(cddar . cddr) '(cadar . cadr)
+ '(caaaar . caaar) '(caadar . caadr) '(cadaar . cadar) '(caddar . caddr)
+ '(cdaaar . cdaar) '(cdadar . cdadr) '(cddaar . cddar) '(cdddar . cdddr))))
+
+ (define (car-subst sym new-sym tree)
+ (cond ((or (not (pair? tree))
+ (eq? (car tree) 'quote))
+ tree)
+ ((not (and (symbol? (car tree))
+ (pair? (cdr tree))
+ (null? (cddr tree))
+ (eq? sym (cadr tree))))
+ (cons (car-subst sym new-sym (car tree))
+ (car-subst sym new-sym (cdr tree))))
+
+ ((hash-table-ref cxars (car tree)) => (lambda (f) (if (symbol? f) (list f new-sym) new-sym)))
+ (else tree)))
+
+ (define (cadr-subst sym new-sym tree)
+ ;(format *stderr* "subst: ~A ~A ~A~%" sym new-sym tree)
+ (cond ((or (not (pair? tree))
+ (eq? (car tree) 'quote))
+ tree)
+ ((and (memq (car tree) '(vector-ref string-ref list-ref))
+ (pair? (cdr tree))
+ (pair? (cddr tree))
+ (null? (cdddr tree))
+ (equal? sym (cadr tree)))
+ new-sym)
+ (else
+ (cons (cadr-subst sym new-sym (car tree))
+ (cadr-subst sym new-sym (cdr tree))))))
+
+ (define (var-step v) ((cdr v) 'step))
+
(define (do-walker caller form env)
(let ((vars ()))
(if (not (and (>= (length form) 3)
@@ -14506,17 +14938,20 @@
(let ((step-vars (cadr form))
(inner-env #f))
- (define (var-step v) ((cdr v) 'step))
+
;; do+lambda in body with stepper as free var never happens
-
- (if (not (side-effect? form env))
- (let ((end+result (caddr form)))
- (if (or (not (pair? end+result))
- (null? (cdr end+result)))
- (lint-format "this do-loop could be replaced by (): ~A" caller (truncated-list->string form))
- (if (and (null? (cddr end+result))
- (code-constant? (cadr end+result)))
- (lint-format "this do-loop could be replaced by ~A: ~A" caller (cadr end+result) (truncated-list->string form))))))
+
+ (unless (side-effect? form env)
+ ;; a much more permissive check here (allowing sets of locals etc) got only a half-dozen hits
+ (let ((end+result (caddr form)))
+ (if (or (not (pair? end+result))
+ (null? (cdr end+result)))
+ ;; (do ((i 0 (+ i 1))) ((= i 1)))
+ (lint-format "this do-loop could be replaced by (): ~A" caller (truncated-list->string form))
+ (if (and (null? (cddr end+result))
+ (code-constant? (cadr end+result)))
+ ;; (begin (z 1) (do ((i 0 (+ i 1))) ((= i n) 32))): 32
+ (lint-format "this do-loop could be replaced by ~A: ~A" caller (cadr end+result) (truncated-list->string form))))))
;; walk the init forms before adding the step vars to env
(do ((bindings step-vars (cdr bindings)))
@@ -14530,8 +14965,10 @@
(hash-table-ref built-in-functions (var-name v))
(tree-table-member binders (cadar bindings))))
(if (not (var-member (var-name v) env))
+ ;; (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y)): x
(lint-format "~A in ~A does not appear to be defined in the calling environment" caller
(var-name v) (car bindings))
+ ;; (let ((x 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3)) (display y))): y
(lint-format "~A in ~A refers to the caller's ~A, not the do-loop variable" caller
(var-name v) (car bindings) (var-name v)))))
vars)
@@ -14549,34 +14986,32 @@
(set! inner-env (append vars env))
;; walk the step exprs
- (let ((baddies ())) ; these are step vars (with step exprs) used within other step vars step expressions
- (do ((bindings step-vars (cdr bindings)))
- ((not (pair? bindings)))
- (let ((stepper (car bindings))) ; the entire binding: '(i 0 (+ i 1))
- (when (and (binding-ok? caller 'do stepper env #t)
- (pair? (cddr stepper)))
- (let ((data (var-member (car stepper) vars)))
- (let ((old-ref (var-ref data)))
- (lint-walk caller (caddr stepper) inner-env)
- (set! (var-ref data) old-ref))
- (if (eq? (car stepper) (caddr stepper)) ; (i 0 i) -> (i 0)
- (lint-format "perhaps ~A" caller (lists->string stepper (list (car stepper) (cadr stepper)))))
- ;; pointless caddr here happens very rarely
- (set! (var-set data) (+ (var-set data) 1))) ; (pair? cddr) above
- (when (and (pair? (caddr stepper))
- (not (eq? (car stepper) (cadr stepper))) ; (lst lst (cdr lst))
- (eq? (car (caddr stepper)) 'cdr)
- (eq? (cadr stepper) (cadr (caddr stepper))))
- (lint-format "this looks suspicious: ~A" caller stepper))
- (for-each (lambda (v)
- (if (and (var-step v)
- (not (eq? (var-name v) (car stepper)))
- (or (eq? (var-name v) (caddr stepper))
- (and (pair? (caddr stepper))
- (tree-unquoted-member (var-name v) (caddr stepper)))))
- (set! baddies (cons (car stepper) baddies))))
- vars))))
-
+ (let ((baddies ())) ; these are step vars (with step exprs) used within other step vars step expressions
+ (for-each (lambda (stepper)
+ (when (and (binding-ok? caller 'do stepper env #t)
+ (pair? (cddr stepper)))
+ (let ((data (var-member (car stepper) vars)))
+ (let ((old-ref (var-ref data)))
+ (lint-walk caller (caddr stepper) inner-env)
+ (set! (var-ref data) old-ref))
+ (if (eq? (car stepper) (caddr stepper))
+ (lint-format "perhaps ~A" caller (lists->string stepper (list (car stepper) (cadr stepper)))))
+ (set! (var-set data) (+ (var-set data) 1)))
+ (when (and (pair? (caddr stepper))
+ (not (eq? (car stepper) (cadr stepper)))
+ (eq? (car (caddr stepper)) 'cdr)
+ (eq? (cadr stepper) (cadr (caddr stepper))))
+ (lint-format "this looks suspicious: ~A" caller stepper))
+ (for-each (lambda (v)
+ (if (and (var-step v)
+ (not (eq? (var-name v) (car stepper)))
+ (or (eq? (var-name v) (caddr stepper))
+ (and (pair? (caddr stepper))
+ (tree-unquoted-member (var-name v) (caddr stepper)))))
+ (set! baddies (cons (car stepper) baddies))))
+ vars)))
+ step-vars)
+
(check-unordered-exprs caller form (map var-initial-value vars) env)
(when (pair? baddies)
@@ -14608,6 +15043,8 @@
,(caddr form)
,@(cdddr form)
, at new-sets)))
+ ;; (do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k))) ->
+ ;; (do ((i 0) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k)) (set! i (+ i j)))
(let* ((loop (find-unique-name form))
(new-body (let ((let-loop `(,loop ,@(map (lambda (s)
((if (pair? (cddr s)) caddr car) s))
@@ -14624,6 +15061,7 @@
(if (null? (cdr (cdaddr form)))
(car (cdaddr form))
`(begin ,@(cdaddr form))))))
+ ;; (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 5) (set! x k) (+ k 1)) (display (+ i j)) -> use named let
(lint-format "this do loop is unreadable; perhaps ~A" caller
(lists->string form
`(let ,loop ,(map (lambda (s)
@@ -14641,13 +15079,16 @@
(if (null? (cddr end+result))
(begin
(if (any-null? (cadr end+result))
+ ;; (do ((i 0 (+ i 1))) ((= i 3) ()) (display i))
(lint-format "nil return value is redundant: ~A" caller end+result))
(lint-walk caller (cadr end+result) inner-env))
(lint-walk-open-body caller 'do-result (cdr end+result) inner-env)))
(if (and (symbol? end) (memq end '(= > < >= <= null? not)))
+ ;; (do ((i 0 (+ i 1))) (= i 10) (display i))
(lint-format "perhaps missing parens: ~A" caller end+result))
(cond ((never-false end)
+ ;; (do ((i 0 (+ i 1))) ((+ i 10) i))
(lint-format "end test is never false: ~A" caller end))
(end ; it's not #f
@@ -14674,14 +15115,18 @@
((-) (and (positive? inc)
(memq (car end) '(> >=))))
(else #f)))
+ ;; (do ((i 0 (+ i 1))) ((< i len)) (display i)
+ ;; (do ((i 0 (- i 1))) ((> i len)) (display i))
(lint-format "do step looks like it doesn't match end test: ~A" caller
(lists->string step end))))))))))
((pair? (cdr end+result))
+ ;; (do ((i 0 (+ i 1))) (#f i))
(lint-format "result is unreachable: ~A" caller end+result)))
(if (and (symbol? end)
(not (var-member end env))
(procedure? (symbol->value end *e*)))
+ ;; (do ((i 0 (+ i 1))) (abs i) (display i))
(lint-format "strange do end-test: ~A in ~A is a procedure" caller end end+result))))))
(lint-walk-body caller 'do (cdddr form) (cons (make-var :name :let
@@ -14711,52 +15156,154 @@
;; look for constant expressions in the do body
(when *report-constant-expressions-in-do*
(let ((constant-exprs (find-constant-exprs 'do (map var-name vars) (cdddr form))))
- (if (pair? constant-exprs)
- (if (null? (cdr constant-exprs))
- (lint-format "in ~A, ~A appears to be constant" caller
- (truncated-list->string form)
- (car constant-exprs))
- (lint-format "in ~A, the following expressions appear to be constant:~%~NC~A" caller
- (truncated-list->string form)
- (+ lint-left-margin 4) #\space
- (format #f "~{~A~^, ~}" constant-exprs))))))
-
+ (when (pair? constant-exprs)
+ (if (null? (cdr constant-exprs))
+ ;; (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (display x))
+ (lint-format "in ~A, ~A appears to be constant" caller
+ (truncated-list->string form)
+ (car constant-exprs))
+ (lint-format "in ~A, the following expressions appear to be constant:~%~NC~A" caller
+ (truncated-list->string form)
+ (+ lint-left-margin 4) #\space
+ (format #f "~{~A~^, ~}" constant-exprs))))))
+
;; if simple lambda expanded and exists only for the loop, remove let as well?
;; this can sometimes be simplified
(let ((body (cdddr form)))
(when (and (pair? body)
(null? (cdr body))
(pair? (car body)))
+
+ ;; do+let: tons of hits but how to distinguish the rewritable ones?
+ ;; very tricky if val is not a constant
+ (if (and (eq? (caar body) 'let)
+ (not (symbol? (cadar body)))
+ (every? (lambda (c) (code-constant? (cadr c))) (cadar body)))
+ ;; (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
+ ;; (do ((i 0 (+ i 1)) (a 12 12)) ((= i 3)) (set! a (+ a i)) ...)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(do (,@(cadr form)
+ ,@(map (lambda (c)
+ (list (car c) (cadr c) (cadr c)))
+ (cadar body)))
+ ,(caddr form)
+ ,@(one-call-and-dots (cddar body))))))
+
(let ((v (var-member (caar body) env)))
(when (and (var? v)
(memq (var-ftype v) '(define lambda)))
(let* ((vfunc (var-initial-value v))
(vbody (cddr vfunc)))
;; we already detect a do body with no side-effects (walk-body)
- (if (and (proper-list? ((if (eq? (var-ftype v) 'define) cdadr cadr) vfunc))
- (null? (cdr vbody))
- (< (tree-leaves vbody) 16))
- (do ((pp (var-arglist v) (cdr pp)))
- ((or (null? pp)
- (> (tree-count1 (car pp) vbody 0) 1))
- (when (null? pp)
- (let ((new-body (copy vbody)))
- (for-each (lambda (par arg)
- (if (not (eq? par arg))
- (set! new-body (tree-subst arg par new-body))))
- (var-arglist v)
- (cdar body))
- (lint-format "perhaps ~A" caller
- (lists->string form
- `(do ,(cadr form)
- ,(caddr form)
- , at new-body)))))))))))))
+ (when (and (proper-list? ((if (eq? (var-ftype v) 'define) cdadr cadr) vfunc))
+ (null? (cdr vbody))
+ (< (tree-leaves vbody) 16))
+ (do ((pp (var-arglist v) (cdr pp)))
+ ((or (null? pp)
+ (> (tree-count1 (car pp) vbody 0) 1))
+ (when (null? pp)
+ (let ((new-body (copy vbody)))
+ (for-each (lambda (par arg)
+ (if (not (eq? par arg))
+ (set! new-body (tree-subst arg par new-body))))
+ (var-arglist v)
+ (cdar body))
+ ;; (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) (abs (* 2 i)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(do ,(cadr form)
+ ,(caddr form)
+ , at new-body)))))))))))))
+ ;; do -> for-each
+ (when (and (pair? step-vars)
+ (null? (cdr step-vars)))
+ (let ((var (car step-vars)))
+ (when (and (pair? (cdr var))
+ (pair? (cddr var))
+ (pair? (caddr var))
+ (pair? (caddr form))
+ (pair? (caaddr form))
+ (null? (cdaddr form))
+ (pair? (cdaddr var))
+ (eq? (car var) (cadr (caddr var))))
+ (let ((vname (car var))
+ (end (caaddr form)))
+ (case (caaddr var)
+ ((cdr)
+ (when (and (case (car end)
+ ((null?)
+ (eq? (cadr end) vname))
+ ((not)
+ (and (pair? (cadr end))
+ (eq? (caadr end) 'pair?)
+ (eq? (cadadr end) vname)))
+ (else #f))
+ (not (let walker ((tree (cdddr form))) ; since only (cxar sym) is accepted, surely sym can't be shadowed?
+ (or (eq? tree vname)
+ (and (pair? tree)
+ (or (and (match-cxr 'cdr (car tree))
+ (pair? (cdr tree))
+ (eq? vname (cadr tree)))
+ (and (not (hash-table-ref cxars (car tree)))
+ (or (walker (car tree))
+ (walker (cdr tree))))))))))
+ ;; this assumes slightly more than the do-loop if (not (pair? var)) is the end-test
+ ;; for-each wants a sequence, but the do loop checks that in advance.
+ ;; (do ((p lst (cdr p))) ((null? p)) (display (car p))) -> (for-each (lambda ([p]) (display [p])) lst)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (let ((new-sym (symbol "[" (symbol->string vname) "]")))
+ `(for-each (lambda (,new-sym)
+ ,@(car-subst vname new-sym (cdddr form)))
+ ,(cadr var)))))))
+ ((+)
+ (when (and (eqv? (cadr var) 0)
+ (pair? (cddr (caddr var)))
+ (eqv? (caddr (caddr var)) 1)
+ (null? (cdddr (caddr var))))
+ (let ((end-var ((if (eq? vname (cadr end)) caddr cadr) end)))
+ (if (and (pair? end-var)
+ (memq (car end-var) '(length string-length vector-length)))
+ (set! end-var (cadr end-var))
+ (let ((v (var-member end-var env)))
+ (if (and (var? v)
+ (pair? (var-initial-value v))
+ (memq (car (var-initial-value v)) '(length string-length vector-length)))
+ (set! end-var (cadr (var-initial-value v))))))
+ (when (and (memq (car end) '(= >=))
+ (memq vname end)
+ (tree-memq vname (cdddr form))
+ (not (let walker ((tree (cdddr form)))
+ (if (and (pair? tree)
+ (memq vname tree)
+ (memq (car tree) '(string-ref list-ref vector-ref))
+ (eq? (caddr tree) vname))
+ (not (equal? (cadr tree) end-var))
+ (or (eq? tree vname)
+ (and (pair? tree)
+ (if (memq vname tree)
+ (not (and (memq (car tree) '(string-ref list-ref vector-ref))
+ (pair? (cdr tree))
+ (pair? (cddr tree))
+ (eq? (caddr tree) vname)))
+ (or (walker (car tree))
+ (walker (cdr tree))))))))))
+ ;; (do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i))) ->
+ ;; (for-each (lambda ([x]) (find [x])) x)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (let ((new-sym (symbol "[" (symbol->string (if (symbol? end-var) end-var (car end-var))) "]")))
+ `(for-each (lambda (,new-sym)
+ ,@(cadr-subst end-var new-sym (cdddr form)))
+ ,end-var)))))))))))))
+
;; check for do-loop as copy/fill! stand-in and other similar cases
(when (and (pair? vars)
(null? (cdr vars)))
(let ((end-test (and (pair? (caddr form)) (caaddr form)))
- (first-var (caadr form))
+ (first-var (car step-vars))
(body (cdddr form))
(setv #f))
(when (and (pair? end-test)
@@ -14791,6 +15338,7 @@
(and (pair? val)
(memq (car val) '(vector-ref float-vector-ref int-vector-ref list-ref string-ref byte-vector-ref))
(eq? (caddr val) vname)))))
+ ;; (do ((i 2 (+ i 1))) ((= i len)) (string-set! s i #\a)) -> (fill! s #\a 2 len)
(lint-format "perhaps ~A" caller
(lists->string form
(if (code-constant? setv)
@@ -14806,32 +15354,37 @@
(if (or (< (length form) 3)
(not (or (symbol? (cadr form))
(list? (cadr form)))))
+ ;; (let ((a 1) (set! a 2)))
(lint-format "let is messed up: ~A" caller (truncated-list->string form))
(let ((named-let (and (symbol? (cadr form)) (cadr form))))
(if (keyword? named-let)
+ ;; (let :x ((i y)) (x i))
(lint-format "bad let name: ~A" caller named-let))
(unless named-let
-
(if (and (null? (cadr form)) ; this can be fooled by macros that define things
(eq? form lint-current-form) ; i.e. we're in a body?
(not (tree-set-member '(call/cc call-with-current-continuation lambda lambda* define define*
define-macro define-macro* define-bacro define-bacro* define-constant define-expansion
load eval eval-string require)
(cddr form))))
+ ;; (begin (let () (display x)) y)
(lint-format "pointless let: ~A" caller (truncated-list->string form))
(let ((body (cddr form)))
(when (and (null? (cdr body))
(pair? (car body)))
(if (memq (caar body) '(let let*))
(if (null? (cadr form))
+ ;; (let () (let ((a x)) (+ a 1)))
(lint-format "pointless let: ~A" caller (lists->string form (car body)))
(if (null? (cadar body))
+ ;; (let ((a x)) (let () (+ a 1)))
(lint-format "pointless let: ~A" caller (lists->string form `(let ,(cadr form) ,@(cddar body))))))
(if (and (memq (caar body) '(lambda lambda*)) ; or any definer?
(null? (cadr form)))
+ ;; (let () (lambda (a b) (if (positive? a) (+ a b) b))) -> (lambda (a b) (if (positive? a) (+ a b) b))
(lint-format "pointless let: ~A" caller (lists->string form (car body)))))))))
-
+
(let ((vars (if (or (not named-let)
(keyword? named-let)
(not (or (null? (caddr form))
@@ -14853,11 +15406,13 @@
(pair? body)
(null? (cdr body))
(not (side-effect? (car body) env)))
+ ;; (let xx () z)
(lint-format "perhaps ~A" caller (lists->string form (car body)))))
(do ((bindings varlist (cdr bindings)))
((not (pair? bindings))
(if (not (null? bindings))
+ ;; (let ((a 1) . b) a)
(lint-format "let variable list is not a proper list? ~S" caller varlist)))
(when (binding-ok? caller 'let (car bindings) env #f)
(let ((val (cadar bindings)))
@@ -14865,6 +15420,7 @@
(eq? 'lambda (car val))
(tree-car-member (caar bindings) val)
(not (var-member (caar bindings) env)))
+ ;; (let ((x (lambda (a) (x 1)))) x)
(lint-format "let variable ~A is called in its binding? Perhaps let should be letrec: ~A"
caller (caar bindings)
(truncated-list->string bindings))
@@ -14874,16 +15430,27 @@
(not (hash-table-ref built-in-functions (var-name v)))
(not (tree-table-member binders (cadar bindings))))
(if (not (var-member (var-name v) env))
+ ;; (let ((x 1) (y x)) (+ x y)): x in (y x)
(lint-format "~A in ~A does not appear to be defined in the calling environment" caller
(var-name v) (car bindings))
+ ;; (let ((x 3)) (+ x (let ((x 1) (y x)) (+ x y)))): x in (y x)
(lint-format "~A in ~A refers to the caller's ~A, not the let variable" caller
(var-name v) (car bindings) (var-name v)))))
vars)))
- (lint-walk caller val env)
- (set! vars (cons (make-var :name (caar bindings)
- :initial-value val
- :definer (if named-let 'named-let 'let))
- vars)))))
+ (let ((e (if (symbol? val)
+ (set-ref val caller form env)
+ (lint-walk caller val env))))
+ (if (and (pair? e)
+ (not (eq? e env))
+ (memq (var-name (car e)) '(:lambda :dilambda)))
+ (let ((ldata (cdar e)))
+ (set! (var-name (car e)) (caar bindings))
+ (set! (ldata 'initial-value) val)
+ (set! vars (cons (car e) vars)))
+ (set! vars (cons (make-var :name (caar bindings)
+ :initial-value val
+ :definer (if named-let 'named-let 'let))
+ vars)))))))
(check-unordered-exprs caller form
(map (if (not named-let)
@@ -15011,6 +15578,7 @@
(pair? (cadr p))
(or (eq? (caadr p) 'pair?)
(and (eq? (caadr p) 'null?)
+ ;; (let ((x (assoc y z))) (if (null? x) (g x)))
(lint-format "in ~A, ~A can't be null because ~A in ~A only returns #f or a pair"
caller p vname (car vvalue) (truncated-list->string (car varlist)))
#f))
@@ -15020,7 +15588,7 @@
(pair? (cdaddr p))
(null? (cddr (caddr p))) ; one func arg
(or (eq? vname (cadr (caddr p)))
- (and (memq (caaddr p) combinable-cxrs)
+ (and (hash-table-ref combinable-cxrs (caaddr p))
((lambda* (cr arg) ; lambda* not lambda because combine-cxrs might return just #f
(and cr
(< (length cr) 5)
@@ -15030,6 +15598,7 @@
(and (eq? (car p) 'if)
(eq? (caddr p) vname)
(not (tree-unquoted-member vname (cdddr p)))
+ ;; (let ((x (g y))) (if x x (g z))) -> (or (g y) (g z))
(lint-format "perhaps ~A" caller
(lists->string form
(if (null? (cdddr p))
@@ -15051,10 +15620,107 @@
((or) '((else #t)))
(else ())))))
(unless (eq? else-clause :oops!)
+ ;; (let ((x (assoc y z))) (if x (cdr x))) -> (cond ((assoc y z) => cdr))
(lint-format "perhaps ~A" caller
(lists->string form `(cond (,vvalue => ,(or crf (caaddr p))) , at else-clause))))))))
)) ; one var in varlist
+
+ ;; ----------------------------------------
+ ;; move let in:
+ ;; (let ((a (car x))) (if b (+ a (f a)) (display c))) -> (if b (let ((a (car x))) (+ a (f a))) (display c))
+ ;; let* version gets only 3 hits
+ (unless (or named-let
+ (any? (lambda (c)
+ (not (and (pair? c)
+ (symbol? (car c))
+ (pair? (cdr c))
+ (not (side-effect? (cadr c) env)))))
+ (cadr form)))
+ (case (caar body)
+ ((if)
+ (let ((test (cadar body))
+ (true (caddar body))
+ (false (and (pair? (cdddar body)) (car (cdddar body))))
+ (vars (map car (cadr form)))
+ (false-let #f))
+ (when (and (not (memq test vars))
+ (not (tree-set-member vars test))
+ (or (and (not (memq true vars))
+ (not (tree-set-member vars true))
+ (set! false-let #t))
+ (not false)
+ (not (or (memq false vars)
+ (tree-set-member vars false))))
+ (tree-set-member vars body)) ; otherwise we'll complain elsewhere about unused variables
+ (lint-format "perhaps move the let to the ~A branch: ~A" caller
+ (if false-let "false" "true")
+ (lists->string form
+ (let ((true-dots (if (> (tree-leaves true) 30) '... true))
+ (false-dots (if (and (pair? false) (> (tree-leaves false) 30)) '... false)))
+ (if false-let
+ `(if ,test ,true-dots (let ,(cadr form) ,@(unbegin false-dots)))
+ (if (pair? (cdddr (caddr form)))
+ `(if ,test (let ,(cadr form) ,@(unbegin true-dots)) ,false-dots)
+ `(if ,test (let ,(cadr form) ,@(unbegin true-dots)))))))))))
+ ((cond)
+ ;; happens about a dozen times
+ (let ((vars (map car (cadr form))))
+ (if (tree-set-member vars (cdar body))
+ (call-with-exit
+ (lambda (quit)
+ (let ((branch-let #f))
+ (for-each (lambda (c)
+ (if (and (not branch-let)
+ (side-effect? (car c) env))
+ (quit))
+ (when (and (pair? c)
+ (tree-set-member vars c))
+ (if branch-let (quit))
+ (set! branch-let c)))
+ (cdar body))
+ (if (and branch-let
+ (not (memq (car branch-let) vars))
+ (not (tree-set-member vars (car branch-let))))
+ (lint-format "perhaps move the let into the '~A branch: ~A" caller
+ (truncated-list->string branch-let)
+ (lists->string form
+ (if (eq? branch-let (cadar body))
+ `(cond (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)
+ `(cond ... (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)))))))))))
+ ((case)
+ (let ((vars (map car (cadr form)))
+ (test (cadar body)))
+ (if (and (not (memq test vars))
+ (not (tree-set-member vars test))
+ (tree-set-member vars (cddar body)))
+ (call-with-exit
+ (lambda (quit)
+ (let ((branch-let #f))
+ (for-each (lambda (c)
+ (when (and (pair? c)
+ (tree-set-member vars (cdr c)))
+ (if branch-let (quit))
+ (set! branch-let c)))
+ (cddar body))
+ (if branch-let
+ (lint-format "perhaps move the let into the '~A branch: ~A" caller
+ (truncated-list->string branch-let)
+ (lists->string form
+ (if (eq? branch-let (caddar body))
+ `(case ,test (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)
+ `(case ,test ... (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)))))))))))
+ ((when unless) ; no hits -- maybe someday?
+ (let ((test (cadar body))
+ (vars (map car (cadr form))))
+ (unless (or (memq test vars)
+ (tree-set-member vars test)
+ (side-effect? test env))
+ (lint-format "perhaps move the let inside the ~A: ~A" caller
+ (caar body)
+ (truncated-lists->string form `(,(caar body) ,test (let ,(cadr form) ,@(cddar body))))))))))
+ ;; ----------------------------------------
+
;; (let ((x 1) (y 2)) (+ x y)) -> (+ 1 2)
;; this happens a lot, but it often looks like a form of documentation
(when (and (= suggest made-suggestion)
@@ -15140,7 +15806,7 @@
(set! (var-ref v) (+ (var-ref v) 1)))
e))
- (report-usage caller 'let vars cur-env)
+ (report-usage caller 'let vars e)
;; look for splittable lets and let-temporarily possibilities
(when (and (pair? vars)
@@ -15163,6 +15829,8 @@
(begin
(if (or preref
(side-effect? (var-initial-value local-var) env))
+ ;; (let ((x 32)) (display x) (set! y (f x)) (g (+ x 1) y) (a y) (f y) (g y) (h y) (i y) (set! x 3) (display x) (h y x))
+ ;; (let ... (let ((x 3)) ...))
(lint-format "perhaps add a new binding for ~A to replace ~A: ~A" caller
vname
(truncated-list->string (car p))
@@ -15170,6 +15838,7 @@
`(let ...
(let ((,vname ,(caddar p)))
...))))
+ ;; (let ((x 32)) (set! y (f 1)) (a y) (f y) (g y) (h y) (i y) (set! x (+ x... -> (let () ... (let ((x (+ 32 1))) ...))
(lint-format "perhaps move the ~A binding to replace ~A: ~A" caller
vname
(truncated-list->string (car p))
@@ -15194,49 +15863,50 @@
(set! preref i))))
(when (and (zero? (var-set local-var))
- (= (var-ref local-var) 1)
- (symbol? (var-initial-value local-var)))
- (let (;(vname (var-name local-var))
- (saved-name (var-initial-value local-var)))
- (do ((p body (cdr p))
- (last-pos #f)
- (first-pos #f))
- ((not (pair? p))
- (when (and (pair? last-pos)
- (not (eq? first-pos last-pos))
- (not (tree-member saved-name (cdr last-pos))))
- (lint-format "perhaps use let-temporarily here (see stuff.scm): ~A" caller
- (lists->string form
- (let ((new-let `(let-temporarily
- ((,saved-name ,(if (pair? first-pos)
- (caddar first-pos)
- saved-name)))
- ,@(map (lambda (expr)
- (if (or (and (pair? first-pos)
- (eq? expr (car first-pos)))
- (eq? expr (car last-pos)))
- (values)
- expr))
- body))))
- (if (null? (cdr vars)) ; we know vars is a pair, want len=1
- new-let
- `(let ,(map (lambda (v)
- (if (eq? (car v) vname)
- (values)
- v))
- (cadr form))
- ,new-let)))))))
- ;; someday maybe look for additional saved vars, but this happens only in snd-test
- ;; also the let-temp could be reduced to the set locations (so the tree-member
- ;; check above would be unneeded).
- (let ((expr (car p)))
- (when (and (pair? expr)
- (eq? (car expr) 'set!)
- (eq? (cadr expr) saved-name))
- (if (not first-pos)
- (set! first-pos p))
- (if (eq? (caddr expr) vname)
- (set! last-pos p)))))))))
+ (= (var-ref local-var) 2)) ; initial value and set!
+ (do ((saved-name (var-initial-value local-var))
+ (p body (cdr p))
+ (last-pos #f)
+ (first-pos #f))
+ ((not (pair? p))
+ (when (and (pair? last-pos)
+ (not (eq? first-pos last-pos))
+ (not (tree-equal-member saved-name (cdr last-pos))))
+ ;; (let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x)) ->
+ ;; (let-temporarily ((x 12)) (display (log x)) (set! x 1))
+ (lint-format "perhaps use let-temporarily here: ~A" caller
+ (lists->string form
+ (let ((new-let `(let-temporarily
+ ((,saved-name ,(if (pair? first-pos)
+ (caddar first-pos)
+ saved-name)))
+ ,@(map (lambda (expr)
+ (if (or (and (pair? first-pos)
+ (eq? expr (car first-pos)))
+ (eq? expr (car last-pos)))
+ (values)
+ expr))
+ body))))
+ (if (null? (cdr vars)) ; we know vars is a pair, want len=1
+ new-let
+ `(let ,(map (lambda (v)
+ (if (eq? (car v) vname)
+ (values)
+ v))
+ (cadr form))
+ ,new-let)))))))
+ ;; someday maybe look for additional saved vars, but this happens only in snd-test
+ ;; also the let-temp could be reduced to the set locations (so the tree-equal-member
+ ;; check above would be unneeded).
+ (let ((expr (car p)))
+ (when (and (pair? expr)
+ (eq? (car expr) 'set!)
+ (equal? (cadr expr) saved-name)
+ (pair? (cddr expr)))
+ (if (not first-pos)
+ (set! first-pos p))
+ (if (eq? (caddr expr) vname)
+ (set! last-pos p))))))))
vars)))
(when (and (pair? varlist)
@@ -15267,6 +15937,7 @@
;; unlike in letrec, here there can't be recursion (ref to same name is ref to outer env)
(if (eq? sym (car body))
(if (not (tree-memq sym (cdr body)))
+ ;; (let ((x (lambda (y) (+ y (x (- y 1)))))) (x 2)) -> (let ((y 2)) (+ y (x (- y 1))))
(lint-format "perhaps ~A" caller
(lists->string
form `(let ,(map list (cadr lform) (cdr body))
@@ -15276,6 +15947,7 @@
(when (pair? call)
(let ((new-call `(let ,(map list (cadr lform) (cdr call))
,@(cddr lform))))
+ ;; (let ((f60 (lambda (x) (* 2 x)))) (+ 1 (f60 y))) -> (+ 1 (let ((x y)) (* 2 x)))
(lint-format "perhaps ~A" caller
(lists->string form (tree-subst new-call call body))))))))))))
(when (pair? body)
@@ -15296,7 +15968,7 @@
(side-effect? (cadr v1) env)))
varlist)))))
(else #f)))
- (lint-format "perhaps ~A" caller
+ (lint-format "perhaps ~A" caller ; (let ((a 1)) (set! a 2)) -> 2
(lists->string form
(if (null? (cdr body)) ; this only happens in test suites...
(if (null? (cdr varlist))
@@ -15336,28 +16008,28 @@
;; remove it (the var) and replace with val throughout
(when (and (proper-list? (cadr form))
- (not (tree-memq 'curlet (cddr form))))
- (let ((changes ()))
- (do ((vs (cadr form) (cdr vs)))
- ((null? vs)
- (if (pair? changes)
- (let ((new-form (copy form)))
- (for-each
- (lambda (v)
- (list-set! new-form 1 (remove-if (lambda (p) (equal? p v)) (cadr new-form)))
- (set! new-form (tree-subst (cadr v) (car v) new-form)))
- changes)
- (lint-format "assuming we see all set!s, the binding~A ~{~A~^, ~} ~A pointless: perhaps ~A" caller
- (if (pair? (cdr changes)) "s" "")
- changes
- (if (pair? (cdr changes)) "are" "is")
- (lists->string form
- (if (< (tree-leaves new-form) 200)
- new-form
- `(let ,(cadr new-form)
- ,@(one-call-and-dots (cddr new-form)))))))))
- (let ((v (car vs)))
- (if (and (pair? v)
+ (not (tree-set-member '(curlet lambda lambda* define define*) (cddr form))))
+ (do ((changes ())
+ (vs (cadr form) (cdr vs)))
+ ((null? vs)
+ (if (pair? changes)
+ (let ((new-form (copy form)))
+ (for-each
+ (lambda (v)
+ (list-set! new-form 1 (remove-if (lambda (p) (equal? p v)) (cadr new-form)))
+ (set! new-form (tree-subst (cadr v) (car v) new-form)))
+ changes)
+ (lint-format "assuming we see all set!s, the binding~A ~{~A~^, ~} ~A pointless: perhaps ~A" caller
+ (if (pair? (cdr changes)) "s" "")
+ changes
+ (if (pair? (cdr changes)) "are" "is")
+ (lists->string form
+ (if (< (tree-leaves new-form) 200)
+ new-form
+ `(let ,(cadr new-form)
+ ,@(one-call-and-dots (cddr new-form)))))))))
+ (let ((v (car vs)))
+ (when (and (pair? v)
(pair? (cdr v))
(null? (cddr v)) ; good grief
(symbol? (cadr v))
@@ -15368,22 +16040,23 @@
(and (not (eq? (var-definer data) 'parameter))
(or (null? (var-setters data))
(not (tree-set-member (var-setters data) body)))))))
- (set! changes (cons v changes)))))))
+ (set! changes (cons v changes))))))
(when (pair? varlist)
;; if last is (set! local-var...) and no complications, complain
(let ((last (list-ref body (- (length body) 1))))
- (if (and (pair? last)
- (eq? (car last) 'set!)
- (pair? (cdr last))
- (pair? (cddr last)) ; (set! a)
- (symbol? (cadr last))
- (assq (cadr last) varlist)
- (not (tree-set-member '(call/cc call-with-current-continuation curlet lambda lambda*) form)))
- (lint-format "set! is pointless in ~A: use ~A" caller
- last (caddr last))))
-
+ (when (and (pair? last)
+ (eq? (car last) 'set!)
+ (pair? (cdr last))
+ (pair? (cddr last)) ; (set! a)
+ (symbol? (cadr last))
+ (assq (cadr last) varlist) ; (let ((a 1) (b (display 2))) (set! a 2))
+ ;; this is overly restrictive:
+ (not (tree-set-member '(call/cc call-with-current-continuation curlet lambda lambda*) form)))
+ (lint-format "set! is pointless in ~A: use ~A" caller
+ last (caddr last))))
+
(when (and (pair? (car body))
(eq? (caar body) 'do))
(when (and (null? (cdr body)) ; removing this restriction gets only 3 hits
@@ -15400,35 +16073,44 @@
;; (let ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i))) -> (do ((i 1 (+ i 1))) ...)
(lint-format "perhaps ~A" caller
(lists->string form `(do ,new-cadr ...)))))))
-
- ;; TODO: same for cond branch, probably case branch etc
- (let ((inits (if (pair? (cadar body))
- (map cadr (cadar body))
- ()))
- (locals (if (pair? (cadar body))
- (map car (cadar body))
- ())))
- (unless (or (and (pair? inits)
- (any? (lambda (v)
- (or (memq (car v) locals) ; shadowing
- (tree-memq (car v) inits)
- (side-effect? (cadr v) env))) ; let var opens *stdin*, do stepper reads it at init
- varlist))
- (> (tree-leaves (cdr body)) 40))
- ;; (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y))) ->
- ;; (do ((xx 0) (x 1 (+ x 1)) (y x (- y 1))) ...)
- (lint-format "perhaps ~A" caller
- (lists->string form
- (let ((do-form (car body)))
- (if (null? (cdr body)) ; do is only expr in let
- `(do ,(append varlist (cadr do-form))
- ...)
- `(do ,(append varlist (cadr do-form))
- (,(and (pair? (caddr do-form)) (caaddr do-form))
- ,@(if (side-effect? (cdr (caddr do-form)) env) (cdr (caddr do-form)) ())
- ,@(cdr body)) ; include rest of let as do return value
- ...))))))))
-
+
+ ;; let->do -- sometimes a bad idea, set *max-cdr-len* 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 (integer? *max-cdr-len*)
+ (let ((inits (if (pair? (cadar body))
+ (map cadr (cadar body))
+ ()))
+ (locals (if (pair? (cadar body))
+ (map car (cadar body))
+ ())))
+ (unless (or (and (pair? inits)
+ (any? (lambda (v)
+ (or (memq (car v) locals) ; shadowing
+ (tree-memq (car v) inits)
+ (side-effect? (cadr v) env))) ; let var opens *stdin*, do stepper reads it at init
+ varlist))
+ (and (pair? (cdr body))
+ (pair? (cddr 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
+ ;; it (the end stuff) refers to the let/do variables -- in the unedited case,
+ ;; the result is hard to see.
+ (> (tree-leaves (cdr body)) *max-cdr-len*))
+ ;; (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y))) ->
+ ;; (do ((xx 0) (x 1 (+ x 1)) (y x (- y 1))) ...)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (let ((do-form (cdar body)))
+ (if (null? (cdr body)) ; do is only expr in let
+ `(do ,(append varlist (car do-form))
+ ...)
+ `(do ,(append varlist (car do-form))
+ (,(and (pair? (cadr do-form)) (caadr do-form))
+ ,@(if (side-effect? (cdadr do-form) env) (cdadr do-form) ())
+ ,@(cdr body)) ; include rest of let as do return value
+ ...)))))))))
+
(when (and (> (length body) 3) ; setting this to 1 did not catch anything new
(every? pair? varlist)
(not (tree-set-car-member '(define define* define-macro define-macro*
@@ -15492,9 +16174,9 @@
(lint-format "~{~A~^, ~} ~A only used in expression~A (of ~A),~%~NC~A~A of~%~NC~A" caller
(map (lambda (v) (v 0)) cur-vars)
(if (null? (cdr cur-vars)) "is" "are")
- (if (= cur-line max-line)
- (format #f " ~D" (+ cur-line 1))
- (format #f "s ~D and ~D" (+ cur-line 1) (+ max-line 1)))
+ (format #f (if (= cur-line max-line)
+ (values " ~D" (+ cur-line 1))
+ (values "s ~D and ~D" (+ cur-line 1) (+ max-line 1))))
(length body)
(+ lint-left-margin 6) #\space
(truncated-list->string (list-ref body cur-line))
@@ -15551,7 +16233,7 @@
(eq? (caar p) 'set!)
(var-member (cadar p) vars)
(not (tree-memq (cadar p) (cdr p))))
- (if (not (side-effect? (caddar p) env))
+ (if (not (side-effect? (caddar p) env)) ; (set! v0 (channel->vct 1000 100)) -> (channel->vct 1000 100)
(lint-format "~A in ~A could be omitted" caller (car p) (truncated-list->string form))
(lint-format "perhaps ~A" caller (lists->string (car p) (caddar p)))))
;; 1 use in cadr and none thereafter happens a few times, but looks like set-as-documentation mostly
@@ -15585,6 +16267,7 @@
(for-each (lambda (v)
(set! new-args (tree-subst (cadr v) (car v) new-args)))
varlist)
+ ;; (let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b))) -> (let loop ((a (+ 1 1)) (b (f g 2))) (loop a b))
(lint-format "perhaps ~A" caller
(lists->string form
`(let ,inner-vars ,new-args , at named-body)))))))
@@ -15609,6 +16292,7 @@
(cond ((and (null? (cdadr form)) ; let(1) + let* -> let*
(eq? (car inner) 'let*)
(not (symbol? inner-vars))) ; not named let*
+ ;; (let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c)))) -> (let* ((a 1) (b (+ a 1)) (c (* b 2))) (display (+ a b c)))
(lint-format "perhaps ~A" caller
(lists->string form
`(let* ,(append outer-vars inner-vars)
@@ -15619,33 +16303,36 @@
(eq? (caaddr inner) 'let)
(pair? (cdr (caddr inner)))
(pair? (cadr (caddr inner))))
- (let* ((inner1 (caddr inner))
- (inner1-vars (cadr inner1)))
- (if (and (pair? (cddr inner1))
- (null? (cdddr inner1))
- (pair? (caddr inner1))
- (eq? (caaddr inner1) 'let)
- (pair? (cdr (caddr inner1)))
- (pair? (cadr (caddr inner1))))
- (let* ((inner2 (caddr inner1))
- (inner2-vars (cadr inner2)))
+ (let* ((inner1 (cdaddr inner))
+ (inner1-vars (car inner1)))
+ (if (and (pair? (cdr inner1))
+ (null? (cddr inner1))
+ (pair? (cadr inner1))
+ (eq? (caadr inner1) 'let)
+ (pair? (cdadr inner1))
+ (pair? (cadadr inner1)))
+ (let* ((inner2 (cdadr inner1))
+ (inner2-vars (car inner2)))
(if (not (letstar outer-vars
inner-vars
inner1-vars
inner2-vars))
+ ;; (let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d))))) -> (let ((a 1) (b 2) (c 3) (d 4)) (+ a b c d))
(lint-format "perhaps ~A" caller
(lists->string form
`(let ,(append outer-vars inner-vars inner1-vars inner2-vars)
- ,@(one-call-and-dots (cddr inner2)))))))
+ ,@(one-call-and-dots (cdr inner2)))))))
(if (not (letstar outer-vars
inner-vars
inner1-vars))
+ ;; (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))) -> (let ((b 2) (c 3) (d 4)) (+ a b c d))
(lint-format "perhaps ~A" caller
(lists->string form
`(let ,(append outer-vars inner-vars inner1-vars)
- ,@(one-call-and-dots (cddr inner1)))))))))
+ ,@(one-call-and-dots (cdr inner1)))))))))
((not (letstar outer-vars
inner-vars))
+ ;; (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d))
(lint-format "perhaps ~A" caller
(lists->string form
`(let ,(append outer-vars inner-vars)
@@ -15654,6 +16341,7 @@
((and (null? (cdadr form)) ; 1 outer var
(pair? inner-vars)
(null? (cdadr inner))) ; 1 inner var, dependent on outer
+ ;; (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let* ((x 0) (y (g 0))) (+ x y))
(lint-format "perhaps ~A" caller
(lists->string form
`(let* ,(append outer-vars inner-vars)
@@ -15670,18 +16358,19 @@
(let ((named-let (and (symbol? (cadr form)) (cadr form))))
(let ((vars (if named-let (list (make-var :name named-let
- :definer 'let*)) ())) ; TODO: fvar
+ :definer 'let*)) ()))
(varlist ((if named-let caddr cadr) form))
(body ((if named-let cdddr cddr) form)))
(if (not (list? varlist))
(lint-format "let* is messed up: ~A" caller (truncated-list->string form)))
- ;; let->do (could go further down
- (when (and (pair? varlist)
+ ;; let->do (could go further down)
+ (when (and (integer? *max-cdr-len*)
+ (pair? varlist)
(pair? body)
(pair? (car body))
(eq? (caar body) 'do)
- (< (tree-leaves (cdr body)) 40))
+ (< (tree-leaves (cdr body)) *max-cdr-len*))
(let ((inits (if (pair? (cadar body))
(map cadr (cadar body))
()))
@@ -15693,80 +16382,88 @@
(or (memq (car lv) locals) ; shadowing
(tree-memq (car lv) inits)
(side-effect? (cadr lv) env)))
+ ;; (let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x))) -> (do ((x (log z)) (i 0 (+ x z))) ...)
(lint-format "perhaps ~A" caller
(lists->string form
- (let ((do-form (car body)))
- (let ((new-do (if (null? (cdr body))
- `(do ,(append (list lv) (cadr do-form))
+ (let ((new-do (let ((do-form (cdar body)))
+ (if (null? (cdr body))
+ `(do ,(cons lv (car do-form))
...)
- `(do ,(append (list lv) (cadr do-form))
- (,(and (pair? (caddr do-form)) (caaddr do-form))
- ,@(if (side-effect? (cdr (caddr do-form)) env) (cdr (caddr do-form)) ())
+ `(do ,(cons lv (car do-form))
+ (,(and (pair? (cadr do-form)) (caadr do-form))
+ ,@(if (side-effect? (cdadr do-form) env) (cdadr do-form) ())
,@(cdr body)) ; include rest of let as do return value
- ...))))
- (case (length varlist)
- ((1) new-do)
- ((2) `(let (,(car varlist)) ,new-do))
- (else `(let* ,(copy varlist (make-list (- (length varlist) 1)))
- ,new-do))))))))))
-
-
- (let ((side-effects #f))
- (do ((bindings varlist (cdr bindings)))
- ((not (pair? bindings))
- (if (not (null? bindings))
- (lint-format "let* variable list is not a proper list? ~S"
- caller ((if named-let caddr cadr) form))))
- (when (binding-ok? caller 'let* (car bindings) env #f)
- (let ((expr (cadar bindings))
- (side (side-effect? (cadar bindings) env)))
- (if (not (or (eq? bindings varlist)
- ;; first var side-effect is innocuous (especially if it's the only one!)
- ;; does this need to protect against a side-effect that the next var accesses?
- ;; I think we're ok -- the accessed var must be exterior, and we go down in order
- side-effects))
- (set! side-effects side))
- (lint-walk caller expr (append vars env))
- (set! vars (cons (make-var :name (caar bindings)
- :initial-value expr
- :definer (if named-let 'named-let* 'let*))
- vars))
-
- ;; look for duplicate values
- ;; TODO: protect against any shadows if included in any expr
- (if (not (or side
- (not (pair? expr))
- (code-constant? expr)
- (maker? expr)))
- (let ((name (caar bindings)))
- (let dup-check ((vs (cdr vars)))
- (if (and (pair? vs)
- (pair? (car vs))
- (not (eq? name (caar vs)))
- (not (tree-memq (caar vs) expr)))
- ;; perhaps also not side-effect of car vs initial-value (char-ready? + read + char-ready? again)
- (if (equal? expr (var-initial-value (car vs)))
- (lint-format "~A's value ~A could be ~A" caller
- name expr (caar vs))
- (dup-check (cdr vs))))))))))
-
- (if (not (or side-effects
- (any? (lambda (v) (positive? (var-ref v))) vars)))
- (lint-format "let* could be let: ~A" caller (truncated-list->string form))))
- ;; in s7, let evaluates var values top down, so this message is correct
- ;; even in cases like (let ((ind (open-sound...)) (mx (maxamp))) ...)
- ;; in r7rs, the order is not specified (section 4.2.2 of the spec), so
- ;; here we would restrict this message to cases where there is only
- ;; one variable, or where subsequent values are known to be independent.
- ;; if each function could tell us what globals it depends on or affects,
- ;; we could make this work in all cases.
-
+ ...)))))
+ (case (length varlist)
+ ((1) new-do)
+ ((2) `(let (,(car varlist)) ,new-do))
+ (else `(let* ,(copy varlist (make-list (- (length varlist) 1)))
+ ,new-do)))))))))
+ (do ((side-effects #f)
+ (bindings varlist (cdr bindings)))
+ ((not (pair? bindings))
+ (if (not (null? bindings))
+ (lint-format "let* variable list is not a proper list? ~S"
+ caller ((if named-let caddr cadr) form)))
+ (if (not (or side-effects
+ (any? (lambda (v) (positive? (var-ref v))) vars)))
+ ;; (let* ((x (log y))) x)
+ (lint-format "let* could be let: ~A" caller (truncated-list->string form))))
+ ;; in s7, let evaluates var values top down, so this message is correct
+ ;; even in cases like (let ((ind (open-sound...)) (mx (maxamp))) ...)
+ ;; in r7rs, the order is not specified (section 4.2.2 of the spec), so
+ ;; here we would restrict this message to cases where there is only
+ ;; one variable, or where subsequent values are known to be independent.
+ ;; if each function could tell us what globals it depends on or affects,
+ ;; we could make this work in all cases.
+
+ (when (binding-ok? caller 'let* (car bindings) env #f)
+ (let ((expr (cadar bindings))
+ (side (side-effect? (cadar bindings) env)))
+ (if (not (or (eq? bindings varlist)
+ ;; first var side-effect is innocuous (especially if it's the only one!)
+ ;; does this need to protect against a side-effect that the next var accesses?
+ ;; I think we're ok -- the accessed var must be exterior, and we go down in order
+ side-effects))
+ (set! side-effects side))
+ (let ((e (lint-walk caller expr (append vars env))))
+ (if (and (pair? e)
+ (not (eq? e env))
+ (memq (var-name (car e)) '(:lambda :dilambda)))
+ (let ((ldata (cdar e)))
+ (set! (var-name (car e)) (caar bindings))
+ (set! (ldata 'initial-value) expr)
+ (set! vars (cons (car e) vars)))
+ (set! vars (cons (make-var :name (caar bindings)
+ :initial-value expr
+ :definer (if named-let 'named-let* 'let*))
+ vars))))
+
+ ;; look for duplicate values
+ ;; someday protect against any shadows if included in any expr
+ (unless (or side
+ (not (pair? expr))
+ (code-constant? expr)
+ (maker? expr))
+ (let ((name (caar bindings)))
+ (let dup-check ((vs (cdr vars)))
+ (if (and (pair? vs)
+ (pair? (car vs))
+ (not (eq? name (caar vs)))
+ (not (tree-memq (caar vs) expr)))
+ ;; perhaps also not side-effect of car vs initial-value (char-ready? + read + char-ready? again)
+ (if (equal? expr (var-initial-value (car vs)))
+ ;; (let* ((x (log y 2)) (y (log y 2)) (z (f x))) (+ x y z z))
+ (lint-format "~A's value ~A could be ~A" caller
+ name expr (caar vs))
+ (dup-check (cdr vs))))))))))
+
;; if var is not used except in other var bindings, it can be moved out of this let*
;; collect vars not in body, used in only one binding, gather these cases, and rewrite the let*
;; repeated names are possible here
- ;; also cascading depencies: (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x)))
- ;; (let ((x (let ((y (let ((z 1))) (+ z 2))) (< y 3)))) ...) ??
- ;; new-vars: ((z y) (y x))
+ ;; also cascading dependencies: (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x)))
+ ;; (let ((x (let ((y (let ((z 1))) (+ z 2))) (< y 3)))) ...) ??
+ ;; new-vars: ((z y) (y x))
(when (and (pair? vars)
(pair? (cdr vars)))
(let ((new-vars ())
@@ -15819,6 +16516,7 @@
(values)
`(,(var-name v) ,(gather-dependencies (var-name v) (var-initial-value v) env))))
(reverse vars))))
+ ;; (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((b 2) (c (let ((a 1)) (+ a 1)))) ...)
(lint-format "perhaps restrict ~{~A~^, ~} which ~A not used in the let* body ~A" caller
(map cadr new-vars)
(if (null? (cdr new-vars)) "is" "are")
@@ -15845,19 +16543,20 @@
(cdr vs))))
(set! inner-vars (cons v inner-vars))
(set! outer-vars (cons v outer-vars)))))
- (if (and (pair? outer-vars)
- (pair? inner-vars)
- (pair? (cdr inner-vars)))
- (lint-format "perhaps split this let*: ~A" caller
- (lists->string form
- `(,(if (pair? (cdr outer-vars)) 'let* 'let)
- ,(map (lambda (v)
- `(,(var-name v) ,(var-initial-value v)))
- (reverse outer-vars))
- (let ,(map (lambda (v)
- `(,(var-name v) ,(var-initial-value v)))
- (reverse inner-vars))
- ...)))))))
+ (when (and (pair? outer-vars)
+ (pair? inner-vars)
+ (pair? (cdr inner-vars)))
+ ;; (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let ((a 1)) (let ((b 2) (c (+ a 1))) ...))
+ (lint-format "perhaps split this let*: ~A" caller
+ (lists->string form
+ `(,(if (pair? (cdr outer-vars)) 'let* 'let)
+ ,(map (lambda (v)
+ `(,(var-name v) ,(var-initial-value v)))
+ (reverse outer-vars))
+ (let ,(map (lambda (v)
+ `(,(var-name v) ,(var-initial-value v)))
+ (reverse inner-vars))
+ ...)))))))
)) ; pair? vars
(let* ((cur-env (cons (make-var :name :let
@@ -15875,7 +16574,7 @@
(set! nvars (cdr nvars)))
(set! vars (append nvars vars)))))
- (report-usage caller 'let* vars cur-env))
+ (report-usage caller 'let* vars e))
(when (and (not named-let)
(pair? body)
@@ -15890,59 +16589,62 @@
(null? (cdadar body))))))
(null? (cdr body))
(not (symbol? (cadar body))))
+ ;; (let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (display a) (+ a... ->
+ ;; (let* ((a 1) (b (+ a 2)) (c (+ b 3)) (d (+ c 4))) (display a) ...)
(lint-format "perhaps ~A" caller
(lists->string form
`(let* ,(append varlist (cadar body))
,@(one-call-and-dots (cddar body))))))
(when (and (proper-list? (cadr form))
- (not (tree-memq 'curlet (cddr form))))
+ (not (tree-set-member '(curlet lambda lambda* define define*) (cddr form))))
;; see let above
- (let ((changes ()))
- (do ((vs (cadr form) (cdr vs)))
- ((null? vs)
- (if (pair? changes)
- (let ((new-form (copy form)))
- (for-each
- (lambda (v)
- (list-set! new-form 1 (remove-if (lambda (p) (equal? p v)) (cadr new-form)))
- (set! new-form (tree-subst (cadr v) (car v) new-form)))
- changes)
- (lint-format "assuming we see all set!s, the binding~A ~{~A~^, ~} ~A pointless: perhaps ~A" caller
- (if (pair? (cdr changes)) "s" "")
- changes
- (if (pair? (cdr changes)) "are" "is")
- (lists->string form
- (let ((header (if (and (pair? (cadr new-form))
- (pair? (cdadr new-form)))
- 'let* 'let)))
+ (do ((changes ())
+ (vs (cadr form) (cdr vs)))
+ ((null? vs)
+ (if (pair? changes)
+ (let ((new-form (copy form)))
+ (for-each
+ (lambda (v)
+ (list-set! new-form 1 (remove-if (lambda (p) (equal? p v)) (cadr new-form)))
+ (set! new-form (tree-subst (cadr v) (car v) new-form)))
+ changes)
+ ;; (let* ((x y) (a (* 2 x))) (+ (f a (+ a 1)) (* 3 x))) -> (let ((a (* 2 y))) (+ (f a (+ a 1)) (* 3 y)))
+ (lint-format "assuming we see all set!s, the binding~A ~{~A~^, ~} ~A pointless: perhaps ~A" caller
+ (if (pair? (cdr changes)) "s" "")
+ changes
+ (if (pair? (cdr changes)) "are" "is")
+ (lists->string form
+ (let ((header (if (and (pair? (cadr new-form))
+ (pair? (cdadr new-form)))
+ 'let* 'let)))
(if (< (tree-leaves new-form) 200)
`(,header ,@(cdr new-form))
`(,header ,(cadr new-form)
- ,@(one-call-and-dots (cddr new-form))))))))))
- (let ((v (car vs)))
- (if (and (pair? v)
- (pair? (cdr v))
- (null? (cddr v))
- (symbol? (cadr v))
- (not (assq (cadr v) (cadr form))) ; value is not a local var
- (not (set-target (car v) body env))
- (not (set-target (cadr v) body env)))
- (let ((data (var-member (cadr v) env)))
- (if (and (or (not (var? data))
- (and (not (eq? (var-definer data) 'parameter))
- (or (null? (var-setters data))
- (not (tree-set-member (var-setters data) body)))))
- (not (any? (lambda (p)
- (and (pair? p)
- (pair? (cdr p))
- (or (set-target (cadr v) (cdr p) env)
- (set-target (car v) (cdr p) env)
- (and (var? data)
- (pair? (var-setters data))
- (tree-set-member (var-setters data) body)))))
- (cdr vs))))
- (set! changes (cons v changes)))))))))
+ ,@(one-call-and-dots (cddr new-form))))))))))
+ (let ((v (car vs)))
+ (if (and (pair? v)
+ (pair? (cdr v))
+ (null? (cddr v))
+ (symbol? (cadr v))
+ (not (assq (cadr v) (cadr form))) ; value is not a local var
+ (not (set-target (car v) body env))
+ (not (set-target (cadr v) body env)))
+ (let ((data (var-member (cadr v) env)))
+ (if (and (or (not (var? data))
+ (and (not (eq? (var-definer data) 'parameter))
+ (or (null? (var-setters data))
+ (not (tree-set-member (var-setters data) body)))))
+ (not (any? (lambda (p)
+ (and (pair? p)
+ (pair? (cdr p))
+ (or (set-target (cadr v) (cdr p) env)
+ (set-target (car v) (cdr p) env)
+ (and (var? data)
+ (pair? (var-setters data))
+ (tree-set-member (var-setters data) body)))))
+ (cdr vs))))
+ (set! changes (cons v changes))))))))
(let* ((varlist-len (length varlist))
(last-var (and (positive? varlist-len)
@@ -15972,6 +16674,7 @@
(set! waiter #f)
new-v))))
varlist))
+ ;; (let* ((y 3) (x (log y))) x) -> (let ((x (log 3))) ...)
(lint-format "perhaps substitute ~{~{~A into ~A~}~^, ~}: ~A" caller
(reverse save-vars)
(lists->string form
@@ -15981,6 +16684,9 @@
(let ((cur-var (car v))
(nxt-var (cadr v)))
(when (and (pair? cur-var)
+ (let ((v (var-member (car cur-var) vars)))
+ (and (var? v)
+ (zero? (var-set v))))
(pair? nxt-var)
(pair? (cdr cur-var))
(pair? (cdr nxt-var))
@@ -16022,13 +16728,13 @@
(or (not (hash-table-ref no-side-effect-functions (car p)))
(any? pair? (cdr p)))))
(cdar body))))
+ ;; (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((a 1) (b 2)) (* (+ a 1) 2))
(lint-format "perhaps ~A" caller
(lists->string form `(,(if (<= varlist-len 2) 'let 'let*)
,(copy varlist (make-list (- varlist-len 1)))
,@(tree-subst (cadr last-var) (car last-var) body)))))
(when (null? (cdr body)) ; (let* (...(x A)) (if x (f A) B)) -> (let(*) (...) (cond (A => f) (else B)))
-
(when (pair? (cdr last-var))
(let ((p (car body)))
(when (and (pair? p)
@@ -16057,29 +16763,32 @@
((and) '((else #f)))
((or) '((else #t)))
(else ())))))
- (if (not (eq? else-clause :oops!))
- (lint-format "perhaps ~A" caller
- (case varlist-len
- ((1) (lists->string form
- `(cond (,(cadr last-var) => ,(caaddr p)) , at else-clause)))
- ((2) (lists->string form
- `(let (,(car varlist))
- (cond (,(cadr last-var) => ,(caaddr p)) , at else-clause))))
- (else (lists->string form
- `(let* ,(copy varlist (make-list (- varlist-len 1)))
- (cond (,(cadr last-var) => ,(caaddr p)) , at else-clause)))))))))))
+ (unless (eq? else-clause :oops!)
+ ;; (let* ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f)
+ (lint-format "perhaps ~A" caller
+ (case varlist-len
+ ((1) (lists->string form
+ `(cond (,(cadr last-var) => ,(caaddr p)) , at else-clause)))
+ ((2) (lists->string form
+ `(let (,(car varlist))
+ (cond (,(cadr last-var) => ,(caaddr p)) , at else-clause))))
+ (else (lists->string form
+ `(let* ,(copy varlist (make-list (- varlist-len 1)))
+ (cond (,(cadr last-var) => ,(caaddr p)) , at else-clause)))))))))))
(when (and (pair? (car varlist)) ; same as let: (let* ((x y)) x) -> y -- (let* (x) ...)
(not (pair? (car body))))
(if (and (eq? (car body) (caar varlist))
(null? (cdr varlist))
(pair? (cdar varlist))) ; (let* ((a...)) a)
+ ;; (let* ((x (log y))) x) -> (log y)
(lint-format "perhaps ~A" caller (lists->string form (cadar varlist)))
(if (and (> varlist-len 1) ; (let* (... (x y)) x) -> (let(*)(...) y)
(pair? last-var)
(pair? (cdr last-var))
(null? (cddr last-var))
(eq? (car body) (car last-var)))
+ ;; (let* ((y 3) (x (log y))) x) -> (let ((y 3)) (log y))
(lint-format "perhaps ~A" caller
(lists->string form `(,(if (= varlist-len 2) 'let 'let*)
,(copy varlist (make-list (- varlist-len 1)))
@@ -16108,24 +16817,24 @@
,@(copy body (make-list (+ max-line 1))))
,(list-ref body (+ max-line 1))
...)))
- (if (and (integer? cur-line)
- (< (- max-line cur-line) 2)
- (code-constant? (var-initial-value (last-ref 3))))
- (lint-format "~A is only used in expression~A (of ~A),~%~NC~A~A of~%~NC~A" caller
- vname
- (if (= cur-line max-line)
- (format #f " ~D" (+ cur-line 1))
- (format #f "s ~D and ~D" (+ cur-line 1) (+ max-line 1)))
- (length body)
- (+ lint-left-margin 6) #\space
- (truncated-list->string (list-ref body cur-line))
- (if (= cur-line max-line)
- ""
- (format #f "~%~NC~A"
- (+ lint-left-margin 6) #\space
- (truncated-list->string (list-ref body max-line))))
- (+ lint-left-margin 4) #\space
- (truncated-list->string form))))))
+ (when (and (integer? cur-line)
+ (< (- max-line cur-line) 2)
+ (code-constant? (var-initial-value (last-ref 3))))
+ (lint-format "~A is only used in expression~A (of ~A),~%~NC~A~A of~%~NC~A" caller
+ vname
+ (format #f (if (= cur-line max-line)
+ (values " ~D" (+ cur-line 1))
+ (values "s ~D and ~D" (+ cur-line 1) (+ max-line 1))))
+ (length body)
+ (+ lint-left-margin 6) #\space
+ (truncated-list->string (list-ref body cur-line))
+ (if (= cur-line max-line)
+ ""
+ (format #f "~%~NC~A"
+ (+ lint-left-margin 6) #\space
+ (truncated-list->string (list-ref body max-line))))
+ (+ lint-left-margin 4) #\space
+ (truncated-list->string form))))))
(when (tree-memq (last-ref 0) (car p))
(set! (last-ref 2) i)
(if (not (last-ref 1)) (set! (last-ref 1) i))))))
@@ -16136,17 +16845,17 @@
;; ---------------- letrec ----------------
(let ()
(define (letrec-walker caller form env)
- (if (< (length form) 3)
+ (if (< (length form) 3) ; (letrec () . 1)
(lint-format "~A is messed up: ~A" caller (car form) (truncated-list->string form))
(let ((vars ())
(head (car form)))
- (cond ((null? (cadr form))
+ (cond ((null? (cadr form)) ; (letrec () 1)
(lint-format "~A could be let: ~A" caller head (truncated-list->string form)))
- ((not (pair? (cadr form)))
+ ((not (pair? (cadr form))) ; (letrec a b)
(lint-format "~A is messed up: ~A" caller head (truncated-list->string form)))
((and (null? (cdadr form))
- (eq? head 'letrec*))
+ (eq? head 'letrec*)) ; (letrec* ((a (lambda b (a 1)))) a)
(lint-format "letrec* could be letrec: ~A" caller (truncated-list->string form))))
(do ((warned (or (eq? head 'letrec*)
@@ -16155,7 +16864,7 @@
(baddy #f)
(bindings (cadr form) (cdr bindings)))
((not (pair? bindings))
- (if (not (null? bindings))
+ (if (not (null? bindings)) ; (letrec* letrec)!
(lint-format "~A variable list is not a proper list? ~S" caller head (cadr form))))
(when (and (not warned) ; letrec -> letrec*
@@ -16173,6 +16882,7 @@
(set! baddy b)))
(cdr bindings)))
(set! warned #t)
+ ;; (letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+ x f2))
(lint-format "in ~A,~%~NCletrec should be letrec* because ~A is used in ~A's value (not a function): ~A" caller
(truncated-list->string form)
(+ lint-left-margin 4) #\space
@@ -16184,7 +16894,7 @@
(let ((init (if (and (eq? (caar bindings) (cadar bindings))
(or (eq? head 'letrec)
(not (var-member (caar bindings) vars))))
- (begin
+ (begin ; (letrec ((x x)) x)
(lint-format "~A is the same as (~A #<undefined>) in ~A" caller
(car bindings) (caar bindings) head)
;; in letrec* ((x 12) (x x)) is an error
@@ -16206,18 +16916,19 @@
(not (pair? (cdar bindings)))
(memq (cadar bindings) vs)
(tree-set-member vs (cadar bindings)))
- (if (null? bindings)
- (let ((letx (if (or (eq? head 'letrec)
- (do ((p (map cadr (cadr form)) (cdr p))
- (q (map car (cadr form)) (cdr q)))
- ((or (null? p)
- (side-effect? (car p) env)
- (memq (car q) (cdr q)))
- (null? p))))
- 'let 'let*)))
- (lint-format "~A could be ~A: ~A" caller
- head letx
- (truncated-list->string form))))))
+ (when (null? bindings)
+ (let ((letx (if (or (eq? head 'letrec)
+ (do ((p (map cadr (cadr form)) (cdr p))
+ (q (map car (cadr form)) (cdr q)))
+ ((or (null? p)
+ (side-effect? (car p) env)
+ (memq (car q) (cdr q)))
+ (null? p))))
+ 'let 'let*)))
+ ;; (letrec ((f1 (lambda (a) a))) 32)
+ (lint-format "~A could be ~A: ~A" caller
+ head letx
+ (truncated-list->string form))))))
(when (and (null? (cdr vars))
(pair? (cddr form))
@@ -16255,10 +16966,11 @@
;; lambda here is handled under define??
(let ((new-env (append vars env)))
- (do ((bindings (cadr form) (cdr bindings)))
- ((not (pair? bindings)))
- (if (binding-ok? caller head (car bindings) env #t)
- (lint-walk caller (cadar bindings) new-env)))
+ (when (pair? (cadr form))
+ (for-each (lambda (binding)
+ (if (binding-ok? caller head binding env #t)
+ (lint-walk caller (cadr binding) new-env)))
+ (cadr form)))
(let* ((cur-env (cons (make-var :name :let
:initial-value form
@@ -16268,14 +16980,14 @@
(let ((nvars (and (not (eq? e cur-env))
(env-difference caller e cur-env ()))))
- (if (pair? nvars)
- (if (memq (var-name (car nvars)) '(:lambda :dilambda))
- (begin
- (set! env (cons (car nvars) env))
- (set! nvars (cdr nvars)))
- (set! vars (append nvars vars)))))
+ (when (pair? nvars)
+ (if (memq (var-name (car nvars)) '(:lambda :dilambda))
+ (begin
+ (set! env (cons (car nvars) env))
+ (set! nvars (cdr nvars)))
+ (set! vars (append nvars vars)))))
- (report-usage caller head vars cur-env))))) ; constant exprs never happen here
+ (report-usage caller head vars e))))) ; constant exprs never happen here
env)
(hash-table-set! h 'letrec letrec-walker)
(hash-table-set! h 'letrec* letrec-walker))
@@ -16286,13 +16998,48 @@
(define (begin-walker caller form env)
(if (not (proper-list? form))
- (begin
+ (begin ; (begin . 1)
(lint-format "stray dot in begin? ~A" caller (truncated-list->string form))
env)
(begin
- (if (and (pair? (cdr form))
- (null? (cddr form)))
- (lint-format "begin could be omitted: ~A" caller (truncated-list->string form)))
+ (when (pair? (cdr form))
+ (if (null? (cddr form)) ; (begin (f y))
+ (lint-format "begin could be omitted: ~A" caller (truncated-list->string form))
+
+ ;; these two are questionable -- simpler, but scope enlarged
+ (when (and (pair? (cadr form))
+ (pair? (cddr form))
+ (null? (cdddr form)))
+ (if (and (eq? (caadr form) 'do)
+ (< (tree-leaves (caddr form)) 24) ; or maybe (< ... (min 24 (tree-leaves do-form)))?
+ (not (tree-set-member (map car (cadadr form)) (caddr form))))
+ ;; (begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) 32) (display i))
+ ;; the do loop has to end normally to go on? That is, moving the following expr into the do end section is safe?
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (let ((do-form (cdadr form)))
+ (let ((do-test (and (pair? (cadr do-form))
+ (caadr do-form)))
+ (new-end (if (and (pair? (cadr do-form))
+ (pair? (cdadr do-form)))
+ (append (cdadr do-form) (cddr form))
+ (cddr form))))
+ `(do ,(car do-form)
+ (,do-test , at new-end)
+ ,@(cddr do-form))))))
+
+ (if (and (memq (caadr form) '(let let* letrec letrec*)) ; same for begin + let + expr -- not sure about this...
+ (not (symbol? (cadadr form)))
+ (< (tree-leaves (caddr form)) 24) ; or maybe (< ... (min 24 (tree-leaves do-form)))?
+ (not (tree-set-member (map car (cadadr form)) (caddr form))))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (let ((let-form (cadr form)))
+ `(,(car let-form) ,(cadr let-form)
+ ,@(if (< (tree-leaves (cddr let-form)) 60)
+ (cddr let-form)
+ (one-call-and-dots (cddr let-form)))
+ ,(caddr form))))))))))
(lint-walk-open-body caller 'begin (cdr form) env))))
(hash-table-set! h 'begin begin-walker))
@@ -16321,15 +17068,15 @@
(and (pair? e)
(let ((op (return-type (car e) env)))
(and op
- (not (return-type-ok? 'let? op))))))
- (lint-format "~A: first argument should be an environment: ~A" 'with-let caller (truncated-list->string form)))
+ (not (return-type-ok? 'let? op)))))) ; (with-let 123 123)
+ (lint-format "~A: first argument should be an environment: ~A" 'with-let caller (truncated-list->string form)))
(if (symbol? e)
(set-ref e caller form env)
(if (pair? e)
(begin
(if (and (null? (cdr e))
- (eq? (car e) 'curlet))
+ (eq? (car e) 'curlet)) ; (with-let (curlet) x)
(lint-format "~A is not needed here: ~A" 'with-let caller (truncated-list->string form)))
(lint-walk caller e (cons (make-var :name :let
:initial-value form
@@ -16378,9 +17125,9 @@
(body (cdddr form))
(head (car form)))
(if (and (pair? args)
- (repeated-member? args env))
+ (repeated-member? args env)) ; (defmacro hi (a b a) a)
(lint-format "~A parameter is repeated: ~A" caller head (truncated-list->string args))
- (lint-format "~A is deprecated; perhaps ~A" caller head
+ (lint-format "~A is deprecated; perhaps ~A" caller head ; (defmacro hi (a b) `(+ ,a ,b))
(truncated-lists->string form
`(,(if (eq? head 'defmacro) 'define-macro 'define-macro*)
,(cons sym args)
@@ -16394,6 +17141,10 @@
;; ---------------- load ----------------
(let ()
(define (load-walker caller form env)
+ (check-call caller 'load form env)
+ (if (and (pair? (cdr form))
+ (equal? (cadr form) ""))
+ (lint-format "load needs a real file name, not the empty string: ~A" caller form))
(lint-walk caller (cdr form) env)
(if (and *report-loaded-files*
(string? (cadr form)))
@@ -16409,9 +17160,9 @@
;; ---------------- require ----------------
(let ()
(define (require-walker caller form env)
- (if (not (pair? (cdr form)))
- (lint-format "~A is pointless" caller form)
- (if (any? string? (cdr form))
+ (if (not (pair? (cdr form))) ; (require)
+ (lint-format "~A is pointless" caller form)
+ (if (any? string? (cdr form)) ; (require "repl.scm")
(lint-format "in s7, require's arguments should be symbols: ~A" caller (truncated-list->string form))))
(if (not *report-loaded-files*)
env
@@ -16440,19 +17191,26 @@
(lint-walk caller (cadr form) env))
(if (not (and (pair? func)
(eq? (car func) 'lambda)))
- (lint-walk caller func env)
+ (let ((f (and (symbol? func)
+ (symbol->value func *e*))))
+ (if (and (procedure? f)
+ (not (aritable? f 1)))
+ (lint-format "~A argument should be a function of one argument: ~A" caller (car form) func))
+ (lint-walk caller func env))
(let ((args (cadr func)))
(let ((body (cddr func))
(port (and (pair? args) (car args)))
(head (car form)))
(if (or (not port)
(pair? (cdr args)))
+ ;; (lambda () (write args) (newline))
(lint-format "~A argument should be a function of one argument: ~A" caller head func)
(if (and (null? (cdr body))
(pair? (car body))
(pair? (cdar body))
(eq? (cadar body) port)
(null? (cddar body)))
+ ;; (call-with-input-file "file" (lambda (p) (read-char p))) -> (call-with-input-file "file" read-char)
(lint-format "perhaps ~A" caller
(lists->string form
(if (= len 2)
@@ -16493,6 +17251,7 @@
(eq? (car tag) 'quote)
(or (not (pair? (cdr tag)))
(length (cadr tag)))))
+ ;; (catch #(0) (lambda () #f) (lambda a a))
(lint-format "catch tag ~S is unreliable (catch uses eq? to match tags)" caller tag))
(let ((body (caddr form))
(error-handler (cadddr form)))
@@ -16528,12 +17287,14 @@
(eq? continuation (car body))
(tree-sym-set-member continuation '(lambda lambda* define define* curlet error apply) body)))
;; this checks for continuation as arg (of anything), and any of set as car
+ ;; (call/cc (lambda (p) (+ x (p 1))))
(lint-format* caller
(string-append "perhaps " (symbol->string head))
" could be call-with-exit: "
(truncated-list->string form)))
(if (not (tree-unquoted-member continuation body))
+ ;; (call-with-exit (lambda (p) (+ x 1)))
(lint-format "~A ~A ~A appears to be unused: ~A" caller head
(if (eq? head 'call-with-exit) "exit function" "continuation")
continuation
@@ -16542,6 +17303,7 @@
(list-ref body (- (length body) 1)))))
(if (and (pair? last)
(eq? (car last) continuation))
+ ;; (call-with-exit (lambda (return) (display x) (return (+ x y))))
(lint-format "~A is redundant here: ~A" caller continuation (truncated-list->string last)))))
(let ((cc (make-var :name continuation
@@ -16564,10 +17326,12 @@
h 'provide
(lambda (caller form env)
(if (not (= (length form) 2))
+ ;; (provide a b c)
(lint-format "provide takes one argument: ~A" caller (truncated-list->string form))
(unless (symbol? (cadr form))
(let ((op (->lint-type (cadr form))))
(if (not (memq op '(symbol? #f #t values)))
+ ;; (provide "test")
(lint-format "provide's argument should be a symbol: ~S" caller form)))))
env))
@@ -16639,6 +17403,7 @@
(if (pair? choice)
(let ((len (length (car choice))))
(if (member len lens)
+ ;; (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args))
(lint-format "repeated parameter list? ~A in ~A" caller (car choice) form))
(set! lens (cons len lens))
(lint-walk 'case-lambda (cons 'lambda choice) env))))
@@ -16646,6 +17411,7 @@
(case (length lens)
((1)
+ ;; (case-lambda (() (if #f #f))) -> (lambda () (if #f #f))
(lint-format "perhaps ~A" caller
(lists->string form
(if doc-string
@@ -16681,6 +17447,7 @@
(if (null? (cdr arglist))
`((,arg-name ,(car diffs)))
`(,(car arglist) (,arg-name ,(car diffs)))))))
+ ;; (case-lambda (() (display x #f)) ((y) (display x y))) -> (lambda* (y) (display x y))
(lint-format "perhaps ~A" caller
(lists->string form
(if doc-string
@@ -16690,8 +17457,502 @@
env)
(hash-table-set! h 'case-lambda case-lambda-walker))
h))
+ ;; end walker-functions
+ ;; ----------------------------------------
+ (define (hash-fragment reduced-form leaves env func orig-form)
+ ;; func here is either #f or an env-style entry (cons name let) as produced by make-fvar,
+ ;; the let entries accessed are initial-value, history, arglist
+ (let ((old (hash-table-ref (fragments leaves) reduced-form))
+ (line (pair-line-number orig-form)))
+ ;(if func (format *stderr* "hash-fragment ~A ~A~%~%" (var-name func) reduced-form))
+ (if (not (vector? old))
+ (hash-table-set! (fragments leaves) reduced-form (vector 1 (list line) (and func (list func)) orig-form #f))
+ ;; key = reduced-form
+ ;; value = #(list uses line-numbers fvar original-form)
+ (begin
+ (vector-set! old 0 (+ (vector-ref old 0) 1))
+ (vector-set! old 1 (cons (pair-line-number orig-form) (vector-ref old 1)))
+ (when func
+ (if (not (vector-ref old 2))
+ (vector-set! old 2 (list func))
+ (let ((caller (if (keyword? (var-name func)) 'define (var-name func))))
+ (let search ((vs (vector-ref old 2)))
+ (when (pair? vs)
+ (let ((v (car vs)))
+ (cond ((not (eqv? (length (var-arglist v)) (length (var-arglist func))))
+ (search (cdr vs)))
+
+ ((eq? (var-history v) :built-in)
+ (lint-format "~A is the same as the built-in ~A ~A" caller
+ (var-name func)
+ (if (eq? (car (var-initial-value v)) 'define-macro) 'macro 'function)
+ (var-name v)))
+
+ ((not (var-member (var-name v) env))
+ (lint-format "~A is the same as ~A" caller
+ (var-name func)
+ (if (< 0 (pair-line-number (var-initial-value v)) 100000)
+ (format #f "~A (line ~D)" (var-name v) (pair-line-number (var-initial-value v)))
+ (if (eq? (var-name func) (var-name v))
+ (format #f "previous ~A" (var-name v))
+ (var-name v)))))
+
+ ((eq? (var-name v) (var-name func))
+ (lint-format "~A definition repeated: ~A" caller
+ (var-name func) (truncated-list->string (var-initial-value func))))
+
+ (else
+ (lint-format "~A could be (define ~A ~A)" caller
+ (var-name func) (var-name func) (var-name v)))))))
+ (vector-set! old 2 (cons func (vector-ref old 2))))))))))
+
+ (define (reduce-tree new-form env fvar orig-form)
+ ;(format *stderr* "reduce-tree: ~A ~A~%" new-form (and fvar (var-name fvar)))
+ (let ((leaves (tree-leaves new-form)))
+ (when (< 5 leaves *fragments-size*)
+ (call-with-exit
+ (lambda (quit)
+ (let ((outer-vars (if fvar
+ (do ((e (list (list (var-name fvar) (symbol "_F_") 0 ())))
+ (i 1 (+ i 1))
+ (args (args->proper-list (var-arglist fvar)) (cdr args)))
+ ((null? args) e)
+ (set! e (cons (list (car args) (symbol "_" (number->string i) "_") i ()) e)))
+ (list (list () '_1_) (list () '_2_) (list () '_3_))))
+ (local-ctr 0))
+ (let ((reduced-form
+ (let walker ((tree new-form) (vars outer-vars))
+ ;(format *stderr* "walker: ~A, vars: ~A~%" tree vars)
+ (cond ((or (not (symbol? tree))
+ (keyword? tree))
+ (if (or (not (pair? tree))
+ (eq? (car tree) 'quote))
+ tree
+ (case (car tree)
+ ((let let*)
+ ;; in let we need to sort locals by order of appearance in the body
+ (if (not (and (pair? (cdr tree))
+ (pair? (cddr tree))))
+ (quit))
+ (let ((locals ())
+ (body ())
+ (named-let (symbol? (cadr tree)))
+ (lvars ()))
+ (if named-let
+ (begin
+ (set! lvars (cons (list (cadr tree) (symbol "_NL" (number->string local-ctr) "_") -1) lvars))
+ (set! local-ctr (+ local-ctr 1))
+ (set! locals (caddr tree))
+ (set! body (cdddr tree)))
+ (begin
+ (set! locals (cadr tree))
+ (set! body (cddr tree))))
+ (if (not (list? locals)) (quit))
+
+ (if (eq? (car tree) 'let)
+ (for-each (lambda (local)
+ (if (not (and (pair? local) (pair? (cdr local)))) (quit))
+ (set! lvars (cons (list (car local) () 0 (walker (cadr local) vars)) lvars)))
+ locals)
+ (for-each (lambda (local)
+ (if (not (and (pair? local) (pair? (cdr local)))) (quit))
+ (set! lvars (cons (list (car local)
+ (symbol "_L" (number->string local-ctr) "_")
+ local-ctr
+ (walker (cadr local) (append lvars vars)))
+ lvars))
+ (set! local-ctr (+ local-ctr 1)))
+ locals))
+
+ ;; now walk the body, setting the reduced local name by order of encounter (in let, not let*)
+ (let ((new-body (walker body (append lvars vars))))
+ (when (and (eq? (car tree) 'let)
+ ;; fill-in unused-var dummy names etc
+ (pair? lvars))
+ (for-each (lambda (v)
+ (when (null? (cadr v))
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1))))
+ lvars))
+ (set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b)))))
+
+ (if named-let
+ `(,(car tree) ,(cadr (assq (cadr tree) lvars))
+ ,(map (lambda (v) (list (cadr v) (cadddr v))) (cdr lvars))
+ , at new-body)
+ `(,(car tree) ,(map (lambda (v) (list (cadr v) (cadddr v))) lvars)
+ , at new-body)))))
+
+ ((letrec letrec*)
+ (if (not (pair? (cdr tree))) (quit))
+ (let ((locals (cadr tree))
+ (body (cddr tree))
+ (lvars ()))
+ (if (not (and (list? locals) (pair? body))) (quit))
+ (for-each (lambda (local)
+ (if (not (and (pair? local)
+ (pair? (cdr local))))
+ (quit))
+ (set! lvars (cons (list (car local)
+ (symbol "_L" (number->string local-ctr) "_")
+ local-ctr ())
+ lvars))
+ (set! local-ctr (+ local-ctr 1)))
+ locals)
+ (for-each (lambda (local lv)
+ (list-set! lv 3 (walker (cadr local) lvars)))
+ locals lvars)
+ `(,(car tree)
+ ,(map (lambda (v) (list (cadr v) (cadddr v))) lvars)
+ ,@(walker body (append lvars vars)))))
+
+ ((do)
+ (if (not (and (pair? (cdr tree))
+ (list? (cadr tree))
+ (pair? (cddr tree))
+ (list? (cdddr tree))))
+ (quit))
+ (let ((locals (cadr tree))
+ (end+result (caddr tree))
+ (body (cdddr tree))
+ (lvars ()))
+ (if (not (list? end+result)) (quit))
+ (for-each (lambda (local)
+ (if (not (and (pair? local)
+ (pair? (cdr local))))
+ (quit))
+ (set! lvars (cons (list (car local)
+ () 0
+ (walker (cadr local) vars)
+ (if (pair? (cddr local))
+ (caddr local)
+ :unset))
+ lvars)))
+ locals)
+ (let ((new-env (append lvars vars)))
+ (let ((new-end (walker end+result new-env))
+ (new-body (walker body new-env)))
+
+ (when (pair? lvars)
+ (for-each (lambda (lv)
+ (if (not (eq? (lv 4) :unset))
+ (list-set! lv 4 (walker (lv 4) new-env))))
+ lvars)
+ (for-each (lambda (v)
+ (when (null? (cadr v))
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1))))
+ lvars)
+ (set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b))))))
+
+ `(do ,(map (lambda (v)
+ (if (eq? (v 4) :unset)
+ (list (v 1) (v 3))
+ (list (v 1) (v 3) (v 4))))
+ lvars)
+ ,new-end
+ , at new-body)))))
+
+ ((lambda)
+ (if (not (and (pair? (cdr tree))
+ (proper-list? (cddr tree))))
+ (quit))
+ (let* ((lvars (map (lambda (a)
+ (let ((res (list a (symbol "_A" (number->string local-ctr) "_") local-ctr)))
+ (set! local-ctr (+ local-ctr 1))
+ res))
+ (let ((args (args->proper-list (cadr tree))))
+ (if (pair? args) args (quit)))))
+ (new-body (let ((new-vars (append lvars vars)))
+ (map (lambda (p) (walker p new-vars)) (cddr tree))))
+ (new-args (if (symbol? (cadr tree))
+ (cadar lvars)
+ (if (proper-list? (cadr tree))
+ (map cadr lvars)
+ (let ((lst (map cadr lvars)))
+ (append (copy lst (make-list (- (length lst) 1)))
+ (list-ref lst (- (length lst) 1))))))))
+ `(lambda ,new-args , at new-body)))
+
+ ((lambda*)
+ (if (not (and (pair? (cdr tree))
+ (or (symbol? (cadr tree))
+ (proper-list? (cadr tree)))))
+ (quit))
+ (let* ((lvars (map (lambda (a)
+ (if (memq a '(:rest :allow-other-keys))
+ (values)
+ (let ((res (list (if (pair? a) (car a) a)
+ (symbol "_A" (number->string local-ctr) "_") local-ctr)))
+ (set! local-ctr (+ local-ctr 1))
+ res)))
+ (args->proper-list (cadr tree))))
+ (new-body (let ((new-vars (append lvars vars)))
+ (map (lambda (p) (walker p new-vars)) (cddr tree))))
+ (new-args (if (symbol? (cadr tree))
+ (cadar lvars)
+ (map (lambda (a)
+ (cond ((keyword? a) a)
+ ((symbol? a) (cadr (assq a lvars)))
+ ((and (pair? a)
+ (pair? (cdr a)))
+ (list (assq a lvars) (cadr a)))
+ (else (quit))))
+ (cadr tree)))))
+ `(lambda* ,new-args , at new-body)))
+
+ ((case)
+ (if (not (and (pair? (cdr tree))
+ (pair? (cddr tree))
+ (pair? (caddr tree))))
+ (quit))
+ `(case ,(walker (cadr tree) vars)
+ ,(map (lambda (c)
+ (if (not (and (pair? c)
+ (pair? (cdr c))))
+ (quit))
+ (cons (car c)
+ (map (lambda (p) (walker p vars)) (cdr c))))
+ (cddr tree))))
+
+ ((if)
+ (if (not (and (pair? (cdr tree))
+ (pair? (cddr tree))
+ (list? (cdddr tree))))
+ (quit))
+ (let ((expr (walker (cadr tree) vars))
+ (true (walker (caddr tree) vars)))
+ (if (null? (cdddr tree))
+ (if (and (pair? expr)
+ (eq? (car expr) 'not))
+ `(unless ,(cadr expr) ,@(unbegin true))
+ `(when ,expr ,@(unbegin true)))
+ `(if ,expr ,true ,(walker (cadddr tree) vars)))))
+
+ ((when unless)
+ (if (not (and (pair? (cdr tree))
+ (pair? (cddr tree))))
+ (quit))
+ `(,(car tree) ,(walker (cadr tree) vars)
+ ,@(map (lambda (p) (walker p vars)) (cddr tree))))
+
+ ((set!)
+ (if (not (and (pair? (cdr tree)) (pair? (cddr tree)))) (quit))
+ (if (symbol? (cadr tree))
+ (let ((v (assq (cadr tree) vars)))
+ (if (or (not v) ; if not a var, it's about to be an outer-var
+ (and (not fvar)
+ (memq (cadr v) '(_1_ _2_ _3_))))
+ (quit))
+ (when (null? (cadr v)) ; must be a previously unencountered local
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1)))
+ `(set! ,(cadr v) ,(walker (caddr tree) vars)))
+ `(set! ,(walker (cadr tree) vars) ,(walker (caddr tree) vars))))
+
+ ((define define*
+ ;; these propagate backwards and we're not returning the new env in this loop,
+ ;; lvars can be null, so splicing a new local into vars is a mess,
+ ;; but if the defined name is not reduced, it can occur later as itself (not via car),
+ ;; so without lots of effort (a dummy var if null lvars, etc), we can only handle
+ ;; functions within a function (fvar not #f).
+ ;; but adding that possibility got no hits
+
+ define-constant define-macro define-macro*
+ define-syntax let-syntax letrec-syntax match syntax-rules case-lambda
+ require import module cond-expand quasiquote reader-cond while unquote
+ call-with-values let-values define-values let*-values multiple-value-bind)
+ (quit))
+
+ (else
+ (cons (cond ((pair? (car tree))
+ (walker (car tree) vars))
+ ((assq (car tree) vars) =>
+ (lambda (v) (if (symbol? (cadr v)) (cadr v) (car tree))))
+ (else (car tree)))
+ (if (pair? (cdr tree))
+ (map (lambda (p)
+ (walker p vars))
+ (cdr tree))
+ (cdr tree)))))))
+
+ ((assq tree vars) => ; replace in-tree symbol with its reduction
+ (lambda (v)
+ ;; v is a list: local-name possible-reduced-name [counter value]
+ (when (null? (cadr v))
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1)))
+ (cadr v)))
+
+ (else
+ (if fvar (quit))
+ (let set-outer ((ovars outer-vars))
+ (if (null? ovars)
+ (quit)
+ (if (null? (caar ovars))
+ (begin
+ (set-car! (car ovars) tree)
+ (cadar ovars))
+ (set-outer (cdr ovars))))))))))
+
+ ;; if->when, for example, so tree length might change
+ (set! leaves (tree-leaves reduced-form))
+ (hash-fragment reduced-form leaves env fvar orig-form)
+
+ (if (and (memq (car reduced-form) '(or and))
+ (> (length reduced-form) 3))
+ (do ((i (- (length reduced-form) 1) (- i 1))
+ (rfsize leaves))
+ ((or (= i 2)
+ (< rfsize 6)))
+ (let ((rf (copy reduced-form (make-list i))))
+ (set! rfsize (tree-leaves rf))
+ (when (> rfsize 5)
+ (hash-fragment rf rfsize env #f orig-form)))))
+
+ (when fvar (quit))
+
+ ;; TODO: also below and clean this up!
+ (unless (and (pair? lint-function-body)
+ (equal? new-form (car lint-function-body)))
+ (let ((fvars (let ((fcase (hash-table-ref (fragments leaves) (list reduced-form))))
+ (and (vector? fcase)
+ (vector-ref fcase 2)))))
+ (when (pair? fvars)
+ (call-with-exit
+ (lambda (ok)
+ (for-each (lambda (fv)
+ (when (var-member (var-name fv) env)
+ (format outport "~NCperhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
+ (truncated-list->string new-form)
+ (var-name fv)
+ (map (lambda (a)
+ (if (null? (car a))
+ (values)
+ (car a)))
+ outer-vars))
+ (ok)))
+ fvars)
+ (format outport "~NCif '~A were in scope, perhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
+ (var-name (car fvars))
+ (truncated-list->string new-form)
+ (var-name (car fvars))
+ (map (lambda (a)
+ (if (null? (car a))
+ (values)
+ (car a)))
+ outer-vars)))))))
+
+ ;; now look for (f _1_) -> _1_ possibilities
+ ;; every reference to _1_ has to be via (f _1_), and f must have no side-effects
+ ;; so first rescan the form, gathering info about each _n_ var
+ (let* ((rnames (map (lambda (v)
+ (if (symbol? (car v))
+ (cadr v)
+ (values)))
+ outer-vars))
+ (rvars (map (lambda (v)
+ (vector v 0 ()))
+ rnames)))
+ (when (and (pair? reduced-form)
+ (not (eq? (car reduced-form) 'quote)))
+ (let walker ((tree reduced-form))
+ (for-each (lambda (p)
+ (if (pair? p)
+ (if (not (eq? (car p) 'quote))
+ (walker p))
+ (if (and (symbol? p)
+ (memq p rnames))
+ (let search ((rv rvars))
+ (let ((v (car rv)))
+ (if (eq? (v 0) p)
+ (begin
+ (set! (v 1) (+ (v 1) 1))
+ (set! (v 2) (cons tree (v 2))))
+ (search (cdr rv))))))))
+ tree)))
+
+ (let ((reducibles ()))
+ (for-each (lambda (v)
+ (if (and (pair? (v 2))
+ (pair? (car (v 2)))
+ (pair? (cdar (v 2)))
+ (null? (cddar (v 2)))
+ (not (side-effect-with-vars? (car (v 2)) env rnames))
+ (or (= (v 1) 1)
+ (let ((first (car (v 2))))
+ (not (member first (cdr (v 2))
+ (lambda (a b)
+ (not (equal? a b))))))))
+ (set! reducibles (cons (car (v 2)) reducibles))))
+ rvars)
+
+ ;; reducibles is a list of _n_ vars that can be simplified one more level
+ (when (pair? reducibles)
+ (for-each (lambda (r)
+ (let ((rf (let walker ((tree reduced-form))
+ (if (or (not (pair? tree))
+ (eq? (car tree) 'quote))
+ tree
+ (if (equal? tree r)
+ (cadr tree)
+ (cons (walker (car tree))
+ (walker (cdr tree))))))))
+ (set! leaves (tree-leaves rf))
+ (when (> leaves 5)
+ (hash-fragment rf leaves env fvar orig-form))))
+ reducibles)
+
+ ;; if more than one reducible, try all combinations
+ (when (pair? (cdr reducibles))
+ (let ((combo (if (null? (cddr reducibles))
+ (list (list (reducibles 0) (reducibles 1)))
+ (list (list (reducibles 0) (reducibles 1))
+ (list (reducibles 0) (reducibles 2))
+ (list (reducibles 1) (reducibles 2))
+ (list (reducibles 0) (reducibles 1) (reducibles 2))))))
+ (for-each (lambda (r)
+ (let ((rf (let walker ((tree reduced-form))
+ (if (or (not (pair? tree))
+ (eq? (car tree) 'quote))
+ tree
+ (if (member tree r)
+ (cadr tree)
+ (cons (walker (car tree))
+ (walker (cdr tree))))))))
+ (set! leaves (tree-leaves rf))
+ (when (> (tree-leaves rf) 5)
+ (hash-fragment rf leaves env fvar orig-form))))
+ combo)))))))))))))
+
+ (define (lint-fragment form env)
+ (if (memq (car form) '(or and))
+ ;; or/and are special because leading and trailing cases are separable (like leading cases for bodies)
+ (do ((i (length form) (- i 1))
+ (p (cdr form) (cdr p)))
+ ((<= i 2))
+ (reduce-tree (cons (car form) p) env #f form))
+ (reduce-tree form env #f form)))
+
+ (define (reduce-function-tree fvar env)
+ (let ((definition (cond ((var-initial-value fvar) => cddr) (else #f))))
+ (when (pair? definition)
+ (reduce-tree (if (and (string? (car definition))
+ (pair? (cdr definition)))
+ (cdr definition)
+ definition)
+ env
+ (and (not (keyword? (var-name fvar)))
+ fvar)
+ (var-initial-value fvar)))))
+ ;; ----------------------------------------
+
(define lint-walk-pair
(let ((unsafe-makers '(sublet inlet copy cons list append make-shared-vector vector hash-table hash-table*
make-hash-table make-hook #_{list} #_{append} gentemp or and not))
@@ -16699,11 +17960,8 @@
(lambda (caller form env)
(let ((head (car form)))
(set! line-number (pair-line-number form))
-
- (when *report-function-stuff*
- (function-match caller form env))
- ;; differ-in-one here across args gets few interesting hits
+ (lint-fragment form env)
(cond
((hash-table-ref walker-functions head)
@@ -16716,6 +17974,7 @@
(if (and (pair? form)
(symbol? head)
(procedure? (symbol->value head *e*)))
+ ;; (+ . 1)
(lint-format "unexpected dot: ~A" caller (truncated-list->string form)))
(begin
(cond ((symbol? head)
@@ -16741,22 +18000,22 @@
(pair? (caddr arg))
(eq? 'lambda (caaddr arg)))
(assq head (cadr arg)))))
- ;; (string->symbol (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) s)) ->
- ;; (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) (string->symbol s))")
+ ;; (string->symbol (let ((s (copy vstr))) (set! (s (+ pos 1)) #\s) s)) ->
+ ;; (let ((s (copy vstr))) (set! (s (+ pos 1)) #\s) (string->symbol s))")
(lint-format "perhaps~%~NC~A ->~%~NC~A" caller
(+ lint-left-margin 4) #\space
(truncated-list->string form)
(+ lint-left-margin 4) #\space
(let* ((body (cddr arg))
- (len (length body))
+ (len (- (length body) 1))
(str (object->string `(,(car arg) ,(cadr arg)
- ,@(copy body (make-list (- len 1)))
- (,head ,(list-ref body (- len 1)))))))
+ ,@(copy body (make-list len))
+ (,head ,(list-ref body len))))))
(if (<= (length str) target-line-length)
str
(format #f "(~A ... (~A ~A))"
(car arg) head
- (truncated-list->string (list-ref body (- len 1))))))))
+ (truncated-list->string (list-ref body len)))))))
(when (eq? (car arg) 'or)
(let ((else-clause (let ((last-clause (list-ref arg (- (length arg) 1))))
(if (and (pair? last-clause)
@@ -16773,6 +18032,7 @@
res)))))))
(unless (eq? else-clause :checked-eval-error)
(set! last-rewritten-internal-define form)
+ ;; (string->number (or (f x) "4")) -> (cond ((f x) => string->number) (else 4))
(lint-format "perhaps ~A" caller
(lists->string form
`(cond (,(if (or (null? (cddr arg))
@@ -16805,7 +18065,9 @@
""
(format #f ", assuming ~A is not a macro," head))))
;; begin=(caar p) here is almost entirely as macro arg
- (lint-format "perhaps~A~%~NC~A ->~%~NC~A" caller disclaimer
+ ;; (apply env-channel (make-env ...) args) -> (let ((_1_ (make-env ...))) (apply env-channel _1_ args))
+ (lint-format "perhaps~A~%~NC~A ->~%~NC~A" caller
+ disclaimer
(+ lint-left-margin 4) #\space
(lint-pp `(, at header ,(one-call-and-dots (car p)) , at trailer))
(+ lint-left-margin 4) #\space
@@ -16852,26 +18114,26 @@
(cond ((hash-table-ref special-case-functions head)
=> (lambda (f)
(f caller head form env))))
-
+
;; change (list ...) to '(....) if it's safe as a constant list
;; and (vector ...) -> #(...)
(if (and (pair? (cdr form))
(hash-table-ref no-side-effect-functions head)
(not (memq head unsafe-makers)))
- (do ((p (cdr form) (cdr p)))
- ((not (pair? p)))
- (if (let constable? ((cp (car p)))
- (and (pair? cp)
- (memq (car cp) '(list vector))
- (pair? (cdr cp))
- (every? (lambda (inp)
- (or (code-constant? inp)
- (constable? inp)))
- (cdr cp))))
- (lint-format "perhaps ~A -> ~A~A" caller
- (truncated-list->string (car p))
- (if (eq? (caar p) 'list) "'" "")
- (object->string (eval (car p)))))))
+ (for-each (lambda (p)
+ (if (let constable? ((cp p))
+ (and (pair? cp)
+ (memq (car cp) '(list vector))
+ (pair? (cdr cp))
+ (every? (lambda (inp)
+ (or (code-constant? inp)
+ (constable? inp)))
+ (cdr cp))))
+ (lint-format "perhaps ~A -> ~A~A" caller
+ (truncated-list->string p)
+ (if (eq? (car p) 'list) "'" "")
+ (object->string (eval p)))))
+ (cdr form)))
(if (and (not (= line-number last-simplify-numeric-line-number))
(hash-table-ref numeric-ops head)
@@ -16880,6 +18142,7 @@
(if (not (equal-ignoring-constants? form val))
(begin
(set! last-simplify-numeric-line-number line-number)
+ ;; (+ 1 2) -> 3, and many others
(lint-format "perhaps ~A" caller (lists->string form val))))))
;; if a var is used before it is defined, the var history and ref/set
@@ -16904,45 +18167,56 @@
(pair? (cddr q)) ; there's a true branch
(pair? (cdddr q))))))) ; and a false branch (similarly below)
(when (pair? p)
- (let ((test (cadar p)))
- (do ((q (cdr p) (cdr q)))
- ((not (and (pair? q)
- (let ((x (car q)))
- (and (pair? x)
- (eq? (car x) 'if)
- (pair? (cdr x))
- (equal? (cadr x) test)
- (pair? (cddr x))
- (pair? (cdddr x))))))
- (unless (eq? q (cdr p))
- (let ((header (do ((i 1 (+ i 1))
- (r (cdr form) (cdr r)))
- ((eq? r p)
- (copy form (make-list i)))))
- (middle (do ((r p (cdr r))
- (trues ())
- (falses ()))
- ((eq? r q)
- `(if ,test
- (values ,@(reverse trues))
- (values ,@(reverse falses))))
- (set! trues (cons (caddar r) trues))
- (set! falses (cons (car (cdddar r)) falses)))))
- (lint-format "perhaps~A ~A" caller
- (if (side-effect? test env)
- (format #f " (ignoring ~S's possible side-effects)" test)
- "")
- (lists->string form `(, at header ,middle , at q)))))))))))))
+ (do ((test (cadar p))
+ (q (cdr p) (cdr q)))
+ ((not (and (pair? q)
+ (let ((x (car q)))
+ (and (pair? x)
+ (eq? (car x) 'if)
+ (pair? (cdr x))
+ (equal? (cadr x) test)
+ (pair? (cddr x))
+ (pair? (cdddr x))))))
+ (unless (eq? q (cdr p))
+ (let ((header (do ((i 1 (+ i 1))
+ (r (cdr form) (cdr r)))
+ ((eq? r p)
+ (copy form (make-list i)))))
+ (middle (do ((r p (cdr r))
+ (trues ())
+ (falses ()))
+ ((eq? r q)
+ `(if ,test
+ (values ,@(reverse trues))
+ (values ,@(reverse falses))))
+ (set! trues (cons (caddar r) trues))
+ (set! falses (cons (car (cdddar r)) falses)))))
+ ;; (+ (if A B C) (if A C D) y) -> (+ (if A (values B C) (values C D)) y)
+ (lint-format "perhaps~A ~A" caller
+ (if (side-effect? test env)
+ (format #f " (ignoring ~S's possible side-effects)" test)
+ "")
+ (lists->string form `(, at header ,middle , at q))))))))))))
((pair? head)
(cond ((not (and (pair? (cdr head))
(memq (car head) '(lambda lambda*)))))
((and (identity? head)
(pair? (cdr form))) ; identity needs an argument
+ ;; ((lambda (x) x) 32) -> 32
(lint-format "perhaps ~A" caller (truncated-lists->string form (cadr form))))
+
+ ((and (symbol? (cadr head)) ; ((lambda x x) 1 2 3) -> (list 1 2 3)
+ (pair? (cddr head))
+ (eq? (cadr head) (caddr head))
+ (null? (cdddr head)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(list ,@(cdr form)))))
((and (null? (cadr head))
(pair? (cddr head)))
+ ;; ((lambda () 32) 0) -> 32
(lint-format "perhaps ~A" caller
(truncated-lists->string
form
@@ -16982,7 +18256,7 @@
(set! vals (cons #f vals)))))))
(set! vars (cons ((if (pair? (car v)) caar car) v) vars))
(set! vals (cons (car a) vals)))
-
+ ;; ((lambda* (a b) (+ a b)) 1) -> (let ((a 1) (b #f)) (+ a b))
(lint-format "perhaps ~A" caller
(lists->string form
`(,(if (or (eq? (car head) 'lambda)
@@ -16995,57 +18269,56 @@
((and (procedure? head)
(memq head '(#_{list} #_{apply_values} #_{append})))
(for-each (lambda (p)
- (if (quoted-symbol? p)
- (let* ((sym (cadr p))
- (v (var-member sym env)))
+ (let ((sym (and (symbol? p) p)))
+ (when sym
+ (let ((v (var-member sym env)))
(if (var? v)
(set-ref sym caller form env)
(if (not (defined? sym (rootlet)))
(hash-table-set! other-identifiers sym
(if (not (hash-table-ref other-identifiers sym))
(list form)
- (cons form (hash-table-ref other-identifiers sym)))))))))
+ (cons form (hash-table-ref other-identifiers sym))))))))))
(cdr form))
(when (and (eq? head #_{list})
(not (eq? lint-current-form qq-form)))
- (let ((len (length form)))
- (set! qq-form lint-current-form) ; only interested in simplest cases here
- (case len
- ((2)
- (if (and (pair? (cadr form))
- (eq? (caadr form) #_{apply_values}) ; `(, at x) -> (copy x)
- (not (qq-tree? (cadadr form))))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (un_{list} (if (pair? (cadadr form))
- (cadadr form)
- `(copy ,(cadadr form))))))
- (if (symbol? (cadr form))
- (lint-format "perhaps ~A" caller ; `(,x) -> (list x)
- (lists->string form `(list ,(cadr form)))))))
- ((3)
- (if (and (pair? (caddr form))
- (eq? (caaddr form) #_{apply_values})
- (not (qq-tree? (cadr (caddr form))))
- (pair? (cadr form)) ; `(, at x , at y) -> (append x y)
- (eq? (caadr form) #_{apply_values})
- (not (qq-tree? (cadadr form))))
- (lint-format "perhaps ~A" caller
- (lists->string form
- `(append ,(un_{list} (cadadr form))
- ,(un_{list} (cadr (caddr form))))))))
- (else
- (if (every? (lambda (a) ; `(, at x , at y etc) -> (append x y ...)
- (and (pair? a)
- (eq? (car a) #_{apply_values})
- (not (qq-tree? (cdr a)))))
- (cdr form))
- (lint-format "perhaps ~A" caller
- (lists->string form `(append ,@(map (lambda (a)
- (un_{list} (cadr a)))
- (cdr form)))))))
- )))))
+ (set! qq-form lint-current-form) ; only interested in simplest cases here
+ (case (length form)
+ ((2)
+ (if (and (pair? (cadr form))
+ (eq? (caadr form) #_{apply_values}) ; `(, at x) -> (copy x)
+ (not (qq-tree? (cadadr form))))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (un_{list} (if (pair? (cadadr form))
+ (cadadr form)
+ `(copy ,(cadadr form))))))
+ (if (symbol? (cadr form))
+ (lint-format "perhaps ~A" caller ; `(,x) -> (list x)
+ (lists->string form `(list ,(cadr form)))))))
+ ((3)
+ (if (and (pair? (caddr form))
+ (eq? (caaddr form) #_{apply_values})
+ (not (qq-tree? (cadr (caddr form))))
+ (pair? (cadr form)) ; `(, at x , at y) -> (append x y)
+ (eq? (caadr form) #_{apply_values})
+ (not (qq-tree? (cadadr form))))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(append ,(un_{list} (cadadr form))
+ ,(un_{list} (cadr (caddr form))))))))
+ (else
+ (if (every? (lambda (a) ; `(, at x , at y etc) -> (append x y ...)
+ (and (pair? a)
+ (eq? (car a) #_{apply_values})
+ (not (qq-tree? (cdr a)))))
+ (cdr form))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(append ,@(map (lambda (a)
+ (un_{list} (cadr a)))
+ (cdr form)))))))
+ ))))
(let ((vars env))
(for-each
@@ -17054,24 +18327,6 @@
form))))
env))))))
-#|
- (define previous-form #f)
- (define (lint-walk caller form env)
- (if (and previous-form
- (or (not (pair? form))
- (not (member previous-form form))))
- (begin
- (format *stderr* " ~A~%~%" (lint-pp previous-form))
- (set! previous-form #f)))
- (let ((sug made-suggestion))
- (let ((res (lint-walk-1 caller form env)))
- (if (and (= sug made-suggestion)
- (not (eq? (car form) 'define-syntax))
- (> (tree-leaves form) 12))
- (set! previous-form form))
- res)))
-|#
-
(define (lint-walk caller form env)
(cond ((symbol? form)
(if (memq form '(+i -i))
@@ -17085,6 +18340,7 @@
(let ((len (length form)))
(if (and (> len 16)
(string=? form (make-string len (string-ref form 0))))
+ ;; "*****************************" -> (format #f "~NC" 29 #\*)
(lint-format "perhaps ~S -> ~A" caller form `(format #f "~NC" ,len ,(string-ref form 0)))))
env)
@@ -17097,6 +18353,7 @@
(lint-walk caller (cadr x) env) ; register refs
(set! happy #f)))
form)
+ ;; (begin (define x 1) `#(,x))
(if (not happy) ; these are used exactly 4 times (in a test suite!) in 2 million lines of open source scheme code
(lint-format "quasiquoted vectors are not supported: ~A" caller form)))
;; `(x #(,x)) for example will not work in s7, but `(,x ,(vector x)) will
@@ -17119,63 +18376,102 @@
(catch #t
(lambda ()
(let ((p (open-input-file file)))
- (if *report-input*
- (format outport
- (if (and (output-port? outport)
- (not (memq outport (list *stderr* *stdout*))))
- (values "~%~NC~%;~A~%" (+ lint-left-margin 16) #\-)
- ";~A~%")
- file))
+ (when *report-input*
+ (format outport
+ (if (and (output-port? outport)
+ (not (memq outport (list *stderr* *stdout*))))
+ (values "~%~NC~%;~A~%" (+ lint-left-margin 16) #\-)
+ ";~A~%")
+ file))
p))
(lambda args
(format outport "~NCcan't open ~S: ~A~%" lint-left-margin #\space file (apply format #f (cadr args)))
#f))))))
(when (input-port? fp)
- (let ((vars env)
- (line 0)
- (last-form #f)
- (last-line-number -1))
+ (do ((vars env)
+ (line 0)
+ (last-form #f)
+ (last-line-number -1)
+ (form (read fp) (read fp)))
+ ((eof-object? form)
+
+ (if (not (input-port? file))
+ (close-input-port fp))
+
+ (when *report-repeated-code-fragments*
+ (do ((i 6 (+ i 1)))
+ ((= i *fragments-size*))
+ (when (> (hash-table-entries (fragments i)) 0)
+ (let ((v (copy (fragments i) (make-vector (hash-table-entries (fragments i)))))) ; (key . vector)
+ (for-each (lambda (a1)
+ (let ((a (cdr a1)))
+ (when (> (vector-ref a 0) 1)
+ (vector-set! a 1 (map (lambda (b)
+ (if (< 0 b 100000)
+ b
+ (values)))
+ (reverse (vector-ref a 1)))))))
+ v)
+ (for-each (lambda (keyval)
+ (let ((val (cdr keyval)))
+ (if (and (>= (vector-ref val 0) 2)
+ (> (* (vector-ref val 0) (vector-ref val 0) i) 100)) ; 120 seems too high
+ (if (equal? (vector-ref val 3) (car keyval))
+ (format outport "~NC~A uses, size: ~A, lines: '~A):~%~NCexpression: ~A~%"
+ lint-left-margin #\space
+ (vector-ref val 0) i (vector-ref val 1)
+ (+ lint-left-margin 2) #\space
+ (truncated-list->string (car keyval)))
+ (format outport "~NC~A uses, size: ~A, lines: '~A):~%~NCpattern: ~A~%~NCexample: ~A~%"
+ lint-left-margin #\space
+ (vector-ref val 0) i (vector-ref val 1)
+ (+ lint-left-margin 2) #\space
+ (truncated-list->string (car keyval))
+ (+ lint-left-margin 2) #\space
+ (truncated-list->string (vector-ref val 3)))))))
+ (sort! v (lambda (kv1 kv2)
+ (let ((a (cdr kv1))
+ (b (cdr kv2)))
+ (or (> (vector-ref a 0) (vector-ref b 0))
+ (and (= (vector-ref a 0) (vector-ref b 0))
+ (string<? (or (vector-ref a 4)
+ (vector-set! a 4 (object->string (vector-ref a 3))))
+ (or (vector-ref b 4)
+ (vector-set! b 4 (object->string (vector-ref b 3))))))))))))))))
+
+ (if (pair? form)
+ (set! line (max line (pair-line-number form))))
- (do ((form (read fp) (read fp)))
- ((eof-object? form))
- (if (pair? form)
- (set! line (max line (pair-line-number form))))
-
- (if (not (or (= last-line-number -1)
- (side-effect? last-form vars)))
- (format outport "~NCtop-level (line ~D): this has no effect: ~A~%"
- lint-left-margin #\space last-line-number
- (truncated-list->string last-form)))
- (set! last-form form)
- (set! last-line-number line)
-
- (if (and (pair? form)
- (memq (car form) '(define define-macro))
- (pair? (cdr form))
- (pair? (cadr form)))
- (let ((f (caadr form)))
- (if (and (symbol? f)
- (hash-table-ref built-in-functions f))
- (format outport "~NCtop-level ~Aredefinition of built-in function ~A: ~A~%"
- lint-left-margin #\space
- (if (> (pair-line-number form) 0)
- (format #f "(line ~D) " (pair-line-number form))
- "")
- f (truncated-list->string form)))))
-
- (set! vars (lint-walk (if (symbol? form)
- form
- (and (pair? form)
- (car form)))
- form
- vars)))
+ (if (not (or (= last-line-number -1)
+ (side-effect? last-form vars)))
+ (format outport "~NCtop-level (line ~D): this has no effect: ~A~%"
+ lint-left-margin #\space last-line-number
+ (truncated-list->string last-form)))
+ (set! last-form form)
+ (set! last-line-number line)
- (if (not (input-port? file))
- (close-input-port fp))
+ (if (and (pair? form)
+ (memq (car form) '(define define-macro))
+ (pair? (cdr form))
+ (pair? (cadr form)))
+ (let ((f (caadr form)))
+ (if (and (symbol? f)
+ (hash-table-ref built-in-functions f))
+ (format outport "~NCtop-level ~Aredefinition of built-in function ~A: ~A~%"
+ lint-left-margin #\space
+ (if (> (pair-line-number form) 0)
+ (format #f "(line ~D) " (pair-line-number form))
+ "")
+ f (truncated-list->string form)))))
+
+ (set! vars (lint-walk (if (symbol? form)
+ form
+ (and (pair? form)
+ (car form)))
+ form
+ vars))))))
- vars))))
-
(define (lint-file file env)
;; (if (string? file) (format *stderr* "lint ~S~%" file))
@@ -17222,6 +18518,11 @@
(set! other-identifiers (make-hash-table))
(set! linted-files ())
(fill! other-names-counts 0)
+
+ (do ((i 0 (+ i 1)))
+ ((= i *fragments-size*))
+ (fill! (fragments i) #f))
+
(set! last-simplify-boolean-line-number -1)
(set! last-simplify-numeric-line-number -1)
(set! last-simplify-cxr-line-number -1)
@@ -17233,9 +18534,7 @@
(set! quote-warnings 0)
(set! pp-left-margin 0)
(set! lint-left-margin -3) ; lint-file above adds 4
-
(set! big-constants (make-hash-table))
- (set! equable-closures (make-hash-table))
(set! *report-input* report-input)
(set! *report-nested-if* (if (integer? *report-nested-if*) (max 3 *report-nested-if*) 4))
@@ -17243,24 +18542,24 @@
(set! *#readers*
(list (cons #\e (lambda (str)
- (if (not (string=? str "e"))
- (let ((num (string->number (substring str 1))))
- (if num
- (cond ((rational? num)
- (format outport "~NCthis #e is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
- ((not (real? num))
- (format outport "~NC#e can't handle complex numbers, #~A -> ~A~%" lint-left-margin #\space str num))
- ((= num (floor num))
- (format outport "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (floor num)))))))
+ (unless (string=? str "e")
+ (let ((num (string->number (substring str 1))))
+ (cond ((not num))
+ ((rational? num)
+ (format outport "~NCthis #e is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
+ ((not (real? num))
+ (format outport "~NC#e can't handle complex numbers, #~A -> ~A~%" lint-left-margin #\space str num))
+ ((= num (floor num))
+ (format outport "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (floor num))))))
#f))
(cons #\i (lambda (str)
- (if (not (string=? str "i"))
- (let ((num (string->number (substring str 1))))
- (if num
- (format outport
- (if (not (rational? num))
- (values "~NCthis #i is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1))
- (values "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (* 1.0 num)))))))
+ (unless (string=? str "i")
+ (let ((num (string->number (substring str 1))))
+ (when num
+ (format outport
+ (if (not (rational? num))
+ (values "~NCthis #i is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1))
+ (values "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (* 1.0 num)))))))
#f))
(cons #\d (lambda (str)
(if (and (not (string=? str "d"))
@@ -17371,10 +18670,10 @@
((#\<) ; Chicken also, #<<EOF -> EOF
(if (and (char=? (data 1) #\<)
(> (length data) 2))
- (let ((end (substring data 2)))
- (do ((c (read-line) (read-line)))
- ((string-position end c)
- (values))))
+ (do ((end (substring data 2))
+ (c (read-line) (read-line)))
+ ((string-position end c)
+ (values)))
(string->symbol data)))
((#\\)
@@ -17416,7 +18715,27 @@
(else
(string->symbol data))))
(lambda args #f)))))))))
+
+ ;; preset list-tail and list-ref
+ (hash-table-set! (fragments 10) '((if (zero? _2_) _1_ (_F_ (cdr _1_) (- _2_ 1))))
+ (vector 0 ()
+ (list (cons 'list-tail
+ (inlet :initial-value '(define (list-tail x k) (if (zero? k) x (list-tail (cdr x) (- k 1))))
+ :arglist '(x k)
+ :history :built-in)))
+ '(define (list-tail x k) (if (zero? k) x (list-tail (cdr x) (- k 1))))
+ #f))
+ (hash-table-set! (fragments 12) '((if (= _2_ 0) (car _1_) (_F_ (cdr _1_) (- _2_ 1))))
+ (vector 0 ()
+ (list (cons 'list-ref (inlet :initial-value '(define (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1))))
+ :arglist '(items n)
+ :history :built-in)))
+ '(define (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1))))
+ #f))
+
+
+ ;; -------- call lint --------
(let ((vars (lint-file file ())))
(set! lint-left-margin (max lint-left-margin 1))
@@ -17481,10 +18800,10 @@
(if (not (or apos epos))
str
(let* ((pos ((if (and apos epos) min or) apos epos))
- (bpos (char-position #\> str (+ pos 1)))
- (epos (string-position (if (and apos (= pos apos)) "</a>" "</em>") str (+ bpos 1))))
+ (bpos (+ (char-position #\> str (+ pos 1)) 1))
+ (epos (string-position (if (and apos (= pos apos)) "</a>" "</em>") str bpos)))
(string-append (substring str 0 pos)
- (substring str (+ bpos 1) epos)
+ (substring str bpos epos)
(remove-markups (substring str (+ epos (if (and apos (= apos pos)) 4 5)))))))))))
(define (fixup-html str)
@@ -17499,7 +18818,7 @@
("mdash" . "-")
("amp" . "&"))
string=?) => cdr)
- (else (format () "unknown: ~A~%" substr)))
+ (else (format #t "unknown: ~A~%" substr)))
(fixup-html (substring str (+ epos 1)))))))))
(call-with-input-file file
@@ -17522,33 +18841,33 @@
(set! code (string-append code cline)))
;; is first non-whitespace char #\(? ignoring comments
- (let ((len (length code)))
- (do ((i 0 (+ i 1)))
- ((>= i len))
- (let ((c (string-ref code i)))
- (if (not (char-whitespace? c))
- (if (char=? c #\;)
- (set! i (char-position #\newline code i))
- (begin
- (set! i (+ len 1))
- (if (char=? c #\()
- (catch #t
- (lambda ()
- (let ((outstr (call-with-output-string
- (lambda (op)
- (call-with-input-string
- (object->string (with-input-from-string
- (fixup-html (remove-markups code))
- read)
- #t) ; write, not display
- (lambda (ip)
- (let-temporarily ((*report-shadowed-variables* #t))
- (lint ip op #f))))))))
- (if (> (length outstr) 1) ; possible newline at end
- (format () ";~A ~D: ~A~%" file line-num outstr))))
- (lambda args
- (format () ";~A ~D, error in read: ~A ~A~%" file line-num args
- (fixup-html (remove-markups code)))))))))))))))))))
+ (do ((len (length code))
+ (i 0 (+ i 1)))
+ ((>= i len))
+ (let ((c (string-ref code i)))
+ (unless (char-whitespace? c)
+ (if (char=? c #\;)
+ (set! i (char-position #\newline code i))
+ (begin
+ (set! i (+ len 1))
+ (when (char=? c #\()
+ (catch #t
+ (lambda ()
+ (let ((outstr (call-with-output-string
+ (lambda (op)
+ (call-with-input-string
+ (object->string (with-input-from-string
+ (fixup-html (remove-markups code))
+ read)
+ #t) ; write, not display
+ (lambda (ip)
+ (let-temporarily ((*report-shadowed-variables* #t))
+ (lint ip op #f))))))))
+ (if (> (length outstr) 1) ; possible newline at end
+ (format () ";~A ~D: ~A~%" file line-num outstr))))
+ (lambda args
+ (format () ";~A ~D, error in read: ~A ~A~%" file line-num args
+ (fixup-html (remove-markups code))))))))))))))))))
;;; --------------------------------------------------------------------------------
@@ -17580,18 +18899,19 @@
;; clean out backslashes
(do ((i 0 (+ i 1)))
((>= i (- len 3)))
- (if (char=? (code i) #\\)
- (cond ((char=? (code (+ i 1)) #\n)
- (set! (code i) #\space)
- (set! (code (+ i 1)) #\space))
-
- ((memv (code (+ i 1)) '(#\newline #\"))
- (set! (code i) #\space))
-
- ((and (char=? (code (+ i 1)) #\\)
- (char=? (code (- i 1)) #\#))
- (set! (code (- i 1)) #\space)
- (set! (code i) #\#))))))
+ (cond ((not (char=? (code i) #\\)))
+
+ ((char=? (code (+ i 1)) #\n)
+ (set! (code i) #\space)
+ (set! (code (+ i 1)) #\space))
+
+ ((memv (code (+ i 1)) '(#\newline #\"))
+ (set! (code i) #\space))
+
+ ((and (char=? (code (+ i 1)) #\\)
+ (char=? (code (- i 1)) #\#))
+ (set! (code (- i 1)) #\space)
+ (set! (code i) #\#)))))
(catch #t
(lambda ()
(let ((outstr (call-with-output-string
@@ -17629,21 +18949,23 @@
#f))
|#
-;;; --------------------------------------------------------------------------------
-;;; TODO:
+;;; fragments:
+;;; perhaps for fragment hash-ref (list fragment) to find function?
+;;; and check leading cases for all bodies? -- would need to handle this in reduce-tree walker?
+;;; need any-match arg nums (a 2nd level match)
+;;; if 2-arg func, reversed -> nth for list-ref -- need reversal signal
+;;; this is tricky (initial code in tmp) -- if recursive call, need args reversed so check shadowing etc
+;;; if several fragments share the same code, report just the biggest, and maybe give the _n_ values for at least the example?
+;;; maybe divide the trigger by the _n_ top? (need to save this number)
;;;
-;;; code-equal if/when/unless/cond, case: any order of clauses, let: any order of vars, etc, zero/=0
-;;; include named-lets in this search
-;;; these should translate when/unless first -> if?
-;;; (abs|magnitude (- x y)) is reversible internally
-;;; indentation is confused in pp by if expr+values?, pp handling of (list ((lambda...)..)) is bad
-;;; there are now lots of cases where we need to check for values (/ as invert etc)
-;;; the ((lambda ...)) -> let rewriter is still tricked by values
-;;; for scope calc, each macro call needs to be expanded or use out-vars?
-;;; if we know a macro's value, expand via macroexpand each time encountered and run lint on that? [see tmp for expansion]
-;;; hg-results has a lot of changes
-;;; currently differ-by-one is only in if/cond/case-walker -- would it make sense elsewhere? [16685]
-;;; (two branch cond/case), f+args (each can differ at the same spot) -- the simple cases here already work
-;;; differ-in-trailers would require values I think
+;;; blocks:
+;;; reduce-dependencies -- look for blocks with restricted outer vars, make func and add to closure, check for func-reuse
+;;; but this collides with current 1-call->embedded code in lint-walk-body unless we use the closure
+;;; so... perhaps use out-vars to get names -- if < 5, func? (if any out-var set, quit)
+;;; perhaps start with if branches, when/unless
;;;
-;;; 148 24013 659015
+;;; unused var search made smarter (in any body+locals)
+;;; named-let + map init ->embed as in map+map [do does not happen usefully]
+;;; where <expr> assumed <expr>, or where <expr> set to <expr> or assert <expr> and report violations [expr=pattern here]
+
+;;; 184 25029 665340
diff --git a/marks-menu.scm b/marks-menu.scm
index 407f2ec..193b348 100644
--- a/marks-menu.scm
+++ b/marks-menu.scm
@@ -637,15 +637,16 @@ between two marks,using the granulate generator to fix up the selection duration
(define loop-data '(0 0 0 0 0 0 1 1))
(define (update-labels start range end sus-rel range-in-secs)
- (if range-in-secs
- (begin
- (change-label start (format #f "~,3F" (/ (loop-data (* sus-rel 2)) (srate))))
- (change-label range (format #f "~,3F" (/ (- (loop-data (+ 1 (* sus-rel 2))) (loop-data (* sus-rel 2))) (srate))))
- (change-label end (format #f "~,3F" (/ (loop-data (+ 1 (* sus-rel 2))) (srate)))))
- (begin
- (change-label start (format #f "~D" (loop-data (* sus-rel 2))))
- (change-label range (format #f "~D" (- (loop-data (+ 1 (* sus-rel 2))) (loop-data (* sus-rel 2)))))
- (change-label end (format #f "~D" (loop-data (+ 1 (* sus-rel 2))))))))
+ (let ((sr2 (* sus-rel 2)))
+ (if range-in-secs
+ (begin
+ (change-label start (format #f "~,3F" (/ (loop-data sr2) (srate))))
+ (change-label range (format #f "~,3F" (/ (- (loop-data (+ 1 sr2)) (loop-data sr2)) (srate))))
+ (change-label end (format #f "~,3F" (/ (loop-data (+ 1 sr2)) (srate)))))
+ (begin
+ (change-label start (format #f "~D" (loop-data sr2)))
+ (change-label range (format #f "~D" (- (loop-data (+ 1 sr2)) (loop-data sr2))))
+ (change-label end (format #f "~D" (loop-data (+ 1 sr2))))))))
(define (create-loop-dialog)
(unless (Widget? loop-dialog)
@@ -849,29 +850,29 @@ between two marks,using the granulate generator to fix up the selection duration
(for-each
(lambda (rparent loc)
- (let ((sus-rel-start (* offset 2)))
+ (let ((sus-rel-start (+ (* offset 2) 1)))
(let ((someright (XtCreateManagedWidget " > " xmPushButtonWidgetClass rparent ())))
(XtAddCallback someright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (let ((ml (if (= loc 0) (loop-data sus-rel-start) (framples))))
(set! (loop-data (+ loc (* offset 2))) (min ml (+ (loop-data (+ loc (* offset 2))) 1)))
(update-labels midlab1 midlab2 midlab3 offset range-in-secs)))))
(let ((lotsright (XtCreateManagedWidget " >>" xmPushButtonWidgetClass rparent ())))
(XtAddCallback lotsright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (let ((ml (if (= loc 0) (loop-data sus-rel-start) (framples))))
(set! (loop-data (+ loc (* offset 2))) (min ml (+ (loop-data (+ loc (* offset 2))) 10)))
(update-labels midlab1 midlab2 midlab3 offset range-in-secs)))))
(let ((stopright (XtCreateManagedWidget " O " xmPushButtonWidgetClass rparent ())))
(XtAddCallback stopright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (let ((ml (if (= loc 0) (loop-data sus-rel-start) (framples))))
(set! (loop-data (+ loc (* offset 2))) ml)
(update-labels midlab1 midlab2 midlab3 offset range-in-secs)))))
(let ((farright (XtCreateManagedWidget ">>" xmPushButtonWidgetClass rparent ())))
(XtAddCallback farright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (let ((ml (if (= loc 0) (loop-data sus-rel-start) (framples))))
(set! (loop-data (+ loc (* offset 2))) ml)
(update-labels midlab1 midlab2 midlab3 offset range-in-secs)))))))
(list rowrighttop rowrightbottom)
diff --git a/maxf.scm b/maxf.scm
index d760729..54d64d6 100644
--- a/maxf.scm
+++ b/maxf.scm
@@ -313,23 +313,22 @@ the desired phase.
(snd-msg "Please leave default or enter [1] [2] [4] [9] [12] [13]~%")
(set! numf 1)))
- (let ((run-state (case numf
- ((1) state-0)
- ((2) state-5)
- ((4) state-4)
- ((9) state-2)
- ((12) state-1)
- ((13) state-3))))
-
- (do ((i beg (+ 1 i)))
- ((= i end))
- (let ((outvalA (* att (readin rdA)))
- (add-fl 0.0))
- (do ((j 0 (+ 1 j)))
- ((= j numf))
- (set-coeffs formfil (array-ref run-state j 0) (array-ref run-state j 1) (array-ref run-state j 2))
- (set! add-fl (+ add-fl (mvmfilt formfil outvalA))))
- (locsig loc i (* (env ampf) add-fl))))))))))
+ (do ((run-state (case numf
+ ((1) state-0)
+ ((2) state-5)
+ ((4) state-4)
+ ((9) state-2)
+ ((12) state-1)
+ ((13) state-3)))
+ (i beg (+ 1 i)))
+ ((= i end))
+ (let ((outvalA (* att (readin rdA)))
+ (add-fl 0.0))
+ (do ((j 0 (+ 1 j)))
+ ((= j numf))
+ (set-coeffs formfil (array-ref run-state j 0) (array-ref run-state j 1) (array-ref run-state j 2))
+ (set! add-fl (+ add-fl (mvmfilt formfil outvalA))))
+ (locsig loc i (* (env ampf) add-fl)))))))))
;; (let* ((ifile "dog.snd")
;; (ofile "gmax_dog.snd")
diff --git a/misc.scm b/misc.scm
index 018110d..e80d429 100644
--- a/misc.scm
+++ b/misc.scm
@@ -123,16 +123,13 @@
(XtAddCallback new-dialog XmNokCallback
(lambda (w c i)
(let ((new-name (XmTextFieldGetString rename-text)))
- (if (and (string? new-name)
- (> (length new-name) 0)
- (>= (selected-sound) 0))
- (let ();(current-name (file-name)))
- (save-sound-as new-name)
- (close-sound)
- ;(rename-file current-name new-name)
- ;; (delete-file current-name) perhaps?
- (open-sound new-name)
- (XtUnmanageChild w))))))
+ (when (and (string? new-name)
+ (> (length new-name) 0)
+ (>= (selected-sound) 0))
+ (save-sound-as new-name)
+ (close-sound)
+ (open-sound new-name)
+ (XtUnmanageChild w)))))
(for-each XmStringFree (vector xhelp xok xdismiss titlestr))
(set! rename-dialog new-dialog)
(let* ((mainform (XtCreateManagedWidget "formd" xmRowColumnWidgetClass rename-dialog
diff --git a/mix.scm b/mix.scm
index ed34b5d..18ad22c 100644
--- a/mix.scm
+++ b/mix.scm
@@ -426,13 +426,13 @@ panning operation."))
(cons (car e) (cons (- 1.0 (cadr e)) (invert-envelope (cddr e))))))
(let ((incoming-chans (channels name))
- (receiving-chans (channels index)))
+ (receiving-mono (= (channels index) 1)))
(if (= incoming-chans 1)
;; mono input
- (if (= receiving-chans 1)
+ (if receiving-mono
;; mono to mono = just scale or envelope
(let ((idx (mix name beg 0 index 0 *with-mix-tags* auto-delete))) ; file start in-chan snd chn ...
@@ -457,7 +457,7 @@ panning operation."))
;; stero input
- (if (= receiving-chans 1)
+ (if receiving-mono
;; stereo -> mono => scale or envelope both input chans into the output
(let ((idx0 (mix name beg 0 index 0 *with-mix-tags* deletion-choice))
@@ -549,10 +549,10 @@ begin time of each mix that starts after beg in the given channel"))
(if (not snd)
(for-each check-mix-tags (sounds))
(if (not chn)
- (let ((chns (channels snd)))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (check-mix-tags snd i)))
+ (do ((chns (channels snd))
+ (i 0 (+ i 1)))
+ ((= i chns))
+ (check-mix-tags snd i))
(let ((mxs (mixes snd chn))
(changed #f))
(let check-mix ((mx (car mxs))
diff --git a/mockery.scm b/mockery.scm
index 82a14f6..66e67db 100644
--- a/mockery.scm
+++ b/mockery.scm
@@ -292,7 +292,7 @@
'getenv (lambda (obj) (#_getenv (obj 'value)))
'delete-file (lambda (obj) (#_delete-file (obj 'value)))
'system (lambda* (obj cap) (#_system (obj 'value) cap))
- '->byte-vector (lambda (obj) (#_->byte-vector (obj 'value))) ; this is in-place!
+ 'string->byte-vector (lambda (obj) (#_string->byte-vector (obj 'value))) ; this is in-place!
'load (lambda* (obj (e (curlet))) (#_load (obj 'value) e))
'eval-string (lambda* (obj (e (curlet))) (#_eval-string (obj 'value) e))
'char-position (make-local-method #_char-position)
diff --git a/musglyphs.scm b/musglyphs.scm
index aaa4620..0650050 100644
--- a/musglyphs.scm
+++ b/musglyphs.scm
@@ -21,12 +21,12 @@
(vals (make-vector (total-length args 0))))
(cond ((null? vects) vals)
((vector? (car vects))
- (let* ((vect (car vects))
- (len (length vect)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (set! (vals (+ start i)) (vect i)))
- (set-vals (cdr vects) (+ start len) vals)))
+ (let ((vect (car vects)))
+ (do ((len (length vect))
+ (i 0 (+ 1 i)))
+ ((= i len)
+ (set-vals (cdr vects) (+ start len) vals))
+ (set! (vals (+ start i)) (vect i)))))
((car vects)
(set! (vals start) (car vects))
(set-vals (cdr vects) (+ start 1) vals))
@@ -260,13 +260,13 @@
(if (provided? 'snd-gtk)
(define (draw-staff x0 y0 width line-sep)
- (let ((cr (make-cairo (car (channel-widgets ps-snd ps-chn)))))
- (do ((line 0 (+ 1 line))
- (x x0)
- (y y0 (+ y (floor line-sep))))
- ((= line 5))
- (draw-line x y (floor (+ x width)) y ps-snd ps-chn time-graph cr))
- (free-cairo cr)))
+ (do ((cr (make-cairo (car (channel-widgets ps-snd ps-chn))))
+ (line 0 (+ 1 line))
+ (x x0)
+ (y y0 (+ y (floor line-sep))))
+ ((= line 5)
+ (free-cairo cr))
+ (draw-line x y (floor (+ x width)) y ps-snd ps-chn time-graph cr)))
(define (draw-staff x0 y0 width line-sep)
(do ((line 0 (+ 1 line))
(x x0)
diff --git a/new-effects.scm b/new-effects.scm
index 49c63b4..23693cb 100644
--- a/new-effects.scm
+++ b/new-effects.scm
@@ -66,12 +66,12 @@
(overlap (if decay (floor (* (srate) decay)) 0)))
(apply for-each
(lambda (snd chn)
- (let ((end (if (memq target '(sound cursor))
- (- (framples snd chn) 1)
- (if (eq? target 'selection)
- (+ (selection-position) (selection-framples))
- (cadr ms)))))
- (if (= (sync snd) snc)
+ (if (= (sync snd) snc)
+ (let ((end (if (memq target '(sound cursor))
+ (- (framples snd chn) 1)
+ (if (eq? target 'selection)
+ (+ (selection-position) (selection-framples))
+ (cadr ms)))))
(map-channel (func (- end beg)) beg (+ end overlap 1) snd chn
#f
(format #f "~A ~A ~A" (origin target (- end beg)) (if (eq? target 'sound) 0 beg)
@@ -412,23 +412,23 @@
(define effects-echo
(let ((documentation "(effects-echo input-samps-1 delay-time echo-amount beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
(lambda* (input-samps-1 delay-time echo-amount beg dur snd chn)
- (let* ((del (make-delay (round (* delay-time (srate snd)))))
- (len (or dur (framples snd chn)))
- (input-samps (or input-samps-1 len)))
- (as-one-edit
- (lambda ()
- (map-channel
- (lambda (inval)
- (+ inval
- (delay del (* echo-amount (+ (tap del) inval)))))
- beg input-samps snd chn)
- (if (> len input-samps)
- (map-channel
- (lambda (inval)
- (+ inval
- (delay del (* echo-amount (tap del)))))
- (+ beg input-samps) (- dur input-samps) snd chn)))
- (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur))))))
+ (let ((del (make-delay (round (* delay-time (srate snd)))))
+ (len (or dur (framples snd chn))))
+ (let ((input-samps (or input-samps-1 len)))
+ (as-one-edit
+ (lambda ()
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (+ (tap del) inval)))))
+ beg input-samps snd chn)
+ (if (> len input-samps)
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (tap del)))))
+ (+ beg input-samps) (- dur input-samps) snd chn)))
+ (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur)))))))
(define effects-flecho-1
(let ((documentation "(effects-flecho-1 scaler secs input-samps-1 beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
@@ -2995,14 +2995,14 @@ the synthesis amplitude, the FFT size, and the radius value."))
(let* ((len (framples snd chn))
(data (make-float-vector len))
(reader (make-sampler 0 snd chn)))
- (let ((lastx 0.0)
- (lasty 0.0))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((inval (next-sample reader)))
- (set! lasty (- (+ inval (* 0.999 lasty)) lastx))
- (set! lastx inval)
- (float-vector-set! data i lasty))))
+ (do ((lastx 0.0)
+ (lasty 0.0)
+ (i 0 (+ i 1)))
+ ((= i len))
+ (let ((inval (next-sample reader)))
+ (set! lasty (- (+ inval (* 0.999 lasty)) lastx))
+ (set! lastx inval)
+ (float-vector-set! data i lasty)))
(float-vector->channel data 0 len snd chn current-edit-position "effects-remove-dc")))
(add-to-menu effects-menu "Remove DC" effects-remove-dc)
diff --git a/noise.scm b/noise.scm
index d4b5d87..79587ff 100644
--- a/noise.scm
+++ b/noise.scm
@@ -125,32 +125,32 @@
; (distance 1.0)
; (reverb-amount 0.005)
)
- (let* ((dur (/ len (floor (srate))))
- (dev-ff (let ((dev-attack (attack-point dur devat devdc))
- (dev-decay (- 100.0 (attack-point dur devdc devat))))
- (make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
- :duration dur :scaler (hz->radians (- dev1 dev0)))))
- (amp-ff (let ((amp-attack (attack-point dur ampat ampdc))
- (amp-decay (- 100.0 (attack-point dur ampdc ampat))))
- (make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
- :duration dur :scaler amp)))
- (freq-ff (let ((freq-attack (attack-point dur freqat freqdc))
- (freq-decay (- 100.0 (attack-point dur freqdc freqat))))
- (make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
- :duration dur :scaler (hz->radians (- freq1 freq)))))
- (rfreq-ff (let ((rfreq-attack (attack-point dur rfreqat rfreqdc))
- (rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat))))
- (make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
- :duration dur :scaler (hz->radians (- rfreq1 rfreq0)))))
- (carrier (make-oscil freq))
- (modulator (make-rand :frequency rfreq0 :amplitude 1.0))
- (dev-0 (hz->radians dev0))
- (dev-f (lambda () (env dev-ff)))
- (amp-f (lambda () (env amp-ff)))
- (freq-f (lambda () (env freq-ff)))
- (rfreq-f (lambda () (env rfreq-ff))))
- (lambda ()
- (* (amp-f) (oscil carrier (+ (freq-f) (* (+ dev-0 (dev-f)) (rand modulator (rfreq-f)))))))))
+ (let ((dur (/ len (floor (srate)))))
+ (let ((dev-ff (let ((dev-attack (attack-point dur devat devdc))
+ (dev-decay (- 100.0 (attack-point dur devdc devat))))
+ (make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
+ :duration dur :scaler (hz->radians (- dev1 dev0)))))
+ (amp-ff (let ((amp-attack (attack-point dur ampat ampdc))
+ (amp-decay (- 100.0 (attack-point dur ampdc ampat))))
+ (make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
+ :duration dur :scaler amp)))
+ (freq-ff (let ((freq-attack (attack-point dur freqat freqdc))
+ (freq-decay (- 100.0 (attack-point dur freqdc freqat))))
+ (make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
+ :duration dur :scaler (hz->radians (- freq1 freq)))))
+ (rfreq-ff (let ((rfreq-attack (attack-point dur rfreqat rfreqdc))
+ (rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat))))
+ (make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
+ :duration dur :scaler (hz->radians (- rfreq1 rfreq0)))))
+ (carrier (make-oscil freq))
+ (modulator (make-rand :frequency rfreq0 :amplitude 1.0))
+ (dev-0 (hz->radians dev0)))
+ (let ((dev-f (lambda () (env dev-ff)))
+ (amp-f (lambda () (env amp-ff)))
+ (freq-f (lambda () (env freq-ff)))
+ (rfreq-f (lambda () (env rfreq-ff))))
+ (lambda ()
+ (* (amp-f) (oscil carrier (+ (freq-f) (* (+ dev-0 (dev-f)) (rand modulator (rfreq-f)))))))))))
;; (let* ((beg 0)
;; (dur 9.8)
diff --git a/numerics.scm b/numerics.scm
index a0898d3..807047f 100644
--- a/numerics.scm
+++ b/numerics.scm
@@ -64,9 +64,9 @@
0
(if (= mn 0)
1
- (let* ((mx (max k (- n k)))
- (cnk (+ 1 mx)))
- (do ((i 2 (+ i 1)))
+ (let ((mx (max k (- n k))))
+ (do ((cnk (+ 1 mx))
+ (i 2 (+ i 1)))
((> i mn) cnk)
(set! cnk (/ (* cnk (+ mx i)) i))))))))))
@@ -95,15 +95,14 @@
(let ((pmmp1 (* x pmm (+ (* 2 m) 1))))
(if (= L (+ m 1))
pmmp1
- (let ((pk 0.0)) ; NR used "ll" which is unreadable
- (do ((k (+ m 2) (+ k 1)))
- ((> k L))
- (set! pk (/ (- (* x (- (* 2 k) 1) pmmp1)
- (* (+ k m -1) pmm))
- (- k m)))
- (set! pmm pmmp1)
- (set! pmmp1 pk))
- pk)))))))
+ (do ((pk 0.0) ; NR used "ll" which is unreadable
+ (k (+ m 2) (+ k 1)))
+ ((> k L) pk)
+ (set! pk (/ (- (* x (- (* 2 k) 1) pmmp1)
+ (* (+ k m -1) pmm))
+ (- k m)))
+ (set! pmm pmmp1)
+ (set! pmmp1 pk))))))))
;;; A&S (bessel.lisp)
@@ -375,57 +374,52 @@
(define (Si x)
(if (>= x 1.0)
(- (/ pi 2) (* (cos x) (aux-f x)) (* (sin x) (aux-g x)))
- (let ((sum x)
- (fact 2.0)
- (one -1.0)
- (xs x)
- (x2 (* x x))
- (err .000001)
- (unhappy #t))
- (do ((i 3.0 (+ i 2.0)))
- ((not unhappy))
+ (do ((sum x)
+ (fact 2.0)
+ (one -1.0)
+ (xs x)
+ (x2 (* x x))
+ (err .000001)
+ (unhappy #t)
+ (i 3.0 (+ i 2.0)))
+ ((not unhappy) sum)
(set! xs (/ (* one x2 xs) (* i fact)))
(set! one (- one))
(set! fact (+ 1 fact))
(set! xs (/ xs fact))
(set! unhappy (> (abs xs) err))
- (set! sum (+ sum xs)))
- sum)))
+ (set! sum (+ sum xs)))))
(define (Ci x)
(if (>= x 1.0)
(- (* (sin x) (aux-f x)) (* (cos x) (aux-g x)))
- (let ((g .5772156649)
- (sum 0.0)
- (fact 1.0)
- (one -1.0)
- (xs 1.0)
- (x2 (* x x))
- (err .000001)
- (unhappy #t))
- (do ((i 2.0 (+ i 2.0)))
- ((not unhappy))
+ (do ((g .5772156649)
+ (sum 0.0)
+ (fact 1.0)
+ (one -1.0)
+ (xs 1.0)
+ (x2 (* x x))
+ (err .000001)
+ (unhappy #t)
+ (i 2.0 (+ i 2.0)))
+ ((not unhappy)
+ (+ g (log x) sum))
(set! xs (/ (* one x2 xs) (* i fact)))
(set! one (- one))
(set! fact (+ 1 fact))
(set! xs (/ xs fact))
(set! unhappy (> (abs xs) err))
- (set! sum (+ sum xs)))
- (+ g (log x) sum))))
+ (set! sum (+ sum xs)))))
;;; --------------------------------------------------------------------------------
(define bernoulli3
- (let ((saved-values (let ((v (make-vector 100 #f))
- (vals (vector 1 -1/2 1/6 0 -1/30 0 1/42 0 -1/30 0 5/66 0 -691/2730
- 0 7/6 0 -3617/510 0 43867/798 0 -174611/330 0
- 854513/138 0 -236364091/2730 0 8553103/6 0
- -23749461029/870 0 8615841276005/14322 0)))
- (do ((i 0 (+ i 1)))
- ((= i 30))
- (set! (v i) (vals i)))
- v)))
+ (let ((saved-values (copy #(1 -1/2 1/6 0 -1/30 0 1/42 0 -1/30 0 5/66 0 -691/2730
+ 0 7/6 0 -3617/510 0 43867/798 0 -174611/330 0
+ 854513/138 0 -236364091/2730 0 8553103/6 0
+ -23749461029/870 0 8615841276005/14322 0)
+ (make-vector 100 #f))))
(lambda (n)
(if (number? (saved-values n))
(saved-values n)
@@ -696,13 +690,12 @@
(define (ihex x nhx chx)
;; This returns, in chx, the first nhx hex digits of the fraction of x.
- (let ((y (abs x))
- (hx "0123456789ABCDEF"))
- (do ((i 0 (+ i 1)))
- ((= i nhx))
- (set! y (* 16.0 (- y (floor y))))
- (set! (chx i) (hx (floor y))))
- chx))
+ (do ((y (abs x))
+ (hx "0123456789ABCDEF")
+ (i 0 (+ i 1)))
+ ((= i nhx) chx)
+ (set! y (* 16.0 (- y (floor y))))
+ (set! (chx i) (hx (floor y)))))
(define (series m id)
;; This routine evaluates the series sum_k 16^(id-k)/(8*k+m) using the modular exponentiation technique.
@@ -760,13 +753,13 @@
(set! s (- s (floor s)))))
;; Compute a few terms where k >= id.
- (let ((happy #f))
- (do ((k id (+ k 1)))
- ((or (> k (+ id 100)) happy) s)
- (let ((t (/ (expt 16.0 (- id k)) (+ (* 8 k) m))))
- (set! happy (< t eps))
- (set! s (+ s t))
- (set! s (- s (floor s))))))))
+ (do ((happy #f)
+ (k id (+ k 1)))
+ ((or (> k (+ id 100)) happy) s)
+ (let ((t (/ (expt 16.0 (- id k)) (+ (* 8 k) m))))
+ (set! happy (< t eps))
+ (set! s (+ s t))
+ (set! s (- s (floor s)))))))
;; id is the digit position. Digits generated follow immediately after id.
(let ((chx (make-string 17))
@@ -829,17 +822,18 @@
(set! peak val)
(set! location x)))))
;; now narrow it by zigzagging around the peak
- (let ((x location))
- (do ((zig-size (* incr 2) (/ zig-size 2)))
- ((< zig-size err))
- (let ((cur (abs (+ (sin x) (sin (+ offset (* n x))))))
- (left (abs (+ (sin (- x zig-size)) (sin (+ (* n (- x zig-size)) offset))))))
- (if (< left cur)
- (let ((right (abs (+ (sin (+ x zig-size)) (sin (+ (* n (+ x zig-size)) offset))))))
- (if (> right cur)
- (set! x (+ x zig-size))))
- (set! x (- x zig-size)))))
- (list (abs (+ (sin x) (sin (+ (* n x) offset)))) x)))))
+ (do ((x location)
+ (zig-size (* incr 2) (/ zig-size 2)))
+ ((< zig-size err)
+ (list (abs (+ (sin x) (sin (+ (* n x) offset)))) x))
+ (let ((cur (abs (+ (sin x) (sin (+ offset (* n x))))))
+ (left (abs (+ (sin (- x zig-size)) (sin (+ (* n (- x zig-size)) offset))))))
+ (if (< left cur)
+ (let ((right (abs (+ (sin (+ x zig-size)) (sin (+ (* n (+ x zig-size)) offset))))))
+ (if (> right cur)
+ (set! x (+ x zig-size))))
+ (set! x (- x zig-size))))))))
+
;;; --------------------------------------------------------------------------------
diff --git a/peak-phases.scm b/peak-phases.scm
index 4f386f7..5209a76 100644
--- a/peak-phases.scm
+++ b/peak-phases.scm
@@ -1671,8 +1671,8 @@
(vector 20 5.043 #(0 1 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0)
4.357980 #(0.000000 0.074668 -0.007236 0.182274 -0.090904 0.683075 1.087950 1.620610 1.402047 0.349796 1.096502 -0.498958 0.949574 -0.321894 1.411823 0.831379 -0.654670 0.294879 -0.284984 1.407225)
- 4.301350 #(0.000000 1.462657 0.315046 1.257119 0.218364 -0.229560 0.191266 0.646076 -0.074737 0.182805 -0.095884 0.518081 0.428215 -0.270813 1.227758 1.155049 -0.394507 0.393747 0.491847 -0.074127)
- 4.300696 #(0.000000 1.453960 0.305048 1.243496 0.204325 -0.251563 0.160990 0.613695 -0.108690 0.149379 -0.143222 0.469144 0.382436 -0.318799 1.156560 1.098024 -0.463350 0.326646 0.412158 -0.149696)
+ 4.300525 #(0.000000 1.454922 0.306846 1.245703 0.207273 -0.248151 0.165464 0.618585 -0.103207 0.155791 -0.136302 0.476852 0.390970 -0.309608 1.166284 1.108669 -0.452208 0.338277 0.424300 -0.136694)
+ 4.300411 #(0.000000 1.455414 0.307661 1.246638 0.208834 -0.246349 0.167594 0.620918 -0.100474 0.159208 -0.133203 0.480470 0.395357 -0.304743 1.170590 1.114440 -0.446663 0.344322 0.430311 -0.130164)
)
;;; 21 odd -------------------------------------------------------------------------------- ; 4.5825756
@@ -1687,48 +1687,48 @@
(vector 22 5.1805551751198 #(0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0)
4.581017 #(0.000000 0.180996 0.414015 1.937535 0.354831 0.584078 1.521008 1.778595 1.533807 1.338106 -0.034930 1.700610 0.808153 0.348626 1.850606 -0.102689 0.038967 0.664253 1.395687 0.513457 1.627689 0.472162)
- 4.572966 #(0.000000 0.624974 -0.494704 -0.062730 0.437887 0.708437 0.329958 1.081405 -0.318053 -0.503605 0.061743 0.515507 -0.185504 0.100991 -0.057279 1.106734 -1.261148 -0.049536 0.800865 0.581274 0.648500 0.158381)
- 4.564487 #(0.000000 0.576405 -0.579542 -0.156941 0.290094 0.541216 0.112010 0.847419 -0.573063 -0.792734 -0.277370 0.148421 -0.579056 -0.322667 -0.510430 0.613557 -1.772650 -0.608491 0.219823 -0.009843 -0.000061 -0.530362)
+ 4.559399 #(0.000000 0.818164 -0.192940 0.348191 -0.389846 0.508891 0.493197 0.093591 -0.504577 -0.897041 -0.065084 0.067843 -0.236861 0.107466 -0.207423 -0.742951 0.106255 0.956224 0.876829 -0.230549 0.370673 0.390286)
+ 4.519002 #(0.000000 -0.221397 1.057824 1.492981 -0.263486 0.870091 -0.528249 -0.376750 0.756810 0.176851 -0.090091 1.600251 -0.084632 0.635148 0.821442 1.002126 0.978361 0.034872 -0.759728 0.321190 0.972421 0.245173)
)
;;; 23 odd -------------------------------------------------------------------------------- ; 4.7958315
(vector 23 5.4125407453101 #(0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1)
4.661614 #(0.000000 0.402662 0.143299 -0.307618 -0.213995 0.796949 1.006633 1.285380 1.569840 0.564104 0.342477 0.293161 1.200899 0.723618 0.539973 0.518746 0.907665 0.184015 1.163786 0.995418 -1.860771 1.039418 -0.124574)
- 4.636176 #(0.000000 0.519866 0.374819 -0.030447 0.192370 1.304984 1.571487 -0.066414 0.252962 1.322528 1.209237 1.264494 0.242765 1.907322 1.729898 1.793071 0.231940 1.678090 0.706948 0.606492 1.894338 0.853159 1.787580)
4.634825 #(0.000000 0.336809 0.806144 -0.062567 0.702047 1.353357 1.333544 1.711363 1.335973 0.156420 1.259722 0.268353 0.775391 0.709193 0.489222 -0.013866 0.215803 1.155224 0.942400 0.393893 0.015582 0.693933 0.411664)
+ 4.634407 #(0.000000 0.337913 0.805462 -0.065533 0.702753 1.354327 1.334664 1.709523 1.331667 0.152462 1.257186 0.263947 0.769802 0.707842 0.485157 -0.009174 0.212207 1.154954 0.942106 0.386101 0.011788 0.687978 0.407297)
)
;;; 24 odd -------------------------------------------------------------------------------- ; 4.89897948
(vector 24 5.6193280144865 #(0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1)
4.786434 #(0.000000 0.498846 1.191572 1.399155 0.479838 1.497230 -0.058887 0.823598 0.010384 0.864577 0.051220 1.057330 0.998513 1.799328 -0.041050 0.199658 0.646825 0.272218 0.034139 0.159133 0.043804 -0.115906 1.177655 0.690674)
- 4.783551 #(0.000000 0.718903 0.843951 1.646228 0.245318 1.348243 -0.241958 0.553724 -0.135398 0.478801 -0.417787 0.837802 1.118912 1.185206 0.001003 -0.012570 0.249549 -0.381853 -0.460156 -0.067734 -0.098370 -0.601123 0.571496 -0.014893)
4.783029 #(0.000000 0.726248 0.856709 1.665477 0.271147 1.375734 -0.206610 0.592121 -0.087409 0.530646 -0.360424 0.901293 1.188841 1.262301 0.080781 0.071714 0.339949 -0.286037 -0.360911 0.038946 0.015798 -0.483821 0.695754 0.114401)
+ 4.782962 #(0.000000 0.726238 0.856679 1.665577 0.271280 1.375871 -0.206382 0.592175 -0.087179 0.530852 -0.360257 0.901705 1.189234 1.262764 0.081277 0.072171 0.340463 -0.285522 -0.360411 0.039578 0.016656 -0.483158 0.696443 0.115110)
)
;;; 25 odd -------------------------------------------------------------------------------- ; 5
(vector 25 5.7220960914079 #(0 1 0 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1)
4.886819 #(0.000000 -0.128793 0.647898 0.792536 -0.285146 0.144218 1.160103 1.183437 -0.004858 -0.239530 1.215352 0.277973 0.699697 1.110172 0.616181 1.458993 0.406636 0.121039 0.182656 -0.085662 1.058149 0.147121 0.546131 0.378165 0.309175)
- 4.865690 #(0.000000 0.049083 0.518359 1.226987 -0.738416 0.540127 0.766518 1.426508 -0.434331 -0.154303 1.590262 0.480087 0.287057 -1.105890 0.346099 -0.140690 0.422510 0.142277 0.052967 -0.203330 -0.865415 -0.068820 0.420811 -0.449472 0.543736)
- 4.862034 #(0.000000 0.010883 0.500081 1.154509 -0.822082 0.447783 0.644746 1.285452 -0.548061 -0.355481 1.403627 0.281321 0.074705 -1.368546 0.081592 -0.437696 0.142447 -0.192640 -0.266326 -0.565494 -1.250657 -0.428908 -0.017603 -0.874024 0.089961)
+ 4.833870 #(0.000000 0.682487 0.229329 1.065182 1.133347 0.718396 -0.534947 0.962349 0.109795 -0.506458 1.066135 -0.520472 -0.571394 0.037503 0.493262 0.263583 -0.535314 -0.444645 1.130989 -0.865083 -0.231904 -0.824110 -0.626051 0.420930 0.748241)
+ 4.833585 #(0.000000 0.684418 0.231543 1.068448 1.131681 0.716084 -0.543413 0.960963 0.108056 -0.510271 1.064008 -0.527153 -0.574236 0.032340 0.486849 0.263393 -0.542768 -0.456188 1.134973 -0.877871 -0.236595 -0.839653 -0.635589 0.413586 0.738028)
)
;;; 26 odd -------------------------------------------------------------------------------- ; 5.0990
(vector 26 5.8537594936002 #(0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1)
5.006443 #(0.000000 1.694135 1.368613 1.372881 0.625230 0.749494 1.218456 1.691757 1.088538 0.652397 -0.134215 1.088115 0.314540 0.197061 0.715518 1.230349 1.542812 -0.159343 1.427261 1.767442 0.867761 1.850745 0.671024 -0.112496 0.172562 0.147817)
- 4.998313 #(0.000000 1.734366 1.452800 1.481416 0.767178 0.912208 1.420592 -0.092819 1.341912 0.935356 0.173174 1.426025 0.695197 0.600881 1.161029 1.696831 0.036081 0.368394 -0.024124 0.350178 1.493610 0.485227 1.353414 0.593653 0.909305 0.920489)
- 4.997597 #(0.000000 1.738732 1.464944 1.506852 0.793026 0.939307 1.467000 -0.059120 1.386349 0.993314 0.226614 1.492120 0.767958 0.673251 1.262733 1.788242 0.135591 0.470430 0.083411 0.467468 1.606652 0.610267 1.492062 0.741835 1.051515 1.074180)
+ 4.996915 #(0.000000 1.742755 1.471776 1.501254 0.794548 0.943595 1.463682 -0.050384 1.394006 0.990276 0.231933 1.492372 0.767814 0.678653 1.249512 1.790068 0.139370 0.475758 0.085016 0.469457 1.614468 0.612558 1.488941 0.735631 1.061318 1.072925)
+ 4.996683 #(0.000000 1.740815 1.471360 1.504333 0.793966 0.944959 1.469851 -0.050031 1.395444 0.990928 0.238054 1.493878 0.769155 0.680547 1.256014 1.792102 0.136976 0.478247 0.085153 0.474291 1.616841 0.617611 1.491514 0.741599 1.059794 1.082318)
)
;;; 27 odd -------------------------------------------------------------------------------- ; 5.196152
(vector 27 5.8637111082051 #(0 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1)
5.088823 #(0.000000 0.108028 1.216984 1.164689 0.975005 -0.022884 0.035464 -0.148996 0.575654 1.005987 1.378471 0.117457 0.956928 1.741009 0.131397 -0.243584 0.873140 0.514628 1.810242 0.918281 0.161062 1.222969 1.595595 1.233298 1.211975 1.332117 1.297417)
- 5.085863 #(0.000000 0.128925 1.251125 1.214764 1.041899 0.057706 0.132363 -0.027871 0.701338 1.157060 1.544495 0.300753 1.157743 -0.045909 0.351461 -0.002752 1.121958 0.779052 0.085933 1.218255 0.473721 1.545898 1.955446 1.591383 1.599506 1.727019 1.708190)
5.085571 #(0.000000 0.134554 1.259859 1.228144 1.060230 0.079084 0.158344 0.004220 0.734810 1.196702 1.588244 0.348524 1.210515 0.009117 0.409728 0.061105 1.186771 0.849208 0.158894 1.297636 0.556923 1.631224 0.049754 1.687106 1.701477 1.830544 1.814985)
+ 5.085376 #(0.000000 0.134436 1.259874 1.228201 1.060157 0.078706 0.158097 0.004323 0.734629 1.196644 1.588020 0.348173 1.210355 0.008907 0.409496 0.060743 1.186070 0.848591 0.158658 1.296780 0.556238 1.631048 0.049386 1.686839 1.701113 1.829904 1.814076)
)
;;; 28 odd -------------------------------------------------------------------------------- ; 5.291502
@@ -1741,14 +1741,15 @@
(vector 29 6.0348020511367 #(0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 1)
5.263365 #(0.000000 0.151064 0.558177 0.735081 1.367806 -0.011277 1.649265 0.435302 1.718318 1.203162 0.977127 1.010028 0.703023 1.591655 0.710208 0.371369 0.285721 1.400549 0.654738 0.961707 0.849244 0.833954 0.047113 1.107680 1.103136 1.834278 0.611441 1.521356 0.107658)
- 5.259288 #(0.000000 0.166681 0.583269 0.778340 1.425069 0.059765 1.739046 0.528564 1.829114 1.331524 1.122056 1.160867 0.870985 1.763529 0.904217 0.580915 0.504372 1.635384 0.897463 1.218677 1.129924 1.124231 0.338591 1.419164 1.429852 0.160125 0.961152 1.885698 0.486330)
- 5.258751 #(0.000000 0.171574 0.592319 0.792973 1.446819 0.084857 1.769829 0.564731 1.868550 1.377844 1.173689 1.214525 0.934263 1.825439 0.976268 0.658329 0.582828 1.724114 0.984894 1.311650 1.228345 1.227537 0.450506 1.533849 1.549709 0.281643 1.094059 0.018092 0.627024)
+ 5.257572 #(0.000000 0.173145 0.594158 0.795369 1.446698 0.086774 1.773903 0.563415 1.870889 1.380641 1.174997 1.216907 0.933657 1.828478 0.975502 0.657848 0.586415 1.721400 0.987820 1.313934 1.233706 1.234202 0.445482 1.535953 1.550258 0.283390 1.091724 0.021764 0.624654)
+ 5.257294 #(0.000000 0.173417 0.594854 0.796262 1.448087 0.088760 1.776024 0.565819 1.873894 1.383720 1.178388 1.220868 0.937816 1.832318 0.979592 0.662513 0.591751 1.726716 0.993575 1.320249 1.240786 1.241192 0.451577 1.543498 1.557502 0.291356 1.099404 0.030228 0.632911)
)
;;; 30 odd -------------------------------------------------------------------------------- ; 5.4772255
(vector 30 6.2357559204102 #(0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
5.353062 #(0.000000 -0.273797 0.780589 0.428126 1.742006 0.813705 1.826779 0.243133 0.799231 0.444552 0.600071 1.280010 -0.037027 0.801371 0.587721 1.132556 0.784854 1.819749 1.361833 1.646165 1.057885 0.274456 0.188906 0.072120 0.645190 1.511097 1.900389 1.698668 1.288971 1.535352)
+ 5.352588 #(0.000000 -0.273931 0.766389 0.417785 1.759969 0.852970 1.831793 0.250419 0.820927 0.459290 0.634623 1.258292 -0.010367 0.819856 0.603568 1.142686 0.772733 1.853850 1.422248 1.684383 1.092051 0.281817 0.215433 0.103401 0.692837 1.549368 1.938793 1.739493 1.350311 1.578167)
)
;;; 31 odd -------------------------------------------------------------------------------- ; 5.56776
@@ -1761,6 +1762,8 @@
(vector 32 6.3532226957365 #(0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1)
5.563263 #(0.000000 0.861343 1.208721 0.520795 1.054113 1.500902 0.176395 1.932292 0.475897 1.249746 1.078677 0.960255 1.432432 1.363500 0.301492 1.951062 1.402695 1.767079 1.762968 0.052405 1.191435 0.031852 1.950934 1.508841 1.124488 1.063642 0.897258 1.672866 0.358501 1.273522 0.844792 1.935288)
+ 5.562972 #(0.000000 0.861217 1.206835 0.514668 1.049373 1.493527 0.165833 1.922649 0.463026 1.234869 1.062460 0.942281 1.415945 1.343562 0.279233 1.931459 1.376805 1.743078 1.738289 0.026086 1.157890 -0.002180 1.918803 1.472699 1.091275 1.028581 0.857328 1.631630 0.315548 1.231287 0.799592 1.886286)
+ 5.562411 #(0.000000 0.859323 1.190444 0.494012 1.028692 1.469692 0.141558 1.885052 0.424090 1.180902 1.008009 0.895780 1.351886 1.274948 0.207413 1.853283 1.295225 1.657605 1.650700 -0.065848 1.060843 -0.109787 1.811684 1.362896 0.980346 0.908138 0.729852 1.507776 0.172839 1.085598 0.653947 1.738565)
)
;;; 33 odd -------------------------------------------------------------------------------- ; 5.74456
@@ -1773,18 +1776,21 @@
(vector 34 6.5771403312683 #(0 0 1 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0)
5.740544 #(0.000000 1.128136 0.272558 -0.038354 0.299624 0.550945 0.313230 0.243494 0.297552 -0.035270 1.018110 0.345979 1.524929 0.448210 1.252682 0.941202 0.533185 0.349491 1.187324 0.383773 0.599245 -0.155984 1.372487 0.578854 1.244062 1.476419 0.215593 0.058496 0.148247 1.077304 1.406503 0.859804 1.327046 0.146527)
+ 5.740096 #(0.000000 1.126579 0.274797 -0.036973 0.303383 0.553483 0.314264 0.246856 0.297834 -0.033499 1.019845 0.345774 1.526899 0.447745 1.258364 0.944671 0.535960 0.355266 1.190803 0.389672 0.604320 -0.151880 1.372982 0.583869 1.247701 1.480892 0.216497 0.062583 0.153614 1.084578 1.412571 0.866785 1.333165 0.152476)
)
;;; 35 odd -------------------------------------------------------------------------------- ; 5.9160
(vector 35 6.7392678260803 #(0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0)
5.833275 #(0.000000 0.446552 1.591598 1.665970 0.393066 0.930519 1.356028 1.466278 0.225797 1.216894 0.009583 0.233020 1.866671 1.148796 1.079614 1.602870 0.201424 1.366765 -0.045388 1.214248 0.402056 0.196949 1.726073 1.538289 -0.146596 -0.105825 1.452686 0.350527 1.133547 0.212285 1.683225 0.967867 0.587559 1.049939 0.968758)
+ 5.831940 #(0.000000 0.442592 1.595559 1.667149 0.390888 0.932710 1.355699 1.467421 0.225808 1.216274 0.006151 0.229030 1.863501 1.148120 1.076941 1.603023 0.203908 1.367674 -0.048841 1.213555 0.398968 0.193979 1.723886 1.530859 -0.143197 -0.110963 1.445011 0.352490 1.136021 0.209386 1.681224 0.955375 0.584685 1.044680 0.963426)
)
;;; 36 odd -------------------------------------------------------------------------------- ; 6
(vector 36 6.8277182579041 #(0 1 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0)
5.977640 #(0.000000 -0.070466 1.538192 0.984355 0.488221 1.019554 1.547512 1.704002 1.584416 0.668394 -0.001385 0.884114 1.504028 -0.187464 0.437132 1.457048 0.752720 0.480053 1.746828 0.789836 0.816665 1.133277 1.144098 1.330854 0.114924 1.293712 1.538716 1.521496 0.841528 0.693020 1.172435 0.408530 0.666143 -0.084621 1.417045 -0.037001)
+ 5.976954 #(0.000000 -0.070556 1.536418 0.980505 0.483987 1.015677 1.541485 1.698146 1.578396 0.660292 -0.011221 0.873208 1.492968 -0.199079 0.425437 1.441408 0.737503 0.464140 1.729055 0.774687 0.798932 1.115905 1.126505 1.309834 0.093266 1.273387 1.516076 1.497797 0.815827 0.668525 1.146329 0.381039 0.638332 -0.112948 1.387354 -0.069078)
;; 35+1
6.030643 #(0.000000 1.022108 1.134386 0.040000 1.020689 1.082726 -0.154753 1.098409 0.988397 0.898657 1.161207 0.157216 -0.172638 1.251128 1.003109 0.170160 0.036385 0.822058 1.148915 -0.012280 -0.203882 0.002376 0.142366 -0.019253 0.880987 1.211008 -0.244514 0.790432 -0.315814 0.996657 -0.069816 0.913294 0.063655 0.034201 0.148650 -0.048872)
@@ -1795,6 +1801,7 @@
(vector 37 7.0 #(0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0)
6.019116 #(0.000000 1.198867 1.849092 0.935330 1.781957 0.496846 0.026335 0.303736 1.089299 1.074310 1.006658 1.377317 0.271438 1.654659 0.071833 0.494433 1.198697 -0.081156 0.936704 0.883271 1.529398 0.425484 0.218240 1.480439 1.569267 1.446099 0.465358 0.265303 1.385278 0.810099 0.212275 0.106695 0.522036 0.380536 0.175723 0.325421 -0.016008)
+ 6.017983 #(0.000000 1.196303 1.848565 0.939650 1.786501 0.501068 0.028495 0.309805 1.093071 1.080045 0.999577 1.377779 0.273016 1.658005 0.074466 0.493082 1.197720 -0.080740 0.935043 0.876257 1.528656 0.420990 0.220232 1.480020 1.566042 1.443116 0.463685 0.261601 1.382015 0.812725 0.198582 0.107078 0.513834 0.371234 0.176917 0.320137 -0.019751)
)
;;; 38 odd -------------------------------------------------------------------------------- ; 6.1644
@@ -1804,14 +1811,16 @@
;; 37+1
6.138688 #(0.000000 1.046261 1.784835 0.956057 1.812170 0.474533 0.170721 0.206638 1.084578 1.210612 0.877325 1.304868 0.216526 1.666615 0.017582 0.377950 1.122637 -0.152317 0.759942 0.908307 1.610556 0.619180 0.252252 1.289240 1.682699 1.456452 0.437125 0.204631 1.313659 1.057657 0.251390 0.015459 0.426277 0.374256 0.211841 0.291412 0.083784 0.055093)
- 6.109073 #(0.000000 0.982171 1.705612 0.986921 1.873378 0.509690 0.102590 0.186755 1.133224 1.164029 0.874124 1.283945 0.138084 1.739224 -0.073147 0.350734 1.013698 -0.141497 0.646696 0.873432 1.551583 0.589738 0.246954 1.196679 1.600352 1.425024 0.430454 0.103410 1.227168 1.077407 0.227980 -0.028101 0.385573 0.330289 0.176030 0.160255 0.005449 0.061254)
- 6.108235 #(0.000000 0.982140 1.705650 0.987359 1.873951 0.509617 0.101844 0.187009 1.133759 1.164160 0.874009 1.284219 0.137756 1.739325 -0.073001 0.350923 1.012778 -0.140699 0.646579 0.873989 1.552501 0.590083 0.247447 1.196795 1.599951 1.425383 0.431367 0.103900 1.228072 1.077985 0.228759 -0.027472 0.386360 0.330507 0.175983 0.160536 0.005039 0.061859)
+ 6.087370 #(0.000000 0.962483 1.659153 0.914328 1.849172 0.463645 0.002900 0.259371 1.183040 1.024765 0.911958 1.251368 0.102054 1.776941 -0.148963 0.404605 1.125456 -0.014132 0.657558 0.931281 1.619025 0.584036 0.270146 1.200954 1.580244 1.397448 0.441226 0.047739 1.209421 1.023008 0.216419 -0.079920 0.328466 0.107952 0.198261 0.033021 -0.066955 0.032314)
+ 6.086997 #(0.000000 0.953375 1.633071 0.896468 1.836046 0.446251 0.005314 0.261080 1.150812 1.022172 0.925577 1.262013 0.110019 1.780522 -0.172498 0.425767 1.135112 -0.038998 0.639910 0.892046 1.610037 0.590743 0.244804 1.202482 1.560034 1.391559 0.438973 0.040190 1.198091 1.025103 0.198443 -0.088030 0.291908 0.074116 0.167595 -0.010789 -0.085438 -0.008873)
)
;;; 39 odd -------------------------------------------------------------------------------- ; 6.2449
(vector 39 7.2362656593323 #(0 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0)
6.181539 #(0.000000 0.390214 1.432668 1.784856 0.372658 0.651343 0.590730 1.420862 1.232876 1.274776 1.031604 0.648830 1.314325 1.550338 0.798266 0.829350 0.920173 0.286182 1.175424 0.776791 1.481341 -0.170207 1.810272 0.591377 1.604472 0.287027 1.660006 1.308050 0.895442 0.027306 0.915319 0.337380 0.586293 1.687170 1.285611 1.205943 1.760871 1.039296 0.923977)
+ 6.169770 #(0.000000 0.379312 1.457703 1.806417 0.392748 0.695845 0.534025 1.484912 1.216476 1.257505 1.065556 0.592024 1.388763 1.536688 0.712979 0.853274 0.941952 0.200722 1.210757 0.667745 1.526290 -0.208951 1.814930 0.590809 1.623232 0.252350 1.590946 1.293117 0.938100 -0.012345 0.921702 0.427384 0.603131 1.573035 1.298673 1.244575 1.709680 1.074653 0.937276)
+ 6.168200 #(0.000000 0.381775 1.454935 1.814403 0.398564 0.697479 0.558864 1.481835 1.237160 1.266386 1.075040 0.611438 1.386693 1.563073 0.754834 0.848982 0.969933 0.242588 1.250658 0.716314 1.559259 -0.161914 1.840309 0.618465 1.616822 0.275923 1.613382 1.346746 0.955815 0.024617 0.939581 0.484552 0.627049 1.599410 1.353605 1.268412 1.756052 1.090300 0.972610)
)
;;; 40 odd -------------------------------------------------------------------------------- ; 6.3245
@@ -4442,20 +4451,21 @@
(define (tstodd phs)
- (let ((len (length phs))
- (incr 0.0001)
- (mx 0.0)
- (loc 0.0))
- (do ((x 0.0 (+ x incr)))
- ((> x (* 2 pi)) (list mx loc))
- (do ((val 0.0)
- (k 0 (+ k 1))
- (j 1 (+ j 2)))
- ((= k len)
- (when (> (abs val) mx)
- (set! mx (abs val))
- (set! loc x)))
- (set! val (+ val (sin (+ (* j x) (* pi (phs k))))))))))
+ (do ((len (length phs))
+ (incr 0.0001)
+ (mx 0.0)
+ (loc 0.0)
+ (x 0.0 (+ x incr)))
+ ((> x (* 2 pi))
+ (list mx loc))
+ (do ((val 0.0)
+ (k 0 (+ k 1))
+ (j 1 (+ j 2)))
+ ((= k len)
+ (when (> (abs val) mx)
+ (set! mx (abs val))
+ (set! loc x)))
+ (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))))
(define (tstoddderiv x phs)
@@ -4469,69 +4479,72 @@
(define* (tstall phs phs1)
(if (real? phs) (set! phs phs1))
- (let ((len (length phs))
- (incr 0.0001)
- (mx 0.0)
- (loc 0.0))
- (do ((x 0.0 (+ x incr)))
- ((> x (* 2 pi)) (list mx loc))
- (do ((val 0.0)
- (k 0 (+ k 1))
- (j 1 (+ j 1)))
- ((= k len)
- (when (> (abs val) mx)
- (set! mx (abs val))
- (set! loc x)))
- (set! val (+ val (sin (+ (* j x) (* pi (phs k))))))))))
+ (do ((len (length phs))
+ (incr 0.0001)
+ (mx 0.0)
+ (loc 0.0)
+ (x 0.0 (+ x incr)))
+ ((> x (* 2 pi))
+ (list mx loc))
+ (do ((val 0.0)
+ (k 0 (+ k 1))
+ (j 1 (+ j 1)))
+ ((= k len)
+ (when (> (abs val) mx)
+ (set! mx (abs val))
+ (set! loc x)))
+ (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))))
(define (tstallf mult phs)
- (let ((len (length phs))
- (incr 0.0001)
- (mx 0.0)
- (loc 0.0))
- (do ((x 0.0 (+ x incr)))
- ((> x (* 2 pi)) (list mx loc))
- (do ((val 0.0)
- (k 0 (+ k 1))
- (j 1 (+ j 1)))
- ((= k len)
- (when (> (abs val) mx)
- (set! mx (abs val))
- (set! loc x)))
- (set! val (+ val (if (= k (- len 1))
- (* mult (sin (+ (* j x) (* pi (phs k)))))
- (sin (+ (* j x) (* pi (phs k)))))))))))
+ (do ((len (length phs))
+ (incr 0.0001)
+ (mx 0.0)
+ (loc 0.0)
+ (x 0.0 (+ x incr)))
+ ((> x (* 2 pi))
+ (list mx loc))
+ (do ((val 0.0)
+ (k 0 (+ k 1))
+ (j 1 (+ j 1)))
+ ((= k len)
+ (when (> (abs val) mx)
+ (set! mx (abs val))
+ (set! loc x)))
+ (set! val (+ val (if (= k (- len 1))
+ (* mult (sin (+ (* j x) (* pi (phs k)))))
+ (sin (+ (* j x) (* pi (phs k))))))))))
(define (tsteven phs)
- (let ((len (length phs))
- (incr 0.0001)
- (mx 0.0)
- (loc 0.0))
- (do ((x 0.0 (+ x incr)))
- ((> x (* 2 pi)) (list mx loc))
- (do ((val 0.0)
- (k 0 (+ k 1)))
- ((= k len)
- (when (> (abs val) mx)
- (set! mx (abs val))
- (set! loc x)))
- (set! val (+ val (sin (+ (* (max (* 2 k) 1) x) (* pi (phs k))))))))))
+ (do ((len (length phs))
+ (incr 0.0001)
+ (mx 0.0)
+ (loc 0.0)
+ (x 0.0 (+ x incr)))
+ ((> x (* 2 pi))
+ (list mx loc))
+ (do ((val 0.0)
+ (k 0 (+ k 1)))
+ ((= k len)
+ (when (> (abs val) mx)
+ (set! mx (abs val))
+ (set! loc x)))
+ (set! val (+ val (sin (+ (* (max (* 2 k) 1) x) (* pi (phs k)))))))))
(define (tstprime phs)
- (let ((len (length phs))
- (incr 0.0001)
- (mx 0.0)
- (loc 0.0))
- (do ((x 0.0 (+ x incr)))
- ((> x (* 2 pi)) (list mx loc))
- (let ((val 0.0))
- (do ((k 0 (+ k 1)))
- ((= k len))
- (set! val (+ val (sin (+ (* (primes k) x) (* pi (phs k)))))))
- (if (> (abs val) mx)
- (begin
- (set! mx (abs val))
- (set! loc x)))))))
+ (do ((len (length phs))
+ (incr 0.0001)
+ (mx 0.0)
+ (loc 0.0)
+ (x 0.0 (+ x incr)))
+ ((> x (* 2 pi))
+ (list mx loc))
+ (do ((val 0.0)
+ (k 0 (+ k 1)))
+ ((= k len)
+ (when (> (abs val) mx)
+ (set! mx (abs val))
+ (set! loc x)))
+ (set! val (+ val (sin (+ (* (primes k) x) (* pi (phs k)))))))))
(define (tstallderiv x phs)
(do ((sum 0.0)
@@ -4562,11 +4575,12 @@
((:odd) nodd-min-peak-phases)
((:even) neven-min-peak-phases)
(else primoid-min-peak-phases))))
- (let ((len (length vect))
- (result #f))
- (do ((i 0 (+ i 1)))
- ((or (= i len) result) result)
- (set! result (func (vect i)))))))
+ (do ((len (length vect))
+ (result #f)
+ (i 0 (+ i 1)))
+ ((or (= i len) result)
+ result)
+ (set! result (func (vect i))))))
(define (showall len)
@@ -4625,17 +4639,17 @@
(set! val (+ val (sin (+ (* j x) (* pi (phs k))))))))))
(define (showdiff n1 n2)
- (let* ((len (length n1))
- (data (make-float-vector len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
+ (let ((len (length n1)))
+ (do ((data (make-float-vector len))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (new-sound)
+ (float-vector->channel data))
(set! (data i) (modulo (- (n1 i) (n2 i)) 2.0))
(if (> (data i) 1.0)
(set! (data i) (- (data i) 2.0))
(if (< (data i) -1)
- (set! (data i) (+ (data i) 2.0)))))
- (new-sound)
- (float-vector->channel data)))
+ (set! (data i) (+ (data i) 2.0)))))))
(define (differ snd)
(let ((x 0.0))
@@ -4853,9 +4867,11 @@
;; 1 May 4150.665
;; 1 Jun 4150.537
;; 1-Jul 4150.466
+;; 1-Aug 4150.332
+;; 1-Sep 4150.229
; all 0.4860 (20) to 0.4986 (125), dist: 0.0000, 15.0910
-; odd 0.4820 (11) to 0.5000 (112), dist: 0.0000, 8.6281
+; odd 0.4820 (11) to 0.5000 (112), dist: 0.0000, 8.8655
; even 0.5085 (115) to 0.5242 (22), dist: 57.6719, 0.0000
; prime 0.5444 (24) to 0.5540 (67), dist: 232.5920, 0.0000
@@ -4865,15 +4881,15 @@
<1> (load "test-phases.scm")
test-all-phases
<2> (test-all-phases #f)
-;all peaks... Fri 29-Apr-2016 04:21
+;all peaks... Mon 05-Sep-2016 04:08
(0.001495737399423547 101)
-;odd peaks... Fri 29-Apr-2016 04:29
+;odd peaks... Mon 05-Sep-2016 04:16
(0.001687315629258279 125)
-;even peaks... Fri 29-Apr-2016 04:33
+;even peaks... Mon 05-Sep-2016 04:20
(0.001467169674692848 4)
-;prime peaks... Fri 29-Apr-2016 04:37
+;prime peaks... Mon 05-Sep-2016 04:24
(0.001975582609148319 2048)
-;all done! Fri 29-Apr-2016 04:43
+;all done! Mon 05-Sep-2016 04:29
|#
;;; gad161: clean-up-evens
diff --git a/piano.scm b/piano.scm
index edd599e..251a4bd 100644
--- a/piano.scm
+++ b/piano.scm
@@ -8,10 +8,13 @@
;;; see generators.scm for the old scheme versions of one-pole-all-pass, pnoise, one-pole-swept, and expseg
+;; converts t60 values to suitable :rate values for expseg
+(define (In-t60 t60) (- 1.0 (expt 0.001 (/ 1.0 t60 *clm-srate*))))
+
(define number-of-stiffness-allpasses 8)
(define longitudinal-mode-cutoff-keynum 29)
(define longitudinal-mode-stiffness-coefficient -.5)
-(define loop-gain-env-t60 .05)
+(define loop-gain-env-t60 (In-t60 .05))
(define loop-gain-default .9999)
(define nstrings 3)
(define two-pi (* 2 pi))
@@ -125,9 +128,6 @@
unaCordaGain
(unaCordaGain-table default-unaCordaGain-table))
- ;; converts t60 values to suitable :rate values for expseg
- (define (In-t60 t60) (- 1.0 (expt 0.001 (/ 1.0 t60 *clm-srate*))))
-
(define (make-one-pole-one-zero a0 a1 b1)
(list (make-one-zero a0 a1)
(make-one-pole 1.0 b1)))
@@ -200,13 +200,13 @@
(singleStringPole (or singleStringPole (envelope-interp keyNum singleStringPole-table)))
(releaseLoopGain (or releaseLoopGain (envelope-interp keyNum releaseLoopGain-table)))
- (DryTapFiltCoeft60 (or DryTapFiltCoeft60 (envelope-interp keyNum DryTapFiltCoeft60-table)))
+ (DryTapFiltCoeft60 (In-t60 (or DryTapFiltCoeft60 (envelope-interp keyNum DryTapFiltCoeft60-table))))
(DryTapFiltCoefTarget (or DryTapFiltCoefTarget (envelope-interp keyNum DryTapFiltCoefTarget-table)))
(DryTapFiltCoefCurrent (or DryTapFiltCoefCurrent (envelope-interp keyNum DryTapFiltCoefCurrent-table)))
- (DryTapAmpt60 (or DryTapAmpt60 (envelope-interp keyNum DryTapAmpt60-table)))
+ (DryTapAmpt60 (In-t60 (or DryTapAmpt60 (envelope-interp keyNum DryTapAmpt60-table))))
(sustainPedalLevel (or sustainPedalLevel (envelope-interp keyNum sustainPedalLevel-table)))
(pedalResonancePole (or pedalResonancePole (envelope-interp keyNum pedalResonancePole-table)))
- (pedalEnvelopet60 (or pedalEnvelopet60 (envelope-interp keyNum pedalEnvelopet60-table)))
+ (pedalEnvelopet60 (In-t60 (or pedalEnvelopet60 (envelope-interp keyNum pedalEnvelopet60-table))))
(soundboardCutofft60 (or soundboardCutofft60 (envelope-interp keyNum soundboardCutofft60-table)))
(DryPedalResonanceFactor (or DryPedalResonanceFactor (envelope-interp keyNum DryPedalResonanceFactor-table)))
(unaCordaGain (or unaCordaGain (envelope-interp keyNum unaCordaGain-table)))
@@ -322,16 +322,16 @@
;;initialize loop-gain envelope
(loop-gain loop-gain-default)
- (loop-gain-ry (* releaseLoopGain (In-t60 loop-gain-env-t60)))
- (loop-gain-rx (- 1.0 (In-t60 loop-gain-env-t60)))
+ (loop-gain-ry (* releaseLoopGain loop-gain-env-t60))
+ (loop-gain-rx (- 1.0 loop-gain-env-t60))
(dry-coef (* 1.0 DryTapFiltCoefCurrent))
- (dry-coef-ry (* DryTapFiltCoefTarget (In-t60 DryTapFiltCoeft60)))
- (dry-coef-rx (- 1.0 (In-t60 DryTapFiltCoeft60)))
+ (dry-coef-ry (* DryTapFiltCoefTarget DryTapFiltCoeft60))
+ (dry-coef-rx (- 1.0 DryTapFiltCoeft60))
(wet-coef 0.0)
- (wet-coef-ry (* -0.5 (In-t60 pedalEnvelopet60)))
- (wet-coef-rx (- 1.0 (In-t60 pedalEnvelopet60)))
+ (wet-coef-ry (* -0.5 pedalEnvelopet60))
+ (wet-coef-rx (- 1.0 pedalEnvelopet60))
(dryTap 0.0)
(dryTap-x 1.0)
@@ -404,8 +404,8 @@
(outa i couplingFilter-input)))))
- (set! dryTap-rx (- 1.0 (In-t60 DryTapAmpt60)))
- (set! wetTap-rx (- 1.0 (In-t60 pedalEnvelopet60)))
+ (set! dryTap-rx (- 1.0 DryTapAmpt60))
+ (set! wetTap-rx (- 1.0 pedalEnvelopet60))
(piano-loop beg release-time)
(set! dryTap-rx (- 1.0 sb-cutoff-rate))
diff --git a/play.scm b/play.scm
index b7a3493..cd1b668 100644
--- a/play.scm
+++ b/play.scm
@@ -160,13 +160,14 @@ x typed in the graph, or C-g in the listener exits the loop."))
(let ((documentation "(play-with-amps snd :rest amps) plays snd with each channel scaled by the corresponding
amp: (play-with-amps 0 1.0 0.5) plays channel 2 of stereo sound at half amplitude"))
(lambda (sound . amps)
- (let ((chans (channels sound)))
- (do ((chan 0 (+ 1 chan)))
- ((= chan chans))
- (let ((player (make-player sound chan)))
- (set! (amp-control player) (amps chan))
- (add-player player)))
- (start-playing chans (srate sound))))))
+ (do ((chans (channels sound))
+ (chan 0 (+ 1 chan)))
+ ((= chan chans)
+ (start-playing chans (srate sound)))
+ (let ((player (make-player sound chan)))
+ (set! (amp-control player) (amps chan))
+ (add-player player))))))
+
;;; play-sine and play-sines
diff --git a/poly.scm b/poly.scm
index fee07ff..88ceec9 100644
--- a/poly.scm
+++ b/poly.scm
@@ -19,20 +19,20 @@
(define vector-add!
(let ((documentation "(vector-add! p1 p2) adds (elementwise) the vectors p1 and p2"))
(lambda (p1 p2)
- (let ((len (min (length p1) (length p2))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (p1 i) (+ (p1 i) (p2 i))))
- p1))))
+ (do ((len (min (length p1) (length p2)))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (set! (p1 i) (+ (p1 i) (p2 i))))
+ p1)))
(define vector-scale!
(let ((documentation "(vector-scale! p1 scl) scales each element of the vector p1 by scl"))
(lambda (p1 scl)
- (let ((len (length p1)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (p1 i) (* scl (p1 i))))
- p1))))
+ (do ((len (length p1))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (set! (p1 i) (* scl (p1 i))))
+ p1)))
(define poly-as-vector-eval
(let ((documentation "(poly-as-vector-eval v x) treats 'v' as a vector of polynomial coefficients, returning the value of the polynomial at x"))
@@ -103,15 +103,14 @@
(vector-scale! (copy p2) p1)
(if (not (vector? p2))
(vector-scale! (copy p1) p2)
- (let* ((p1len (length p1))
- (p2len (length p2))
- (m (make-vector (+ p1len p2len) 0)))
- (do ((i 0 (+ i 1)))
- ((= i p1len))
+ (let ((p1len (length p1))
+ (p2len (length p2)))
+ (do ((m (make-vector (+ p1len p2len) 0))
+ (i 0 (+ i 1)))
+ ((= i p1len) m)
(do ((j 0 (+ j 1)))
((= j p2len))
- (set! (m (+ i j)) (+ (m (+ i j)) (* (p1 i) (p2 j))))))
- m))))))
+ (set! (m (+ i j)) (+ (m (+ i j)) (* (p1 i) (p2 j))))))))))))
(define poly*
(let ((documentation "(poly* p1 p2) multiplies the polynomials (float-vectors or vectors) p1 and p2"))
@@ -176,9 +175,9 @@
(define poly-as-vector-derivative
(let ((documentation "(poly-as-vector-derivative p1) returns the derivative or polynomial p1 (as a vector)"))
(lambda (p1)
- (let* ((len (- (length p1) 1))
- (v (make-vector len)))
- (do ((i (- len 1) (- i 1))
+ (let ((len (- (length p1) 1)))
+ (do ((v (make-vector len))
+ (i (- len 1) (- i 1))
(j len (- j 1)))
((< i 0) v)
(set! (v i) (* j (p1 j))))))))
@@ -197,23 +196,21 @@
(define (submatrix mx row col)
- (let* ((old-n (car (vector-dimensions mx)))
- (nmx (let ((new-n (- old-n 1)))
- (make-float-vector (list new-n new-n)))))
- (do ((i 0 (+ i 1))
+ (let ((old-n (car (vector-dimensions mx))))
+ (do ((nmx (let ((new-n (- old-n 1)))
+ (make-float-vector (list new-n new-n))))
+ (i 0 (+ i 1))
(ni 0))
- ((= i old-n))
- (if (not (= i row))
- (begin
- (do ((j 0 (+ j 1))
- (nj 0))
- ((= j old-n))
- (if (not (= j col))
- (begin
- (set! (nmx ni nj) (mx i j))
- (set! nj (+ nj 1)))))
- (set! ni (+ 1 ni)))))
- nmx))
+ ((= i old-n) nmx)
+ (unless (= i row)
+ (do ((j 0 (+ j 1))
+ (nj 0))
+ ((= j old-n))
+ (if (not (= j col))
+ (begin
+ (set! (nmx ni nj) (mx i j))
+ (set! nj (+ nj 1)))))
+ (set! ni (+ 1 ni))))))
(define (determinant mx)
(if (not (float-vector? mx))
@@ -229,15 +226,14 @@
(* (mx 0 1) (mx 1 0) (mx 2 2))
(* (mx 0 2) (mx 1 1) (mx 2 0))))
(else
- (let ((sum 0.0)
- (sign 1))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (let ((mult (mx 0 i)))
- (if (not (= mult 0.0))
- (set! sum (+ sum (* sign mult (determinant (submatrix mx 0 i))))))
- (set! sign (- sign))))
- sum))))))
+ (do ((sum 0.0)
+ (sign 1)
+ (i 0 (+ i 1)))
+ ((= i n) sum)
+ (let ((mult (mx 0 i)))
+ (if (not (= mult 0.0))
+ (set! sum (+ sum (* sign mult (determinant (submatrix mx 0 i))))))
+ (set! sign (- sign)))))))))
(define (poly-as-vector-resultant p1 p2)
(if (not (and (vector? p1)
@@ -419,13 +415,12 @@
#f)))))
(define (nth-roots a b deg) ; ax^n + b
- (let ((n (expt (/ (- b) a) (/ 1.0 deg)))
- (incr (/ (* 2 pi 0+i) deg))
- (roots ()))
- (do ((i 0 (+ i 1)))
- ((= i deg))
- (set! roots (cons (simplify-complex (* n (exp (* i incr)))) roots)))
- roots))
+ (do ((n (expt (/ (- b) a) (/ 1.0 deg)))
+ (incr (/ (* 2 pi 0+i) deg))
+ (roots ())
+ (i 0 (+ i 1)))
+ ((= i deg) roots)
+ (set! roots (cons (simplify-complex (* n (exp (* i incr)))) roots))))
(let ((deg (- (length p1) 1)))
@@ -542,11 +537,11 @@
(list 0.0))
(else
- (let ((pnew (make-vector deg)))
- (do ((i 1 (+ i 1)))
- ((> i deg))
- (set! (pnew (- i 1)) (p1 i)))
- (cons 0.0 (poly-as-vector-roots pnew)))))))
+ (do ((pnew (make-vector deg))
+ (i 1 (+ i 1)))
+ ((> i deg)
+ (cons 0.0 (poly-as-vector-roots pnew)))
+ (set! (pnew (- i 1)) (p1 i)))))))
(define poly-roots
diff --git a/prc95.scm b/prc95.scm
index 7a42051..7cb4c16 100644
--- a/prc95.scm
+++ b/prc95.scm
@@ -115,33 +115,33 @@
(set-pole filt 0.6)
(set-gain filt 0.3)
- (do ((i st (+ i 1)))
+ (do ((i st (+ i 1))
+ (bridgerefl 0.0 0.0)
+ (nutrefl 0.0 0.0)
+ (veldiff 0.0 0.0)
+ (stringvel 0.0 0.0)
+ (bowtemp 0.0 0.0))
((= i end))
- (let ((bridgerefl 0.0)
- (nutrefl 0.0)
- (veldiff 0.0)
- (stringvel 0.0)
- (bowtemp 0.0))
- (if bowing
- (if (not (= maxvelocity bowvelocity))
- (set! bowvelocity ((if (< bowvelocity maxvelocity) + -) bowvelocity attackrate)))
- (if (> bowvelocity 0.0)
- (set! bowvelocity (- bowvelocity attackrate))))
- (set! bowtemp (* 0.3 bowvelocity))
- (let ((filt-output (one-pole filt bridgeout)))
- (set! bridgerefl (- filt-output))
- (set! nutrefl (- neckout))
- (set! stringvel (+ bridgerefl nutrefl))
- (set! veldiff (- bowtemp stringvel))
- (set! veldiff (* veldiff (bowtable bowtab veldiff)))
- (set! neckout (delayl neckdelay (+ bridgerefl veldiff)))
- (set! bridgeout (delayl bridgedelay (+ nutrefl veldiff)))
- (outa i (* amplitude 10.0 filt-output))
- (if (= ctr release)
- (begin
- (set! bowing #f)
- (set! attackrate .0005)))
- (set! ctr (+ ctr 1)))))))))
+ (if bowing
+ (if (not (= maxvelocity bowvelocity))
+ (set! bowvelocity ((if (< bowvelocity maxvelocity) + -) bowvelocity attackrate)))
+ (if (> bowvelocity 0.0)
+ (set! bowvelocity (- bowvelocity attackrate))))
+ (set! bowtemp (* 0.3 bowvelocity))
+ (let ((filt-output (one-pole filt bridgeout)))
+ (set! bridgerefl (- filt-output))
+ (set! nutrefl (- neckout))
+ (set! stringvel (+ bridgerefl nutrefl))
+ (set! veldiff (- bowtemp stringvel))
+ (set! veldiff (* veldiff (bowtable bowtab veldiff)))
+ (set! neckout (delayl neckdelay (+ bridgerefl veldiff)))
+ (set! bridgeout (delayl bridgedelay (+ nutrefl veldiff)))
+ (outa i (* amplitude 10.0 filt-output))
+ (if (= ctr release)
+ (begin
+ (set! bowing #f)
+ (set! attackrate .0005)))
+ (set! ctr (+ ctr 1))))))))
(definstrument (brass beg dur freq amplitude maxa)
diff --git a/pvoc.scm b/pvoc.scm
index 35a1611..f199019 100644
--- a/pvoc.scm
+++ b/pvoc.scm
@@ -240,17 +240,17 @@
(lambda* ((fftsize 512) (overlap 4) (time 1.0)
(pitch 1.0) (gate 0.0) (hoffset 0.0)
(snd 0) (chn 0))
- (let* ((len (framples))
- (N2 (floor (/ fftsize 2)))
- (window (make-fft-window hamming-window fftsize))
- (lastamp (make-float-vector N2))
- (lastfreq (make-float-vector N2))
- (in-data (channel->float-vector 0 (* fftsize 2) snd chn))
- (obank (make-oscil-bank lastfreq (make-float-vector N2) lastamp)))
- (let ((pi2 (* 2 pi))
+ (let ((len (framples))
+ (N2 (floor (/ fftsize 2)))
+ (window (make-fft-window hamming-window fftsize))
+ (in-data (channel->float-vector 0 (* fftsize 2) snd chn)))
+ (let ((lastamp (make-float-vector N2))
+ (lastfreq (make-float-vector N2))
+ (pi2 (* 2 pi))
(outlen (floor (* time len)))
(interp (* (floor (/ fftsize overlap)) time)))
- (let ((filptr 0)
+ (let ((obank (make-oscil-bank lastfreq (make-float-vector N2) lastamp))
+ (filptr 0)
(D (floor (/ fftsize overlap)))
(syngate (if (= 0.0 gate) ; take a resynthesis gate specificed in dB, convert to linear amplitude
0.0000
diff --git a/r7rs.scm b/r7rs.scm
index 9057c28..8d10f2f 100644
--- a/r7rs.scm
+++ b/r7rs.scm
@@ -45,7 +45,7 @@
(apply #_make-hash-table args))))
(define bytevector byte-vector)
-(define ->bytevector ->byte-vector)
+;(define ->bytevector string->byte-vector)
(define bytevector? byte-vector?)
(define make-bytevector make-byte-vector)
@@ -104,8 +104,8 @@
(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) (->byte-vector (apply r7rs-string-copy args)))
-(define (bytevector-append . args) (->byte-vector (apply string-append args)))
+(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* (read-bytevector! bv port (start 0) end)
(let ((lim (or end (length bv)))
@@ -117,8 +117,8 @@
bv)
(set! (bv i) c))))
(define* (read-bytevector k port)
- (read-bytevector! (->byte-vector (make-string k)) port))
-(define (get-output-bytevector port) (->byte-vector (get-output-string port)))
+ (read-bytevector! (string->byte-vector (make-string 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)
(define read-u8 read-byte)
@@ -126,7 +126,7 @@
(define u8-ready? char-ready?)
(define peek-u8 peek-char)
(define* (utf8->string v (start 0) end) (substring v start (or end (length v))))
-(define* (string->utf8 s (start 0) end) (->byte-vector (utf8->string s start end)))
+(define* (string->utf8 s (start 0) end) (string->byte-vector (utf8->string s start end)))
(define write-simple write)
(define (eof-object) #<eof>)
@@ -148,6 +148,7 @@
(define interaction-environment curlet)
+;; for null-environment see stuff.scm
(define-macro (include . files)
`(begin
,@(map (lambda (file)
diff --git a/repl.scm b/repl.scm
index af8ae4b..9cfc002 100644
--- a/repl.scm
+++ b/repl.scm
@@ -152,10 +152,8 @@
(define* (write-history port (spaces 0))
(format port "~NC(set! histpos ~D)~%" spaces #\space histpos)
(format port "~NC(set! histsize ~D)~%" spaces #\space histsize)
- (let ((pl (*s7* 'print-length)))
- (set! (*s7* 'print-length) (* 2 histsize))
- (format port "~NC(set! histbuf ~A)" spaces #\space (object->string histbuf))
- (set! (*s7* 'print-length) pl)))
+ (let-temporarily (((*s7* 'print-length) (* 2 histsize)))
+ (format port "~NC(set! histbuf ~A)" spaces #\space (object->string histbuf))))
(define* (save-history (file "repl-history.scm"))
(call-with-output-file file
@@ -462,27 +460,27 @@
(values "~NC~A" prompt-length #\space (substring cur-line start end))))))
(define (display-cursor)
- (let ((row 0)
- (start 0)
- (len (length cur-line)))
- (do ((i 0 (+ i 1)))
- ((or (= i len)
- (= i cursor-pos))
- (move-cursor (+ prompt-row row) (- (+ prompt-col cursor-pos) start)))
- (when (char=? (cur-line i) #\newline)
- (set! row (+ row 1))
- (set! start (+ i 1))))))
+ (do ((row 0)
+ (start 0)
+ (len (length cur-line))
+ (i 0 (+ i 1)))
+ ((or (= i len)
+ (= i cursor-pos))
+ (move-cursor (+ prompt-row row) (- (+ prompt-col cursor-pos) start)))
+ (when (char=? (cur-line i) #\newline)
+ (set! row (+ row 1))
+ (set! start (+ i 1)))))
(define (display-lines)
(move-cursor prompt-row 0)
(format *stderr* "~C[J" #\escape)
(let ((len (length cur-line))
(new-line ""))
- (let ((line-end 0))
- (do ((i 0 (+ line-end 2)))
- ((> i len))
- (set! line-end (end-of-line i))
- (set! new-line (string-append new-line (display-line i (min (+ line-end 2) len))))))
+ (do ((line-end 0)
+ (i 0 (+ line-end 2)))
+ ((> i len))
+ (set! line-end (end-of-line i))
+ (set! new-line (string-append new-line (display-line i (min (+ line-end 2) len)))))
(format *stderr* "~A" new-line)
(display-cursor)))
@@ -519,13 +517,13 @@
(set! (*repl* 'helpers)
(list
(lambda (c)
- (format #f "cursor: ~A, ~C, line: ~S"
- cursor-pos
- (if (zero? (length cur-line))
- #\space
- (let ((c (cur-line (max 0 (min cursor-pos (- (length cur-line) 1))))))
- (if (char=? c #\newline) #\| c)))
- (one-line cur-line)))
+ (let ((cur-char (if (zero? (length cur-line))
+ #\space
+ (let ((c (cur-line (max 0 (min cursor-pos (- (length cur-line) 1))))))
+ (if (char=? c #\newline) #\| c)))))
+ (format #f "cursor: ~A, ~C, line: ~S"
+ cursor-pos cur-char
+ (one-line cur-line))))
(lambda (c)
(format #f "len: ~D, selection: ~S, previous: ~S"
(length cur-line)
@@ -945,12 +943,12 @@
(define (fixup-new-line)
(define (count-newlines line)
- (let ((len (length line))
- (newlines 0))
- (do ((i 0 (+ i 1)))
- ((= i len) newlines)
- (if (char=? (cur-line i) #\newline)
- (set! newlines (+ newlines 1))))))
+ (do ((len (length line))
+ (newlines 0)
+ (i 0 (+ i 1)))
+ ((= i len) newlines)
+ (if (char=? (cur-line i) #\newline)
+ (set! newlines (+ newlines 1)))))
(set! cursor-pos (length cur-line))
(let ((newlines (count-newlines cur-line)))
(when (< last-row (+ prompt-row newlines))
@@ -1004,30 +1002,30 @@
(loop (+ i 1)))))))
(define (upper-case c)
- (let ((len (length cur-line)))
- (do ((i cursor-pos (+ i 1)))
- ((or (= i len)
- (char-alphabetic? (cur-line i)))
- (when (< i len)
- (save-line)
- (do ((k i (+ k 1)))
- ((or (= k len)
- (not (char-alphabetic? (cur-line k))))
- (set! cursor-pos k))
- (set! (cur-line k) (char-upcase (cur-line k)))))))))
+ (do ((len (length cur-line))
+ (i cursor-pos (+ i 1)))
+ ((or (= i len)
+ (char-alphabetic? (cur-line i)))
+ (when (< i len)
+ (save-line)
+ (do ((k i (+ k 1)))
+ ((or (= k len)
+ (not (char-alphabetic? (cur-line k))))
+ (set! cursor-pos k))
+ (set! (cur-line k) (char-upcase (cur-line k))))))))
(define (lower-case c)
- (let ((len (length cur-line)))
- (do ((i cursor-pos (+ i 1)))
- ((or (= i len)
- (char-alphabetic? (cur-line i)))
- (when (< i len)
- (save-line)
- (do ((k i (+ k 1)))
- ((or (= k len)
- (not (char-alphabetic? (cur-line k))))
- (set! cursor-pos k))
- (set! (cur-line k) (char-downcase (cur-line k)))))))))
+ (do ((len (length cur-line))
+ (i cursor-pos (+ i 1)))
+ ((or (= i len)
+ (char-alphabetic? (cur-line i)))
+ (when (< i len)
+ (save-line)
+ (do ((k i (+ k 1)))
+ ((or (= k len)
+ (not (char-alphabetic? (cur-line k))))
+ (set! cursor-pos k))
+ (set! (cur-line k) (char-downcase (cur-line k))))))))
(set! (meta-keymap-functions (char->integer #\p)) move-backward-in-history)
(set! (meta-keymap-functions (char->integer #\n)) move-forward-in-history)
@@ -1092,75 +1090,82 @@
(lambda ()
(call-with-exit
(lambda (return)
+
+ ;; if (< ctr chars), just send the next char in the buffer (90 lines down after (return #\null))
+ ;; otherwise call read again
(when (>= ctr chars)
(set! ctr 0)
(set! chars (read input-fd cc read-size))
(if (= chars 0)
(tty-reset))
-
- (when (= chars read-size)
- ;; concatenate buffers until we get the entire selection
- (let ((str (substring c 0 read-size)))
- (let reading ((num (read input-fd cc read-size)))
- (set! str (string-append str (substring c 0 num)))
- (set! chars (+ chars num))
- (if (= num read-size)
- (reading (read input-fd cc read-size))))
+
+ (when (> chars (- last-col prompt-length 12))
+ (let ((str (substring c 0 chars)))
+
+ (when (= chars read-size)
+ ;; concatenate buffers until we get the entire selection
+ (let reading ((num (read input-fd cc read-size)))
+ (set! str (string-append str (substring c 0 num)))
+ (set! chars (+ chars num))
+ (if (= num read-size)
+ (reading (read input-fd cc read-size)))))
;; look for simple cut/paste -- no control chars etc
(when (= input-fd terminal-fd)
- (let ((bcksp #\delete)
- (ok-chars (list #\newline #\linefeed #\return #\tab)))
- (do ((i 0 (+ i 1)))
- ((or (= i chars)
- (char>=? (str i) bcksp)
- (and (char<? (str i) #\space)
- (not (memv (str i) ok-chars))))
+ (do ((bcksp #\delete)
+ (ok-chars (list #\newline #\linefeed #\return #\tab))
+ (i 0 (+ i 1)))
+ ((or (= i chars)
+ (char>=? (str i) bcksp)
+ (and (char<? (str i) #\space)
+ (not (memv (str i) ok-chars))))
+
+ (when (= i chars)
+ (let ((search-chars (string #\tab #\return #\newline))
+ (old-pos 0)
+ (start 0)
+ (max-cols 0))
+ (do ((pos (char-position search-chars str 0) (char-position search-chars str (+ pos 1))))
+ ((not pos))
+ (set! cur-line (string-append cur-line
+ (substring str old-pos pos)
+ (if (char=? (str pos) #\tab)
+ tab-as-space
+ (string #\space #\newline))))
+ (set! old-pos (+ pos 1))
+ (unless (char=? (str pos) #\tab)
+ (set! max-cols (max max-cols (- pos start)))
+ (set! start pos)))
+ (if (< (+ old-pos 1) (length str))
+ (set! cur-line (string-append cur-line (substring str (+ old-pos 1)))))
+
+ ;; if the line is too long, the cursor gets confused, so try to reformat long strings
+ ;; this still messes up sometimes
+ (when (> max-cols (- last-col prompt-length))
+ (let-temporarily ((((funclet pretty-print) '*pretty-print-length*) (- last-col prompt-length 12)))
+ (set! ((funclet pretty-print) '*pretty-print-length*) (- last-col prompt-length 12))
+ (set! cur-line (with-output-to-string
+ (lambda ()
+ (pretty-print (with-input-from-string cur-line #_read))))))))
+ ;; this is still bad if the code has a long string -- need to tell pretty print to break it as well
- (when (= i chars)
- (let ((search-chars (string #\tab #\return #\newline))
- (old-pos 0)
- (start 0)
- (max-cols 0))
- (do ((pos (char-position search-chars str 0) (char-position search-chars str (+ pos 1))))
- ((not pos))
- (set! cur-line (string-append cur-line
- (substring str old-pos pos)
- (if (char=? (str pos) #\tab)
- tab-as-space
- (string #\space #\newline))))
- (set! old-pos (+ pos 1))
- (unless (char=? (str pos) #\tab)
- (set! max-cols (max max-cols (- pos start)))
- (set! start pos)))
- (if (< (+ old-pos 1) (length str))
- (set! cur-line (string-append cur-line (substring str (+ old-pos 1)))))
-
- ;; if the line is too long, the cursor gets confused, so try to reformat over-long strings
- ;; this still messes up sometimes
-
- (when (> max-cols (- last-col prompt-length))
- (let ((old-len ((funclet pretty-print) '*pretty-print-length*)))
- (set! ((funclet pretty-print) '*pretty-print-length*) (- last-col prompt-length 2))
- (set! cur-line (with-output-to-string
- (lambda ()
- (pretty-print (with-input-from-string cur-line #_read)))))
- (set! ((funclet pretty-print) '*pretty-print-length*) old-len))))
-
- (set! cursor-pos (length cur-line))
- (set! chars 0)
- (set! ctr 1)
- (display-lines)
- (return #\newline))))))
-
+ (set! cursor-pos (length cur-line))
+ (set! chars 0)
+ (set! ctr 1)
+ (display-lines)
+ (return #\newline)))))
+ ;; now the pasted-in line has inserted newlines, we hope
+
(set! c str)
(set! cc (string->c-pointer c))
+
;; avoid time-consuming redisplays. We need to use a recursive call on next-char here
;; since we might have multi-char commands (embedded #\escape -> meta, etc)
;; actually, the time is not the repl's fault -- xterm seems to be waiting
;; for the window manager or someone to poke it -- if I move the mouse,
;; I get immediate output. I also get immediate output in any case in OSX.
;; valgrind and ps say we're not computing, we're just sitting there.
+
(catch #t
(lambda ()
(do ((ch (next-char) (next-char)))
@@ -1181,6 +1186,7 @@
(new-prompt)
(return #\null))))))
+ ;; send out the next char
(let ((result (c ctr)))
(set! ctr (+ ctr 1))
result)))))))
@@ -1410,6 +1416,66 @@
'----)))))
+
+;;; --------------------------------------------------------------------------------
+;;; just a first stab at this -- where to put this code?
+;;;
+;;; debug-help can be set running via: (((*repl* 'repl-let) 'debug-help))
+
+(define-expansion (repl-debug)
+ `(with-let (inlet :orig (curlet) :line ,(port-line-number) :func __func__)
+ (format () "line ~D: ~A~{~^ ~A~}~%"
+ line (if (pair? func) (car func) func)
+ (reverse
+ (map (lambda (slot)
+ (format #f "~% ~S: ~A"
+ (car slot)
+ (let ((val (object->string (cdr slot) #f)))
+ (if (> (length val) 60)
+ (string-append (substring val 0 60) "...")
+ val))))
+ orig)))
+
+ (let ((C-q (integer->char 17)))
+ (let ((old-C-q ((*repl* 'keymap) C-q))
+ (old-top-level (*repl* 'top-level-let))
+ (old-prompt-string ((*repl* 'repl-let) 'prompt-string))
+ (old-prompt (*repl* 'prompt)))
+
+ (dynamic-wind
+ (lambda ()
+ (set! (*repl* 'top-level-let) orig)
+ (with-let (*repl* 'repl-let)
+ (set! cur-line "")
+ (set! red-par-pos #f)
+ (set! cursor-pos 0)
+ (set! prompt-string (format #f "<debug ~D> " (+ (length histtop) 1)))
+ (set! prompt-length (length prompt-string)))
+ (with-let *repl*
+ (set! prompt (lambda (num)
+ (with-let (sublet repl-let :num num)
+ (set! prompt-string (format #f "<debug ~D> " num))
+ (set! prompt-length (length prompt-string)))))
+ (set! (keymap (integer->char 17))
+ (lambda (c)
+ (set! (repl-let 'all-done) #t)))))
+
+ (lambda ()
+ ((*repl* 'run)))
+
+ (lambda ()
+ (set! (*repl* 'top-level-let) old-top-level)
+ (set! ((*repl* 'repl-let) 'prompt-string) old-prompt)
+ (set! ((*repl* 'repl-let) 'prompt-length) (length old-prompt))
+ (set! (*repl* 'prompt) old-prompt)
+ (set! ((*repl* 'keymap) C-q) old-C-q)))))))
+
+
+;;; to display a variable's value as s7 runs using the repl help window:
+;;; (define xyz 1) ; some variable...
+;;; (set! (symbol-access 'xyz) (lambda (sym val) (set! (*repl* 'helpers) (list (lambda (c) (format #f "xyz: ~S" val)))) val))
+
+
;;; --------------------------------------------------------------------------------
#|
to work in a particular environment:
@@ -1498,10 +1564,10 @@ to post a help string (kinda tedious, but the helper list is aimed more at posti
(old-cursor-pos cursor-pos)
(old-enter-func (keymap-functions 10))
(filename #f))
- (set! (*repl 'prompt) (lambda (num)
- (with-let (*repl* 'repl-let)
- (set! prompt-string "load: ")
- (set! prompt-length 6))))
+ (set! (*repl* 'prompt) (lambda (num)
+ (with-let (*repl* 'repl-let)
+ (set! prompt-string "load: ")
+ (set! prompt-length 6))))
(set! cur-line "")
(set! cursor-pos 0)
(set! (keymap-functions 10) (lambda (c)
diff --git a/rubber.scm b/rubber.scm
index a09daf1..083c2f5 100644
--- a/rubber.scm
+++ b/rubber.scm
@@ -42,27 +42,27 @@
(define (crossings)
;; return number of upward zero crossings that don't look like silence
- (let* ((sr0 (make-sampler 0))
- (samp0 (next-sample sr0)))
- (let ((crosses 0)
- (len (framples))
- (sum 0.0)
- (last-cross 0)
- (silence (* extension .001)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((samp1 (next-sample sr0)))
- (if (and (<= samp0 0.0)
- (> samp1 0.0)
- (> (- i last-cross) 4)
- (> sum silence))
- (begin
- (set! crosses (+ crosses 1))
- (set! last-cross i)
- (set! sum 0.0)))
- (set! sum (+ sum (abs samp0)))
- (set! samp0 samp1)))
- crosses)))
+ (let ((sr0 (make-sampler 0)))
+ (do ((samp0 (next-sample sr0))
+ (crosses 0)
+ (len (framples))
+ (sum 0.0)
+ (last-cross 0)
+ (silence (* extension .001))
+ (i 0 (+ i 1)))
+ ((= i len)
+ crosses)
+ (let ((samp1 (next-sample sr0)))
+ (if (and (<= samp0 0.0)
+ (> samp1 0.0)
+ (> (- i last-cross) 4)
+ (> sum silence))
+ (begin
+ (set! crosses (+ crosses 1))
+ (set! last-cross i)
+ (set! sum 0.0)))
+ (set! sum (+ sum (abs samp0)))
+ (set! samp0 samp1)))))
(define (env-add s0 s1 samps)
(let ((data (make-float-vector samps))
@@ -87,27 +87,27 @@
(cross-weights (make-float-vector crosses))
(cross-marks (make-float-vector crosses))
(cross-periods (make-float-vector crosses)))
- (let* ((sr0 (make-sampler 0 snd chn)) ;; get cross points (sample numbers)
- (samp0 (next-sample sr0)))
- (let ((len (framples))
- (sum 0.0)
- (last-cross 0)
- (cross 0)
- (silence (* extension .001)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((samp1 (next-sample sr0)))
- (if (and (<= samp0 0.0)
- (> samp1 0.0)
- (> (- i last-cross) 40)
- (> sum silence))
- (begin
- (set! last-cross i)
- (set! sum 0.0)
- (set! (cross-samples cross) i)
- (set! cross (+ cross 1))))
- (set! sum (+ sum (abs samp0)))
- (set! samp0 samp1)))))
+ (let ((sr0 (make-sampler 0 snd chn))) ;; get cross points (sample numbers)
+ (do ((samp0 (next-sample sr0))
+ (len (framples))
+ (sum 0.0)
+ (last-cross 0)
+ (cross 0)
+ (silence (* extension .001))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (let ((samp1 (next-sample sr0)))
+ (if (and (<= samp0 0.0)
+ (> samp1 0.0)
+ (> (- i last-cross) 40)
+ (> sum silence))
+ (begin
+ (set! last-cross i)
+ (set! sum 0.0)
+ (set! (cross-samples cross) i)
+ (set! cross (+ cross 1))))
+ (set! sum (+ sum (abs samp0)))
+ (set! samp0 samp1))))
;; now run through crosses getting period match info
(do ((i 0 (+ i 1)))
@@ -119,14 +119,13 @@
(data (samples (floor start) fftlen)))
(autocorrelate data)
(set! autolen 0)
- (let ((happy #f))
- (do ((j 1 (+ 1 j)))
- ((or happy (= j len4)))
- (if (and (< (data j) (data (+ j 1)))
+ (do ((happy #f)
+ (j 1 (+ 1 j)))
+ ((or happy (= j len4)))
+ (when (and (< (data j) (data (+ j 1)))
(> (data (+ j 1)) (data (+ j 2))))
- (begin
- (set! autolen (* j 2))
- (set! happy #t)))))))
+ (set! autolen (* j 2))
+ (set! happy #t)))))
(let* ((next-start (+ start autolen))
(min-i (+ i 1))
(min-samps (floor (abs (- (cross-samples min-i) next-start))))
@@ -140,12 +139,12 @@
(set! min-i k)))))
(let ((current-mark min-i)
(current-min 0.0))
- (let* ((s1 (floor (cross-samples current-mark)))
- (sr0 (make-sampler (floor start)))
- (sr1 (make-sampler (floor s1)))
- (ampsum (make-one-pole 1.0 -1.0))
- (diffsum (make-one-pole 1.0 -1.0)))
- (do ((samp0 0.0)
+
+ (let ((ampsum (make-one-pole 1.0 -1.0))
+ (diffsum (make-one-pole 1.0 -1.0)))
+ (do ((sr0 (make-sampler (floor start)))
+ (sr1 (make-sampler (floor (cross-samples current-mark))))
+ (samp0 0.0)
(i 0 (+ i 1)))
((= i autolen))
(set! samp0 (next-sample sr0))
@@ -154,29 +153,31 @@
(set! diffsum (one-pole diffsum 0.0))
(set! ampsum (one-pole ampsum 0.0))
(set! current-min (if (= diffsum 0.0) 0.0 (/ diffsum ampsum))))
+
(set! min-samps (round (* 0.5 current-min)))
- (let ((top (min (- crosses 1) current-mark (+ i zeros-checked))))
- (do ((k (+ i 1) (+ k 1)))
- ((= k top))
- (let ((wgt 0.0))
- (let* ((s1 (floor (cross-samples k)))
- (sr0 (make-sampler (floor start)))
- (sr1 (make-sampler (floor s1)))
- (ampsum (make-one-pole 1.0 -1.0))
- (diffsum (make-one-pole 1.0 -1.0)))
- (do ((samp0 0.0)
- (i 0 (+ i 1)))
- ((= i autolen))
- (set! samp0 (next-sample sr0))
- (one-pole ampsum (abs samp0))
- (one-pole diffsum (abs (- (next-sample sr1) samp0))))
- (set! diffsum (one-pole diffsum 0.0))
- (set! ampsum (one-pole ampsum 0.0))
- (set! wgt (if (= diffsum 0.0) 0.0 (/ diffsum ampsum))))
- (if (< wgt min-samps)
- (begin
- (set! min-samps (floor wgt))
- (set! min-i k))))))
+ (do ((top (min (- crosses 1) current-mark (+ i zeros-checked)))
+ (k (+ i 1) (+ k 1))
+ (wgt 0.0 0.0))
+ ((= k top))
+ (let ((ampsum (make-one-pole 1.0 -1.0))
+ (diffsum (make-one-pole 1.0 -1.0)))
+ (do ((sr0 (make-sampler (floor start)))
+ (sr1 (make-sampler (floor (cross-samples k))))
+ (samp0 0.0)
+ (i 0 (+ i 1)))
+ ((= i autolen))
+ (set! samp0 (next-sample sr0))
+ (one-pole ampsum (abs samp0))
+ (one-pole diffsum (abs (- (next-sample sr1) samp0))))
+ (set! diffsum (one-pole diffsum 0.0))
+ (set! ampsum (one-pole ampsum 0.0))
+ (set! wgt (if (= diffsum 0.0) 0.0 (/ diffsum ampsum))))
+
+ (if (< wgt min-samps)
+ (begin
+ (set! min-samps (floor wgt))
+ (set! min-i k))))
+
(if (not (= current-mark min-i))
(set! (cross-weights i) 1000.0) ; these are confused, so effectively erase them
(begin
@@ -220,49 +221,50 @@
(if (>= curs weights)
(set! mult (ceiling (/ needed-samps handled))))
- (let ((changed-len 0)
- (weights (length cross-weights)))
- (do ((i 0 (+ i 1)))
- ((or (= i curs) (> changed-len samps)))
- (let* ((best-mark (floor (edits i)))
- (beg (floor (cross-samples best-mark)))
- (next-beg (floor (cross-samples (floor (cross-marks best-mark)))))
- (len (floor (cross-periods best-mark))))
- (when (> len 0)
- (if adding
- (let ((new-samps
- (env-add beg next-beg len)))
- (if show-details
- (add-named-mark beg (format #f "~D:~D" i (floor (/ len extension)))))
- (insert-samples beg len new-samps)
- (if (> mult 1)
- (do ((k 1 (+ k 1)))
- ((= k mult))
- (insert-samples (+ beg (* k len)) len new-samps)))
- (set! changed-len (+ changed-len (* mult len)))
- (do ((j 0 (+ 1 j)))
- ((= j weights))
- (let ((curbeg (floor (cross-samples j))))
- (if (> curbeg beg)
- (set! (cross-samples j) (+ curbeg len))))))
- (begin
- (if (>= beg (framples))
- (snd-print (format #f "trouble at ~D: ~D of ~D~%" i beg (framples))))
- (if show-details
- (add-named-mark (- beg 1) (format #f "~D:~D" i (floor (/ len extension)))))
- (delete-samples beg len)
- (set! changed-len (+ changed-len len))
- (let ((end (+ beg len)))
- (do ((j 0 (+ 1 j)))
- ((= j weights))
- (let ((curbeg (floor (cross-samples j))))
- (if (> curbeg beg)
- (if (< curbeg end)
- (set! (cross-periods j) 0)
- (set! (cross-samples j) (- curbeg len))))))))))))
- (if show-details
- (snd-print (format #f "wanted: ~D, got ~D~%" (floor samps) (floor changed-len)))))
- )))))
+ (do ((changed-len 0)
+ (weights (length cross-weights))
+ (i 0 (+ i 1)))
+ ((or (= i curs)
+ (> changed-len samps))
+ (if show-details
+ (snd-print (format #f "wanted: ~D, got ~D~%" (floor samps) (floor changed-len)))))
+ (let* ((best-mark (floor (edits i)))
+ (beg (floor (cross-samples best-mark)))
+ (next-beg (floor (cross-samples (floor (cross-marks best-mark)))))
+ (len (floor (cross-periods best-mark))))
+ (when (> len 0)
+ (if adding
+ (let ((new-samps
+ (env-add beg next-beg len)))
+ (if show-details
+ (add-named-mark beg (format #f "~D:~D" i (floor (/ len extension)))))
+ (insert-samples beg len new-samps)
+ (if (> mult 1)
+ (do ((k 1 (+ k 1)))
+ ((= k mult))
+ (insert-samples (+ beg (* k len)) len new-samps)))
+ (set! changed-len (+ changed-len (* mult len)))
+ (do ((j 0 (+ 1 j)))
+ ((= j weights))
+ (let ((curbeg (floor (cross-samples j))))
+ (if (> curbeg beg)
+ (set! (cross-samples j) (+ curbeg len))))))
+ (begin
+ (if (>= beg (framples))
+ (snd-print (format #f "trouble at ~D: ~D of ~D~%" i beg (framples))))
+ (if show-details
+ (add-named-mark (- beg 1) (format #f "~D:~D" i (floor (/ len extension)))))
+ (delete-samples beg len)
+ (set! changed-len (+ changed-len len))
+ (do ((end (+ beg len))
+ (j 0 (+ 1 j)))
+ ((= j weights))
+ (let ((curbeg (floor (cross-samples j))))
+ (if (> curbeg beg)
+ (if (< curbeg end)
+ (set! (cross-periods j) 0)
+ (set! (cross-samples j) (- curbeg len)))))))))))
+ )))))
;; and return to original srate
(unsample-sound snd chn)
(if show-details
diff --git a/s7-slib-init.scm b/s7-slib-init.scm
index be378f5..e9a5869 100644
--- a/s7-slib-init.scm
+++ b/s7-slib-init.scm
@@ -6,6 +6,9 @@
;;; S7 is embedded in Snd or Sndlib;
;;; It does not exist as a stand-alone program.
+;;@ define an error procedure for the library
+(define slib:error error)
+
;;@ (software-type) should be set to the generic operating system type.
;;; unix, vms, macos, amiga and ms-dos are supported.
(define (software-type) 'unix)
@@ -100,12 +103,12 @@
(define sub-vicinity
(if (eq? (software-type) 'vms)
(lambda (vic name)
- (let ((L (string-length vic)))
+ (let ((L (- (string-length vic) 1)))
(string-append
(if (or (string=? vic "")
- (not (char=? #\] (string-ref vic (- L 1)))))
+ (not (char=? #\] (string-ref vic L))))
(values vic "[")
- (values (substring vic 0 (- L 1)) "."))
+ (values (substring vic 0 L) "."))
name "]")))
(let ((*vicinity-suffix* (case (software-type)
((nosve) ".")
@@ -321,9 +324,6 @@
(if (provided? 'trace) (print-call-stack cep))
(format cep "Warn: ~{ ~S~}~%" args))))
-;;@ define an error procedure for the library
-(define slib:error error)
-
;@
(define (make-exchanger obj)
(lambda (rep) (let ((old obj)) (set! obj rep) old)))
diff --git a/s7.c b/s7.c
index 44b509b..7d4fb5a 100644
--- a/s7.c
+++ b/s7.c
@@ -997,8 +997,8 @@ struct s7_scheme {
make_vector_symbol, map_symbol, max_symbol, member_symbol, memq_symbol, memv_symbol, min_symbol, modulo_symbol,
multiply_symbol,
newline_symbol, not_symbol, number_to_string_symbol, numerator_symbol,
- object_to_string_symbol, open_input_file_symbol, open_input_string_symbol, open_output_file_symbol, openlet_symbol,
- outlet_symbol, owlet_symbol,
+ object_to_string_symbol, object_to_let_symbol, open_input_file_symbol, open_input_string_symbol, open_output_file_symbol,
+ openlet_symbol, outlet_symbol, owlet_symbol,
pair_filename_symbol, pair_line_number_symbol, peek_char_symbol, pi_symbol, port_filename_symbol, port_line_number_symbol,
procedure_documentation_symbol, procedure_signature_symbol, procedure_source_symbol, provide_symbol,
quotient_symbol,
@@ -1011,7 +1011,7 @@ struct s7_scheme {
string_set_symbol, string_symbol, string_to_number_symbol, string_to_symbol_symbol, string_upcase_symbol,
sublet_symbol, substring_symbol, subtract_symbol, symbol_access_symbol, symbol_symbol, symbol_to_dynamic_value_symbol,
symbol_to_keyword_symbol, symbol_to_string_symbol, symbol_to_value_symbol,
- tan_symbol, tanh_symbol, throw_symbol, to_byte_vector_symbol, truncate_symbol,
+ tan_symbol, tanh_symbol, throw_symbol, string_to_byte_vector_symbol, truncate_symbol,
unlet_symbol,
values_symbol, varlet_symbol, vector_append_symbol, vector_dimensions_symbol, vector_fill_symbol, vector_ref_symbol,
vector_set_symbol, vector_symbol,
@@ -1042,8 +1042,8 @@ struct s7_scheme {
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, key_rest_symbol, key_allow_other_keys_symbol, key_readable_symbol, baffled_symbol,
- __func___symbol, set_symbol, body_symbol, class_name_symbol, feed_to_symbol, format_error_symbol,
+ let_star_symbol, key_rest_symbol, key_allow_other_keys_symbol, key_readable_symbol, value_symbol, type_symbol,
+ baffled_symbol, __func___symbol, set_symbol, body_symbol, class_name_symbol, feed_to_symbol, format_error_symbol,
wrong_number_of_args_symbol, read_error_symbol, string_read_error_symbol, syntax_error_symbol, division_by_zero_symbol,
no_catch_symbol, io_error_symbol, invalid_escape_function_symbol, wrong_type_arg_symbol, out_of_range_symbol;
@@ -1244,7 +1244,7 @@ static void init_types(void)
#if WITH_HISTORY
#define current_code(Sc) car(Sc->cur_code)
-#define set_current_code(Sc, Code) do {Sc->cur_code = cdr(Sc->cur_code); car(Sc->cur_code) = Code;} while (0)
+#define set_current_code(Sc, Code) do {Sc->cur_code = cdr(Sc->cur_code); set_car(Sc->cur_code, Code);} while (0)
#define mark_current_code(Sc) do {int i; s7_pointer p; for (p = Sc->cur_code, i = 0; i < sc->history_size; i++, p = cdr(p)) S7_MARK(car(p));} while (0)
#else
#define current_code(Sc) Sc->cur_code
@@ -1258,7 +1258,6 @@ static void init_types(void)
static s7_scheme *hidden_sc = NULL;
#if DEBUGGING
- static bool check_types = true;
static const char *check_name(int typ);
static s7_pointer check_seti(s7_scheme *sc, s7_pointer x, const char *func, int line);
static s7_pointer check_ref(s7_pointer p, int expected_type, const char *func, int line, const char *func1, const char *func2);
@@ -1296,7 +1295,7 @@ static s7_scheme *hidden_sc = NULL;
static void set_s_syn_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line);
#define unchecked_type(p) ((p)->tf.type_field)
- #define type(p) ({unsigned char _t_; _t_ = (p)->tf.type_field; if (((check_types) && (_t_ == T_FREE)) || (_t_ >= NUM_TYPES)) print_gc_info(p, __LINE__); _t_;})
+ #define type(p) ({unsigned char _t_; _t_ = (p)->tf.type_field; if (((_t_ == T_FREE)) || (_t_ >= NUM_TYPES)) print_gc_info(p, __LINE__); _t_;})
#define set_type(p, f) \
do { \
@@ -1924,13 +1923,16 @@ static int not_heap = -1;
#define caar(p) car(car(p))
#define cadr(p) car(cdr(p))
+#define set_cadr(p, Val) (_TLst(p))->object.cons.cdr->object.cons.car = _NFre(Val)
#define cdar(p) cdr(car(p))
+#define set_cdar(p, Val) (_TLst(p))->object.cons.car->object.cons.cdr = _NFre(Val)
#define cddr(p) cdr(cdr(p))
#define caaar(p) car(car(car(p)))
#define cadar(p) car(cdr(car(p)))
#define cdadr(p) cdr(car(cdr(p)))
#define caddr(p) car(cdr(cdr(p)))
+#define set_caddr(p, Val) (_TLst(p))->object.cons.cdr->object.cons.cdr->object.cons.car = _NFre(Val)
#define caadr(p) car(car(cdr(p)))
#define cdaar(p) cdr(car(car(p)))
#define cdddr(p) cdr(cdr(cdr(p)))
@@ -1955,15 +1957,15 @@ static int not_heap = -1;
#if WITH_GCC
/* slightly tricky because cons can be called recursively */
- #define cons(Sc, A, B) ({s7_pointer _X_, _A_, _B_; _A_ = A; _B_ = B; new_cell(sc, _X_, T_PAIR | T_SAFE_PROCEDURE); car(_X_) = _A_; cdr(_X_) = _B_; _X_;})
+ #define cons(Sc, A, B) ({s7_pointer _X_, _A_, _B_; _A_ = A; _B_ = B; new_cell(sc, _X_, T_PAIR | T_SAFE_PROCEDURE); set_car(_X_, _A_); set_cdr(_X_, _B_); _X_;})
#else
#define cons(Sc, A, B) s7_cons(Sc, A, B)
#endif
-#define list_1(Sc, A) cons(Sc, A, sc->nil)
-#define list_2(Sc, A, B) cons_unchecked(Sc, A, cons(Sc, B, sc->nil))
-#define list_3(Sc, A, B, C) cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons(Sc, C, sc->nil)))
-#define list_4(Sc, A, B, C, D) cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons_unchecked(Sc, C, cons(Sc, D, sc->nil))))
+#define list_1(Sc, A) cons(Sc, A, Sc->nil)
+#define list_2(Sc, A, B) cons_unchecked(Sc, A, cons(Sc, B, Sc->nil))
+#define list_3(Sc, A, B, C) cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons(Sc, C, Sc->nil)))
+#define list_4(Sc, A, B, C, D) cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons_unchecked(Sc, C, cons(Sc, D, Sc->nil))))
#define is_string(p) (type(p) == T_STRING)
#define string_value(p) (_TStr(p))->object.string.svalue
@@ -2065,7 +2067,7 @@ static int not_heap = -1;
#define pair_set_syntax_op(p, Op) set_s_syn_op_1(hidden_sc, _TPair(p), Op, __func__, __LINE__)
#endif
#define pair_syntax_symbol(P) car(opt_back(P))
-static void pair_set_syntax_symbol(s7_pointer p, s7_pointer op) {pair_syntax_symbol(p) = op; pair_set_syntax_op(opt_back(p), symbol_syntax_op(op));}
+static void pair_set_syntax_symbol(s7_pointer p, s7_pointer op) {set_car(opt_back(p), op); pair_set_syntax_op(opt_back(p), symbol_syntax_op(op));}
#define ROOTLET_SIZE 512
#define let_id(p) (_TLid(p))->object.envr.id
@@ -2295,7 +2297,7 @@ static c_object_t **object_types = NULL;
static int object_types_size = 0;
static int num_object_types = 0;
-#define c_object_info(p) object_types[c_object_type(p)]
+#define c_object_info(p) object_types[c_object_type(_TObj(p))]
#define c_object_ref(p) c_object_info(p)->ref
#define c_object_set(p) c_object_info(p)->set
#define c_object_print(p) c_object_info(p)->print
@@ -2320,9 +2322,11 @@ static int num_object_types = 0;
#define is_counter(p) (type(p) == T_COUNTER)
#define counter_result(p) (_TCtr(p))->object.ctr.result
+#define counter_set_result(p, Val) (_TCtr(p))->object.ctr.result = _NFre(Val)
#define counter_list(p) (_TCtr(p))->object.ctr.list
#define counter_set_list(p, Val) (_TCtr(p))->object.ctr.list = _NFre(Val)
#define counter_capture(p) (_TCtr(p))->object.ctr.cap
+#define counter_set_capture(p, Val) (_TCtr(p))->object.ctr.cap = Val
#define counter_let(p) _TLid((_TCtr(p))->object.ctr.env)
#define counter_set_let(p, L) (_TCtr(p))->object.ctr.env = _TLid(L)
#define counter_slots(p) (_TCtr(p))->object.ctr.slots
@@ -3158,7 +3162,7 @@ static s7_pointer set_elist_1(s7_scheme *sc, s7_pointer x1)
static s7_pointer set_elist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
{
set_car(sc->elist_2, x1);
- cadr(sc->elist_2) = x2;
+ set_cadr(sc->elist_2, x2);
return(sc->elist_2);
}
@@ -3225,7 +3229,7 @@ static s7_pointer set_plist_1(s7_scheme *sc, s7_pointer x1)
static s7_pointer set_plist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
{
set_car(sc->plist_2, x1);
- cadr(sc->plist_2) = x2;
+ set_cadr(sc->plist_2, x2);
return(sc->plist_2);
}
@@ -3339,8 +3343,6 @@ static s7_pointer g_is_constant(s7_scheme *sc, s7_pointer args)
/* -------------------------------- GC -------------------------------- */
-#define is_gc_nil(p) ((p) == sc->gc_nil)
-
unsigned int s7_gc_protect(s7_scheme *sc, s7_pointer x)
{
unsigned int loc;
@@ -4284,7 +4286,7 @@ static int gc(s7_scheme *sc)
{
fprintf(stdout, "gc ");
#if DEBUGGING
- fprintf(stdout, "line %s[%d] ", last_gc_func, last_gc_line);
+ fprintf(stdout, "%s[%d] ", last_gc_func, last_gc_line);
#endif
#ifndef _MSC_VER
/* this is apparently deprecated in favor of clock_gettime -- what compile-time switch to use here?
@@ -4297,13 +4299,26 @@ static int gc(s7_scheme *sc)
mark_rootlet(sc);
S7_MARK(sc->args);
mark_let(sc->envir);
-#if DEBUGGING
- check_types = false;
-#endif
+
+ slot_set_value(sc->error_data, sc->F);
+ /* the other choice here is to explicitly mark slot_value(sc->error_data) as we do eval_history1/2 below.
+ * in both cases, the values are permanent lists that do not mark impermanent contents.
+ * this will need circular list checks, and can't depend on marked to exit early
+ */
mark_let(sc->owlet);
-#if DEBUGGING
- check_types = true;
+#if WITH_HISTORY
+ {
+ s7_pointer p1, p2;
+ for (p1 = sc->eval_history1, p2 = sc->eval_history2; ; p2 = cdr(p2))
+ {
+ S7_MARK(car(p1));
+ S7_MARK(car(p2));
+ p1 = cdr(p1);
+ if (p1 == sc->eval_history1) break; /* these are circular lists */
+ }
+ }
#endif
+
S7_MARK(sc->code);
mark_current_code(sc);
mark_stack_1(sc->stack, s7_stack_top(sc));
@@ -4495,7 +4510,7 @@ static int gc(s7_scheme *sc)
fprintf(stdout, "freed %d/%u\n", sc->gc_freed, sc->heap_size);
#endif
}
-
+
/* if (sc->begin_hook) call_begin_hook(sc); */
sc->previous_free_heap_top = sc->free_heap_top;
return(sc->gc_freed); /* needed by cell allocator to decide when to increase heap size */
@@ -4557,7 +4572,6 @@ static bool for_any_other_reason(s7_scheme *sc, int line)
#define new_cell_no_check(Sc, Obj, Type) \
do { \
- if ((Sc->free_heap_top + 16) < Sc->free_heap_trigger) fprintf(stderr, "[%d: cell %d] ", __LINE__, (int)(sc->free_heap_top - sc->free_heap)); \
Obj = (*(--(Sc->free_heap_top))); \
Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
set_type(Obj, Type); \
@@ -4658,7 +4672,10 @@ Evaluation produces a surprising amount of garbage, so don't leave the GC off fo
if (sc->gc_off)
return(sc->F);
}
-
+#if DEBUGGING
+ last_gc_line = __LINE__;
+ last_gc_func = __func__;
+#endif
gc(sc);
return(sc->unspecified);
}
@@ -4900,6 +4917,8 @@ static void resize_op_stack(s7_scheme *sc)
#if DEBUGGING
static void pop_stack(s7_scheme *sc)
{
+ opcode_t cur_op;
+ cur_op = sc->op;
sc->stack_end -= 4;
if (sc->stack_end < sc->stack_start)
{
@@ -4912,13 +4931,25 @@ static void pop_stack(s7_scheme *sc)
sc->op = (opcode_t)(sc->stack_end[3]);
if (sc->op > OP_MAX_DEFINED)
{
- fprintf(stderr, "%sinvalid opcode: " INT_FORMAT "%s\n", BOLD_TEXT, sc->op, UNBOLD_TEXT);
+ fprintf(stderr, "%spop_stack[%d] invalid opcode: " INT_FORMAT "%s\n", BOLD_TEXT, __LINE__, sc->op, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ if (unchecked_type(sc->code) == T_FREE)
+ {
+ fprintf(stderr, "%s%s[%d]: stack code is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ if (unchecked_type(sc->args) == T_FREE)
+ {
+ fprintf(stderr, "%s%s[%d]: stack args is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
if (stop_at_error) abort();
}
}
static void pop_stack_no_op(s7_scheme *sc)
{
+ opcode_t cur_op;
+ cur_op = sc->op;
sc->stack_end -= 4;
if (sc->stack_end < sc->stack_start)
{
@@ -4928,6 +4959,16 @@ static void pop_stack_no_op(s7_scheme *sc)
sc->code = sc->stack_end[0];
sc->envir = _TLid(sc->stack_end[1]);
sc->args = sc->stack_end[2];
+ if (unchecked_type(sc->code) == T_FREE)
+ {
+ fprintf(stderr, "%s%s[%d]: stack code is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ if (unchecked_type(sc->args) == T_FREE)
+ {
+ fprintf(stderr, "%s%s[%d]: stack args is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
}
static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer code)
@@ -4937,15 +4978,21 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c
fprintf(stderr, "%sstack overflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
if (stop_at_error) abort();
}
- if (code) sc->stack_end[0] = code;
+ if (op > OP_MAX_DEFINED)
+ {
+ fprintf(stderr, "%spush_stack[%d] invalid opcode: " INT_FORMAT "%s\n", BOLD_TEXT, __LINE__, sc->op, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ if (code) sc->stack_end[0] = _NFre(code);
sc->stack_end[1] = _TLid(sc->envir);
- if (args) sc->stack_end[2] = args;
+ if (args) sc->stack_end[2] = _NFre(args);
sc->stack_end[3] = (s7_pointer)op;
sc->stack_end += 4;
}
-#define push_stack_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, NULL)
-#define push_stack_no_args(Sc, Op, Code) push_stack(Sc, Op, NULL, Code)
+#define push_stack_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, Sc->gc_nil)
+#define push_stack_no_args(Sc, Op, Code) push_stack(Sc, Op, Sc->gc_nil, Code)
+/* in the non-debugging case, the sc->F's here are not set, so we can (later) pop free cells */
#else
/* these macros are faster than the equivalent simple function calls. If the s7_scheme struct is set up to reflect the
@@ -5933,11 +5980,10 @@ static s7_pointer g_is_let(s7_scheme *sc, s7_pointer args)
/* -------------------------------- unlet -------------------------------- */
-#define UNLET_ENTRIES 400
+#define UNLET_ENTRIES 410 /* 401 if not --disable-deprecated etc */
static void save_unlet(s7_scheme *sc)
{
- /* there are ca 374 predefined functions and whatnot */
int i, k = 0;
s7_pointer x;
s7_pointer *inits;
@@ -6129,6 +6175,30 @@ 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))
+ return(wrong_type_argument_with_type(sc, sc->varlet_symbol, 1, env, a_let_string));
+
+ if (!is_symbol(symbol))
+ return(wrong_type_argument_with_type(sc, sc->varlet_symbol, 2, symbol, a_symbol_string));
+
+ if (env == sc->rootlet)
+ {
+ if (is_slot(global_slot(symbol)))
+ {
+ if (is_syntax(slot_value(global_slot(symbol))))
+ return(wrong_type_argument_with_type(sc, sc->varlet_symbol, 2, symbol, make_string_wrapper(sc, "a non-syntactic keyword")));
+ slot_set_value(global_slot(symbol), value);
+ }
+ else s7_make_slot(sc, env, symbol, value);
+ }
+ else make_slot_1(sc, env, symbol, value);
+ return(value);
+}
+
+
static s7_pointer g_varlet(s7_scheme *sc, s7_pointer args)
{
#define H_varlet "(varlet env ...) adds its arguments (an environment, a cons: symbol . value, or a pair of arguments, the symbol and its value) \
@@ -6378,7 +6448,7 @@ s7_pointer s7_inlet(s7_scheme *sc, s7_pointer args)
{
#define H_inlet "(inlet ...) adds its \
arguments, each an environment, a cons: '(symbol . value), or a keyword/value pair, to a new environment, and returns the \
-new environment."
+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)
return(sublet_1(sc, sc->rootlet, args, sc->inlet_symbol));
@@ -7177,7 +7247,8 @@ static s7_pointer make_macro(s7_scheme *sc)
typ = T_BACRO_STAR | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else
{
- if (sc->op == OP_DEFINE_EXPANSION)
+ if ((sc->op == OP_DEFINE_EXPANSION) &&
+ (!is_let(sc->envir))) /* local expansions are just normal macros */
typ = T_MACRO | T_EXPANSION | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else typ = T_MACRO | T_DONT_EVAL_ARGS | T_COPY_ARGS;
}
@@ -7195,9 +7266,9 @@ static s7_pointer make_macro(s7_scheme *sc)
sc->capture_let_counter++;
sc->code = caar(sc->code);
- if (sc->op == OP_DEFINE_EXPANSION)
+ if ((sc->op == OP_DEFINE_EXPANSION) &&
+ (!is_let(sc->envir)))
set_type(sc->code, T_EXPANSION | T_SYMBOL); /* see comment under READ_TOK */
-
/* symbol? macro name has already been checked, find name in environment, and define it */
cx = find_local_symbol(sc, sc->code, sc->envir);
if (is_slot(cx))
@@ -9515,8 +9586,7 @@ static s7_pf_t pf_3(s7_scheme *sc, s7_pointer expr, s7_pf_t fp, s7_pf_t fs)
static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pf_3(sc, expr, CName ## _pf_p3, CName ## _pf_p3_s));}
PF3_TO_PF(let_set, s7_let_set)
-static s7_pointer c_varlet(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_pointer z) {return(g_varlet(sc, set_plist_3(sc, x, y, z)));}
-PF3_TO_PF(varlet, c_varlet)
+PF3_TO_PF(varlet, s7_varlet)
PF_TO_PF(c_pointer, c_c_pointer)
@@ -10538,9 +10608,9 @@ static s7_pointer copy_counter(s7_scheme *sc, s7_pointer obj)
{
s7_pointer nobj;
new_cell(sc, nobj, T_COUNTER);
- counter_result(nobj) = counter_result(obj);
+ counter_set_result(nobj, counter_result(obj));
counter_set_list(nobj, counter_list(obj));
- counter_capture(nobj) = counter_capture(obj);
+ counter_set_capture(nobj, counter_capture(obj));
counter_set_let(nobj, counter_let(obj));
counter_set_slots(nobj, counter_slots(obj));
return(nobj);
@@ -10583,9 +10653,6 @@ static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int top)
memcpy((void *)nv, (void *)ov, len * sizeof(s7_pointer));
s7_gc_on(sc, false);
-#if DEBUGGING
- check_types = false;
-#endif
for (i = 2; i < top; i += 4)
{
s7_pointer p;
@@ -10601,9 +10668,6 @@ static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int top)
nv[i] = copy_counter(sc, p);
}
}
-#if DEBUGGING
- check_types = true;
-#endif
s7_gc_on(sc, true);
return(new_v);
}
@@ -13333,7 +13397,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int radix, bool
if (int_part != 0) /* 0.<310 zeros here>1e310 for example --
* pow (via ipow) thinks it has to be too big, returns Nan,
- * then Nan * 0 -> Nan and the NaN propogates
+ * then Nan * 0 -> Nan and the NaN propagates
*/
{
if (int_len <= max_len)
@@ -26011,10 +26075,10 @@ static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer g_to_byte_vector(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_to_byte_vector(s7_scheme *sc, s7_pointer args)
{
- #define H_to_byte_vector "(->byte-vector obj) turns a string into a byte-vector."
- #define Q_to_byte_vector s7_make_signature(sc, 2, sc->is_byte_vector_symbol, sc->is_string_symbol)
+ #define H_string_to_byte_vector "(string->byte-vector obj) turns a string into a byte-vector."
+ #define Q_string_to_byte_vector s7_make_signature(sc, 2, sc->is_byte_vector_symbol, sc->is_string_symbol)
s7_pointer str;
str = car(args);
if (is_integer(str))
@@ -26022,15 +26086,15 @@ static s7_pointer g_to_byte_vector(s7_scheme *sc, s7_pointer args)
else
{
if (!is_string(str))
- method_or_bust(sc, str, sc->to_byte_vector_symbol, set_plist_1(sc, str), T_STRING, 1);
+ method_or_bust(sc, str, sc->string_to_byte_vector_symbol, set_plist_1(sc, str), T_STRING, 1);
}
set_byte_vector(str);
return(str);
}
-static s7_pointer c_to_byte_vector(s7_scheme *sc, s7_pointer str) {return(g_to_byte_vector(sc, set_plist_1(sc, str)));}
+static s7_pointer c_string_to_byte_vector(s7_scheme *sc, s7_pointer str) {return(g_string_to_byte_vector(sc, set_plist_1(sc, str)));}
-PF_TO_PF(to_byte_vector, c_to_byte_vector)
+PF_TO_PF(string_to_byte_vector, c_string_to_byte_vector)
static s7_pointer g_make_byte_vector(s7_scheme *sc, s7_pointer args)
@@ -29063,7 +29127,7 @@ static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator)
{
s7_pointer p;
p = iterator_let_cons(iterator);
- car(p) = slot_symbol(slot);
+ set_car(p, slot_symbol(slot));
set_cdr(p, slot_value(slot));
return(p);
}
@@ -31505,9 +31569,9 @@ static s7_pointer check_ref8(s7_pointer p, const char *func, int line)
{
int typ;
typ = unchecked_type(p);
- if ((!t_sequence_p[typ]) && (!t_structure_p[typ]))
+ if ((!t_sequence_p[typ]) && (!t_structure_p[typ]) && (!is_any_closure(p))) /* closure calling itself an iterator?? */
{
- fprintf(stderr, "%s%s[%d]: not a sequence, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ fprintf(stderr, "%s%s[%d]: not a sequence or structure, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
if (stop_at_error) abort();
}
return(p);
@@ -36565,13 +36629,6 @@ s7_pointer s7_list(s7_scheme *sc, int num_values, ...)
p = sc->w;
sc->w = sc->nil;
-#if DEBUGGING
- {
- s7_pointer x;
- for (x = p; is_pair(x); x = cdr(x))
- _NFre(car(x));
- }
-#endif
return(safe_reverse_in_place(sc, p));
}
@@ -39362,7 +39419,7 @@ static s7_pf_t compare_pf;
static int vector_compare(const void *v1, const void *v2)
{
set_car(compare_args, (*(s7_pointer *)v1));
- cadr(compare_args) = (*(s7_pointer *)v2);
+ set_cadr(compare_args, (*(s7_pointer *)v2));
return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1);
}
@@ -40176,9 +40233,24 @@ static unsigned int hash_map_pair(s7_scheme *sc, s7_pointer table, s7_pointer ke
if (!is_sequence(car(key)))
loc = hash_loc(sc, table, car(key)) + 1;
+ else
+ {
+ if ((is_pair(car(key))) &&
+ (!is_sequence(caar(key))))
+ loc = hash_loc(sc, table, caar(key)) + 1;
+ }
p1 = cdr(key);
- if ((is_pair(p1)) && (!is_sequence(car(p1))))
- loc += hash_loc(sc, table, car(p1)) + 1;
+ if (is_pair(p1))
+ {
+ if (!is_sequence(car(p1)))
+ loc += hash_loc(sc, table, car(p1)) + 1;
+ else
+ {
+ if ((is_pair(car(p1))) &&
+ (!is_sequence(caar(p1))))
+ loc += hash_loc(sc, table, caar(p1)) + 1;
+ }
+ }
return(loc);
}
@@ -41771,9 +41843,9 @@ s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function
}
-static s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
- int required_args, int optional_args, bool rest_arg,
- const char *doc, s7_pointer signature)
+s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg,
+ const char *doc, s7_pointer signature)
{
/* returns (string->symbol name), not the c_proc_t func */
s7_pointer func, sym;
@@ -43926,7 +43998,7 @@ static void set_string_error_source(s7_scheme *sc, s7_pointer source)
copy_to_string_error = s7_make_permanent_string("copy ~A to string, ~S is not a character");
if (!copy_to_byte_vector_error)
copy_to_byte_vector_error = s7_make_permanent_string("copy ~A to byte-vector, ~S is not a byte");
- cadr(sc->elist_3) = prepackaged_type_name(sc, source);
+ set_cadr(sc->elist_3, prepackaged_type_name(sc, source));
}
static s7_pointer string_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
@@ -43944,7 +44016,7 @@ static s7_pointer string_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_po
if (!copy_to_string_error) {fprintf(stderr, "string_error not set\n"); abort();}
#endif
set_car(sc->elist_3, copy_to_string_error);
- caddr(sc->elist_3) = val;
+ set_caddr(sc->elist_3, val);
return(s7_error(sc, sc->wrong_type_arg_symbol, sc->elist_3));
}
@@ -43963,7 +44035,7 @@ static s7_pointer byte_vector_setter(s7_scheme *sc, s7_pointer str, s7_int loc,
if (!copy_to_byte_vector_error) {fprintf(stderr, "byte_vector_error not set\n"); abort();}
#endif
set_car(sc->elist_3, copy_to_byte_vector_error);
- caddr(sc->elist_3) = val;
+ set_caddr(sc->elist_3, val);
return(s7_error(sc, sc->wrong_type_arg_symbol, sc->elist_3));
}
@@ -44763,7 +44835,7 @@ static s7_pointer list_fill(s7_scheme *sc, s7_pointer args)
s7_pointer p;
if (end < len) len = end;
for (i = 0, p = obj; i < start; p = cdr(p), i++);
- for (; i < len; p = cdr(p), i++) car(p) = val;
+ for (; i < len; p = cdr(p), i++) set_car(p, val);
return(val);
}
@@ -44771,7 +44843,7 @@ static s7_pointer list_fill(s7_scheme *sc, s7_pointer args)
{
if ((end > 0) && (i >= end))
return(val);
- if (i >= start) car(x) = val;
+ if (i >= start) set_car(x, val);
if (!is_pair(cdr(x)))
{
if (!is_null(cdr(x)))
@@ -44870,13 +44942,17 @@ static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer c
int i;
s7_int len = 0;
- for (i = 0, p = args; is_pair(p); p = cdr(p), i++)
+ for (i = 1, p = args; is_pair(p); p = cdr(p), i++)
{
s7_pointer seq;
s7_int n;
seq = car(p);
n = sequence_length(sc, seq);
- if ((n > 0) && (typ != T_FREE) && ((type(seq) == T_HASH_TABLE) || (type(seq) == T_LET)))
+ if ((n > 0) &&
+ (typ != T_FREE) &&
+ ((type(seq) == T_HASH_TABLE) || /* can't append hash-tables (no obvious meaning to the operation) */
+ ((type(seq) == T_LET) && /* similarly for lets, unless this is a mock-string or something similar */
+ ((!has_methods(seq)) || (find_method(sc, seq, sc->append_symbol) == sc->undefined)))))
{
wrong_type_argument(sc, sc->append_symbol, i, seq, typ);
return(0);
@@ -45180,6 +45256,390 @@ static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
}
+/* -------------------------------- object->let -------------------------------- */
+
+static bool is_decodable(s7_scheme *sc, s7_pointer p);
+static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int top);
+
+static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args)
+{
+ #define H_object_to_let "(object->let obj) returns a let (namespace) describing obj."
+ #define Q_object_to_let s7_make_signature(sc, 2, sc->is_let_symbol, sc->T)
+
+ s7_pointer obj;
+ obj = car(args);
+
+ switch (type(obj))
+ {
+ case T_NIL:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_null_symbol)));
+
+ case T_UNSPECIFIED:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, obj)));
+
+ case T_SYNTAX:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, s7_make_symbol(sc, "syntax?"))));
+
+ case T_UNIQUE:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, (is_eof(obj)) ? sc->is_eof_object_symbol : obj)));
+
+ case T_BOOLEAN:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_boolean_symbol)));
+
+ case T_SYMBOL:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol : sc->is_symbol_symbol)));
+
+ case T_CHARACTER:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_char_symbol)));
+
+ case T_INTEGER:
+ case T_BIG_INTEGER:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_integer_symbol)));
+
+ case T_RATIO:
+ case T_BIG_RATIO:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_rational_symbol)));
+
+ case T_REAL:
+ case T_BIG_REAL:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_real_symbol)));
+
+ case T_COMPLEX:
+ case T_BIG_COMPLEX:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_complex_symbol)));
+
+ case T_STRING:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, (is_byte_vector(obj)) ? sc->is_byte_vector_symbol : sc->is_string_symbol,
+ sc->length_symbol, s7_length(sc, obj))));
+
+ case T_PAIR:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_pair_symbol,
+ sc->length_symbol, s7_length(sc, obj))));
+
+ case T_RANDOM_STATE:
+#if WITH_GMP
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol)));
+#else
+ return(s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_random_state_symbol,
+ s7_make_symbol(sc, "seed"), s7_make_integer(sc, random_seed(obj)),
+ s7_make_symbol(sc, "carry"), s7_make_integer(sc, random_carry(obj)))));
+#endif
+
+ case T_GOTO:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, s7_make_symbol(sc, "goto?"),
+ s7_make_symbol(sc, "active"), s7_make_boolean(sc, call_exit_active(obj)))));
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
+ sc->type_symbol,
+ (is_int_vector(obj)) ? sc->is_int_vector_symbol : ((is_float_vector(obj)) ? sc->is_float_vector_symbol : sc->is_vector_symbol),
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "dimensions"), g_vector_dimensions(sc, list_1(sc, obj)),
+ s7_make_symbol(sc, "shared"),
+ ((vector_has_dimensional_info(obj)) && (is_normal_vector(shared_vector(obj)))) ? shared_vector(obj) : sc->F)));
+
+ case T_C_POINTER:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_c_pointer_symbol,
+ s7_make_symbol(sc, "s7-value"),
+ ((is_decodable(sc, (s7_pointer)raw_pointer(obj))) &&
+ (!is_free(obj))) ? g_object_to_let(sc, cons(sc, (s7_pointer)raw_pointer(obj), sc->nil)) : sc->F)));
+
+ case T_CONTINUATION:
+ {
+ s7_pointer let;
+ int gc_loc;
+ let = s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_continuation_symbol));
+ gc_loc = s7_gc_protect(sc, let);
+ s7_varlet(sc, let, s7_make_symbol(sc, "stack"), stack_entries(sc, continuation_stack(obj), continuation_stack_top(obj)));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(let);
+ }
+
+ case T_ITERATOR:
+ {
+ s7_pointer let, seq;
+ seq = iterator_sequence(obj);
+ let = s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_iterator_symbol,
+ s7_make_symbol(sc, "at-end"), s7_make_boolean(sc, iterator_is_at_end(obj)),
+ s7_make_symbol(sc, "sequence"), iterator_sequence(obj)));
+ if (is_pair(seq))
+ s7_varlet(sc, let, sc->length_symbol, s7_length(sc, seq));
+ else
+ {
+ if (is_hash_table(seq))
+ s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, hash_table_entries(seq)));
+ else s7_varlet(sc, let, sc->length_symbol, s7_length(sc, obj));
+ }
+ if ((is_string(seq)) ||
+ (is_normal_vector(seq)) ||
+ (is_int_vector(seq)) ||
+ (is_float_vector(seq)) ||
+ (seq == sc->rootlet) ||
+ (is_c_object(seq)) ||
+ (is_hash_table(seq)))
+ s7_varlet(sc, let, s7_make_symbol(sc, "position"), s7_make_integer(sc, iterator_position(obj)));
+ else
+ {
+ if (is_pair(seq))
+ s7_varlet(sc, let, s7_make_symbol(sc, "position"), iterator_current(obj));
+ }
+ return(let);
+ }
+
+ case T_HASH_TABLE:
+ {
+ s7_pointer let;
+ let = s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_hash_table_symbol,
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "entries"), s7_make_integer(sc, hash_table_entries(obj)),
+ s7_make_symbol(sc, "locked"), s7_make_boolean(sc, hash_table_checker_locked(obj))));
+
+ if ((hash_table_checker(obj) == hash_eq) ||
+ (hash_table_checker(obj) == hash_c_function) ||
+ (hash_table_checker(obj) == hash_closure) ||
+ (hash_table_checker(obj) == hash_equal_eq) ||
+ (hash_table_checker(obj) == hash_equal_syntax) ||
+ (hash_table_checker(obj) == hash_symbol))
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_eqv)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_eqv_symbol);
+ else
+ {
+ if ((hash_table_checker(obj) == hash_equal) ||
+ (hash_table_checker(obj) == hash_empty))
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_equal_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_morally_equal)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_morally_equal_symbol);
+ else
+ {
+ if ((hash_table_checker(obj) == hash_number) ||
+ (hash_table_checker(obj) == hash_int) ||
+ (hash_table_checker(obj) == hash_float) ||
+ (hash_table_checker(obj) == hash_equal_real) ||
+ (hash_table_checker(obj) == hash_equal_complex))
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_string)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->string_eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_char)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->char_eq_symbol);
+#if (!WITH_PURE_S7)
+ else
+ {
+ if (hash_table_checker(obj) == hash_ci_char)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->char_ci_eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_ci_string)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->string_ci_eq_symbol);
+ }}
+#endif
+ }}}}}}
+ return(let);
+ }
+
+ case T_LET:
+ {
+ s7_pointer let;
+ let = s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_let_symbol,
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "open"), s7_make_boolean(sc, has_methods(obj)),
+ sc->outlet_symbol, (obj == sc->rootlet) ? sc->nil : outlet(obj)));
+ if (obj == sc->rootlet)
+ s7_varlet(sc, let, s7_make_symbol(sc, "alias"), sc->rootlet_symbol);
+ else
+ {
+ if (obj == sc->owlet)
+ s7_varlet(sc, let, s7_make_symbol(sc, "alias"), sc->owlet_symbol);
+ else
+ {
+ if (is_function_env(obj))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), funclet_function(obj));
+ if ((let_file(obj) > 0) &&
+ (let_file(obj) < (s7_int)sc->file_names_top) &&
+ (let_line(obj) > 0))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "file"), sc->file_names[let_file(obj)]);
+ s7_varlet(sc, let, s7_make_symbol(sc, "line"), make_integer(sc, let_line(obj)));
+ }
+ }
+ }
+ }
+ if (has_methods(obj))
+ {
+ s7_pointer func;
+ func = find_method(sc, obj, sc->object_to_let_symbol);
+ if (func != sc->undefined)
+ {
+ int gc_loc;
+ gc_loc = s7_gc_protect(sc, let);
+ s7_apply_function(sc, func, list_2(sc, obj, let));
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ }
+ return(let);
+ }
+
+ case T_C_OBJECT:
+ {
+ s7_pointer let, clet;
+ clet = c_object_let(obj);
+ let = s7_inlet(sc, s7_list(sc, 12, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_c_object_symbol,
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "c-type"), s7_make_integer(sc, c_object_type(obj)),
+ sc->let_symbol, clet,
+ s7_make_symbol(sc, "class"), c_object_scheme_name(obj)));
+ if ((is_let(clet)) &&
+ ((has_methods(clet)) || (has_methods(obj))))
+ {
+ s7_pointer func;
+ func = find_method(sc, clet, sc->object_to_let_symbol);
+ if (func != sc->undefined)
+ {
+ int gc_loc;
+ gc_loc = s7_gc_protect(sc, let);
+ s7_apply_function(sc, func, list_2(sc, obj, let));
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ }
+ return(let);
+ }
+
+ case T_INPUT_PORT:
+ case T_OUTPUT_PORT:
+ {
+ s7_pointer let;
+ int gc_loc;
+ let = s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
+ sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol,
+ s7_make_symbol(sc, "port-type"),
+ (is_string_port(obj)) ? sc->string_symbol :
+ ((is_file_port(obj)) ? s7_make_symbol(sc, "file") : s7_make_symbol(sc, "function")),
+ s7_make_symbol(sc, "closed"), s7_make_boolean(sc, port_is_closed(obj))));
+ gc_loc = s7_gc_protect(sc, let);
+ if (is_file_port(obj))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "file"), g_port_filename(sc, list_1(sc, obj)));
+ if (is_input_port(obj))
+ s7_varlet(sc, let, s7_make_symbol(sc, "line"), g_port_line_number(sc, list_1(sc, obj)));
+ }
+ if (port_data_size(obj) > 0)
+ {
+ s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, port_data_size(obj)));
+ s7_varlet(sc, let, s7_make_symbol(sc, "position"), s7_make_integer(sc, port_position(obj)));
+ /* I think port_data need not be null-terminated, but s7_make_string assumes it is:
+ * both valgrind and lib*san complain about the uninitialized data during strlen.
+ */
+ s7_varlet(sc, let, s7_make_symbol(sc, "data"), s7_make_string_with_length(sc, (const char *)port_data(obj), port_data_size(obj)));
+ }
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(let);
+ }
+
+ 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;
+ int gc_loc;
+ let = s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, (is_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
+ s7_make_symbol(sc, "arity"), s7_arity(sc, obj)));
+ gc_loc = s7_gc_protect(sc, let);
+
+ sig = s7_procedure_signature(sc, obj);
+ if (is_pair(sig))
+ s7_varlet(sc, let, sc->signature_symbol, sig);
+
+ doc = s7_procedure_documentation(sc, obj);
+ if (doc)
+ s7_varlet(sc, let, sc->documentation_symbol, s7_make_string(sc, doc));
+
+ if (is_let(closure_let(obj)))
+ {
+ s7_pointer flet;
+ flet = closure_let(obj);
+ if ((let_file(flet) > 0) &&
+ (let_file(flet) < (s7_int)sc->file_names_top) &&
+ (let_line(flet) > 0))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "file"), sc->file_names[let_file(flet)]);
+ s7_varlet(sc, let, s7_make_symbol(sc, "line"), make_integer(sc, let_line(flet)));
+ }
+ }
+
+ if (closure_setter(obj) != sc->F)
+ s7_varlet(sc, let, s7_make_symbol(sc, "setter"), closure_setter(obj));
+
+ s7_varlet(sc, let, s7_make_symbol(sc, "source"),
+ append_in_place(sc, list_2(sc, (is_closure_star(obj)) ? sc->lambda_star_symbol : sc->lambda_symbol,
+ closure_args(obj)),
+ closure_body(obj)));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(let);
+ }
+
+ case T_C_MACRO:
+ case T_C_FUNCTION_STAR:
+ case T_C_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ {
+ s7_pointer let, sig;
+ const char* doc;
+ let = s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, (is_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
+ s7_make_symbol(sc, "arity"), s7_arity(sc, obj)));
+
+ sig = s7_procedure_signature(sc, obj);
+ if (is_pair(sig))
+ s7_varlet(sc, let, sc->signature_symbol, sig);
+
+ doc = s7_procedure_documentation(sc, obj);
+ if (doc)
+ s7_varlet(sc, let, sc->documentation_symbol, s7_make_string(sc, doc));
+
+ if (c_function_setter(obj) != sc->F)
+ s7_varlet(sc, let, s7_make_symbol(sc, "setter"), c_function_setter(obj));
+
+ return(let);
+ }
+
+ default:
+#if DEBUGGING
+ fprintf(stderr, "object->let: %s, type: %d\n", DISPLAY(obj), type(obj));
+#endif
+ return(sc->F);
+ }
+
+ return(sc->F);
+}
+
+
/* ---------------- stacktrace ---------------- */
@@ -46147,19 +46607,19 @@ static s7_pointer active_exits(s7_scheme *sc)
return(reverse_in_place_unchecked(sc, sc->nil, lst));
}
-static s7_pointer stack_entries(s7_scheme *sc)
+static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int top)
{
int i;
s7_pointer lst;
lst = sc->nil;
- for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ for (i = top - 1; i >= 3; i -= 4)
{
s7_pointer func, args, e;
opcode_t op;
- func = stack_code(sc->stack, i);
- args = stack_args(sc->stack, i);
- e = stack_let(sc->stack, i);
- op = stack_op(sc->stack, i);
+ func = stack_code(stack, i);
+ args = stack_args(stack, i);
+ e = stack_let(stack, i);
+ op = stack_op(stack, i);
if ((s7_is_valid(sc, func)) &&
(s7_is_valid(sc, args)) &&
(s7_is_valid(sc, e)) &&
@@ -46515,6 +46975,7 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
slot_set_value(sc->error_type, type);
slot_set_value(sc->error_data, info);
+
#if DEBUGGING
if (!is_let(sc->owlet))
fprintf(stderr, "owlet clobbered!\n");
@@ -47169,6 +47630,9 @@ static bool call_begin_hook(s7_scheme *sc)
slot_set_value(sc->error_code, current_code(sc));
slot_set_value(sc->error_line, sc->F);
slot_set_value(sc->error_file, sc->F);
+#if WITH_HISTORY
+ slot_set_value(sc->error_history, sc->F);
+#endif
set_outlet(sc->owlet, sc->envir);
sc->value = s7_make_symbol(sc, "begin-hook-interrupt");
@@ -48294,9 +48758,9 @@ static s7_pointer make_counter(s7_scheme *sc, s7_pointer iter)
{
s7_pointer x;
new_cell(sc, x, T_COUNTER);
- counter_result(x) = sc->nil;
+ counter_set_result(x, sc->nil);
counter_set_list(x, iter); /* iterator -- here it's always either an iterator or a pair */
- counter_capture(x) = 0; /* will be capture_let_counter */
+ counter_set_capture(x, 0); /* will be capture_let_counter */
counter_set_let(x, sc->nil); /* will be the saved env */
counter_set_slots(x, sc->nil); /* local env slots before body is evalled */
return(x);
@@ -48325,7 +48789,7 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
{
s7_pointer c;
c = make_counter(sc, p);
- counter_result(c) = p;
+ counter_set_result(c, p);
push_stack(sc, OP_FOR_EACH_2, c, f);
return(sc->unspecified);
}
@@ -51716,7 +52180,7 @@ static void init_choosers(s7_scheme *sc)
s7_pf_set_function(slot_value(global_slot(sc->list_set_symbol)), list_set_pf);
s7_pf_set_function(slot_value(global_slot(sc->let_ref_symbol)), let_ref_pf);
s7_pf_set_function(slot_value(global_slot(sc->let_set_symbol)), let_set_pf);
- s7_pf_set_function(slot_value(global_slot(sc->to_byte_vector_symbol)), to_byte_vector_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->string_to_byte_vector_symbol)), string_to_byte_vector_pf);
s7_rf_set_function(slot_value(global_slot(sc->float_vector_ref_symbol)), float_vector_ref_rf);
s7_rf_set_function(slot_value(global_slot(sc->float_vector_set_symbol)), float_vector_set_rf);
@@ -54146,8 +54610,8 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
if (is_symbol(car_expr))
{
s7_pointer func;
- if (is_syntactic(car_expr))
- return(optimize_syntax(sc, expr, slot_value(global_slot(car_expr)), hop, e));
+ if (is_syntactic(car_expr))
+ return(optimize_syntax(sc, expr, _TSyn(slot_value(global_slot(car_expr))), hop, e));
if (car_expr == sc->quote_symbol)
return(false);
@@ -54156,7 +54620,7 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
if (is_slot(func))
{
func = slot_value(func);
- if (is_syntactic(func))
+ if (is_syntax(func)) /* 12-8-16 was is_syntactic, but that is only appropriate above -- here we have the value */
return(optimize_syntax(sc, expr, func, hop, e));
/* we miss implicit indexing here because at this time, the data are not set */
@@ -55965,7 +56429,7 @@ static s7_pointer check_define(s7_scheme *sc)
set_local(func);
}
if (starred)
- cdar(sc->code) = check_lambda_star_args(sc, cdar(sc->code), &arity);
+ set_cdar(sc->code, check_lambda_star_args(sc, cdar(sc->code), &arity));
else check_lambda_args(sc, cdar(sc->code), &arity);
optimize_lambda(sc, !starred, func, cdar(sc->code), cdr(sc->code));
}
@@ -56285,7 +56749,7 @@ static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op)
set_elist_3(sc, make_string_wrapper(sc, "define-macro ~A argument name is not a symbol: ~S"), x, y)));
if ((sc->op == OP_DEFINE_MACRO_STAR) || (sc->op == OP_DEFINE_BACRO_STAR))
- cdar(sc->code) = check_lambda_star_args(sc, cdar(sc->code), NULL);
+ set_cdar(sc->code, check_lambda_star_args(sc, cdar(sc->code), NULL));
else check_lambda_args(sc, cdar(sc->code), NULL);
return(sc->code);
@@ -58171,11 +58635,11 @@ static int dox_ex(s7_scheme *sc)
long long int id;
s7_pointer frame, vars, slot, code;
s7_function endf;
+ int gc_loc;
bool all_pairs = true;
-
- /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
- new_frame(sc, sc->envir, frame); /* new frame is not tied into the symbol lookup process yet */
+ new_frame(sc, sc->envir, frame); /* new frame is not tied into the symbol lookup process yet */
+ gc_loc = s7_gc_protect(sc, frame); /* maybe use temp3 here? can c_call below jump out? */
for (vars = car(sc->code); is_pair(vars); vars = cdr(vars))
{
s7_pointer expr, val;
@@ -58216,6 +58680,7 @@ static int dox_ex(s7_scheme *sc)
}
sc->envir = frame;
+ s7_gc_unprotect_at(sc, gc_loc);
id = let_id(frame);
for (slot = let_slots(frame); is_slot(slot); slot = next_slot(slot))
symbol_set_local(slot_symbol(slot), id, slot);
@@ -60456,10 +60921,6 @@ static void define2_ex(s7_scheme *sc)
s7_pointer new_func, new_env;
new_func = sc->value;
- /* we can get here from let: (define (outer a) (let () (define (inner b) (+ a b)) (inner a)))
- * but the port info is not relevant here, so restrict the __func__ list making to top-level
- * cases (via sc->envir == sc->nil).
- */
new_cell_no_check(sc, new_env, T_LET | T_FUNCTION_ENV);
let_id(new_env) = ++sc->let_number;
set_outlet(new_env, closure_let(new_func));
@@ -60467,7 +60928,7 @@ static void define2_ex(s7_scheme *sc)
let_set_slots(new_env, sc->nil);
funclet_set_function(new_env, sc->code);
- if ((!is_let(sc->envir)) &&
+ if (/* (!is_let(sc->envir)) && */
(port_filename(sc->input_port)) &&
(port_file(sc->input_port) != stdin))
{
@@ -60940,8 +61401,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (sc->value != sc->no_value)
{
if (is_multiple_value(sc->value))
- counter_result(sc->args) = revappend(sc, multiple_value(sc->value), counter_result(sc->args));
- else counter_result(sc->args) = cons(sc, sc->value, counter_result(sc->args));
+ counter_set_result(sc->args, revappend(sc, multiple_value(sc->value), counter_result(sc->args)));
+ else counter_set_result(sc->args, cons(sc, sc->value, counter_result(sc->args)));
}
case OP_MAP_1:
@@ -60963,7 +61424,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), x);
counter_set_let(args, sc->envir);
counter_set_slots(args, let_slots(sc->envir));
- counter_capture(args) = sc->capture_let_counter;
+ counter_set_capture(args, sc->capture_let_counter);
}
else
{
@@ -60987,9 +61448,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (sc->value != sc->no_value) /* (map (lambda (x) (values)) (list 1)) */
{
if (is_multiple_value(sc->value)) /* (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4)) */
- counter_result(sc->args) = revappend(sc, multiple_value(sc->value), counter_result(sc->args));
+ counter_set_result(sc->args, revappend(sc, multiple_value(sc->value), counter_result(sc->args)));
/* not append_in_place here because sc->value has the multiple-values bit set */
- else counter_result(sc->args) = cons(sc, sc->value, counter_result(sc->args));
+ else counter_set_result(sc->args, cons(sc, sc->value, counter_result(sc->args)));
}
case OP_MAP:
@@ -61068,7 +61529,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), arg);
counter_set_let(counter, sc->envir);
counter_set_slots(counter, let_slots(sc->envir));
- counter_capture(counter) = sc->capture_let_counter;
+ counter_set_capture(counter, sc->capture_let_counter);
}
else
{
@@ -61096,7 +61557,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
counter_set_list(c, cdr(lst));
if (sc->op == OP_FOR_EACH_3)
{
- counter_result(c) = cdr(counter_result(c));
+ counter_set_result(c, cdr(counter_result(c)));
if (counter_result(c) == counter_list(c))
{
sc->value = sc->unspecified;
@@ -61110,7 +61571,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), arg);
counter_set_let(c, sc->envir);
counter_set_slots(c, let_slots(sc->envir));
- counter_capture(c) = sc->capture_let_counter;
+ counter_set_capture(c, sc->capture_let_counter);
}
else
{
@@ -61645,6 +62106,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* we could use slot_pending_value, slot_expression, not this extra list, but the list seems simpler. */
#define DO_VAR_SLOT(P) opt_slot1(P)
#define DO_VAR_NEW_VALUE(P) cdr(P)
+ #define DO_VAR_SET_NEW_VALUE(P, Val) set_cdar(P, Val)
#define DO_VAR_STEP_EXPR(P) car(P)
DO_STEP:
@@ -61723,8 +62185,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_DO_STEP2:
- DO_VAR_NEW_VALUE(car(sc->args)) = sc->value; /* save current value */
- sc->args = cdr(sc->args); /* go to next step var */
+ DO_VAR_SET_NEW_VALUE(sc->args, sc->value); /* save current value */
+ sc->args = cdr(sc->args); /* go to next step var */
goto DO_STEP1;
@@ -65569,7 +66031,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
val = c_call(cdr(sc->code))(sc, cadr(sc->code)); /* this call can step on sc->Tx_x */
set_car(sc->t2_1, cadar(sc->code)); /* might be a constant: (set! (mus-sound-srate "oboe.snd") 12345) */
if (is_symbol(car(sc->t2_1)))
- car(sc->t2_1) = find_symbol_checked(sc, cadar(sc->code));
+ set_car(sc->t2_1, find_symbol_checked(sc, cadar(sc->code)));
set_car(sc->t2_2, val);
sc->value = c_function_call(c_function_setter(obj))(sc, sc->t2_1);
}
@@ -65945,19 +66407,37 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SET_WITH_LET_1:
/* here sc->value is the new value for the settee, args has the (as yet unevaluated) let and settee-expression. */
/* fprintf(stderr, "with_let_1: %s %s %s\n", DISPLAY(sc->value), DISPLAY(sc->code), DISPLAY(sc->args)); */
- sc->code = car(sc->args);
- sc->args = list_2(sc, cadr(sc->args), sc->value);
- push_stack(sc, OP_SET_WITH_LET_2, sc->args, sc->code);
- goto EVAL;
+ if (is_symbol(car(sc->args)))
+ {
+ s7_pointer p;
+ p = list_2(sc, cadr(sc->args), sc->value);
+ sc->value = find_symbol_checked(sc, car(sc->args));
+ sc->args = p;
+ /* fall through */
+ }
+ else
+ {
+ sc->code = car(sc->args);
+ sc->args = list_2(sc, cadr(sc->args), sc->value);
+ push_stack(sc, OP_SET_WITH_LET_2, sc->args, sc->code);
+ goto EVAL;
+ }
case OP_SET_WITH_LET_2:
- /* fprintf(stderr, "with_let_2: %s %s %s\n", DISPLAY(sc->value), DISPLAY(sc->code), DISPLAY(sc->args)); */
+ /* fprintf(stderr, "with_let_2: value: %s, code: %s, args: %s\n", DISPLAY(sc->value), DISPLAY(sc->code), DISPLAY(sc->args)); */
+ if (is_symbol(car(sc->args)))
+ {
+ let_set_1(sc, sc->value, car(sc->args), cadr(sc->args));
+ sc->value = cadr(sc->args);
+ goto START;
+ }
+
/* avoid double evaluation */
if ((is_symbol(cadr(sc->args))) ||
(is_pair(cadr(sc->args))))
sc->code = cons(sc, sc->set_symbol, list_2(sc, car(sc->args), list_2(sc, sc->quote_symbol, cadr(sc->args))));
else sc->code = cons(sc, sc->set_symbol, sc->args);
- activate_let(sc);
+ activate_let(sc); /* this activates sc->value, so the set! will happen in that environment */
goto EVAL;
@@ -69163,7 +69643,7 @@ static s7_pointer big_bignum(s7_scheme *sc, s7_pointer args)
case T_RATIO:
return(promote_number(sc, T_BIG_RATIO, p));
- /* we can't use promote_number here because it propogates C-double inaccuracies
+ /* we can't use promote_number here because it propagates C-double inaccuracies
* (rationalize (bignum "0.1") 0) should return 1/10 not 3602879701896397/36028797018963968
*/
case T_REAL:
@@ -72458,7 +72938,7 @@ static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args)
if (sym == sc->print_length_symbol) /* print-length */
return(s7_make_integer(sc, sc->print_length));
- if (sym == sc->stack_top_symbol) /* stack-top = #frames active (4 stack entries per frame) */
+ if (sym == sc->stack_top_symbol) /* stack-top = how many frames active (4 stack entries per frame) */
return(s7_make_integer(sc, (sc->stack_end - sc->stack_start) / 4));
if (sym == sc->stack_size_symbol) /* stack-size (max so far) */
return(s7_make_integer(sc, sc->stack_size));
@@ -72484,13 +72964,13 @@ static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args)
if (sym == sc->exits_symbol) /* exits */
return(active_exits(sc));
if (sym == sc->stack_symbol) /* stack */
- return(stack_entries(sc));
+ return(stack_entries(sc, sc->stack, s7_stack_top(sc)));
if (sym == sc->heap_size_symbol) /* heap-size */
return(s7_make_integer(sc, sc->heap_size));
if (sym == sc->free_heap_size_symbol) /* free-heap-size (number of unused cells in the heap) */
return(s7_make_integer(sc, sc->free_heap_top - sc->free_heap));
- if (sym == sc->gc_freed_symbol) /* gc-freed = # cells freed during last GC sweep */
+ if (sym == sc->gc_freed_symbol) /* gc-freed = how many cells freed during last GC sweep */
return(s7_make_integer(sc, sc->gc_freed));
if (sym == sc->gc_protected_objects_symbol) /* gc-protected-objects */
return(sc->protected_objects);
@@ -72791,14 +73271,14 @@ static s7_pointer g_is_float(s7_scheme *sc, s7_pointer args)
static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args)
{
- #define H_is_proper_list "(proper-list? x) returns #t is x is a list that is not circular or dotted."
+ #define H_is_proper_list "(proper-list? x) returns #t is x is a list that is neither circular nor dotted."
#define Q_is_proper_list pl_bt
s7_pointer p;
p = car(args);
return(make_boolean(sc, is_proper_list(sc, p)));
}
-/* how to handle this? */
+/* how to handle this? (float-vector-set! and vector-set! signature entries) */
static s7_pointer g_is_integer_or_real_at_end(s7_scheme *sc, s7_pointer args) {return(sc->T);}
static s7_pointer g_is_integer_or_any_at_end(s7_scheme *sc, s7_pointer args) {return(sc->T);}
@@ -72929,19 +73409,6 @@ char *s7_decode_bt(void)
#endif
-/* -------------------------------- initialization -------------------------------- */
-
-static s7_pointer make_unique_object(const char* name, unsigned int typ)
-{
- s7_pointer p;
- p = alloc_pointer();
- set_type(p, typ | T_IMMUTABLE);
- unique_name_length(p) = safe_strlen(name);
- unique_name(p) = copy_string_with_length(name, unique_name_length(p));
- unheap(p);
- return(p);
-}
-
/* ---------------- an experiment ---------------- */
static s7_int tree_len(s7_scheme *sc, s7_pointer p, s7_int i)
{
@@ -72957,8 +73424,21 @@ static s7_pointer g_tree_leaves(s7_scheme *sc, s7_pointer args)
{
return(s7_make_integer(sc, tree_len(sc, car(args), 0)));
}
-/* -------------------------------- */
+
+
+/* -------------------------------- initialization -------------------------------- */
+
+static s7_pointer make_unique_object(const char* name, unsigned int typ)
+{
+ s7_pointer p;
+ p = alloc_pointer();
+ set_type(p, typ | T_IMMUTABLE);
+ unique_name_length(p) = safe_strlen(name);
+ unique_name(p) = copy_string_with_length(name, unique_name_length(p));
+ unheap(p);
+ return(p);
+}
s7_scheme *s7_init(void)
{
@@ -73589,6 +74069,9 @@ s7_scheme *s7_init(void)
sc->key_rest_symbol = s7_make_keyword(sc, "rest");
sc->key_readable_symbol = s7_make_keyword(sc, "readable");
+ sc->value_symbol = s7_make_symbol(sc, "value");
+ sc->type_symbol = s7_make_symbol(sc, "type");
+
sc->__func___symbol = make_symbol(sc, "__func__");
s7_make_slot(sc, sc->nil, sc->else_symbol = make_symbol(sc, "else"), sc->else_object);
sc->owlet = init_owlet(sc);
@@ -73712,6 +74195,7 @@ s7_scheme *s7_init(void)
sc->curlet_symbol = defun("curlet", curlet, 0, 0, false);
sc->unlet_symbol = defun("unlet", unlet, 0, 0, false);
set_immutable(sc->unlet_symbol);
+ /* unlet (and with-let) don't actually need to be immutable, but s7.html says they are... */
sc->sublet_symbol = defun("sublet", sublet, 1, 0, true);
sc->varlet_symbol = unsafe_defun("varlet", varlet, 1, 0, true);
sc->cutlet_symbol = unsafe_defun("cutlet", cutlet, 1, 0, true);
@@ -73937,6 +74421,7 @@ s7_scheme *s7_init(void)
sc->object_to_string_symbol = defun("object->string", object_to_string, 1, 1, false);
sc->format_symbol = defun("format", format, 1, 0, true);
/* this was unsafe, but was that due to the (ill-advised) use of temp_call_2 in the arg lists? */
+ sc->object_to_let_symbol = defun("object->let", object_to_let, 1, 0, false);
sc->cons_symbol = defun("cons", cons, 2, 0, false);
sc->car_symbol = defun("car", car, 1, 0, false);
@@ -74025,7 +74510,7 @@ s7_scheme *s7_init(void)
sc->int_vector_set_symbol = defun("int-vector-set!", int_vector_set, 3, 0, true);
sc->int_vector_ref_symbol = defun("int-vector-ref", int_vector_ref, 2, 0, true);
- sc->to_byte_vector_symbol = defun("->byte-vector", to_byte_vector, 1, 0, false);
+ sc->string_to_byte_vector_symbol = defun("string->byte-vector", string_to_byte_vector, 1, 0, false);
sc->byte_vector_symbol = defun("byte-vector", byte_vector, 0, 0, true);
sc->make_byte_vector_symbol = defun("make-byte-vector", make_byte_vector, 1, 1, false);
@@ -74385,10 +74870,11 @@ s7_scheme *s7_init(void)
(lambda (clause) \n\
(let ((val (eval (car clause)))) \n\
(if val \n\
- (if (null? (cdr clause)) (return val) \n\
- (if (null? (cddr clause)) \n\
- (return (cadr clause)) \n\
- (return (apply values (map quote (cdr clause))))))))) \n\
+ (return (if (null? (cdr clause)) \n\
+ val \n\
+ (if (null? (cddr clause)) \n\
+ (cadr clause) \n\
+ (apply values (map quote (cdr clause))))))))) \n\
clauses) \n\
(values))))");
@@ -74399,8 +74885,8 @@ s7_scheme *s7_init(void)
(let ((body ())) \n\
(apply lambda* args \n\
'(let ((result #<unspecified>)) \n\
- (let ((e (curlet))) \n\
- (for-each (lambda (f) (f e)) body) \n\
+ (let ((hook (curlet))) \n\
+ (for-each (lambda (hook-function) (hook-function hook)) body) \n\
result)) \n\
())))))");
@@ -74420,6 +74906,32 @@ s7_scheme *s7_init(void)
(set! ((funclet hook) 'body) lst) \n\
(error 'wrong-type-arg \"hook-functions must be a list of functions, each accepting one argument: ~S\" lst))))))");
+ s7_eval_c_string(sc, "(define-macro (let-temporarily vars . body) \n\
+ `(with-let (#_inlet :orig (#_curlet) \n\
+ :saved (#_list ,@(map car vars)) \n\
+ :new (#_list ,@(map cadr vars))) \n\
+ (when (memq #<undefined> saved) \n\
+ (error 'unbound-variable \"let-temporarily: ~A is unbound\" \n\
+ (car (list-ref ',vars (- (length saved) (length (memq #<undefined> saved))))))) \n\
+ (dynamic-wind \n\
+ (lambda () #f) \n\
+ (lambda () \n\
+ ,@(map (let ((ctr -1)) \n\
+ (lambda (v) \n\
+ (if (symbol? (car v)) \n\
+ `(set! (orig ',(car v)) (list-ref new ,(set! ctr (+ ctr 1)))) \n\
+ `(set! (with-let orig ,(car v)) (list-ref new ,(set! ctr (+ ctr 1))))))) \n\
+ vars) \n\
+ ,(and (pair? body) `(with-let orig , at body))) \n\
+ (lambda () \n\
+ ,@(map (let ((ctr -1)) \n\
+ (lambda (v) \n\
+ (if (symbol? (car v)) \n\
+ `(set! (orig ',(car v)) (list-ref saved ,(set! ctr (+ ctr 1)))) \n\
+ `(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))))) \n\
+ vars)))))");
+
+
/* -------- *unbound-variable-hook* -------- */
sc->unbound_variable_hook = s7_eval_c_string(sc, "(make-hook 'variable)");
s7_define_constant_with_documentation(sc, "*unbound-variable-hook*", sc->unbound_variable_hook,
@@ -74460,6 +74972,7 @@ s7_scheme *s7_init(void)
(define procedure-with-setter? dilambda?)\n\
(define make-random-state random-state) \n\
(define make-complex complex) \n\
+ (define ->byte-vector string->byte-vector) \n\
(define (procedure-arity obj) (let ((c (arity obj))) (list (car c) (- (cdr c) (car c)) (> (cdr c) 100000)))))");
#endif
@@ -74472,7 +74985,6 @@ s7_scheme *s7_init(void)
save_unlet(sc);
init_s7_let(sc); /* set up *s7* */
already_inited = true;
-
return(sc);
}
@@ -74531,55 +75043,30 @@ int main(int argc, char **argv)
/* --------------------------------------------------------------------
*
- * 12 | 13 | 14 | 15 | 16.0 16.1 16.2 16.7
+ * 12 | 13 | 14 | 15 | 16.0 16.7 16.8
*
- * s7test 1721 | 1358 | 995 | 1194 | 1122 1117 1295 1928
- * index 44.3 | 3291 | 1725 | 1276 | 1156 1158 1159 1166
- * teq | | | 6612 | 2380 2376 2382 2382
- * tauto 265 | 89 | 9 | 8.4 | 2638 2643 2644 2688
- * tcopy | | | 13.6 | 3204 3203 3204 3133
- * bench 42.7 | 8752 | 4220 | 3506 | 3230 3229 3218 3220
- * tform | | | 6816 | 3627 3589 3621 3709
- * tmap | | | 9.3 | 4176 4177 4173 4172
- * titer | | | 7503 | 5218 5219 5211 5235
- * thash | | | 50.7 | 8491 8484 8477 8496
- * lg | | | | 180.
+ * s7test 1721 | 1358 | 995 | 1194 | 1122 1928
+ * index 44.3 | 3291 | 1725 | 1276 | 1156 1166
+ * teq | | | 6612 | 2380 2382
+ * tauto 265 | 89 | 9 | 8.4 | 2638 2688
+ * tcopy | | | 13.6 | 3204 3133
+ * bench 42.7 | 8752 | 4220 | 3506 | 3230 3220
+ * tform | | | 6816 | 3627 3709
+ * tmap | | | 9.3 | 4176 4172
+ * titer | | | 7503 | 5218 5235
+ * thash | | | 50.7 | 8491 8496
+ * lg | | | | 180.
* | | | |
- * tgen | 71 | 70.6 | 38.0 | 12.0 11.7 11.8 11.8
- * tall 90 | 43 | 14.5 | 12.7 | 15.0 15.0 15.0 14.9
- * calls 359 | 275 | 54 | 34.7 | 37.1 37.0 37.2 39.1
+ * tgen | 71 | 70.6 | 38.0 | 12.0 11.8
+ * tall 90 | 43 | 14.5 | 12.7 | 15.0 14.9
+ * calls 359 | 275 | 54 | 34.7 | 37.1 39.1
*
* --------------------------------------------------------------------
*
* new snd version: snd.h configure.ac HISTORY.Snd NEWS barchive
*
- * mockery.scm needs documentation (and stuff.scm: doc cyclic-seq+stuff under circular lists)
- * cyclic-seq in stuff.scm, but current code is really clumsy
- * doc c_object_rf stuff? or how cload ties things into rf/sig
- * libutf8proc.scm doc/examples? cload gtk/sndlib
- * display of let can still get into infinite recursion! (as can a circular list in some weird way)
- * (> (length x) 1) and friends could be optimized by quitting as soon as possible
- * doc (set! (with-let...) ...) and let-temporarily? this could also be greatly optimized
- * with-let and unlet don't need to be constants
- * let-let -- first arg is let, rest are let vars being set, then body with-let
- * this could be a macro, but better built-in (generators)
- * (with-let! (e :x 32 :y 12) (+ x y)) where 'e has 'x and 'y fields
- * symbol as arg of eq? memq defined? case-selector: use gensym? [i.e. don't put make the computed symbol permanent]
- * maybe a freelist (or several) for hash_entry** in s7_make_hash_table (see free_hash_table)
- * but how to tie into a list without allocation?
- * provide/require should use keywords -- then require could be a function
- *
- * how to get at read-error cause in catch? port-data=string, port-position=int, port_data_size=int last-open-paren (sc->current_line)
- * port-data port-position, length=remaining (unread) chars, copy->string gets that data, so no need for new funcs
- * also port-filename|line-number could use let syntax, then maybe add position|data etc -- mock let like *s7*
- * gc troubles with the string wrapper. Another such case: iterator. But how to handle default port as in (port-line-number)?
- *
- * append: 44522: what if method not first arg? use 'values: check_values?
- * (append "asd" ((*mock-string* 'mock-string) "hi")): error: append argument 1, "hi", is mock-string but should be a character
- * s7 44522 -- method check is unfinished -- should look for append and make arglists, not length
- * (append "asd" ((*mock-char* 'mock-char) #\g)): error: append argument 1, #\g, is mock-char but should be a sequence
- * also arg num is incorrect -- always off by 1?
- * append in string case uses string_append, not g_string_append!
+ * with-set setter (op_set_with_let) still sometimes conses up the new expression
+ * if with_history, each func could keep a (circular) history of calls(args/results/stack), vars via symbol-access?
*
* Snd:
* dac loop [need start/end of loop in dac_info, reader goes to start when end reached (requires rebuffering)
@@ -74588,12 +75075,11 @@ int main(int argc, char **argv)
* use begs/other-ends to get loop points, so free_dac_info does not need to restart the loop(?)
* If start/end selection changed while playing, are these loop points updated?
*
- * check stdin-prompt and s7webserver
* gtk gl: I can't see how to switch gl in and out as in the motif version -- I guess I need both gl_area and drawing_area
- * the old mus-audio-* code needs to use play or something, especially bess* -- what about soundio
- * snd namespaces from <mark> etc mark: (inlet :type 'mark :name "" :home <channel> :sample 0 :sync #f) with name/sync/sample settable
- * when trying to display a big 128-channel file, Snd cores up until it crashes?
+ * the old mus-audio-* code needs to use play or something, especially bess*
* musglyphs gtk version is broken (probably cairo_t confusion)
* snd+gtk+script->eps fails?? Also why not make a graph in the no-gui case? t415.scm.
* remove as many edpos args as possible, and num+bool->num
+ * snd namespaces: clm2xen, dac, edits, fft, gxcolormaps, mix, region, snd
+ * for snd-mix, tie-ins are in place
*/
diff --git a/s7.h b/s7.h
index a2a7f1d..b4ec912 100644
--- a/s7.h
+++ b/s7.h
@@ -1,8 +1,8 @@
#ifndef S7_H
#define S7_H
-#define S7_VERSION "4.8"
-#define S7_DATE "30-May-16"
+#define S7_VERSION "4.10"
+#define S7_DATE "9-Aug-16"
typedef long long int s7_int; /* This sets the size of integers in Scheme; it needs to be big enough to accomodate a C pointer. */
typedef double s7_double; /* similarly for Scheme reals; only "double" works in C++ */
@@ -403,6 +403,7 @@ s7_pointer s7_set_curlet(s7_scheme *sc, s7_pointer e); /* r
s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e); /* (outlet e) */
s7_pointer s7_sublet(s7_scheme *sc, s7_pointer env, s7_pointer bindings); /* (sublet e ...) */
s7_pointer s7_inlet(s7_scheme *sc, s7_pointer bindings); /* (inlet ...) */
+s7_pointer s7_varlet(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value); /* (varlet env symbol value) */
s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer env); /* (let->list env) */
bool s7_is_let(s7_pointer e); /* )let? e) */
s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer sym); /* (let-ref e sym) */
@@ -475,6 +476,9 @@ s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function
s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
int required_args, int optional_args, bool rest_arg,
const char *doc, s7_pointer signature);
+s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg,
+ const char *doc, s7_pointer signature);
void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
@@ -775,6 +779,8 @@ s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args,
*
* s7 changes
*
+ * 9-Aug: s7_varlet.
+ * 29-Jul: s7_define_unsafe_typed_function.
* 30-May: symbol takes any number of args. make-vector no longer takes an optional fourth argument.
* 24-May: let-ref/set! check rootlet now if let is not an open let; setter for with-let.
* 20-Feb: removed last vestiges of quasiquoted vector support.
diff --git a/s7.html b/s7.html
index 54a44d7..11684b7 100644
--- a/s7.html
+++ b/s7.html
@@ -151,11 +151,11 @@ s7.h, that want only to disappear into someone else's source tree. There are no
no run-time init files, and no configuration scripts.
It can be built as a stand-alone
interpreter (see <a href="#repl">below</a>). s7test.scm is a regression test for s7.
-A tarball is available: ftp://ccrma-ftp.stanford.edu/pub/Lisp/s7.tar.gz.
+A tarball is available: <a href="ftp://ccrma-ftp.stanford.edu/pub/Lisp/s7.tar.gz">s7 tarball</a>.
</p>
<p>
-s7 is the default extension language of Snd and sndlib (http://ccrma.stanford.edu/software/snd/),
+s7 is the default extension language of Snd and sndlib (<a href="http://ccrma.stanford.edu/software/snd/index.html">snd</a>),
Rick Taube's Common Music (commonmusic at sourceforge), and Kjetil Matheussen's Radium music editor.
There are X, Motif, Gtk, and openGL bindings
in libxm in the Snd tarball, or at ftp://ccrma-ftp.stanford.edu/pub/Lisp/libxm.tar.gz.
@@ -1284,7 +1284,7 @@ control over the environment at any point:
; but (+ a b) is 15 because at that point + is *: (* 1 15)
</pre>
-<p>Hygenic macros are trivial! So s7 does not have syntax-rules because it is not needed.
+<p>Hygienic macros are trivial! So s7 does not have syntax-rules because it is not needed.
s7's lint.scm will warn you about any such problematic macro expansion, so I'd
say just write macros as simply as possible, then let lint tell you
that it's time to do the with-let shuffle. When that happens, wrap the macro body in
@@ -1732,7 +1732,7 @@ And of course:
<p>By my count, around 20 of the Scheme built-in functions are already generic in the sense
that they accept arguments of many types (leaving aside the numeric and type checking functions, take for example equal?, display,
member, assoc, apply, eval, quasiquote, and values). s7 extends that list with map, for-each, reverse,
-and length, and adds a few others such as copy, fill!, sort!, object->string, and append.
+and length, and adds a few others such as copy, fill!, sort!, object->string, object->let, and append.
newLisp takes a more radical approach than s7: it extends operators such as '>'
to compare strings and lists, as well as numbers. In map and for-each, however, you can mix the argument
types, so I'm not as attracted to making '>' generic; you can't, for example, <code>(> "hi" 32.1)</code>,
@@ -1752,6 +1752,7 @@ or even <code>(> 1 0+i)</code>.
(<em class=def id="fillb">fill!</em> sequence value (start 0) end)
(<em class=def id="s7copy">copy</em> obj) and (copy source destination (start 0) end)
(<em class=def id="objecttostring">object->string</em> obj)
+(object->let obj)
(length obj)
(append . sequences)
(map func . sequences) and (for-each func . sequences)
@@ -1863,7 +1864,7 @@ an integer as in the one dimensional case:
<pre class="indented">
(make-vector (list 2 3 4))
(make-vector '(2 3) 1.0)
-(vector-dimensions (make-vector (list 2 3 4))) -> (2 3 4)
+(vector-dimensions (make-vector '(2 3 4))) -> (2 3 4)
</pre>
<p>The second example includes the optional initial element.
@@ -1921,7 +1922,7 @@ homogeneous vector functions are currently built-in:
(<em class=def id="bytevectorp">byte-vector?</em> obj)
(<em class=def id="bytevector">byte-vector</em> . args)
(<em class=def id="makebytevector">make-byte-vector</em> len (init 0))
-(<em class=def id="tobytevector">->byte-vector</em> str)
+(<em class=def id="stringtobytevector">string->byte-vector</em> str)
</pre>
<p>but these are really just strings in disguise.</p>
</div>
@@ -1950,17 +1951,17 @@ homogeneous vector functions are currently built-in:
<pre>
(define (matrix-multiply A B)
;; assume square matrices and so on for simplicity
- (let* ((size (car (vector-dimensions A)))
- (C (make-vector (list size size) 0)))
- (do ((i 0 (+ i 1)))
+ (let ((size (car (vector-dimensions A))))
+ (do ((C (make-vector (list size size) 0))
+ (i 0 (+ i 1)))
((= i size) C)
(do ((j 0 (+ j 1)))
((= j size))
- (let ((sum 0))
- (do ((k 0 (+ k 1)))
- ((= k size))
- (set! sum (+ sum (* (A i k) (B k j)))))
- (set! (C i j) sum))))))
+ (do ((sum 0)
+ (k 0 (+ k 1)))
+ ((= k size)
+ (set! (C i j) sum))
+ (set! sum (+ sum (* (A i k) (B k j)))))))))
</pre>
</div>
@@ -2376,6 +2377,9 @@ Environments are first class (and applicable) objects in s7.
(<em class=def id="openlet">openlet</em> env) mark env as open (see below)
(<em class=def id="openletp">openlet?</em> env) #t is env is open
(<em class=def id="coverlet">coverlet</em> env) mark env as closed (undo an earlier openlet)
+
+(<em class=def id="objecttolet">object->let</em> obj) return an environment containing information about obj
+(<em class=def id="lettemporarily">let-temporarily</em> vars . body)
</pre>
<br>
@@ -2408,7 +2412,7 @@ contain the same symbols with the same values leaving aside shadowing, and takin
chain up to the rootlet. That is, two environments are equal if any local variable of either has the same value in both.
</p>
-<p>with-let evaluates its body in the given environment, so
+<p><b>with-let</b> evaluates its body in the given environment, so
<code>(with-let e . body)</code> is equivalent to
<code>(eval `(begin , at body) e)</code>, but probably faster.
Similarly, <code>(let bindings . body)</code> is equivalent to
@@ -2436,17 +2440,32 @@ Or better,
(+ a b c)))
</pre>
+
+<p><b>let-temporarily</b> (now built-into s7) is somewhat similar to fluid-let in other Schemes.
+Its syntax looks like
+let, but it first saves the current value, then sets the
+variable to the new value (via set!), calls the body, and finally restores the
+original value. It can handle anything settable:
+</p>
+<pre class="indented">
+(let-temporarily (((*s7* 'print-length) 8)) (display x))
+</pre>
+<p>This sets s7's print-length variable to 8 while displaying x, then
+puts it back to its original value.
+</p>
+
+
<p>
-sublet adds bindings (symbols with associated values) to an environment.
+<b>sublet</b> adds bindings (symbols with associated values) to an environment.
It does not change the environment passed to it, but
just prepends the new bindings, shadowing any old ones,
as if you had called "let".
To add the bindings directly to the environment,
-use varlet. Both of these functions accept nil as the
+use <b>varlet</b>. Both of these functions accept nil as the
'env' argument as shorthand for <code>(rootlet)</code>.
Both also accept other environments as well as individual bindings,
adding all the argument's bindings to the new environment.
-inlet is very similar, but normally omits the environment argument.
+<b>inlet</b> is very similar, but normally omits the environment argument.
The arguments to sublet and inlet can be passed as
symbol/value pairs, as a cons, or using keywords as if in define*.
inlet can also be used to copy an environment without accidentally invoking
@@ -2512,7 +2531,9 @@ As mentioned in the macro section, #_<name> is a built-in reader macro
for <code>(with-let (unlet) <name>)</code>,
so for example, #_+ is the built-in + function, no matter what.
<code>(unlet)</code> cleans up the current environment whenever it's called,
-so you can use it to revert the REPL.
+so you can use it to revert the REPL. (The environment of built-in functions
+that unlet accesses is not accessible from scheme code, so there's no way
+that those values can be clobbered).
</p>
<blockquote>
@@ -2639,7 +2660,7 @@ such as abs, we need to put it back to its original form:
</blockquote>
-<p>openlet marks its argument, either an environment, a closure, or a c-object
+<p><b>openlet</b> marks its argument, either an environment, a closure, or a c-object
as open. I need better terminology here! An open object is one that the
built-in s7 functions handle specially. If they encounter one in their
argument list, they look in the object for their own name, and call that
@@ -2679,6 +2700,28 @@ A slightly more complex example:
and openlet? -> methods?.
</p>
+<p><b>object->let</b> returns an environment (more of a dictionary really) that
+contains details about its argument. It
+is intended as a debugging aid, underlying a debugger's "inspect" for example.
+</p>
+
+<pre class="indented">
+> (let ((iter (make-iterator "1234")))
+ (iter)
+ (iter)
+ (object->let iter))
+<em class="gray">(inlet 'value #<iterator: string> 'type iterator? 'at-end #f 'sequence "1234" 'length 4 'position 2)</em>
+</pre>
+
+<p>A c-object (in the sense of s7_new_type), can add its own info to this namespace via an object->let
+method in its local environment. snd-marks.c has a simple example using a class-wide environment (g_mark_methods),
+holding as the value of its 'object->let field the function s7_mark_to_let. The latter uses s7_varlet to
+add information to the namespace created by <code>(object->let mark)</code>.
+</p>
+
+<br>
+
+
<blockquote>
<details>
@@ -4784,9 +4827,9 @@ so this seems like a natural convention.
(g_signal_connect (G_OBJECT (listener-text-widget *listener*)) "motion_notify_event"
(lambda (w e d)
- (let ((mxy (gdk_event_get_coords (GDK_EVENT e))))
- (set! *mouse-x* (cadr mxy))
- (set! *mouse-y* (caddr mxy))))))
+ (let ((mxy (cdr (gdk_event_get_coords (GDK_EVENT e)))))
+ (set! *mouse-x* (car mxy))
+ (set! *mouse-y* (cadr mxy))))))
</pre>
<!--
@@ -4875,10 +4918,10 @@ the directory:
<pre class="indented">
(set! (hook-functions <em class=red>*load-hook*</em>)
(list (lambda (hook)
- (let* ((pos -1)
- (filename (hook 'name))
- (len (length filename)))
- (do ((i 0 (+ i 1)))
+ (let ((pos -1)
+ (filename (hook 'name)))
+ (do ((len (length filename))
+ (i 0 (+ i 1)))
((= i len))
(if (char=? (filename i) #\/)
(set! pos i)))
@@ -5457,7 +5500,7 @@ is simply returned, unevaluated.
`(display ',(car args))
(list 'begin
`(display ',(car args))
- (apply macroexpand (list (append '(rmac) (cdr args))))))))
+ (apply macroexpand (list (cons 'rmac (cdr args))))))))
> (macroexpand (rmac a b c))
<em class="gray">(begin (display 'a) (begin (display 'b) (display 'c)))</em>
@@ -6594,6 +6637,24 @@ M-x run-scheme, and you're talking to s7 in emacs. Of course, this connection c
customized indefinitely. See, for example, inf-snd.el in the Snd package.
</p>
+<p>Here are the not-always-built-in indentations I use in emacs:
+</p>
+<pre class="indented">
+(put 'with-let 'scheme-indent-function 1)
+(put 'with-baffle 'scheme-indent-function 0)
+(put 'with-sound 'scheme-indent-function 1)
+(put 'catch 'scheme-indent-function 1)
+(put 'lambda* 'scheme-indent-function 1)
+(put 'when 'scheme-indent-function 1)
+(put 'let-temporarily 'scheme-indent-function 1)
+(put 'let*-temporarily 'scheme-indent-function 1)
+(put 'call-with-input-string 'scheme-indent-function 1)
+(put 'unless 'scheme-indent-function 1)
+(put 'letrec* 'scheme-indent-function 1)
+(put 'sublet 'scheme-indent-function 1)
+(put 'varlet 'scheme-indent-function 1)
+</pre>
+
<p>To read stdin while working in a GUI-based program is trickier. In glib/gtk, you can use
something like this:
</p>
@@ -9255,7 +9316,8 @@ To try it:
</pre>
-<p>lint tries to reduce false positives, so its default behavior is somewhat laconic. There are several
+<p>
+There are several
variables at the start of lint.scm to control additional output:
</p>
@@ -9271,7 +9333,6 @@ variables at the start of lint.scm to control additional output:
*report-one-armed-if*
*report-loaded-files*
*report-any-!-as-setter*
-*report-function-stuff*
*report-doc-strings*
*report-func-as-arg-arity-mismatch*
*report-constant-expressions-in-do*
diff --git a/s7test.scm b/s7test.scm
index cd17e22..c558998 100644
--- a/s7test.scm
+++ b/s7test.scm
@@ -124,14 +124,14 @@
(define (set-current-input-port port) (error 'undefined-function "set-current-input-port is not in pure-s7"))
(define (exact? n)
- (if (not (number? n))
- (error 'wrong-type-arg "exact? argument should be a number: ~A" n)
- (rational? n)))
+ (if (number? n)
+ (rational? n)
+ (error 'wrong-type-arg "exact? argument should be a number: ~A" n)))
(define (inexact? x)
- (if (not (number? x))
- (error 'wrong-type-arg "inexact? argument should be a number: ~A" x)
- (not (rational? x))))
+ (if (number? x)
+ (not (rational? x))
+ (error 'wrong-type-arg "inexact? argument should be a number: ~A" x)))
(define (inexact->exact x)
(if (not (number? x))
@@ -141,9 +141,9 @@
(rationalize x))))
(define (exact->inexact x)
- (if (not (number? x))
- (error 'wrong-type-arg "exact->inexact argument should be a number: ~A" x)
- (* x 1.0)))
+ (if (number? x)
+ (* x 1.0)
+ (error 'wrong-type-arg "exact->inexact argument should be a number: ~A" x)))
(define (integer-length i)
(if (integer? i)
@@ -293,9 +293,6 @@
(define (op-error op result expected)
- (define (conjugate n)
- (complex (real-part n) (- (imag-part n))))
-
(if (and (real? result)
(real? expected))
(/ (abs (- result expected)) (max 1.0 (abs expected)))
@@ -324,7 +321,7 @@
(max 0.001 (magnitude (tan expected)))))
((cosh)
(/ (min (magnitude (- result expected))
- (magnitude (- result (- expected))))
+ (magnitude (+ result expected)))
(max 0.001 (magnitude expected))))
(else (/ (magnitude (- result expected)) (max 0.001 (magnitude expected)))))))
@@ -336,8 +333,8 @@
(define (number-ok? tst result expected)
(if (and (not (eq? result expected))
- (or (and (not (number? expected))
- (not (eq? result expected)))
+ (or (not (or (number? expected)
+ (eq? result expected)))
(and (number? expected)
(nan? expected)
(not (nan? result)))
@@ -351,14 +348,13 @@
(and (rational? expected)
(rational? result)
(not (= result expected)))
- (and (or (rational? expected)
+ (and (or (rational? expected)
(rational? result))
(real? expected)
(real? result)
(> (/ (abs (- result expected)) (max 1.0 (abs expected))) error-12))
(and (pair? tst)
(> (op-error (car tst) result expected) error-6))))
-
(format-logged #t "~A: ~A got ~A~Abut expected ~A~%~%"
(port-line-number) tst result
(if (and (rational? result) (not (rational? expected)))
@@ -370,7 +366,7 @@
(let ((result (catch #t ola
(lambda args
'error))))
- (number-ok? otst result oexp)))
+ (number-ok? otst result oexp)))
(if (not (defined? 'num-test))
(define-macro (num-test tst expected) ;(display tst *stderr*) (newline *stderr*)
@@ -409,6 +405,7 @@
(define _ht_ (make-hash-table))
+
;;; --------------------------------------------------------------------------------
;;; before starting, make a test c-object
@@ -983,10 +980,11 @@ void block_init(s7_scheme *sc)
s7_define_function(sc, \"block-reverse!\", g_block_reverse_in_place, 1, 0, true, g_block_reverse_in_place_help);
s7_define_function(sc, \"block?\", g_is_block, 1, 0, false, g_is_block_help);
s7_define_function_star(sc, \"blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\");
- g_block_methods = s7_eval_c_string(sc, \"(inlet 'float-vector? (lambda (p) #t) \
- 'subsequence subblock \
- 'append block-append \
- 'reverse! block-reverse!)\");
+ g_block_methods = s7_eval_c_string(sc, \"(openlet (inlet 'float-vector? (lambda (p) #t) \
+ 'object->let (lambda (p e) (varlet e :empty (zero? (length p)))) \
+ 'subsequence subblock \
+ 'append block-append \
+ 'reverse! block-reverse!))\");
s7_gc_protect(sc, g_block_methods);
s7_object_type_set_xf(g_block_type, NULL, NULL, block_rf, block_set_rf);
s7_object_type_set_direct(g_block_type, block_direct_ref, block_direct_set);
@@ -5903,24 +5901,24 @@ zzy" (lambda (p) (eval (read p))))) 32)
;; should (vector? #u8(1 2)) be #t?
(test (format #f "~{~A ~}" (byte-vector 255 0)) "255 0 ")
-;;; ->byte-vector
-(test (byte-vector? (->byte-vector (string #\0))) #t)
-(test (byte-vector? (->byte-vector "")) #t)
-(test (byte-vector? (->byte-vector "1230")) #t)
-(test (byte-vector? (->byte-vector (->byte-vector (string #\0)))) #t)
-(test (byte-vector? (->byte-vector (string))) #t)
-(test (byte-vector? (->byte-vector #u8(1 2))) #t)
-(test (byte-vector? (->byte-vector #u8())) #t)
-(test (byte-vector? (->byte-vector #(1 2))) 'error)
+;;; string->byte-vector
+(test (byte-vector? (string->byte-vector (string #\0))) #t)
+(test (byte-vector? (string->byte-vector "")) #t)
+(test (byte-vector? (string->byte-vector "1230")) #t)
+(test (byte-vector? (string->byte-vector (string->byte-vector (string #\0)))) #t)
+(test (byte-vector? (string->byte-vector (string))) #t)
+(test (byte-vector? (string->byte-vector #u8(1 2))) #t)
+(test (byte-vector? (string->byte-vector #u8())) #t)
+(test (byte-vector? (string->byte-vector #(1 2))) 'error)
(test (byte-vector? (string-append #u8(1 2) #u8(3 4))) #t)
(for-each
(lambda (arg)
- (test (->byte-vector arg) 'error)
+ (test (string->byte-vector arg) 'error)
(test (byte-vector? arg) #f))
(list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
;;; an experiment:
-(test (->byte-vector #x010203) #u8(3 2 1 0 0 0 0 0))
+(test (string->byte-vector #x010203) #u8(3 2 1 0 0 0 0 0))
;;; make-byte-vector
(test (equal? (make-byte-vector 0) #u8()) #t)
@@ -5950,10 +5948,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (map append #u8(0 1 2)) '(0 1 2))
(test (format #f "~{#x~X~| ~}" #u8(49 50 51)) "#x31 #x32 #x33")
-(test (format #f "~{~D~| ~}" (->byte-vector "abcd")) "97 98 99 100")
+(test (format #f "~{~D~| ~}" (string->byte-vector "abcd")) "97 98 99 100")
(test (let ((lst ())) (for-each (lambda (c) (set! lst (cons c lst))) #u8(90 91 92)) (reverse lst)) '(90 91 92))
(test (integer? (#u8(1 2 3) 0)) #t)
-(test (integer? ((->byte-vector "abc") 1)) #t)
+(test (integer? ((string->byte-vector "abc") 1)) #t)
(test ((vector (byte-vector 1)) 0 0) 1) ; i.e. not a character
@@ -8553,8 +8551,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
;;; generic append
(test (append "asdasd" '("asd")) 'error)
(test (append "asdasd" #("asd")) 'error)
-(test (append (->byte-vector "asdasd") '("asd")) 'error)
-(test (append (->byte-vector "asdasd") #("asd")) 'error)
+(test (append (string->byte-vector "asdasd") '("asd")) 'error)
+(test (append (string->byte-vector "asdasd") #("asd")) 'error)
(test (let ((h1 (hash-table* 'a 1 'b 2)) (h2 (hash-table* 'c 3))) (append h1 h2)) (hash-table '(c . 3) '(a . 1) '(b . 2)))
(test (let ((i1 (inlet 'a 1)) (i2 (inlet 'b 2 'c 3))) (append i1 i2)) (inlet 'a 1 'c 3 'b 2))
@@ -9807,7 +9805,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(do ((i 0 (+ i 1)))
((= i size))
(set! strs (cons (make-string size (integer->char (+ 1 (random 255)))) strs))
- (set! bvecs (cons (->byte-vector (make-string size (integer->char (random 256)))) bvecs))
+ (set! bvecs (cons (string->byte-vector (make-string size (integer->char (random 256)))) bvecs))
(set! vecs (cons (make-vector size i) vecs))
(set! ivecs (cons (make-int-vector size i) ivecs))
(set! fvecs (cons (make-float-vector size (* i 1.0)) fvecs))
@@ -9821,7 +9819,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(ifvec (apply vector-append ifvecs))
(allvec (apply vector-append allvecs))
(str (apply string-append strs))
- (bvec (->byte-vector (apply string-append bvecs))))
+ (bvec (string->byte-vector (apply string-append bvecs))))
(test (vector? vec) #t)
(test (length vec) (* size size))
(test (float-vector? fvec) #t)
@@ -18692,7 +18690,6 @@ c"
(test (object->string (inlet 'a (call/cc (lambda (return) return))) :readable) "(inlet 'a continuation)")
;;; these are incorrect:
-;(test (object->string (let ((b 1)) (set! (symbol-access 'b) (lambda (val) val)) (curlet)) :readable) "(inlet 'b 1)")
;(test (object->string (let () (define-constant a 32) (curlet)) :readable) "(inlet 'a 32)")
;(test (object->string #('1)) "(vector '1)")
;(test (object->string (inlet 'a ''()) :readable) "(inlet 'a '())")
@@ -19435,6 +19432,30 @@ c"
(hi)
(hi))
+;; this caught me -- Guile returns 6 3 also
+(test (let ((fnc #f))
+ (for-each
+ (let ((ctr 0))
+ (lambda (x)
+ (if (= ctr 3)
+ (set! fnc (lambda () ctr)))
+ (set! ctr (+ ctr 1))))
+ '(1 2 3 4 5 6))
+ (fnc))
+ 6)
+
+(test (let ((fnc #f))
+ (for-each
+ (let ((ctr 0))
+ (lambda (x)
+ (if (= ctr 3)
+ (set! fnc (let ((local-ctr ctr))
+ (lambda () local-ctr))))
+ (set! ctr (+ ctr 1))))
+ '(1 2 3 4 5 6))
+ (fnc))
+ 3)
+
(let ((x 0))
(let ((p1 (dilambda (lambda (a) (set! x (+ x a))) (lambda (a b) (+ a b)))))
(for-each p1 '(1 2 3))
@@ -22921,23 +22942,6 @@ in s7:
(define* (f2 (a (f1)) (b (f1 2))) (list a b))
(test (f2) '(3 5)))
-(let ()
- (define-macro (define-f*xpr name-and-args . body)
- `(define ,(car name-and-args)
- (apply define-expansion
- (append (list (append (list (gensym)) ',(cdr name-and-args))) ',body))))
-
- (define-f*xpr (quoth x) x)
- (test (quoth a) 'a)
- (test (quoth (+ 1 2)) '(+ 1 2))
-
- (define-f*xpr (mac a) `(+ ,a 1))
- (test (mac (* 2 3)) '(+ (* 2 3) 1))
-
- (define-f*xpr (mac1 a . b) `(, at b ,a))
- (test (mac1 1 2 3) '(2 3 1)))
-
-
;;; --------------------------------------------------------------------------------
@@ -23610,6 +23614,11 @@ in s7:
(test (a1) 32)
(test (a1 1) 1))
+(test (let ((f1 (lambda (x) (+ x 1))))
+ (define f1 (lambda (y) (if (zero? y) y (f1 (- y 1)))))
+ (f1 3))
+ 0)
+
(test (let ((x 1)) (cond (else (define x 2))) x) 2)
(test (let ((x 1)) (and (define x 2)) x) 2)
(test (let () (begin 1)) 1)
@@ -28609,8 +28618,8 @@ who says the continuation has to restart the map from the top?
(test (let* ((a (gensym)) (b a)) (eqv? a b)) #t)
(test (keyword? (symbol->keyword (gensym))) #t)
(test (let ((g (gensym))) (set! g 12) g) 12)
-(test (->byte-vector (substring (symbol->string (gensym #u8(124 255 127))) 0 5)) #u8(123 124 255 127 125))
-(test (->byte-vector (substring (symbol->string (gensym #u8(124 0 127))) 0 3)) #u8(123 124 125)) ; nul->end of symbol string
+(test (string->byte-vector (substring (symbol->string (gensym #u8(124 255 127))) 0 5)) #u8(123 124 255 127 125))
+(test (string->byte-vector (substring (symbol->string (gensym #u8(124 0 127))) 0 3)) #u8(123 124 125)) ; nul->end of symbol string
(let ((sym (gensym)))
(test (eval `(let ((,sym 32)) (+ ,sym 1))) 33))
@@ -31870,7 +31879,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature cdaar) '(#t pair?))
(test (procedure-signature set-car!) '(#t pair? #t))
(test (procedure-signature lcm) (let ((L (list 'rational?))) (set-cdr! L L) L))
-(test (procedure-signature ->byte-vector) '(byte-vector? string?))
+(test (procedure-signature string->byte-vector) '(byte-vector? string?))
(test (procedure-signature magnitude) '(real? number?))
(test (procedure-signature cddaar) '(#t pair?))
(test (procedure-signature list-tail) '(list? pair? integer?))
@@ -32310,12 +32319,30 @@ func
(oops #f))))))))))
#t)))
-(test (let () (define (f1 a) __func__) (f1 1)) 'f1)
-(test (let () (define (f1 a) (define (f2 b) __func__) (f2 a)) (f1 1)) 'f2)
-(test (let () (define (f1 a) (define (f2 b) (define (f3 c) __func__) (f3 b)) (f2 a)) (f1 2)) 'f3)
-(test (let () (define (f1 a) (define (f2 b) (define (f3 c) (define (f4 d) __func__) (f4 c)) (f3 b)) (f2 a)) (f1 1)) 'f4)
-(test (let () (define (f1 a) (let () (define (f2 b) __func__) (f2 a))) (f1 1)) 'f2)
-;(test (with-let (funclet dilambda) __func__) 'dilambda) ; make-procedure-with-setter!?
+(test (let () (define (f1 a) __func__) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f1)
+(test (let () (define (f1 a)
+ (define (f2 b) __func__)
+ (f2 a))
+ (let ((fe (f1 1))) (if (pair? fe) (car fe) fe)))
+ 'f2)
+(test (let () (define (f1 a)
+ (define (f2 b)
+ (define (f3 c) __func__)
+ (f3 b))
+ (f2 a))
+ (let ((fe (f1 2))) (if (pair? fe) (car fe) fe)))
+ 'f3)
+(test (let () (define (f1 a)
+ (define (f2 b)
+ (define (f3 c)
+ (define (f4 d) __func__)
+ (f4 c))
+ (f3 b))
+ (f2 a))
+ (let ((fe (f1 1)))
+ (if (pair? fe) (car fe) fe)))
+ 'f4)
+(test (let () (define (f1 a) (let () (define (f2 b) __func__) (f2 a))) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f2)
(test (with-let (funclet abs) __func__) #<undefined>)
(test (with-let (funclet quasiquote) __func__) #<undefined>)
(test (with-let (funclet reader-cond) __func__) #<undefined>)
@@ -34850,6 +34877,30 @@ func
(set! (with-let a (abc)) 3)
(test ((a 'abc)) 3))
+(let ((lt1 (inlet 'a 1 'b 2)))
+ (set! (with-let lt1 a) 32)
+ (test (lt1 'a) 32)
+ (set! (with-let lt1 a) (with-let lt1 (+ a b)))
+ (test (lt1 'a) 34)
+ (set! (with-let (curlet) (*s7* 'print-length)) 16)
+ (test (*s7* 'print-length) 16)
+ (varlet lt1 'c (vector 1 2 3))
+ (set! (with-let lt1 (c 1)) 12)
+ (test ((lt1 'c) 1) 12)
+ (let ((lt2 (list lt1)))
+ (set! (with-let (car lt2) (c 0)) 11)
+ (test ((lt1 'c) 0) 11))
+ (let ((lt2 (list lt1))
+ (d 100))
+ (set! (with-let (car lt2) (c (sqrt 4))) (sqrt d))
+ (test ((lt1 'c) 2) 10))
+ (let ((lt3 (inlet 'a (vector 1 2 3))))
+ (set! (with-let lt3 a) '(1 2))
+ (test (lt3 'a) '(1 2)))
+ (let ((lt3 (inlet 'a (vector 1 2 3) 'b 1)))
+ (set! (with-let lt3 a) 'b)
+ (test (lt3 'a) 'b)))
+
(for-each
(lambda (arg)
(test (inlet arg) 'error)
@@ -36307,7 +36358,197 @@ func
(test ((owlet) 'error-file) error-file)
))
+;;; --------------------------------------------------------------------------------
+;;; object->let
+
+(test (object->let) 'error)
+(test (object->let 12 21) 'error)
+
+(test (object->let ()) (inlet :value () :type 'null?))
+(test (object->let #<unspecified>) (inlet :value #<unspecified> :type #<unspecified>))
+(test (object->let #<undefined>) (inlet :value #<undefined> :type #<undefined>))
+(test (object->let else) (inlet :value else :type else))
+(test (object->let with-baffle) (inlet :value with-baffle :type 'syntax?))
+(test (object->let #<eof>) (inlet :value #<eof> :type 'eof-object?))
+(test (object->let #t) (inlet :value #t :type 'boolean?))
+
+(test (object->let 'abc) (inlet :value 'abc :type 'symbol?))
+(test (object->let :abc) (inlet :value :abc :type 'keyword?))
+(test (object->let #\space) (inlet :value #\space :type 'char?))
+
+(test (object->let 123) (inlet :value 123 :type 'integer?))
+(test (object->let 1/2) (inlet :value 1/2 :type 'rational?))
+(test (object->let 1.0) (inlet :value 1.0 :type 'real?))
+(test (object->let 1+i) (inlet :value 1+i :type 'complex?))
+(when with-bignums
+ (test (object->let (bignum "123")) (inlet :value (bignum "123") :type 'integer?))
+ (test (object->let (bignum "1/2")) (inlet :value (bignum "1/2") :type 'rational?))
+ (test (object->let (bignum "1.0")) (inlet :value (bignum "1.0") :type 'real?))
+ (test (object->let (bignum "1+i")) (inlet :value (bignum "1+i") :type 'complex?)))
+
+(test (object->let "abc") (inlet :value "abc" :type 'string? :length 3))
+(test (object->let (byte-vector 1 2 3)) (inlet :value (byte-vector 1 2 3) :type 'byte-vector? :length 3))
+(test (object->let (cons 1 2)) (inlet :value (cons 1 2) :type 'pair? :length -1))
+(test (object->let (c-pointer 0)) (inlet :value (c-pointer 0) :type 'c-pointer? :s7-value #f))
+
+(let ((c #f))
+ (call/cc (lambda (f) (set! c f)))
+ (let ((obj (object->let c)))
+ (test (obj 'value) c)
+ (test (obj 'type) 'continuation?)
+ (test (pair? (obj 'stack)) #t)))
+(let ((c #f))
+ (call-with-exit (lambda (f) (set! c f)))
+ (test (object->let c) (inlet :value c :type 'goto? :active #f)))
+(call-with-exit (lambda (f) (test (object->let f) (inlet :value f :type 'goto? :active #t))))
+
+(let ((r (random-state 1234)))
+ (test (object->let r) (inlet :value r :type 'random-state? :seed 1234 :carry 1675393560)))
+
+(test (object->let (vector 1 2 3)) (inlet :value (vector 1 2 3) :type 'vector? :length 3 :dimensions '(3) :shared #f))
+(test (object->let (int-vector 1 2 3)) (inlet :value (int-vector 1 2 3) :type 'int-vector? :length 3 :dimensions '(3) :shared #f))
+(test (object->let (float-vector 1 2 3)) (inlet :value (float-vector 1 2 3) :type 'float-vector? :length 3 :dimensions '(3) :shared #f))
+(let ((v (make-shared-vector (vector 1 2 3) 2 1)))
+ (test (object->let v) (inlet :value (vector 2 3) :type 'vector? :length 2 :dimensions '(2) :shared #(1 2 3))))
+(test (object->let (make-vector '(2 3 4) #f))
+ (inlet :value (make-vector '(2 3 4) #f) :type 'vector? :length 24 :dimensions '(2 3 4) :shared #f))
+
+(let ((iter (make-iterator '(1 2 3))))
+ (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence '(1 2 3) :length 3 :position '(1 2 3))))
+(let ((iter (make-iterator #(1 2 3))))
+ (iter)
+ (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence #(1 2 3) :length 3 :position 1)))
+(let ((iter (make-iterator "1234")))
+ (iter)
+ (iter)
+ (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence "1234" :length 4 :position 2)))
+(let ((iter (make-iterator (int-vector 1 2))))
+ (iter)
+ (iter)
+ (iter)
+ (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #t :sequence (int-vector 1 2) :length 2 :position 2)))
+
+(let ((h (hash-table* :a 1 :b 2))) (test (object->let h) (inlet :value h :type 'hash-table? :length 8 :entries 2 :locked #f :function 'eq?)))
+(let ((h (hash-table* 1 1 2 2))) (test (object->let h) (inlet :value h :type 'hash-table? :length 8 :entries 2 :locked #f :function '=)))
+(let ((h (make-hash-table 8 string=?))) (test (object->let h) (inlet :value h :type 'hash-table? :length 8 :entries 0 :locked #t :function 'string=?)))
+
+(let ((e (inlet 'a 1 'b 2))) (test (object->let e) (inlet :value e :type 'let? :length 2 :open #f :outlet ())))
+(test (object->let (rootlet)) (inlet :value (rootlet) :type 'let? :length (length (rootlet)) :open #f :outlet () :alias 'rootlet))
+;(test (object->let (owlet)) (inlet :value (owlet) :type 'let? :length (length (owlet)) :open #f :outlet () :alias 'owlet))
+
+(let ((e (openlet (inlet 'a 1 'b 2 'object->let (lambda (p lt) (varlet lt 'a+b (+ (p 'a) (p 'b))))))))
+ (test (object->let e) (inlet :value e :type 'let? :length 3 :open #t :outlet () 'a+b 3)))
+
+(let ()
+ (define (fff x) (+ x 1))
+ (let ((e (funclet fff)))
+ (test (object->let e)
+ (inlet 'value e :type 'let? :length 1 :open #f :outlet (inlet 'fff fff) :function 'fff :file "s7test.scm" :line (port-line-number)))))
+(let ((e (openlet (inlet :abs (lambda (x) (- x 1))))))
+ (test (object->let e) (inlet :value e :type 'let? :length 1 :open #t :outlet ())))
+
+(if with-block
+ (let* ((b (make-block 8))
+ (bl (object->let b)))
+ (test (let? bl) #t)
+ (test (bl 'value) b)
+ (test (bl 'length) 8)
+ (test (bl 'type) 'c-object?)
+ (test (bl 'class) "#<block>")
+ (test (integer? (bl 'c-type)) #t)
+ (test (bl 'empty) #f)
+ (test (let? (bl 'let)) #t)))
+(when (provided? 'snd)
+ (when (or (provided? 'snd-gtk)
+ (provided? 'snd-motif))
+ (let ((cl (object->let jet-colormap)))
+ (test (let? cl) #t)
+ (test (cl 'value) jet-colormap)
+ (test (cl 'length) 512)
+ (test (cl 'type) 'c-object?)
+ (test (cl 'class) "<colormap>")
+ (test (integer? (cl 'c-type)) #t)
+ (test (null? (cl 'let)) #t)))
+ (let ((cl (object->let fourier-transform)))
+ (test (let? cl) #t)
+ (test (cl 'value) fourier-transform)
+ (test (integer? (cl 'length)) #t)
+ (test (cl 'type) 'c-object?)
+ (test (cl 'class) "<transform>")
+ (test (integer? (cl 'c-type)) #t)
+ (test (null? (cl 'let)) #t)))
+
+(test (object->let *stderr*) (inlet :value *stderr* :type 'output-port? :port-type 'file :closed #f :file "*stderr*"))
+(test (object->let *stdin*) (inlet :value *stdin* :type 'input-port? :port-type 'file :closed #f :file "*stdin*" :line 0))
+(with-input-from-string "1234"
+ (lambda ()
+ (read-char)
+ (test (object->let (current-input-port))
+ (inlet :value (current-input-port) :type 'input-port? :port-type 'string :closed #f :length 4 :position 1 :data "1234"))))
+(call-with-output-string
+ (lambda (p)
+ (display 123 p)
+ (let ((e (object->let p)))
+ (test (e 'type) 'output-port?)
+ (test (e 'port-type) 'string)
+ (test (e 'length) 128)
+ (test (e 'position) 3)
+ (test (substring (e 'data) 0 3) "123"))))
+(let ((e #f))
+ (call-with-output-string
+ (lambda (p)
+ (display 123 p)
+ (set! e p)))
+ (test (object->let e) (inlet :value e :type 'output-port? :port-type 'string :closed #t)))
+
+(let ()
+ (define (ff1 x y) (+ x y))
+ (test (object->let ff1) (inlet 'value ff1 'type 'procedure? 'arity '(2 . 2) 'file "s7test.scm" 'line (port-line-number) 'source '(lambda (x y) (+ x y)))))
+(let ()
+ (define (ff2 . x) (apply + x))
+ (test (object->let ff2) (inlet 'value ff2 'type 'procedure? 'arity '(0 . 536870912) 'file "s7test.scm" 'line (port-line-number) 'source '(lambda x (apply + x)))))
+(let ()
+ (define* (ff3 x y) (+ x y))
+ (test (object->let ff3) (inlet 'value ff3 'type 'procedure? 'arity '(0 . 2) 'file "s7test.scm" 'line (port-line-number) 'source '(lambda* (x y) (+ x y)))))
+(call-with-output-file "empty-file"
+ (lambda (p)
+ (format p ";;; this is a test of file/line data in object->let~%~%")
+ (format p "(define (ff4 x)~% (+ (log x) 1))~%~%(set! (procedure-setter ff4) set-car!)~%~%")))
+(let ()
+ (load "empty-file" (curlet))
+ (test (object->let ff4)
+ (inlet 'value ff4 'type 'procedure? 'arity '(1 . 1) 'file "empty-file" 'line 4 'setter set-car! 'source '(lambda (x) (+ (log x) 1)))))
+(test (object->let abs)
+ (inlet 'value abs 'type 'procedure? 'arity '(1 . 1) 'signature '(real? real?) 'documentation "(abs x) returns the absolute value of the real number x"))
+(if with-block
+ (test (object->let make-block)
+ (inlet 'value make-block 'type 'procedure? 'arity '(1 . 1) 'documentation "(make-block size) returns a new block of the given size")))
+(test (object->let string=?)
+ (inlet 'value string=?
+ 'type 'procedure?
+ 'arity '(2 . 536870912)
+ 'signature (let ((lst (list 'boolean? 'string?)))
+ (set-cdr! (cdr lst) (cdr lst))
+ lst)
+ 'documentation "(string=? str ...) returns #t if all the string arguments are equal"))
+(test (object->let car)
+ (inlet 'value car 'type 'procedure? 'arity '(1 . 1) 'signature '(#t pair?)
+ 'documentation "(car pair) returns the first element of the pair"
+ 'setter set-car!))
+(test (object->let quasiquote)
+ (inlet 'value quasiquote 'type 'macro? 'arity '(1 . 1)
+ 'documentation "(quasiquote arg) is the same as `arg. If arg is a list, it can contain comma (\"unquote\") and comma-atsign (\"apply values\") to pre-evaluate portions of the list. unquoted expressions are evaluated and plugged into the list, apply-values evaluates the expression and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -> (1 2 3 4)."))
+(let ()
+ (define-macro (1+ x) `(+ ,x 1))
+ (let ((e (object->let 1+)))
+ (test (e 'value) 1+)
+ (test (e 'type) 'macro?)
+ (test (e 'arity) '(1 . 1))
+ (test (e 'source) '(lambda (x) (#_{list} '+ x 1)))))
+
+
+;;; --------------------------------------------------------------------------------
;;; stacktrace
(test (string? (stacktrace)) #t)
@@ -36826,7 +37067,7 @@ hi6: (string-app...
(test (copy #(1 2 3) (make-list 2) 1) '(2 3))
(test (copy (make-int-vector 3 0)) (make-int-vector 3 0))
(let ((orig "0123456789"))
- (let ((iv (copy (->byte-vector orig) (make-int-vector 10))))
+ (let ((iv (copy (string->byte-vector orig) (make-int-vector 10))))
(test (copy iv (make-string 10)) orig)))
(test (copy "0123456789" (make-float-vector 10)) (float-vector 48 49 50 51 52 53 54 55 56 57))
@@ -79933,6 +80174,8 @@ etc
(test (multiple-value-set! () ()) ())
(test (multiple-value-set! () () 1 2) 2)
+;;; let-temporarily
+
(let ((aaa 1)
(bbb 0)
(ccc 0))
@@ -80043,6 +80286,8 @@ etc
(test (list (a x) y z) '(32 32 32)))
(test (list (a x) y z) '(2 32 0)))
+(test (let ((x 1)) (let-temporarily ((x 32)))) #f)
+
(test (hash-table->alist (hash-table)) ())
(test (hash-table->alist (hash-table '(a . 1))) '((a . 1)))
@@ -80432,7 +80677,7 @@ etc
(test (sequence->string "abc") "\"abc\"")
(test (sequence->string "abcd") "\"abc ...\"")
(test (sequence->string #u8()) "#u8()")
- (test (sequence->string (->byte-vector "abc")) "#u8(97 98 99)")
+ (test (sequence->string (string->byte-vector "abc")) "#u8(97 98 99)")
(test (sequence->string (byte-vector 0 1 2 3)) "#u8(0 1 2 ...)")
(test (sequence->string (float-vector)) "#()")
(test (sequence->string (float-vector 0 1 2 3)) "#(0.0 1.0 2.0 ...)")
@@ -80447,6 +80692,11 @@ etc
(test (pair? (member :heap-size (*s7*->list))) #t)
+ (test (#_eval '(define x 3) (null-environment)) 3)
+ (test (#_eval '(< x 4) (null-environment)) 'error)
+ (test (object->string (null-environment)) "(inlet 'x 3)")
+ (test (#_eval '(let ((y 2)) ((lambda z z) x y)) (null-environment)) '(3 2))
+
(test (cdr-assoc 'a '((a . 1) (b . 2))) 1)
(test (cdr-assoc 'c '((a . 1) (b . 2))) #f)
(test (cdr-assoc 'c ()) #f)
@@ -80492,7 +80742,7 @@ etc
(define (ho y) (let ((z (+ y 1))) (hi z)))
(let ((str (with-Display (ho 1))))
- (if (not (Display-string=? str "(hi :x 2) ;called from ho\n -> 3\n"))
+ (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))))
@@ -82510,6 +82760,7 @@ etc
(test (string? s) #t)
(test (morally-equal? s "abc") #t)
(test ((*mock-string* 'mock-string?) s) #t)
+ (test (append "asd" ((*mock-string* 'mock-string) "hi")) "asdhi")
(test ((*mock-vector* 'mock-vector?) s) #f)
(test (string-ref s 0) #\a)
(test (string-set! s 0 #\A) #\A)
@@ -82557,7 +82808,7 @@ etc
(test (format s) "222")
(test (eval-string s) 222)
(test (string-position "2" s) 0)
- (test (->byte-vector s) #u8(50 50 50)))
+ (test (string->byte-vector s) #u8(50 50 50)))
(let ((c ((*mock-char* 'mock-char) #\a)))
(test (char? c) #t)
@@ -85179,6 +85430,7 @@ etc
(lint-test "(+ (* x 2) 3 (* 4 x x))" " +: perhaps (+ (* x 2) 3 (* 4 x x)) -> (+ 3 (* x (+ 2 (* x 4))))")
(lint-test "(+ -1 (* x -2) 3 (* 4 x x x))" " +: perhaps (+ -1 (* x -2) 3 (* 4 x x x)) -> (+ 2 (* x (+ -2 (* x (* x 4)))))")
(lint-test "(+ (* x 65536) (* x 256) x)" " +: perhaps (+ (* x 65536) (* x 256) x) -> (* x 65793)")
+ (lint-test "(+ x x x x)" " +: perhaps (+ x x x x) -> (* x 4)")
(lint-test "(* 2 3)" " *: perhaps (* 2 3) -> 6")
(lint-test "(* 2 (+))" " *: perhaps (* 2 (+)) -> 0")
@@ -85284,6 +85536,7 @@ etc
(lint-test "(/ (/ z x))" " /: perhaps (/ (/ z x)) -> (/ x z)")
(lint-test "(/ (/ z x y))" " /: perhaps (/ (/ z x y)) -> (/ (* x y) z)")
(lint-test "(/ 1 (/ 1 x y))" " /: perhaps (/ 1 (/ 1 x y)) -> (* x y)")
+ (lint-test "(/ x y (length z))" " /: (length z) will cause division by 0 if z is empty")
(lint-test "(/ (exact->inexact x) 10)" " /: perhaps (/ (exact->inexact x) 10) -> (/ x 10.0)")
(lint-test "(+ (exact->inexact x) 10)" " +: perhaps (+ (exact->inexact x) 10) -> (+ x 10.0)")
@@ -85515,6 +85768,7 @@ etc
(lint-test "(negative? (- x))" " negative?: perhaps (negative? (- x)) -> (positive? x)")
(lint-test "(negative? (- x y))" " negative?: perhaps (negative? (- x y)) -> (< x y)")
(lint-test "(negative? (- x y z))" " negative?: perhaps (negative? (- x y z)) -> (< x (+ y z))")
+ (lint-test "(negative? (string-length s))" " negative?: string-length can't be negative: (negative? (string-length s))")
(lint-test "(not (positive? (- n 2)))" " not: perhaps (positive? (- n 2)) -> (> n 2)")
(lint-test "(+ #e21 x)" " this #e is dumb, #e21 -> 21")
@@ -85858,6 +86112,8 @@ etc
(lint-test "(if A (if (not B) C D) (if B C D))" " if: perhaps (if A (if (not B) C D) (if B C D)) -> (if (not (eq? (not A) (not B))) C D)")
(lint-test "(if A (if B C D) (if E C D))" " if: perhaps (if A (if B C D) (if E C D)) -> (if (if A B E) C D)")
(lint-test "(+ (if A B C) (if A C D) y)" " +: perhaps (+ (if A B C) (if A C D) y) -> (+ (if A (values B C) (values C D)) y)")
+ (lint-test "(if A (cond (C D) (else F)) B)" " if: perhaps (if A (cond (C D) (else F)) B) -> (cond ((not A) B) (C D) (else F))")
+ (lint-test "(if A (cond (C D) (else F)))" " if: perhaps (if A (cond (C D) (else F))) -> (cond ((not A) #<unspecified>) (C D) (else F))")
(lint-test "(if x (begin (f y)) (begin (g y)))"
" if: perhaps (if x (begin (f y)) (begin (g y))) -> (begin ((if x f g) y))
@@ -85882,7 +86138,8 @@ etc
(lint-test "(if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y))"
" if: perhaps (if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y)) ->
(let ((y ((if x abs log) x))) (display z) y)")
- (lint-test "(if x (let loop ((x y)) (if (null? x) 1 (loop (cdr x)))) (let loop ((x z)) (if (null? x) 1 (loop (cdr x)))))" "")
+ (lint-test "(if x (let loop1 ((x y)) (if (null? x) 1 (loop1 (cdr x)))) (let loop2 ((x z)) (if (null? x) 1 (loop2 (cdr x)))))"
+ "") ; TODO: leaving aside free vars loop2: loop2 is the same as loop1
(lint-test "(if polar
(let ((vals (parse-polar-coordinates points 3d)))
(set! (bezier-x xpath) (car vals))
@@ -85964,6 +86221,11 @@ etc
" if: perhaps (if x (begin (display y) (set! y z) (display x)) (begin (display y) (set!... ->
(begin (display y) (if x (set! y z) (set! z y)) (display x))")
+ (lint-test "(if A (let () (display x)))" " if: perhaps (if A (let () (display x))) -> (when A (display x))")
+ (lint-test "(if A B (let () (display x)))" " if: perhaps (if A B (let () (display x))) -> (if A B (begin (display x)))")
+ (lint-test "(if A (let () (set! x z) (display x)) (let () (write y)))"
+ " if: perhaps (if A (let () (set! x z) (display x)) (let () (write y))) -> (if A (begin (set! x z) (display x)) (begin (write y)))")
+
(lint-test "(if A (if B (+ x 1)) (if B (- x 1)))"
" if: perhaps (if A (if B (+ x 1)) (if B (- x 1))) -> (if B (if A (+ x 1) (- x 1)))")
(lint-test "(if A (begin (f x) (g y)) (begin (f x) (g z)))"
@@ -85984,7 +86246,9 @@ etc
(lint-test "(begin (if x (begin (display y) (+ x 1)) (begin (display x) z)) z)"
" begin: this is pointless: (+ x 1) in (begin (display y) (+ x 1))
begin: this is pointless: z in (begin (display x) z)")
- (lint-test "(begin (let () (display x)) y)" " begin: pointless let: (let () (display x))")
+ (lint-test "(begin (let () (display x)) y)"
+ " begin: perhaps (begin (let () (display x)) y) -> (let () (display x) y)
+ begin: pointless let: (let () (display x))")
(lint-test "(let ((list x)) (if (null? list) 3 2))"
" let: perhaps (let ((list x)) (if (null? list) 3 2)) -> (if (null? x) 3 2)
@@ -86423,6 +86687,15 @@ etc
(lint-test "(when (and (not x) (not y)) (display z))"
" when: perhaps (when (and (not x) (not y)) (display z)) -> (unless (or x y) ...)
when: perhaps (and (not x) (not y)) -> (not (or x y))")
+ (lint-test "(when A (unless B (display C) (f D E)))"
+ " when: perhaps (when A (unless B (display C) (f D E))) -> (when (and A (not B)) (display C) (f D E))")
+ (lint-test "(unless A (when B (display C) (f D E)))"
+ " unless: perhaps (unless A (when B (display C) (f D E))) -> (when (and (not A) B) (display C) (f D E))")
+ (lint-test "(when A (unless (odd? B) (display C) (f D E)))"
+ " when: perhaps (when A (unless (odd? B) (display C) (f D E))) -> (when (and A (even? B)) (display C) (f D E))")
+ (lint-test "(unless (< x y) (cond ((A B) (C D) (else E))))"
+ " unless: perhaps (unless (< x y) (cond ((A B) (C D) (else E)))) -> (cond ((< x y) #f) ((A B) (C D) (else E)))
+ unless: perhaps (cond ((A B) (C D) (else E))) -> (when (A B) (C D) (else E))")
(lint-test "(if (and (< x 1) y) (when z (display z) x))"
" if: perhaps (if (and (< x 1) y) (when z (display z) x)) -> (when (and (< x 1) y z) (display z) x)")
(lint-test "(if (and (< x 1) y) (unless z (display z) x))"
@@ -86549,7 +86822,7 @@ etc
(lint-test "(list->string (cdr (string->list x)))" " list->string: perhaps (list->string (cdr (string->list x))) -> (substring x 1)")
(lint-test "(list->vector (list-tail (vector->list x) y))"
" list->vector: perhaps (list->vector (list-tail (vector->list x) y)) -> (copy x (make-vector (- (length x) y))) ")
- (lint-test "(string->list \"123\")" " string->list: perhaps (string->list \"123\") -> (#\\1 #\\2 #\\3)")
+ (lint-test "(string->list \"123\")" " string->list: perhaps (string->list \"123\") -> '(#\\1 #\\2 #\\3)")
(lint-test "(list->vector '(1 2 3))" " list->vector: perhaps (list->vector '(1 2 3)) -> #(1 2 3)")
(lint-test "(list->vector (cons x '()))"
" list->vector: perhaps (list->vector (cons x '())) -> (vector x)
@@ -86567,7 +86840,7 @@ etc
(lint-test "(list->string (list x y z))" " list->string: perhaps (list->string (list x y z)) -> (string x y z)")
(lint-test "(list->vector (sort! (vector->list x) y))" " list->vector: perhaps (list->vector (sort! (vector->list x) y)) -> (sort! x y)")
(lint-test "(list->string (sort! (string->list x) y))" " list->string: perhaps (list->string (sort! (string->list x) y)) -> (sort! x y)")
- (lint-test "(string->list x y y)" " string->list: leaving aside errors, (string->list x y y) is ()")
+ (lint-test "(string->list x y y)" " string->list: these string->list indices make no sense: (string->list x y y)")
(lint-test "(symbol->keyword (string->symbol x))" " symbol->keyword: perhaps (symbol->keyword (string->symbol x)) -> (make-keyword x)")
(lint-test "(vector->list (vector a b c))" " vector->list: perhaps (vector->list (vector a b c)) -> (list a b c)")
(lint-test "(vector->list (vector-copy v start end))" " vector->list: perhaps (vector->list (vector-copy v start end)) -> (vector->list v start end)")
@@ -86690,9 +86963,7 @@ etc
(lint-test "(letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+ x f2))"
" letrec: in (letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+...,
letrec should be letrec* because x is used in f2's value (not a function): (f1 x)")
- (lint-test "(let () (define x 3) 32)"
- " let: perhaps (... (define x 3) 32) -> (... (let ((x 3)) ...))
- let: x not used, initially: 3 from define")
+ (lint-test "(let () (define x 3) 32)" " let: x not used, initially: 3 from define")
(lint-test "(let ((z 1)) (define x 12) (define (y a) a) 32)"
" let: perhaps (... (define x 12) (define (y a) a) 32) -> (... (let ((x 12)) ...))
let: y not used, value: (define (y a) a)
@@ -86801,6 +87072,13 @@ etc
(let* ((z 1) (y (+ z (read p))) (x (< y 3))) ...)
let*: perhaps (let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) ->
(let* ((z 1) (w (read p)) (y (+ z w))) (cond ((< y 3) => f)))")
+ (lint-test "(let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i)))"
+ " let*: perhaps (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) ->
+ (let ((a (car x))) (do ((b (+ a 1)) (i 0 (+ i 1))) ...))
+ let*: perhaps restrict a which is not used in the let* body
+ (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((b (let ((a (car x))) (+ a 1)))) ...)
+ let*: perhaps substitute a into b:
+ (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((b (+ (car x) 1))) ...)")
(lint-test "(let ((x (f y))) (if x (g x) x))"
" let: perhaps (let ((x (f y))) (if x (g x) x)) -> (cond ((f y) => g) (else #f))
let: perhaps (if x (g x) x) -> (and x (g x))")
@@ -86845,8 +87123,7 @@ etc
let: perhaps (let () (+ a 1)) -> (+ a 1)
let: assuming we see all set!s, the binding (a x) is pointless: perhaps (let ((a x)) (let () (+ a 1))) -> (let () (let () (+ x 1)))")
(lint-test "(let ((x 32)) (define x 33) x)"
- " let: perhaps (... (define x 33) x) -> (... (let ((x 33)) ...))
- let: perhaps omit x and return 33
+ " let: perhaps omit x and return 33
let: let variable x is redefined in the let body. Perhaps use set! instead: (set! x 33)
let: x not used, initially: 32 from let")
(lint-test "(let ((x 32)) (define (x y) (+ y 33)) (x 1))"
@@ -86890,6 +87167,8 @@ etc
" letrec: perhaps (letrec ((f0 (lambda (i) (if (> i 0) (f0 #() (- i 1)))))) (f0 1)) -> (let f0 ((i 1)) (if (> i 0) (f0 #() (- i 1))))")
(lint-test "(letrec ((f0 (lambda () (if (> i 0) (f0))))) (f0))"
" letrec: perhaps (letrec ((f0 (lambda () (if (> i 0) (f0))))) (f0)) -> (let f0 () (if (> i 0) (f0)))")
+ (lint-test "(let ((a 0)) (display x) (set! a 2) (+ a 1))"
+ " let: perhaps change a's initial value to 2, and remove (set! a 2) in (let ((a 0)) (display x) (set! a 2) (+ a 1))")
(lint-test "(let () (error 'oops \"an error\") #t)" " let: (error 'oops \"an error\") makes this pointless: #t")
(lint-test "(let () (error 'oops \"an error\") (display \"oops\") #t)"
@@ -86978,6 +87257,44 @@ etc
(if z? (begin (set! y (g x)) (display y))) of
(let* ((z x) (y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin...")
+ (lint-test "(let ((x (f y))) (g (car x)) (h (caar x)) (j (caddar x)))"
+ " let: x is not set, and is always accessed via (car x) so its binding could probably be
+ (x (car (f y))) in (let ((x (f y))) (g (car x)) (h (caar x)) (j (caddar x)))")
+ (lint-test "(let ((x (f y))) (g (cddar x)) (h (caar x)) (j (caddar x)))"
+ " let: x is not set, and is always accessed via (car x) so its binding could probably be
+ (x (car (f y))) in (let ((x (f y))) (g (cddar x)) (h (caar x)) (j (caddar x)))")
+ (lint-test "(let ((x 2)) (g (+ x x)) (h (+ x x)) (j (+ x x)))"
+ " let: x is not set, and is always accessed via (+ x x) so its binding could probably be
+ (x (+ 2 2)) in (let ((x 2)) (g (+ x x)) (h (+ x x)) (j (+ x x)))")
+ (lint-test "(let ((x 2)) (g (< 0 x 1)) (h (> 1 x 0)) (j (< 0 x 1)))"
+ " let: x is not set, and is always accessed via (< 0 x 1) so its binding could probably be (x (< 0 2 1)) in
+ (let ((x 2)) (g (< 0 x 1)) (h (> 1 x 0)) (j (< 0 x 1)))")
+ (lint-test "(let ((x (f y))) (g (cddr x)) (h (caar x)) (j (caddar x)))" "")
+ (lint-test "(let ((x (f y))) (g (cddar x)) (h (caadr x)) (j (caddar x)))" "")
+ (lint-test "(let ((x (f y))) (g (abs (car x))) (h (caar x)) (j (caddar x)))"
+ " let: x is not set, and is always accessed via (car x) so its binding could probably be (x (car (f y))) in
+ (let ((x (f y))) (g (abs (car x))) (h (caar x)) (j (caddar x)))")
+
+ (lint-test "(let ((a (car x))) (if b (display (g a b))))"
+ " let: perhaps move the let to the true branch:
+ (let ((a (car x))) (if b (display (g a b)))) -> (if b (let ((a (car x))) (display (g a b))))")
+ (lint-test "(let ((a (car x))) (if b (+ a (f a)) (display c)))"
+ " let: perhaps move the let to the true branch:
+ (let ((a (car x))) (if b (+ a (f a)) (display c))) -> (if b (let ((a (car x))) (+ a (f a))) (display c))")
+ (lint-test "(let ((a (car x))) (if b (begin (display x) (+ a (f a))) (display c)))"
+ " let: perhaps move the let to the true branch:
+ (let ((a (car x))) (if b (begin (display x) (+ a (f a))) (display c))) -> (if b (let ((a (car x))) (display x) (+ a (f a))) (display c))")
+ (lint-test "(let ((a (car x))) (when b (display (g a b))))"
+ " let: perhaps move the let inside the when: (let ((a (car x))) (when b (display (g a b)))) -> (when b (let ((a (car x))) (display (g a b))))")
+ (lint-test "(let ((a (car x))) (cond (b (display (g a b))) (else (set! y z) (display x))))"
+ " let: perhaps move the let into the '(b (display (g a b))) branch:
+ (let ((a (car x))) (cond (b (display (g a b))) (else (set! y z) (display x)))) ->
+ (cond (b (let ((a (car x))) (display (g a b)))) ...)")
+ (lint-test "(let ((a (car x))) (case b ((0) (display (g a b))) (else (set! y z) (display x))))"
+ " let: perhaps move the let into the '((0) (display (g a b))) branch:
+ (let ((a (car x))) (case b ((0) (display (g a b))) (else (set! y z)... ->
+ (case b ((0) (let ((a (car x))) (display (g a b)))) ...)")
+
(lint-test "(eq? x '())" " eq?: perhaps (eq? x '()) -> (null? x) eq?: quote is not needed here: '()")
(lint-test "(equal? x '#())" " equal?: quote is not needed here: '#()")
(lint-test "(equal? x '\"\")" " equal?: quote is not needed here: '\"\"")
@@ -87116,10 +87433,15 @@ etc
(lint-test "(set! x (and y x))" " set!: perhaps (set! x (and y x)) -> (if (not y) (set! x #f))")
(lint-test "(set! x (or x y))" " set!: perhaps (set! x (or x y)) -> (if (not x) (set! x y))")
(lint-test "(set! x (or y x))" "")
-
+ (lint-test "(set! x (cond (z w) (else x)))" " set!: perhaps (set! x (cond (z w) (else x))) -> (if z (set! x w))")
+ (lint-test "(set! x (cond (z x) (else w)))" " set!: perhaps (set! x (cond (z x) (else w))) -> (if (not z) (set! x w))")
(lint-test "(begin (set! x (cons 1 z)) (set! x (cons 2 x)))" " begin: perhaps (set! x (cons 1 z)) (set! x (cons 2 x)) -> (set! x (cons 2 (cons 1 z)))")
(lint-test "(begin (set! x 0) (set! x 1))" " begin: this could be omitted: (set! x 0)")
+ (lint-test "(begin (set! x y) (set! x y))"
+ " begin: this pair of set!s looks odd: (... (set! x y) (set! x y) ...)
+ begin: this could be omitted: (set! x y)")
+ (lint-test "(begin (set! x y) (set! y x))" " begin: this pair of set!s looks odd: (... (set! x y) (set! y x) ...)")
(lint-test "(begin (set! x y) (set! x (+ x 1)))" " begin: perhaps (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))")
(lint-test "(quote 3)" " quote: quote is not needed here: '3")
(lint-test "(quote . 3)" " quote: stray dot in quote's arguments? (quote . 3)")
@@ -87132,8 +87454,9 @@ etc
(lint-test "(let () (case x ((0) 1) (else 2)) x)"
" let: this could be omitted: (case x ((0) 1) (else 2))
let: perhaps (case x ((0) 1) (else 2)) -> (if (eqv? x 0) 1 2)")
- (lint-test "(begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32)"
- " begin: this could be omitted: (let ((a (+ x 1)) (b 2)) (+ a b))
+ (lint-test "(begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32)"
+ " begin: perhaps (begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32) -> (let ((a (+ x 1)) (b 2)) (+ a b) 32)
+ begin: this could be omitted: (let ((a (+ x 1)) (b 2)) (+ a b))
begin: perhaps (let ((a (+ x 1)) (b 2)) (+ a b)) -> (+ (+ x 1) 2)")
(lint-test "(begin (if x y z) a)" " begin: this could be omitted: (if x y z)")
(lint-test "(lambda (a) (if x y z) a)" " lambda: this could be omitted: (if x y z)")
@@ -87181,7 +87504,7 @@ etc
(lint-test "(case c ((a) b) (else (begin (display d) e)))"
" case: perhaps (case c ((a) b) (else (begin (display d) e))) -> (if (eq? c 'a) b (begin (display d) e))
case: redundant begin: (begin (display d) e)")
- (lint-test "(case x ((0) 32) ((1) 32))" " case: perhaps merge keys (1) with (0): (case x ((0) 32) ((1) 32)) -> (case x ((0 1) 32))")
+ (lint-test "(case x ((0) 32) ((1) 32))" "case: perhaps merge keys (1) with (0): (case x ((0) 32) ((1) 32)) -> (case x ((0 1) 32))")
(lint-test "(case x ((0) 32) (else (case x ((1) 32))))"
" case: perhaps (case x ((0) 32) (else (case x ((1) 32)))) -> (if (eqv? x 0) 32 (case x ((1) 32)))
case: perhaps (case x ((1) 32)) -> (if (eqv? x 1) 32)
@@ -87244,6 +87567,12 @@ etc
(lint-test "(case i ((x) x) ((y) y) ((z) z))" " case: perhaps (ignoring the unmatched case) (case i ((x) x) ((y) y) ((z) z)) -> (symbol->value i)")
(lint-test "(case (pair? x) ((#f) y) (else z))" " case: perhaps (case (pair? x) ((#f) y) (else z)) -> (if (not (pair? x)) y z)")
(lint-test "(case x ((#f) y) (else z))" " case: perhaps (case x ((#f) y) (else z)) -> (if (not x) y z)")
+ (lint-test "(begin (if (= x 1) (display y)) (if (= x 2) (f y)) (if (= x 3) (display z)) (f x))"
+ " begin: perhaps (... (if (= x 1) (display y)) (if (= x 2) (f y)) ...) ->
+ (case x ((1) (display y)) ((2) (f y)) ((3) (display z)))")
+ (lint-test "(begin (if (eq? x 'a) (display y)) (if (eqv? x 2) (f y)) (if (char=? x #\\3) (display z)) (f x))"
+ " begin: perhaps (... (if (eq? x 'a) (display y)) (if (eqv? x 2) (f y)) ...) ->
+ (case x ((a) (display y)) ((2) (f y)) ((#\\3) (display z)))")
(lint-test "(do ())" " do: do is messed up: (do ())")
(lint-test "(do () ())" " do: this do-loop could be replaced by (): (do () ())")
@@ -87280,13 +87609,30 @@ etc
(lint-test "(do ((i 0 (display i))) ((x y) z))" "")
(lint-test "(do ((i 0 (+ i 1))) (abs i) (display i))" " do: strange do end-test: abs in (abs i) is a procedure")
(lint-test "(begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x)"
- " begin: (do ((i 0 (+ i 1))) ((= i 10) i) (display i)): result i is not used")
+ " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x) -> (do ((i 0 (+ i 1))) ((= i 10) i x) (display i))
+ begin: (do ((i 0 (+ i 1))) ((= i 10) i) (display i)): result i is not used")
(lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (display p))" "")
(let-temporarily ((*report-constant-expressions-in-do* #t))
(lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (display x))"
- " do: in (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (display x)), (log z 2) appears to be constant"))
- (lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x))" "")
+ " do: in (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (display x)), (log z 2) appears to be constant
+ do: perhaps (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (display x)) ->
+ (for-each (lambda ([p]) (set! y (log z 2)) (display x)) (list 1))"))
+ (lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x))"
+ " do: perhaps (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z... ->
+ (for-each (lambda ([p]) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x)) (list 1))")
(lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()) (display i))" " do: nil return value is redundant: ((= i 3) ())")
+ (lint-test "(do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))"
+ " do: this do-loop could be replaced by (): (do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))
+ do: this could be omitted: (let ((y x)) (car y)) do: perhaps (let ((y x)) (car y)) -> (car x)
+ do: assuming we see all set!s, the binding (y x) is pointless: perhaps (let ((y x)) (car y)) -> (let () (car x))")
+
+ (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32)"
+ " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) 32) (display i))")
+ (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 3) (display x)) (display i)) 32)"
+ " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 3) (display x)) (display i)) 32) ->
+ (do ((i 0 (+ i 1))) ((= i 3) (display x) 32) (display i))")
+ (lint-test "(begin (do () ((= i 3)) (display i)) 32)" " begin: perhaps (begin (do () ((= i 3)) (display i)) 32) -> (do () ((= i 3) 32) (display i))")
+ (lint-test "(let ((x 2)) (do ((x 0 (+ x 1))) ((= x 2)) (display x)) (display x))" "") ; x shadowed if moved into do
(lint-test "(let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y)))"
" let: x in (y x (- y 1)) does not appear to be defined in the calling environment
@@ -87335,6 +87681,19 @@ etc
(begin
(display (+ i j))
(_1_ j i (+ k 1)))))")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a)))"
+ " do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
+ (do ((i 0 (+ i 1)) (a 12 12)) ((= i 3)) (set! a (+ a i)) ...)")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let () (set! a (+ a i)) (display a)))"
+ " do: pointless let: (let () (set! a (+ a i)) (display a))
+ do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let () (set! a (+ a i)) (display a))) ->
+ (do ((i 0 (+ i 1))) ((= i 3)) (set! a (+ a i)) ...)")
+ (lint-test "(do () ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a)))"
+ " do: perhaps (do () ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
+ (do ((a 12 12)) ((= i 3)) (set! a (+ a i)) ...)")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i)) (display a)))"
+ " do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i))... ->
+ (do ((i 0 (+ i 1)) (a 12 12) (b 1 1)) ((= i 3)) (set! a (+ a b i)) ...)")
(lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4) (+ i j k)))"
" do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4) (+ i j k))) ->
(let _1_ ((i 0) (j 1) (k 0)) (if (= k 4) (+ i j k) (_1_ j i (+ k 1))))")
@@ -87356,14 +87715,41 @@ etc
(lint-test "(let ((x (log y))) (do () ((= i 3)) (display x)))"
" let: perhaps (let ((x (log y))) (do () ((= i 3)) (display x))) -> (do ((x (log y))) ...)")
(lint-test "(let ((x (log y)) (z (log w))) (do () ((= i 3)) (display x)) (display x) (cdr v))"
- " let: z not used, initially: (log w) from let
- let: perhaps (let ((x (log y)) (z (log w))) (do () ((= i 3)) (display x)) (display x)... ->
- (do ((x (log y)) (z (log w))) ((= i 3) (display x) (cdr v)) ...)")
+ " let: z not used, initially: (log w) from let")
(lint-test "(let ((x (log y))) (do ((x 0 (+ x 1))) ((= i 3)) (display x)))"
" let: x not used, initially: (log y) from let")
(lint-test "(let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j))) 32)"
" let: perhaps (let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i... ->
(do ((a 1) (i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3) 32) ...)")
+ (lint-test "(let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x)) (display i)))"
+ " let: perhaps (let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x)) (display i))) -> (do ((x (length y)) (i 0 (+ i 1))) ...)")
+ (lint-test "(let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x) (display x)) (display i)) (log x))"
+ " let: perhaps (let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x) (display x)) (display... ->
+ (do ((x (length y)) (i 0 (+ i 1))) ((= i x) (display x) (log x)) ...)")
+
+ (lint-test "(do ((p lst (cdr p))) ((null? p)) (display (car p)))"
+ " do: perhaps (do ((p lst (cdr p))) ((null? p)) (display (car p))) -> (for-each (lambda ([p]) (display [p])) lst)")
+ (lint-test "(do ((p lst (cdr p))) ((not (pair? p))) (if (cadar p) (display (cdddar p))))"
+ " do: perhaps (do ((p lst (cdr p))) ((not (pair? p))) (if (cadar p) (display (cdddar p)))) ->
+ (for-each (lambda ([p]) (if (cadr [p]) (display (cdddr [p])))) lst)")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i)))"
+ " do: perhaps (do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i))) -> (for-each (lambda ([x]) (find [x])) x)")
+ (lint-test "(let ((n (length v))) (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v j))) (f (car x) (cdr x)))))"
+ " let: perhaps (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v j))) (f (car x) (cdr x)))) ->
+ (for-each (lambda ([v]) (let ((x [v])) (f (car x) (cdr x)))) v)
+ let: perhaps (let ((n (length v))) (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v... ->
+ (do ((n (length v)) (j 0 (+ j 1))) ...)")
+
+ (lint-test "(let ((x (f y))) (display x) (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i))))"
+ " let: the scope of z could be reduced: (... (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i)))) ->
+ (... (let ((z (f x))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i)))))")
+ (lint-test "(let () (display x) (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))))"
+ " let: the scope of z could be reduced: (... (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i)))) ->
+ (... (let ((z (f x))) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i)))))")
+ (lint-test "(let () (display x) (define z (f x)) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i))))"
+ " let: the scope of z could be reduced: (... (define z (f x)) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i)))) ->
+ (... (let ((z (f x))) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i)))))
+ let: j not used, initially: 0 from do")
;(lint-test "(byte-vector 3213)" " byte-vector: byte-vector's argument should be a byte?: 3213: (byte-vector 3213)")
(lint-test "(let ())" " let: let is messed up: (let ())")
@@ -87458,21 +87844,26 @@ etc
" let: assuming we see all set!s, the binding (x y) is pointless: perhaps (let ((x y) (a (* 2 y))) (+ (f a (+ a 1)) (* 3 y x))) ->
(let ((a (* 2 y))) (+ (f a (+ a 1)) (* 3 y y)))")
(lint-test "(let ((x y) (a (* 2 y))) (set! x (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" "")
- (lint-test "(let ((x y) (a (* 2 y))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" "")
+ (lint-test "(let ((x y) (a (* 2 y))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))"
+ " let: x is not set, and is always accessed via (* 3 x) so its binding could probably be (x (* 3 y)) in
+ (let ((x y) (a (* 2 y))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))")
(lint-test "(let ((old-x x)) (set! x 12) (display (log x)) (set! x old-x))"
- " let: perhaps use let-temporarily here (see stuff.scm):
+ " let: perhaps use let-temporarily here:
(let ((old-x x)) (set! x 12) (display (log x)) (set! x old-x)) -> (let-temporarily ((x 12)) (display (log x)))")
(lint-test "(let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x))"
" let: this could be omitted: (set! x 1)
- let: perhaps use let-temporarily here (see stuff.scm):
+ let: perhaps use let-temporarily here:
(let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x)) -> (let-temporarily ((x 12)) (display (log x)) (set! x 1))")
(lint-test "(let ((old-x x) (z (f 3))) (set! x z) (display (log x)) (set! x old-x))"
- " let: perhaps use let-temporarily here (see stuff.scm):
+ " let: perhaps use let-temporarily here:
(let ((old-x x) (z (f 3))) (set! x z) (display (log x)) (set! x old-x)) -> (let ((z (f 3))) (let-temporarily ((x z)) (display (log x))))")
(lint-test "(let ((z (f 3)) (old-x x)) (set! x z) (display (log x)) (set! x old-x))"
- " let: perhaps use let-temporarily here (see stuff.scm):
+ " let: perhaps use let-temporarily here:
(let ((z (f 3)) (old-x x)) (set! x z) (display (log x)) (set! x old-x)) -> (let ((z (f 3))) (let-temporarily ((x z)) (display (log x))))")
+ (lint-test "(let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32) (display x) (set! (*s7* 'print-length) old-p))"
+ " let: perhaps use let-temporarily here: (let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32)... ->
+ (let-temporarily (((*s7* 'print-length) 32)) (display x))")
(lint-test "(let* ((x (log y)) (a (+ x 1)) (a (* x 2))) (+ a 1))"
" let*: let* variable a is declared twice
@@ -87821,16 +88212,15 @@ etc
(lint-test "(list-tail (list-tail x 1) 2)" " list-tail: perhaps (list-tail (list-tail x 1) 2) -> (list-tail x 3)")
(lint-test "(list-tail (list-tail x y) z)" " list-tail: perhaps (list-tail (list-tail x y) z) -> (list-tail x (+ y z))")
- (lint-test "(list (f (g x y) z (* a b)) (f (g x y) z (* a b)))"
- " list: perhaps (list (f (g x y) z (* a b)) (f (g x y) z (* a b))) -> (let ((_1_ (lambda () (f (g x y) z (* a b))))) (list (_1_) (_1_)))")
+ (lint-test "(list (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)))"
+ " list: perhaps (list (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f... ->
+ (let ((_1_ (lambda () (f (g x y) z (* a b))))) (list (_1_) (_1_) (_1_) (_1_)))")
(lint-test "(vector 12 12 12 12 12 12)" " vector: perhaps (vector 12 12 12 12 12 12) -> (make-vector 6 12)")
(lint-test "(vector (car x) (car x) (car x) (car x))" " vector: perhaps (vector (car x) (car x) (car x) (car x)) -> (make-vector 4 (car x))")
(lint-test "(vector #(1 2) #(1 2) #(1 2) #(1 2))"
" vector: perhaps (vector #(1 2) #(1 2) #(1 2) #(1 2)) -> (make-vector 4 #(1 2))
or wrap (copy #(1 2)) in a function and call that 4 times")
- (lint-test "(int-vector 0 0 0 0)" " int-vector: perhaps (int-vector 0 0 0 0) -> (make-int-vector 4)")
- (lint-test "(list (make-list 3 0) (make-list 3 0) (make-list 3 0))"
- " list: perhaps (list (make-list 3 0) (make-list 3 0) (make-list 3 0)) -> (let ((_1_ (lambda () (make-list 3 0)))) (list (_1_) (_1_) (_1_)))")
+ (lint-test "(int-vector 0 0 0 0)" " int-vector: perhaps (int-vector 0 0 0 0) -> (make-int-vector 4)")
(lint-test "(unless x)" " unless: unless is messed up: (unless x)")
(lint-test "(unless (abs x) #f)" " unless: unless test is never false: (unless (abs x) #f)")
(lint-test "(with-let x)" " with-let: with-let is messed up: (with-let x)")
@@ -88125,8 +88515,8 @@ etc
(lint-test "(and (equal? (caadr a) (caadr b)) (equal? (cdadr a) (cdadr b)))"
" and: perhaps (and (equal? (caadr a) (caadr b)) (equal? (cdadr a) (cdadr b))) -> (equal? (cadr a) (cadr b))")
- (lint-test "(and t (string? t))" " and: perhaps (and t (string? t)) -> (string? t)")
- (lint-test "(and t (string? t) v (string? v))" " and: perhaps (and t (string? t) v (string? v)) -> (and (string? t) (string? v))")
+ (lint-test "(and t! (string? t!))" " and: perhaps (and t! (string? t!)) -> (string? t!)")
+ (lint-test "(and t! (string? t!) v (string? v))" " and: perhaps (and t! (string? t!) v (string? v)) -> (and (string? t!) (string? v))")
(lint-test "(and v (boolean? v) (not (equal? v w)))" " and: perhaps (and v (boolean? v) (not (equal? v w))) -> (and (eq? v #t) (not (equal? v w)))")
(lint-test "(and x (< x 2))" " in (and x (< x 2)), perhaps change x to (real? x)")
(lint-test "(and w x (substring s 0 x))" " in (and x (substring s 0 x)), perhaps change x to (integer? x)")
@@ -88137,10 +88527,10 @@ etc
(lint-test "(and v (v 100))" " in (and v (v 100)), perhaps change v to (procedure? v) ; or maybe sequence?")
(lint-test "(when x (substring y x))" " in (when x (substring y x)), perhaps change x to (integer? x)")
(lint-test "(cond (x (+ 1 (abs x))) (else y))" " in (cond (x (+ 1 (abs x))) (else y)), perhaps change x to (real? x)")
- (lint-test "(and t v (string? t) (string? v))"
- " in (and t v (string? t) (string? v)), perhaps change (and ... t ... (string? t)) to (string? t)
- in (and t v (string? t) (string? v)), perhaps change (and ... v ... (string? v)) to (string? v)")
- (lint-test "(and (number? a) (positive? a))" " in (and (number? a) (positive? a)), perhaps change (number? a) to (real? a)")
+ (lint-test "(and t! v (string? t!) (string? v))"
+ " in (and t! v (string? t!) (string? v)), perhaps change (and ... t! ... (string? t!)) to (string? t!)
+ in (and t! v (string? t!) (string? v)), perhaps change (and ... v ... (string? v)) to (string? v)")
+ (lint-test "(and (number? a!) (positive? a!))" " in (and (number? a!) (positive? a!)), perhaps change (number? a!) to (real? a!)")
(lint-test "(and (number? x) (< x 1))" " in (and (number? x) (< x 1)), perhaps change (number? x) to (real? x)")
(lint-test "(and (number? x) (even? x))" " in (and (number? x) (even? x)), perhaps change (number? x) to (integer? x)")
(lint-test "(and (list? arg2) (pair? arg2) (memq (car arg2) '(x y)))"
@@ -88330,6 +88720,8 @@ etc
(lint-test "(eval '(begin (display (* x y)) z) env)" " eval: perhaps (eval '(begin (display (* x y)) z) env) -> (with-let env (display (* x y)) z)")
(lint-test "(eval (list '* 2 x))" " eval: perhaps (eval (list '* 2 x)) -> (* 2 (eval x))")
+ (lint-test "(write-char x (current-output-port))"
+ " write-char: (current-output-port) is the default port for write-char: (write-char x (current-output-port))")
(lint-test "(with-let 123 123)" " with-let: with-let: first argument should be an environment: (with-let 123 123)")
(lint-test "(with-let (rootlet) 1)" "")
(lint-test "(string-length \"asdf\")" " string-length: perhaps (string-length \"asdf\") -> 4")
@@ -88367,6 +88759,8 @@ etc
(lint-test "(even? (- 1 x))" " even?: perhaps (even? (- 1 x)) -> (odd? x)")
(lint-test "(even? (- 1 2))" " even?: perhaps (even? (- 1 2)) -> #f even?: perhaps (- 1 2) -> -1")
(lint-test "(format t \" \")" " format: 't in (format t \" \") should probably be #t")
+ (lint-test "(string-append str (format () str arg))"
+ " string-append: in (string-append str (format () str arg)), string-append's argument 2 should be a string, but (format () str arg) might also be boolean?")
(lint-test "(not (peek-char))" " not: (not (peek-char)) can't be true (peek-char never returns #f)")
(lint-test "(number->string saturation 10)" " number->string: 10 is the default radix for number->string: (number->string saturation 10)")
(lint-test "(<= (string-length m) 0)" " <=: string-length is never negative, so (<= (string-length m) 0) -> (= (string-length m) 0)")
@@ -88391,6 +88785,9 @@ etc
" cadr: perhaps (cadr (or (find i alist) '(1 2 3))) -> (cond ((find i alist) => cadr) (else 2))")
(lint-test "(list->vector (reverse nts))" " list->vector: perhaps (list->vector (reverse nts)) -> (reverse (list->vector nts))")
(lint-test "(cadr (reverse (f x)))" " cadr: perhaps (cadr (reverse (f x))) -> (let ((_1_ (f x))) (list-ref _1_ (- (length _1_) 2)))")
+ (lint-test "(begin (if x (error 'oops)) (if x y))"
+ " begin: x is #f in (if x y)
+ begin: perhaps (... (if x (error 'oops)) (if x y) ...) -> (... (when x (error 'oops) y) ...)")
(lint-test "(round (char-position #\\a \"asb\"))"
" round: in (round (char-position #\\a \"asb\")), round's argument should be real, but (char-position #\\a \"asb\") might also be boolean?")
@@ -88400,6 +88797,7 @@ etc
(lint-test "(char-position \"xyz\" \"asb\")" "")
(lint-test "(if (null? (cons x y)) 1.0 0.0)" " if: perhaps (if (null? (cons x y)) 1.0 0.0) -> 0.0")
(lint-test "(if (null (cdr x)) 0)" " if: misspelled 'null? in (null (cdr x))?")
+ (lint-test "(list-set x 1 y)" " list-set: misspelled 'list-set! in (list-set x 1 y)?")
(lint-test "(string-index path #\\/)" " string-index: perhaps (string-index path #\\/) -> (char-position #\\/ path)")
(lint-test "(string-index path #\\/ start end)" " string-index: perhaps (string-index path #\\/ start end) -> (char-position #\\/ path start end)")
(lint-test "(cons* x y)" " cons*: perhaps (cons* x y) -> (cons x y)")
@@ -88488,6 +88886,7 @@ etc
(lint-test "(lambda ())" " lambda: lambda is messed up in (lambda ())")
(lint-test "(lambda (a b a) a)" " lambda: lambda parameter is repeated: (a b a) lambda: lambda parameter a is declared twice")
(lint-test "((lambda () 32) 0)" " (lambda () 32): perhaps ((lambda () 32) 0) -> 32")
+ (lint-test "((lambda x x) 1 2 3)" " (lambda x x): perhaps ((lambda x x) 1 2 3) -> (list 1 2 3)")
(lint-test "((lambda (a b) (+ a b)) 1)"
" (lambda (a b) (+ a b)): perhaps ((lambda (a b) (+ a b)) 1) -> (let ((a 1) (b #f)) (+ a b))
(lambda (a b) (+ a b)): perhaps (lambda (a b) (+ a b)) -> +")
@@ -88589,8 +88988,7 @@ etc
(lint-test "(let f1 ((a 1)) (+ a (f1)))" " f1: f1 needs 1 argument: (f1)")
(lint-test "(let f1 ((a 1)) (f1 a 2))" " f1: f1 has too many arguments: (f1 a 2)")
(lint-test "(define f7 (let ((a 1)) (lambda () a)))" "")
- (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7))"
- " let: perhaps (... (define f7 (let ((a 1)) (lambda () a))) (f7)) -> (... (let ((f7 (let ((a 1)) (lambda () a)))) ...))")
+ (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7))" "")
; (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7 1))" "...")
(lint-test "(let () (define (f1) 32) (f1))" " let: perhaps (... (define (f1) 32) (f1)) -> (... 32)")
@@ -88762,8 +89160,7 @@ etc
(lint-test "(begin (define (f30 x) (if (> x 0) (f30 #() (- x 1)))) (f30 1))" " f30: f30 has too many arguments: (f30 #() (- x 1))")
(lint-test "(let () (define plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args)))) (plus))"
- " let: perhaps (... (define plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z)... -> (... (let ((plus ...)) ...))
- plus: repeated parameter list? (x y) in (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args)))")
+ " plus: repeated parameter list? (x y) in (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args)))")
(lint-test "(case-lambda ((a b) (+ a b)))"
" case-lambda: perhaps (case-lambda ((a b) (+ a b))) -> (lambda (a b) (+ a b))")
(lint-test "(case-lambda \"a doc string\" ((a b) (+ a b)))"
@@ -88788,8 +89185,7 @@ etc
(lint-test "(define (f12 :key) :key)" " define: f12 parameter can't be a keyword: (f12 :key)")
(lint-test "(define :a 3)" " define: keywords are constants :a")
(lint-test "(let () (define most-positive-fixnum 32) most-positive-fixnum)"
- " let: perhaps (... (define most-positive-fixnum 32) most-positive-fixnum) -> (... (let ((most-positive-fixnum 32)) ...))
- let: most-positive-fixnum is a constant in s7: (define most-positive-fixnum 32)
+ " let: most-positive-fixnum is a constant in s7: (define most-positive-fixnum 32)
let: perhaps omit most-positive-fixnum and return 32")
(lint-test "(let () (define-constant __lt1__ 32) (set! __lt1__ 3) (+ __lt1__ 1))"
" let: can't set! __lt1__ in (set! __lt1__ 3) (it is a constant: 32)")
@@ -88893,6 +89289,7 @@ etc
" and: perhaps (and (string? (car c)) (string=? (car c) \" \")) -> (equal? (car c) \" \")")
(lint-test "(and (list? x) (equal? x '(1 2)))" " and: perhaps (and (list? x) (equal? x '(1 2))) -> (equal? x '(1 2))")
(lint-test "(and (char? x) (char=? x #\\a))" " and: perhaps (and (char? x) (char=? x #\\a)) -> (eqv? x #\\a)")
+
(lint-test "(if (number? x) (member x y) 0)" " in (if (number? x) (member x y) 0), perhaps change (member x y) to (memv ...)")
(lint-test "(if (number? x) (< x y) 0)" " in (if (number? x) (< x y) 0), perhaps change (number? x) to (real? x)")
(lint-test "(if (not (number? x)) 0 (< x y))" " in (if (not (number? x)) 0 (< x y)), perhaps change (not (number? x)) to (not (real? x))")
@@ -88920,7 +89317,9 @@ etc
" let: perhaps (... (define (f x) (if (pair? x) (reverse! x))) (f (vector 1 2))) -> (... (let ((x (vector 1 2))) (if (pair? x) (reverse! x))))
f: if x (a function argument) is a pair, (reverse! x) is ill-advised")
; (lint-test "(if (and (list? x) (car x)) 3)" "")
- (lint-test "(if (and (list? x) (not (null? x)) (car x)) 3)" "")
+ (lint-test "(if (and (list? x) (not (null? x)) (car x)) 3)" " if: perhaps (and (list? x) (not (null? x)) (car x)) -> (and (pair? x) (car x))")
+ (lint-test "(and (pair? obj) (not (null? obj)) (pair? x))" " and: perhaps (and (pair? obj) (not (null? obj)) (pair? x)) -> (and (pair? obj) (pair? x))")
+
(lint-test "(if x (map f x))" " in (if x (map f x)), perhaps change x to (sequence? x)")
(lint-test "(let ((x 0)) (/ 21 x))" " let: perhaps (let ((x 0)) (/ 21 x)) -> (/ 21 0) let: x is 0, so (/ 21 x) is an error")
(lint-test "(cond ((> x 0) => abs) (else y))" " cond: in ((> x 0) => abs), (> x 0) returns a a boolean, but abs expects real?")
@@ -88986,12 +89385,13 @@ etc
" let (line 3): perhaps embed f14:
(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 x y)... ->
(... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
- f14 (line 2): f14 could be (define f14 f11)")
+ f14 (line 2): f14 could be (define f14 f11)")
(lint-test "(let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2))))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ x (f14 1 2)))"
" let: perhaps (... (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2)) -> (... (let ((a 1) (b 2)) (if (positive? a) (+ a b) b)))
- let: 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))))")
+ let: perhaps (... (define (f14 x y) (if (positive? x) (+ x y) y)) (+ x (f14 1 2))) -> (... (+ x (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
+ f14 (line 1): f14 is the same as f11")
(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))
@@ -89000,23 +89400,24 @@ etc
(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): 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))")
+ (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))
(+ (f11 1 2) (f14 1 2)))"
" let (line 3): perhaps embed f14:
(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 y x)... ->
- (... (+ (f11 1 2) (let ((y 1) (x 2)) (if (positive? x) (+ x y) y))))
- f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 x y)")
+ (... (+ (f11 1 2) (let ((y 1) (x 2)) (if (positive? x) (+ x y) y))))")
+ ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
(lint-test "(let ()
(define (f11 b a) (if (positive? a) (+ a b) b))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ (f11 1 2) (f14 1 2)))"
" let (line 3): perhaps embed f14:
(let () (define (f11 b a) (if (positive? a) (+ a b) b)) (define (f14 x y)... ->
- (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
- f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 y x)")
+ (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))")
+ ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 y x)
(lint-test "(let ()
(define (f1 x) (set! x 32) (log x 2.0))
(define (f2 y) (set! y 32) (log y 2.0))
@@ -89025,38 +89426,33 @@ etc
(let () (define (f1 x) (set! x 32) (log x 2.0)) (define (f2 y) (set! y 32)... ->
(... (+ (f1 0) (let ((y 0)) (set! y 32) (log y 2.0))))
f1 (line 1): perhaps (set! x 32) -> (let ((x 32)) ...)
- f2 (line 2): perhaps (set! y 32) -> (let ((y 32)) ...)
- f2 (line 2): f2 could be (define f2 f1)")
+ f2 (line 2): f2 could be (define f2 f1)
+ f2 (line 2): perhaps (set! y 32) -> (let ((y 32)) ...)")
(lint-test "(let ()
(define (f11 a b) (if (positive? a) (+ a b) b))
(let ((z (if (positive? a1) (+ a1 b1) b1)))
- (+ z (f11 1 2))))" " let (line 2): perhaps (if (positive? a1) (+ a1 b1) b1) -> (f11 a1 b1)")
+ (+ z (f11 1 2))))" " perhaps (if (positive? a1) (+ a1 b1) b1) -> (f11 a1 b1)")
(lint-test "(let ()
(define (f11 a b) (if (positive? a) (+ a b) b))
(define f14 (lambda (x y) (if (positive? x) (+ x y) y)))
(+ (f11 1 2) (f14 1 2)))"
" let (line 3): the scope of f14 could be reduced:
(... (define f14 (lambda (x y) (if (positive? x) (+ x y) y))) (+ (f11 1 2) (f14 1 2))) ->
- (... (let ((f14 (lambda (x y) (if (positive? x) (+ x y) y)))) (+ (f11 1 2) (f14 1 2))))
- f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 x y)")
+ (... (let ((f14 (lambda (x y) (if (positive? x) (+ x y) y)))) (+ (f11 1 2) (f14 1 2))))")
+ ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
(lint-test "(let ()
(define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ (f11 1 2) (f14 1 2)))"
- " let (line 3): perhaps (... (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))... ->
- (... (let ((f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))) ...))
- let (line 3): perhaps embed f14: (let () (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))... ->
- (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
- f11 (line 1): pointless let: (let () (lambda (a b) (if (positive? a) (+ a b) b))) -> (lambda (a b) (if (positive? a) (+ a b) b))
- f14 (line 2): f14 could be (define f14 f11)")
+ " let (line 3): perhaps embed f14: (let () (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))... ->
+ (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
+ f11 (line 1): pointless let: (let () (lambda (a b) (if (positive? a) (+ a b) b))) -> (lambda (a b) (if (positive? a) (+ a b) b))")
+ ; TODO: f14 (line 2): f14 could be (define f14 f11)
(lint-test "(let ()
(define (f11 a b) (if (positive? a) (+ a b) b))
(define (f14 x y) (if (positive? x) (+ x (log y)) (log y)))
- (+ (f11 1 2) (f14 1 2)))" " f14 (line 2): perhaps (if (positive? x) (+ x (log y)) (log y)) -> (f11 x (log y))")
- (lint-test "(let ()
- (define union (let ((z 32)) (set! x (lambda (y) (+ z y))) (lambda args args)))
- (union 1 2))"
- " let (line 2): perhaps (... (define union (let ((z 32)) (set! x (lambda (y) (+ z y))) (lambda... -> (... (let ((union ...)) ...))")
+ (+ (f11 1 2) (f14 1 2)))" "") ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x (log y)) (log y)) -> (f11 x (log y))
+ (lint-test "(let () (define union (let ((z 32)) (set! x (lambda (y) (+ z y))) (lambda args args))) (union 1 2))" "")
(lint-test "(let ()
(define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
(define (f14 x y) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
@@ -89075,9 +89471,9 @@ etc
(define (f14 x y z) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
(+ (f11 1 2) (f14 1 2 3)))"
" f11 (line 1): perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
- f14 (line 2): perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (f11 x y)
f14 (line 2): perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)
let (line 3): f14's parameter 3 is not used, but a value is passed: 3")
+ ; TODO: f14 (line 2): perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (f11 x y)
(lint-test "(let ()
(define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
(define (f14 x y) (let ((w (+ x 1)) (ww 1)) (if (positive? w) (+ x y) y)))
@@ -89091,6 +89487,7 @@ etc
" f12 (line 1): perhaps (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz)) -> (let ((z (+ a 1))) (if (positive? z) (+ a b) z))
f15 (line 2): f15 could be (define f15 f12)
f15 (line 2): perhaps (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww)) -> (let ((w (+ x 1))) (if (positive? w) (+ x y) w))")
+
(lint-test "(let ()
(define (f16 x) (do ((i 0 (+ i 1))) ((= i x)) (display i)))
(define (f17 y) (do ((k 0 (+ k 1))) ((= k y)) (display k)))
@@ -89100,20 +89497,21 @@ etc
(define (f19 x y) (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)))
(+ (f18 1 2) (f19 1 2)))"
" f18 (line 1): perhaps (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b)) -> (if (positive? (let ((c 1)) (+ c 1))) (+ a b) b)
- f19 (line 2): f19 could be (define f19 f18)
f19 (line 2): perhaps (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)) -> (if (positive? (let ((d 1)) (+ d 1))) (+ x y) y)")
+ ; TODO: f19 (line 2): f19 could be (define f19 f18)
+
(lint-test "(let ()
(define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a))
(define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x))
(+ (f20 1) (f21 2)))"
" let (line 1): perhaps (define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a)) -> (define (f20 a) (let ((b a)) (+ (* 2 b) a)))
- let (line 2): perhaps (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x)) -> (define (f21 x) (let ((c x)) (+ (* 2 c) x)))
- f21 (line 2): f21 could be (define f21 f20)")
+ let (line 2): perhaps (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x)) -> (define (f21 x) (let ((c x)) (+ (* 2 c) x)))")
+ ; f21 (line 2): f21 could be (define f21 f20)
(lint-test "(let ()
(define (f20 a) (define f20a (lambda (b) (+ (* 2 b) a))) (f20a a))
(define (f21 x) (define f21a (lambda (c) (+ (* 2 c) x))) (f21a x))
- (+ (f20 1) (f21 2)))"
- " f21 (line 2): f21 could be (define f21 f20)")
+ (+ (f20 1) (f21 2)))" "")
+ ; f21 (line 2): f21 could be (define f21 f20)
(lint-test "(let ()
(define (f22 a) (lambda (b) (+ (* 2 b) a)))
(define (f23 x) (lambda (c) (+ (* 2 c) x)))
@@ -89129,7 +89527,7 @@ etc
"let (line 3): perhaps embed f23:
(let () (define (f22 a) (lambda* ((b 21)) (+ (* 2 b) a))) (define (f23 x)... ->
(... (+ ((f22 1) 2) ((let ((x 2)) (lambda* ((c 21)) (+ (* 2 c) x))) 3)))
- f23 (line 2): f23 could be (define f23 f22)")
+ f23 (line 2): f23 could be (define f23 f22)")
(lint-test "(let ()
(define (f1 x) (abs (* 2 (+ (car x) 1))))
(define (f2 . x) (abs (* 2 (+ (car x) 1))))
@@ -89152,10 +89550,6 @@ etc
" f27 (line 2): f27 could be (define f27 f26)")
(lint-test "(let ()
(define (f31 a b) (if (> a 0) (+ a b) b))
- (define (f32 x y) (if (< 0 x) (+ x y) y))
- (+ (f31 1 2) (f32 1 2)))" " f32 (line 2): f32 could be (define f32 f31)")
- (lint-test "(let ()
- (define (f31 a b) (if (> a 0) (+ a b) b))
(define (f32 x y) (if (< 0 y) (+ x y) y))
(+ (f31 1 2) (f32 1 2)))" "")
(lint-test "(let () (define (f32) (let ((xx 1)) (set! xx 2) (+ xx 1))) (f32) 3)"
@@ -89172,12 +89566,17 @@ etc
" let: perhaps (... (define (f32 x) (let ((xx (car x))) (vector-set! xx 0 2) xx)) (f32... ->
(... (let ((x (list (vector 1)))) (let ((xx (car x))) (vector-set! xx 0 2) xx)) 3)")
(lint-test "(let () (define* (f1 x (y 0)) (+ x y 1)) (+ (f1 2) (f1 2 3) (f1 3) (f1 4) (f1 5) (f1 6)))" "")
- (lint-test "(define f1 (let ((a abs)) (lambda (b) (if (> b 0) (+ (a b) b) b))))
- (define f2 (let ((a log)) (lambda (b) (if (> b 0) (+ (a b) b) b))))"
- " f1: assuming we see all set!s, the binding (a abs) is pointless: perhaps (let ((a abs)) (lambda (b) (if (> b 0) (+ (a b) b) b))) ->
- (let () (lambda (b) (if (> b 0) (+ (abs b) b) b)))
- f2 (line 1): assuming we see all set!s, the binding (a log) is pointless: perhaps (let ((a log)) (lambda (b) (if (> b 0) (+ (a b) b) b))) ->
- (let () (lambda (b) (if (> b 0) (+ (log b) b) b)))")
+ (lint-test "(let () (define (f21 x) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)))) (f21 1))"
+ " let: perhaps (... (define (f21 x) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1))))... ->
+ (... (let f21 ((x 1)) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)))))
+ f21: let variable f21 in (f21 (lambda (y) (+ x y))) shadows the current function?
+ f21: perhaps (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)) -> ((lambda (y) (+ x y)) x 1)
+ f21: f21 has too many arguments: (f21 x 1)
+ f21: perhaps (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)) -> (let ((y x)) (+ x y))")
+
+ (lint-test "(let* ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx)))" " let*: fx needs 1 argument: (fx)")
+ (lint-test "(let* ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx 1 2)))" " let*: fx has too many arguments: (fx 1 2)")
+ (lint-test "(let ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx 1 2)))" " let: fx has too many arguments: (fx 1 2)")
(lint-test "(define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b))"
" define: perhaps (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) ->
@@ -89240,8 +89639,7 @@ etc
(lint-test "(let () (define (f60 x) (* 2 x)) (+ 1 (f60 y)))"
" let: perhaps (... (define (f60 x) (* 2 x)) (+ 1 (f60 y))) -> (... (+ 1 (let ((x y)) (* 2 x))))")
(lint-test "(let () (define f60 (let ((a (lambda (x) (* 2 x)))) a)) (+ 1 (f60 y)))"
- " let: perhaps (... (define f60 (let ((a (lambda (x) (* 2 x)))) a)) (+ 1 (f60 y))) -> (... (let ((f60 (let ((a (lambda (x) (* 2 x)))) a))) ...))
- f60: perhaps (let ((a (lambda (x) (* 2 x)))) a) -> (lambda (x) (* 2 x))")
+ " f60: perhaps (let ((a (lambda (x) (* 2 x)))) a) -> (lambda (x) (* 2 x))")
(lint-test "(let ((x 2)) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)))"
" let: perhaps (let ((x 2)) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0))) -> (let loop ((y 2)) (if (positive? y) (loop (- y 1)) 0))")
(lint-test "(let ((f60 (lambda (x) (* 2 x)))) (+ 1 (f60 y)))"
@@ -89293,6 +89691,7 @@ etc
(define xyz-zy (dilambda (lambda (xyzzy b) (+ b (car xyzzy))) (lambda (xyzzy b c) (list (+ xyzzy c) b))))")
(lint-test "(begin (define x (let ((y 0)) (dilambda (lambda () y) (lambda (z) (set! y z))))) (or (> (x) 0) (= (x) 0)))"
" begin: perhaps (or (> (x) 0) (= (x) 0)) -> (>= (x) 0)")
+ (lint-test "(let* ((x 32) (dx (dilambda (lambda (z) (+ x z)) (lambda (z) (set! x z))))) (set! (dx) 3) x)" "")
(lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (f105 (f104 3)))"
" let: perhaps change f105 to a let: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (f105... ->
@@ -89334,13 +89733,8 @@ etc
" let: perhaps omit this useless let: (let ((abs abs)) (+ x y)) -> (+ x y)
let: abs not used, initially: abs from let
let: assuming we see all set!s, the binding (abs abs) is pointless: perhaps (let ((abs abs)) (+ x y)) -> (let () (+ x y))")
- (lint-test "(define cx (let ((open-input-file open-input-file) (apply apply)) (lambda (file proc) (apply open-input-file file proc))))"
- " cx: assuming we see all set!s, the bindings (apply apply), (open-input-file open-input-file) are pointless: perhaps
- (let ((open-input-file open-input-file) (apply apply)) (lambda (file proc)... ->
- (let () (lambda (file proc) (apply open-input-file file proc)))")
- (lint-test "(define (f x) (define y (g x)) (h (+ y x)))"
- " f: perhaps (... (define y (g x)) (h (+ y x))) -> (... (let ((y (g x))) ...))")
+ (lint-test "(define (f x) (define y (g x)) (h (+ y x)))" "")
(lint-test "(define (f x) (define y (g x)) (define z (h x)) (w (+ y x z)))"
" f: perhaps (... (define y (g x)) (define z (h x)) (w (+ y x z))) -> (... (let ((y (g x)) (z (h x))) ...))
f: the scope of z could be reduced: (... (define z (h x)) (w (+ y x z))) -> (... (let ((z (h x))) (w (+ y x z))))")
@@ -89356,18 +89750,31 @@ etc
f: the scope of z could be reduced:
(... (define z (lambda (a) (if y (z (- a 1))))) (z (+ y x))) -> (... (letrec ((z (lambda (a) (if y (z (- a 1)))))) (z (+ y x))))")
+ (let-temporarily ((*report-clobbered-function-return-value* #t))
+ (lint-test "(let ((v #f)) (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0 #\\a))"
+ " let: perhaps (... (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0 #\\a)) ->
+ (... (set! v (let () (display v) \"a string\")) (string-set! v 0 #\\a))
+ f80: returns a string constant: \"a string\"
+ let: (set! v (f80)) returns a constant sequence, but (string-set! v 0 #\\a) appears to clobber it")
+ (lint-test "(let ((v #f)) (define (f81) (display v) '(0 1 2 3)) (set! v (f81)) (list-set! v 0 32))"
+ " let: perhaps (... (define (f81) (display v) '(0 1 2 3)) (set! v (f81)) (list-set! v 0 32)) ->
+ (... (set! v (let () (display v) '(0 1 2 3))) (list-set! v 0 32))
+ f81: returns a list constant: '(0 1 2 3)
+ let: (set! v (f81)) returns a constant sequence, but (list-set! v 0 32) appears to clobber it"))
+
(let-temporarily ((*report-shadowed-variables* #t))
(lint-test "(let ((f33 33)) (define f33 4) (g f33 1))"
- " let: perhaps (... (define f33 4) (g f33 1)) -> (... (let ((f33 4)) ...))
- let: let variable f33 in (define f33 4) shadows an earlier declaration
- let: let variable f33 is redefined in the let body. Perhaps use set! instead: (set! f33 4)
- let: f33 not used, initially: 33 from let")
+ " let: let variable f33 in (define f33 4) shadows an earlier declaration
+ let: let variable f33 is redefined in the let body. Perhaps use set! instead: (set! f33 4)
+ let: f33 not used, initially: 33 from let")
(lint-test "(let ((f33 33)) (define (f33 x) (+ x 4)) (g f33 1))"
" let: let variable f33 in (define (f33 x) (+ x 4)) shadows an earlier declaration
let: let variable f33 is declared twice
let: f33 not used, initially: 33 from let")
(lint-test "(let ((f33 33)) (if (g x) (begin (define f33 4) (g f33)) 4))"
- " let: begin variable f33 in (define f33 4) shadows an earlier declaration
+ " let: perhaps move the let to the true branch:
+ (let ((f33 33)) (if (g x) (begin (define f33 4) (g f33)) 4)) -> (if (g x) (let ((f33 33)) (define f33 4) (g f33)) 4)
+ let: begin variable f33 in (define f33 4) shadows an earlier declaration
let: let variable f33 is redefined in the let body. Perhaps use set! instead: (set! f33 4)
let: f33 not used, initially: 33 from let"))
@@ -89393,6 +89800,10 @@ etc
" let: perhaps (... (define (f50 y z) (y (+ z 1))) (f50 (lambda (a b) (+ a 1)) 2)) ->
(... (let ((y (lambda (a b) (+ a 1))) (z 2)) (y (+ z 1))))
let: f50's parameter y is passed (lambda (a b) (+ a 1)) and called (y (+ z 1)), but (lambda (a b) (+ a 1)) needs 2 arguments"))
+
+ (let-temporarily ((*report-boolean-functions-misbehaving* #t))
+ (lint-test "(let () (define (f80? x) (if z (display x) (string-append x y z))) (display x) f80?)"
+ " let: f80? looks boolean, but it can return (string-append x y z)"))
(lint-test "(let () (define x 2) (display x) (set! y 32) (display y) (* y (log y)))"
" let: perhaps (... (define x 2) (display x) (set! y 32) (display y) (* y (log y))) -> (... (let ((x 2)) ...))
@@ -89597,7 +90008,9 @@ etc
let: x is an integer, so (and x (< x 1) x) -> (and (< x 1) x)")
(lint-test "(let ((x 1)) (not x))" " let: perhaps (let ((x 1)) (not x)) -> (not 1) let: x is an integer, so (not x) -> #f")
(lint-test "(gensym 'ok)" " gensym: in (gensym 'ok), gensym's argument should be a string, but 'ok is a symbol?")
- (lint-test "(string-ref 'ok 0)" " string-ref: in (string-ref 'ok 0), string-ref's argument 1 should be a string, but 'ok is a symbol?")
+ (lint-test "(string-ref 'ok 0)"
+ " string-ref: in (string-ref 'ok 0), string-ref's argument 1 should be a string, but 'ok is a symbol?
+ string-ref: (string-ref 'ok 0): string-ref argument 1, ok, is a symbol but should be a string")
(lint-test "(+ 2 #X11)" " reader[0]: unknown # object: #X11 use #x11 not #X11 +: perhaps (+ 2 17) -> 19")
(lint-test "(let ((l 1)) (+ l 1))" " let: perhaps (let ((l 1)) (+ l 1)) -> (+ 1 1) let: \"l\" is a really bad variable name")
@@ -89674,6 +90087,64 @@ etc
(lint-test "(- (cond ((char-position c dline id-pos)) (else 0)) 1)"
" -: perhaps (cond ((char-position c dline id-pos)) (else 0)) -> (or (char-position c dline id-pos) 0)")
(lint-test "(begin (cond ((find-sound v) => close-sound)) (display x))" "") ; check for side-effect confusion
+
+ (lint-test "(let ((p (open-output-file str))) (display 32 p) x)"
+ " let: in (let ((p (open-output-file str))) (display 32 p) x) perhaps p is opened via (open-output-file str), but never closed")
+ (lint-test "(let ((p #f)) (if x (set! p (open-output-file str))) (display 32 p) x)"
+ " let: in (let ((p #f)) (if x (set! p (open-output-file str))) (display 32 p) x)
+ perhaps p is opened via (set! p (open-output-file str)), but never closed")
+
+ (lint-test "(cdr '(a))" " cdr: perhaps (cdr '(a)) -> ()")
+ (lint-test "(char-upcase #\\a)" " char-upcase: perhaps (char-upcase #\\a) -> #\\A")
+ (lint-test "(char-upper-case? #\\a)" " char-upper-case?: perhaps (char-upper-case? #\\a) -> #f")
+ (lint-test "(load \"\")" " load: load needs a real file name, not the empty string: (load \"\")")
+ (lint-test "(load)" " load: load needs at least 1 argument: (load)")
+ (lint-test "(write-byte 300)" " write-byte: write-byte argument must be (<= 0 byte 255): (write-byte 300)")
+ (lint-test "(write-byte 95 (current-output-port))"
+ " write-byte: (current-output-port) is the default port for write-byte: (write-byte 95 (current-output-port))")
+ (lint-test "(peek-char (current-input-port))"
+ " peek-char: (current-input-port) is the default port for peek-char: (peek-char (current-input-port))")
+ (lint-test "(write-char #\\newline)" " write-char: perhaps (write-char #\\newline) -> (newline)")
+ (lint-test "(write-char #\\newline port)" " write-char: perhaps (write-char #\\newline port) -> (newline port)")
+ (lint-test "(write-string \"\n\")" " write-string (line 1): perhaps (write-string \"\n\") -> (newline)")
+ (lint-test "(define (listtail x k) (if (zero? k) x (listtail (cdr x) (- k 1))))" " listtail: listtail is the same as the built-in function list-tail")
+ (lint-test "(char? #\\a)" " char?: perhaps (char? #\\a) -> #t")
+ (lint-test "(symbol->string (keyword->symbol :hi))" " symbol->string: perhaps (keyword->symbol :hi) -> 'hi")
+ (lint-test "(keyword->symbol :hi)" " keyword->symbol: perhaps (keyword->symbol :hi) -> 'hi")
+ (lint-test "(symbol->keyword 'hiho)" " symbol->keyword: perhaps (symbol->keyword 'hiho) -> :hiho")
+ (lint-test "(positive? 1.0)" " positive?: perhaps (positive? 1.0) -> #t")
+ (lint-test "(list? 'a)" " list?: perhaps (list? 'a) -> #f")
+ (lint-test "(pair? 'a)" " pair?: perhaps (pair? 'a) -> #f")
+ (lint-test "(proper-list? '(this - that))" " proper-list?: perhaps (proper-list? '(this - that)) -> #t")
+ (lint-test "(symbol? 'let)" " symbol?: perhaps (symbol? 'let) -> #t")
+ (lint-test "(keyword? :rest)" " keyword?: perhaps (keyword? :rest) -> #t")
+ (lint-test "(char? 'a)" " char?: perhaps (char? 'a) -> #f")
+ (lint-test "(lcm 3/4 2)" " lcm: perhaps (lcm 3/4 2) -> 6")
+ (lint-test "(string->list \"12345\" 2 1)" " string->list: these string->list indices make no sense: (string->list \"12345\" 2 1)")
+ (lint-test "(list->vector '(1 2 3))" " list->vector: perhaps (list->vector '(1 2 3)) -> #(1 2 3)")
+ (lint-test "(port-filename *stdout*)" " port-filename: (port-filename *stdout*): \"*stdout*\"")
+ (lint-test "(call-with-input-string \"(+ 1 2 3)\" s7-version)"
+ " call-with-input-string: call-with-input-string argument should be a function of one argument: s7-version")
+ (lint-test "(call-with-input-file tmp-output-file s7-version)"
+ " call-with-input-file: call-with-input-file argument should be a function of one argument: s7-version")
+ (lint-test "(vector? vector?)" " vector?: perhaps (vector? vector?) -> #f")
+ (lint-test "(vector? begin)" " vector?: perhaps (vector? begin) -> #f")
+ (lint-test "(procedure? apply)" " procedure?: perhaps (procedure? apply) -> #t")
+ (lint-test "(dilambda? quasiquote)" " dilambda?: perhaps (dilambda? quasiquote) -> #f")
+ (lint-test "(number? most-negative-fixnum)" " number?: perhaps (number? most-negative-fixnum) -> #t")
+ (lint-test "(complex? pi)" " complex?: perhaps (complex? pi) -> #t")
+ (lint-test "(exact? 1.0)" " exact?: perhaps (exact? 1.0) -> #f")
+ (lint-test "(constant? most-positive-fixnum)" " constant?: perhaps (constant? most-positive-fixnum) -> #t")
+ (lint-test "(vector-ref #(hi) 0)" " vector-ref: perhaps (vector-ref #(hi) 0) -> 'hi")
+ (lint-test "(close-output-port (current-output-port))"
+ " close-output-port: (current-output-port) is the default port for close-output-port: (close-output-port (current-output-port))")
+ (lint-test "(string-ref \"\" 0)" " string-ref: (string-ref \"\" 0) is an error")
+ (lint-test "(string-ref \"abc\" -1)" " string-ref: (string-ref \"abc\" -1): string-ref argument 2, -1, is an integer but should be a non-negative integer")
+ (lint-test "(vector-ref #() 0)" " vector-ref: (vector-ref #() 0) is an error")
+ (lint-test "(string-ref \"abc\" 1)" " string-ref: perhaps (string-ref \"abc\" 1) -> #\\b")
+ (lint-test " (dilambda 1 2)"
+ " dilambda: in (dilambda 1 2), dilambda's argument 1 should be a procedure, but 1 is an integer?
+ dilambda: in (dilambda 1 2), dilambda's argument 2 should be a procedure, but 2 is an integer?")
(when (provided? 'snd)
(lint-test "(begin (cond ((find-sound \"test.snd\") => close-sound)) (display x))" "")
@@ -89705,11 +90176,43 @@ etc
(lint-test "(gtk_scale_set_value_pos (GTK_SCALE scale) x)" "")
(lint-test "(gtk_scale_set_value_pos (GTK_SCALE scale) 1/2)"
" gtk_scale_set_value_pos: in (gtk_scale_set_value_pos (GTK_SCALE scale) 1/2),
- gtk_scale_set_value_pos's argument 2 should be an integer, but 1/2 is rational?")
- ))
+ gtk_scale_set_value_pos's argument 2 should be an integer, but 1/2 is rational?")))
+
+ (let ((out-vars (*lint* 'out-vars)))
+ (test (out-vars 'hi '(a b) '(+ a b)) '(() ()))
+ (test (out-vars 'hi '(a b) '(set! a b)) '(() ()))
+ (test (out-vars 'hi '(a b) '(set! c (+ a b))) '(() (c)))
+ (test (out-vars 'hi '(a b) '(set! a (+ b c))) '((c) ()))
+ (test (out-vars 'hi '(a b) '(set! c (+ (* a b) c))) '((c) (c)))
+ (test (out-vars 'hi '(a b) '(set! (c 0) (+ (* a b) c))) '((c) (c)))
+ (test (out-vars 'hi '(a b) '(let ((c 1)) (+ (* a b) c))) '(() ()))
+ (test (out-vars 'hi '(a b) '(let ((c (+ a b))) (set! c (* a b)))) '(() ()))
+ (test (out-vars 'hi '(a b) '(let loop ((c (+ a b))) (set! c (loop a)))) '(() ()))
+ (test (out-vars 'hi '(a b) '(let loop ((c (+ a b))) (set! c (loop d)))) '((d) ()))
+ (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! c (loop d)))) '((loop) ()))
+ (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! e d) (+ a b c d))) '(() (e)))
+ (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! e d) (+ a b c d e f g))) '((g f e) (e)))
+ (test (out-vars 'hi '(a b) '(let ((c 1) (d (+ c 1))) (+ (* a b) c))) '((c) ()))
+ (test (out-vars 'hi '(a b) '(let* ((c 1) (d (+ c 1))) (+ (* a b) c))) '(() ()))
+ (test (out-vars 'hi '(a b) '(let ((g 1)) (let ((c g)) (* c g)))) '(() ()))
+ (test (out-vars 'hi '(a b) '(let ((g 1)) (letrec ((c g)) (* c g)))) '(() ()))
+ (test (out-vars 'hi '(a b) '(do ((i 0 (+ i 1))) ((= i 10) i) (display i))) '(() ()))
+ (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j))) ((= i 10) i) (display i))) '((j) ()))
+ (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) i) (display i))) '(() ()))
+ (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) k) (display i))) '((k) ()))
+ (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) k) (set! n i))) '((k) (n)))
+ (test (out-vars 'hi '(a b) '(lambda () (+ a b))) '(() ()))
+ (test (out-vars 'hi '(a b) '(lambda (c) (+ a b c))) '(() ()))
+ (test (out-vars 'hi '(a b) '(lambda c (+ a b c))) '(() ()))
+ (test (out-vars 'hi '(a b) '(lambda (c . d) (+ a b c d))) '(() ()))
+ (test (out-vars 'hi '(a b) '(lambda (c . d) (set! e (+ a b c d)))) '(() (e)))
+ (test (out-vars 'hi '(a b) '(lambda* ((c 1) (d 2)) (+ a b c d))) '(() ()))
+ (test (out-vars 'hi '(a b) '(let () (define c 1) (+ a b c))) '(() ()))
+ (test (out-vars 'hi '(a b) '(let () (define c 1) (+ a b c d))) '((d) ()))
+ (test (out-vars 'hi '(a b) '(let* () (define c 1) (+ a b c d))) '((d) ()))
+ (test (out-vars 'hi '(a b) '(let () (define (c s) (* s 2)) (+ a b (c d)))) '((d) ())))
#|
- ;; a way to test internal lint functions:
(define fmatch (*lint* 'function-match))
(define walkfunc (*lint* 'lint-walk-function))
(define (f1 x) (if (< x 3) (+ x 1) (+ x 2)))
diff --git a/selection.scm b/selection.scm
index 699cb8e..4d82722 100644
--- a/selection.scm
+++ b/selection.scm
@@ -48,11 +48,12 @@
(error 'wrong-number-of-channels "swap-selection-channels needs a stereo selection")
(let* ((snd-chn0 (find-selection-sound ()))
(snd-chn1 (find-selection-sound snd-chn0)))
- (let ((beg (selection-position))
- (len (selection-framples)))
- (if snd-chn1
- (swap-channels (car snd-chn0) (cadr snd-chn0) (car snd-chn1) (cadr snd-chn1) beg len)
- (error 'wrong-number-of-channels "swap-selection-channels needs two channels to swap"))))))))))
+ (if snd-chn1
+ (swap-channels (car snd-chn0) (cadr snd-chn0)
+ (car snd-chn1) (cadr snd-chn1)
+ (selection-position)
+ (selection-framples))
+ (error 'wrong-number-of-channels "swap-selection-channels needs two channels to swap")))))))))
;;; -------- replace-with-selection
diff --git a/snd-1.h b/snd-1.h
index d4a1e99..0655590 100644
--- a/snd-1.h
+++ b/snd-1.h
@@ -1164,7 +1164,6 @@ void redirect_xen_error_to(void (*handler)(const char *msg, void *ufd), void *da
void redirect_errors_to(void (*handler)(const char *msg, void *ufd), void *data);
void redirect_everything_to(void (*handler)(const char *msg, void *ufd), void *data);
Xen snd_catch_any(Xen_catch_t body, void *body_data, const char *caller);
-Xen snd_throw(Xen key, Xen args);
Xen snd_no_such_file_error(const char *caller, Xen filename);
Xen snd_no_such_channel_error(const char *caller, Xen snd, Xen chn);
Xen snd_bad_arity_error(const char *caller, Xen errstr, Xen proc);
diff --git a/snd-data.c b/snd-data.c
index dc7de16..be62c55 100644
--- a/snd-data.c
+++ b/snd-data.c
@@ -966,13 +966,15 @@ sync_info *snd_sync(int sync)
si->chans = chans;
for (i = 0, j = 0; i < ss->max_sounds; i++)
{
- int k;
sp = ss->sounds[i];
if ((sp) &&
(sp->inuse == SOUND_NORMAL) &&
(sp->sync == sync))
- for (k = 0; k < sp->nchans; k++, j++)
- si->cps[j] = sp->chans[k];
+ {
+ int k;
+ for (k = 0; k < sp->nchans; k++, j++)
+ si->cps[j] = sp->chans[k];
+ }
}
return(si);
}
diff --git a/snd-draw.c b/snd-draw.c
index feae2c2..de08e79 100644
--- a/snd-draw.c
+++ b/snd-draw.c
@@ -2033,7 +2033,7 @@ Xen_wrap_3_args(g_set_combined_data_color_w, g_set_combined_data_color)
void g_init_draw(void)
{
#if HAVE_SCHEME
- s7_pointer i, b, p, t, r, mx, s, v, pcl_p, pcl_t;
+ s7_pointer i, b, p, t, r, mx, s, v, pcl_p, pcl_t, bi;
i = s7_make_symbol(s7, "integer?");
b = s7_make_symbol(s7, "boolean?");
p = s7_make_symbol(s7, "pair?");
@@ -2044,6 +2044,7 @@ void g_init_draw(void)
t = s7_t(s7);
pcl_p = s7_make_circular_signature(s7, 0, 1, p);
pcl_t = s7_make_circular_signature(s7, 0, 1, t);
+ bi = s7_make_signature(s7, 2, i, b);
#endif
dialog_widgets = Xen_undefined;
@@ -2061,7 +2062,7 @@ void g_init_draw(void)
Xen_define_typed_procedure(S_fill_rectangle, g_fill_rectangle_w, 4, 5, 0, H_fill_rectangle, s7_make_signature(s7, 10, b, i, i, i, i, t, t, i, b, p));
Xen_define_typed_procedure(S_fill_polygon, g_fill_polygon_w, 1, 4, 0, H_fill_polygon, s7_make_signature(s7, 6, v, v, t, t, i, p));
Xen_define_typed_procedure(S_make_graph_data, g_make_graph_data_w, 0, 5, 0, H_make_graph_data, s7_make_signature(s7, 6, t, t, t, t, i, i));
- Xen_define_typed_procedure(S_graph_data, g_graph_data_w, 1, 7, 0, H_graph_data, s7_make_signature(s7, 9, t, t, t, t, t, i, i, i, p));
+ Xen_define_typed_procedure(S_graph_data, g_graph_data_w, 1, 7, 0, H_graph_data, s7_make_signature(s7, 9, t, t, t, t, t, bi, bi, bi, p));
Xen_define_typed_procedure(S_main_widgets, g_main_widgets_w, 0, 0, 0, H_main_widgets, pcl_p);
Xen_define_typed_procedure(S_dialog_widgets, g_dialog_widgets_w, 0, 0, 0, H_dialog_widgets, pcl_p);
diff --git a/snd-edits.c b/snd-edits.c
index eefe833..8afb338 100644
--- a/snd-edits.c
+++ b/snd-edits.c
@@ -9326,8 +9326,7 @@ void g_init_edits(void)
Xen_define_typed_procedure(S_is_snd_to_sample, g_is_snd_to_sample_w, 1, 0, 0, H_is_snd_to_sample, s7_make_signature(s7, 2, b, t));
Xen_define_typed_procedure(S_make_snd_to_sample, g_make_snd_to_sample_w, 0, 1, 0, H_make_snd_to_sample, s7_make_signature(s7, 2, t, t));
Xen_define_typed_procedure(S_snd_to_sample, g_snd_to_sample_w, 2, 1, 0, H_snd_to_sample, s7_make_signature(s7, 4, f, t, i, i));
- /* Xen_define_typed_procedure(S_edit_list_to_function, g_edit_list_to_function_w, 0, 4, 0, H_edit_list_to_function, s7_make_signature(s7, 5, t, t, t, i, i)); */
- Xen_define_procedure(S_edit_list_to_function, g_edit_list_to_function_w, 0, 4, 0, H_edit_list_to_function);
+ Xen_define_unsafe_typed_procedure(S_edit_list_to_function, g_edit_list_to_function_w, 0, 4, 0, H_edit_list_to_function, s7_make_signature(s7, 5, t, t, t, i, i));
/* not safe because it calls eval-string */
#define H_save_hook S_save_hook " (snd name): called each time a file is about to be saved. \
diff --git a/snd-fft.c b/snd-fft.c
index 87021c7..90ce009 100644
--- a/snd-fft.c
+++ b/snd-fft.c
@@ -2246,8 +2246,12 @@ static void init_xen_transform(void)
static Xen g_integer_to_transform(Xen n)
{
#define H_integer_to_transform "(" S_integer_to_transform " n) returns a transform object corresponding to the given integer"
+ int type;
Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_transform, "an integer");
- return(new_xen_transform(Xen_integer_to_C_int(n)));
+ type = Xen_integer_to_C_int(n);
+ if (is_transform(type))
+ return(new_xen_transform(type));
+ return(Xen_false);
}
diff --git a/snd-gl.scm b/snd-gl.scm
index cddad33..d217916 100644
--- a/snd-gl.scm
+++ b/snd-gl.scm
@@ -326,9 +326,9 @@
(let ((rl (channel->float-vector (left-sample) 512))
(im (make-float-vector 512)))
(mus-fft rl im)
- (let ((peak (* 2 (max (float-vector-peak rl) (float-vector-peak im)))))
- (float-vector-scale! rl (/ 1.0 peak))
- (float-vector-scale! im (/ 1.0 peak)))
+ (let ((peak (/ (* 2 (max (float-vector-peak rl) (float-vector-peak im))))))
+ (float-vector-scale! rl peak)
+ (float-vector-scale! im peak))
;; display each element in the complex plane rotated to stack along the x axis
(glNewList gl-list GL_COMPILE)
(glBegin GL_LINES)
diff --git a/snd-gtk.scm b/snd-gtk.scm
index 093c10e..b6b6f2b 100644
--- a/snd-gtk.scm
+++ b/snd-gtk.scm
@@ -350,16 +350,14 @@
(snd (car context))
(chn (cadr context)))
(if (sound-property 'dragger snd)
- (begin
- (do ((i 0 (+ i 1)))
- ((= i (channels snd)))
- (if (not (= i chn))
- (begin
- (set! (y-zoom-slider snd i) (* val val))
- (set! (y-position-slider snd i) (y-position-slider snd chn)))))
- (g_signal_stop_emission (GPOINTER adj)
- (g_signal_lookup "value_changed" (G_OBJECT_TYPE (G_OBJECT adj)))
- 0)))))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels snd))
+ (g_signal_stop_emission (GPOINTER adj)
+ (g_signal_lookup "value_changed" (G_OBJECT_TYPE (G_OBJECT adj)))
+ 0))
+ (unless (= i chn)
+ (set! (y-zoom-slider snd i) (* val val))
+ (set! (y-position-slider snd i) (y-position-slider snd chn)))))))
(set! (sound-property 'dragger snd) #t)
(set! (sound-property 'save-state-ignore snd)
diff --git a/snd-gxcolormaps.c b/snd-gxcolormaps.c
index a678495..b8f4685 100644
--- a/snd-gxcolormaps.c
+++ b/snd-gxcolormaps.c
@@ -1032,8 +1032,12 @@ static void init_xen_colormap(void)
static Xen g_integer_to_colormap(Xen n)
{
#define H_integer_to_colormap "(" S_integer_to_colormap " n) returns a colormap object corresponding to the given integer"
+ int id;
Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_colormap, "an integer");
- return(new_xen_colormap(Xen_integer_to_C_int(n)));
+ id = Xen_integer_to_C_int(n);
+ if (is_colormap(id))
+ return(new_xen_colormap(id));
+ return(Xen_false);
}
diff --git a/snd-lint.scm b/snd-lint.scm
index f67e4ec..b66670f 100644
--- a/snd-lint.scm
+++ b/snd-lint.scm
@@ -138,6 +138,15 @@
ladspa-dir left-sample lgamma linear->db lisp-graph-style lisp-graph?
listener-color listener-colorized listener-font listener-prompt listener-selection listener-text-color little-endian?
localtime locsig-ref locsig-reverb-ref locsig-type locsig? log-freq-start main-menu main-widgets
+
+ make-env make-pulsed-env make-one-pole make-fir-coeffs make-formant make-all-pass-bank make-iir-filter make-filter
+ make-comb make-polywave make-bezier make-delay make-nrxycos make-moving-norm make-nrxysin make-firmant make-cairo
+ make-sawtooth-wave make-color make-graph-data make-oscil make-oscil-bank make-two-zero make-fft-window make-moving-max
+ make-filtered-comb-bank make-filtered-comb make-nsin make-rand-interp make-one-pole-all-pass make-rand make-formant-bank
+ make-all-pass make-table-lookup make-one-zero make-notch make-square-wave make-moving-average make-polyshape
+ make-triangle-wave make-comb-bank make-ncos make-rxyk!sin make-fir-filter make-two-pole make-asymmetric-fm
+ make-rxyk!cos make-pulse-train
+
mark->integer mark-color mark-home mark-hook mark-name mark-properties
mark-property mark-sample mark-sync mark-sync-max mark-tag-height mark-tag-width mark?
marks max-regions max-transform-peaks maxamp maxamp-position menu-widgets min-dB mix->integer mix-color mix-dialog-mix mix-drag-hook mix-home
@@ -185,6 +194,22 @@
zoom-focus-style zoom-one-pixel)))
+;;; ---------------- Snd makers ----------------
+(let ((h (*lint* 'makers)))
+ (for-each
+ (lambda (s)
+ (hash-table-set! h s #t))
+ '(make-env make-pulsed-env make-one-pole make-fir-coeffs make-convolve make-wave-train make-formant make-all-pass-bank
+ make-iir-filter make-filter make-comb make-sample->file make-polywave make-bezier make-delay make-nrxycos make-moving-norm
+ make-nrxysin make-firmant make-cairo make-sawtooth-wave make-color make-player make-graph-data make-oscil make-oscil-bank
+ make-two-zero make-fft-window make-moving-max make-filtered-comb-bank make-filtered-comb make-nsin make-rand-interp
+ make-one-pole-all-pass make-rand make-formant-bank make-readin make-all-pass make-phase-vocoder make-table-lookup
+ make-one-zero make-notch make-square-wave make-file->frample make-moving-average make-granulate make-polyshape
+ make-locsig make-triangle-wave make-mix-sampler make-move-sound make-comb-bank make-ncos make-rxyk!sin
+ make-variable-graph make-fir-filter make-file->sample make-ssb-am make-two-pole make-region-sampler
+ make-frample->file make-asymmetric-fm make-sampler make-region make-snd->sample make-src make-rxyk!cos make-pulse-train)))
+
+
;;; ---------------- Snd booleans ----------------
;;; add Snd/clm type checkers to lint's table (lint assumes that these take one argument)
diff --git a/snd-marks.c b/snd-marks.c
index 06e18bd..ac3f5ea 100644
--- a/snd-marks.c
+++ b/snd-marks.c
@@ -2040,6 +2040,9 @@ static xen_mark *xen_mark_make(int n)
return(new_v);
}
+#if HAVE_SCHEME
+ static s7_pointer g_mark_methods = NULL;
+#endif
Xen new_xen_mark(int n)
{
@@ -2048,7 +2051,16 @@ Xen new_xen_mark(int n)
return(Xen_false);
mx = xen_mark_make(n);
+#if HAVE_SCHEME
+ {
+ s7_pointer m;
+ m = Xen_make_object(xen_mark_tag, mx, 0, free_xen_mark);
+ s7_object_set_let(m, g_mark_methods);
+ return(m);
+ }
+#else
return(Xen_make_object(xen_mark_tag, mx, 0, free_xen_mark));
+#endif
}
@@ -2078,13 +2090,19 @@ static Xen s7_xen_mark_copy(s7_scheme *sc, s7_pointer args)
}
return(obj);
}
+
+static s7_pointer mark_to_let_func = NULL;
#endif
static void init_xen_mark(void)
{
#if HAVE_SCHEME
- xen_mark_tag = s7_new_type_x(s7, "<mark>", print_xen_mark, free_xen_mark, s7_xen_mark_equalp, NULL, NULL, NULL, NULL, s7_xen_mark_copy, NULL, NULL);
+ {
+ g_mark_methods = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), mark_to_let_func)));
+ s7_gc_protect(s7, g_mark_methods);
+ xen_mark_tag = s7_new_type_x(s7, "<mark>", print_xen_mark, free_xen_mark, s7_xen_mark_equalp, NULL, NULL, NULL, NULL, s7_xen_mark_copy, NULL, NULL);
+ }
#else
#if HAVE_RUBY
xen_mark_tag = Xen_make_object_type("XenMark", sizeof(xen_mark));
@@ -2113,8 +2131,12 @@ static void init_xen_mark(void)
static Xen g_integer_to_mark(Xen n)
{
#define H_integer_to_mark "(" S_integer_to_mark " n) returns a mark object corresponding to the given integer"
+ mark *m;
Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_mark, "an integer");
- return(new_xen_mark(Xen_integer_to_C_int(n)));
+ m = find_mark_from_id(Xen_integer_to_C_int(n), NULL, AT_CURRENT_EDIT_POSITION);
+ if (m)
+ return(new_xen_mark(m->id));
+ return(Xen_false);
}
@@ -2909,6 +2931,22 @@ Xen_wrap_3_args(g_set_mark_property_w, g_set_mark_property)
#if HAVE_SCHEME
static s7_pointer acc_mark_tag_height(s7_scheme *sc, s7_pointer args) {return(g_set_mark_tag_height(s7_cadr(args)));}
static s7_pointer acc_mark_tag_width(s7_scheme *sc, s7_pointer args) {return(g_set_mark_tag_width(s7_cadr(args)));}
+
+static s7_pointer s7_mark_to_let(s7_scheme *sc, s7_pointer args)
+{
+ /* this is called upon (object->let <mark>) */
+ s7_pointer mark, env, val;
+ mark = s7_car(args);
+ env = s7_cadr(args);
+ val = mark_get(mark, MARK_NAME, Xen_undefined, S_mark_name);
+ if ((s7_is_string(val)) &&
+ (s7_string_length(val) > 0))
+ s7_varlet(sc, env, s7_make_symbol(sc, "name"), val);
+ s7_varlet(sc, env, s7_make_symbol(sc, "sample"), mark_get(mark, MARK_SAMPLE, Xen_undefined, S_mark_sample));
+ s7_varlet(sc, env, s7_make_symbol(sc, "sync"), mark_get(mark, MARK_SYNC, Xen_undefined, S_mark_sync));
+ s7_varlet(sc, env, s7_make_symbol(sc, "home"), mark_get(mark, MARK_HOME, Xen_undefined, S_mark_home));
+ return(env);
+}
#endif
void g_init_marks(void)
@@ -2928,6 +2966,8 @@ void g_init_marks(void)
pl_im = s7_make_signature(s7, 2, i, m);
pl_add = s7_make_signature(s7, 6, s7_make_signature(s7, 2, m, b), i, t, t, s7_make_signature(s7, 2, s, b), i);
pl_i = s7_make_circular_signature(s7, 0, 1, i);
+
+ mark_to_let_func = s7_make_function(s7, "mark->let", s7_mark_to_let, 2, 0, false, "mark->let");
#endif
init_xen_mark();
diff --git a/snd-mix.c b/snd-mix.c
index a104f54..2fa733b 100644
--- a/snd-mix.c
+++ b/snd-mix.c
@@ -2613,8 +2613,13 @@ static Xen g_xen_mix_to_string(Xen obj)
}
#endif
+#if HAVE_SCHEME
+static s7_pointer g_mix_methods = NULL;
+static s7_pointer g_mix_sampler_methods = NULL;
+static s7_pointer mix_to_let_func = NULL;
+static s7_pointer mix_sampler_to_let_func = NULL;
+#else
-#if (!HAVE_SCHEME)
static bool xen_mix_equalp(xen_mix *v1, xen_mix *v2)
{
return((v1 == v2) ||
@@ -2645,7 +2650,16 @@ Xen new_xen_mix(int n)
return(Xen_false);
mx = xen_mix_make(n);
+#if HAVE_SCHEME
+ {
+ s7_pointer m;
+ m = Xen_make_object(xen_mix_tag, mx, 0, free_xen_mix);
+ s7_object_set_let(m, g_mix_methods);
+ return(m);
+ }
+#else
return(Xen_make_object(xen_mix_tag, mx, 0, free_xen_mix));
+#endif
}
@@ -2675,6 +2689,8 @@ static Xen s7_xen_mix_copy(s7_scheme *sc, s7_pointer args)
static void init_xen_mix(void)
{
#if HAVE_SCHEME
+ g_mix_methods = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), mix_to_let_func)));
+ s7_gc_protect(s7, g_mix_methods);
xen_mix_tag = s7_new_type_x(s7, "<mix>", print_xen_mix, free_xen_mix, s7_xen_mix_equalp, NULL, NULL, NULL, s7_xen_mix_length, s7_xen_mix_copy, NULL, NULL);
#else
#if HAVE_RUBY
@@ -2707,7 +2723,9 @@ static Xen g_integer_to_mix(Xen n)
{
#define H_integer_to_mix "(" S_integer_to_mix " n) returns a mix object corresponding to the given integer"
Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_mix, "an integer");
- return(new_xen_mix(Xen_integer_to_C_int(n)));
+ if (mix_is_active(Xen_integer_to_C_int(n)))
+ return(new_xen_mix(Xen_integer_to_C_int(n)));
+ return(Xen_false);
}
@@ -3592,7 +3610,16 @@ Xen g_make_mix_sampler(Xen mix_id, Xen ubeg)
if (mf->sf)
{
mf->sf->region = md->id;
+#if HAVE_SCHEME
+ {
+ s7_pointer m;
+ m = Xen_make_object(mf_tag, mf, 0, free_mf);
+ s7_object_set_let(m, g_mix_sampler_methods);
+ return(m);
+ }
+#else
return(Xen_make_object(mf_tag, mf, 0, free_mf));
+#endif
}
free(mf);
}
@@ -3989,6 +4016,44 @@ static s7_pointer acc_mix_tag_height(s7_scheme *sc, s7_pointer args) {return(g_s
static s7_pointer acc_mix_tag_width(s7_scheme *sc, s7_pointer args) {return(g_set_mix_tag_width(s7_cadr(args)));}
static s7_pointer acc_mix_waveform_height(s7_scheme *sc, s7_pointer args) {return(g_set_mix_waveform_height(s7_cadr(args)));}
static s7_pointer acc_with_mix_tags(s7_scheme *sc, s7_pointer args) {return(g_set_with_mix_tags(s7_cadr(args)));}
+
+static s7_pointer s7_mix_sampler_to_let(s7_scheme *sc, s7_pointer args)
+{
+ /* this is called upon (object->let <mix-sampler>) */
+ s7_pointer m, env;
+ mix_fd *fd;
+
+ m = s7_car(args);
+ env = s7_cadr(args);
+ fd = Xen_to_mix_sampler(m);
+
+ if ((fd) && (fd->sf) &&
+ (mix_is_active(fd->sf->region)) &&
+ (fd->md) &&
+ (fd->sf->region == (fd->md->id)))
+ {
+ mix_info *md;
+ md = fd->md;
+
+ s7_varlet(sc, env, s7_make_symbol(sc, "mix"), (mix_is_active(md->id)) ? new_xen_mix(md->id) : Xen_false);
+ s7_varlet(sc, env, s7_make_symbol(sc, "source"), (md->in_filename) ? s7_make_string(sc, md->in_filename) : Xen_false);
+ s7_varlet(sc, env, s7_make_symbol(sc, "start"), s7_make_integer(sc, fd->sf->initial_samp));
+ s7_varlet(sc, env, s7_make_symbol(sc, "position"), s7_make_integer(sc, fd->sf->loc));
+ s7_varlet(sc, env, s7_make_symbol(sc, "eof"), s7_make_boolean(sc, fd->sf->at_eof));
+ }
+ return(env);
+}
+
+static s7_pointer s7_mix_to_let(s7_scheme *sc, s7_pointer args)
+{
+ /* this is called upon (object->let <mix>) */
+ s7_pointer m, env;
+ m = s7_car(args);
+ env = s7_cadr(args);
+
+ s7_varlet(sc, env, s7_make_symbol(sc, "position"), g_mix_position(m));
+ return(env);
+}
#endif
void g_init_mix(void)
@@ -4004,11 +4069,16 @@ void g_init_mix(void)
f = s7_make_symbol(s7, "float?");
fv = s7_make_symbol(s7, "float-vector?");
t = s7_t(s7);
+
+ mix_to_let_func = s7_make_function(s7, "mix->let", s7_mix_to_let, 2, 0, false, "mix->let");
+ mix_sampler_to_let_func = s7_make_function(s7, "mix-sampler->let", s7_mix_sampler_to_let, 2, 0, false, "mix-sampler->let");
#endif
init_xen_mix();
#if HAVE_SCHEME
+ g_mix_sampler_methods = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), mix_sampler_to_let_func)));
+ s7_gc_protect(s7, g_mix_sampler_methods);
mf_tag = s7_new_type_x(s7, "<mix-sampler>", print_mf, free_mf, s7_equalp_mf, NULL, s7_read_mix_sample, NULL, NULL, NULL, NULL, NULL);
#else
mf_tag = Xen_make_object_type("MixSampler", sizeof(mix_fd));
diff --git a/snd-motif.scm b/snd-motif.scm
index 1b61b5b..f744df2 100644
--- a/snd-motif.scm
+++ b/snd-motif.scm
@@ -73,9 +73,9 @@
(let ((documentation "(xm-clean-string str) changes slash to underbar in the filename 'str' (for the peak env file)"))
(lambda (str)
;; full file name should be unique, so I think we need only fix it up to look like a flat name
- (let* ((len (length str))
- (new-str (make-string len #\.)))
- (do ((i 0 (+ i 1)))
+ (let ((len (length str)))
+ (do ((new-str (make-string len #\.))
+ (i 0 (+ i 1)))
((= i len) new-str)
(let ((c (str i)))
(set! (new-str i) (if (memv c '(#\\ #\/)) #\_ c))))))))
@@ -269,25 +269,25 @@
(or (sound-property 'save-state-ignore snd)
(list 'save-state-ignore))))
(set! (sound-property 'dragger snd)
- (let ((calls ()))
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (let ((new-callback
- (let* ((zy ((channel-widgets snd chn) 6))
- (zy-div (max 10 (- (cadr (XtGetValues zy (list XmNmaximum 0)))
- (cadr (XtGetValues zy (list XmNsliderSize 0))))))) ; this is relative to max size
- (XtAddCallback zy
- XmNdragCallback
- (lambda (w data info)
- (let ((v (/ (.value info) zy-div)))
- (do ((i 0 (+ i 1)))
- ((= i (channels snd)))
- (if (not (= i chn))
- (begin
- (set! (y-zoom-slider snd i) (* v v))
- (set! (y-position-slider snd i) (y-position-slider snd chn)))))))))))
- (set! calls (cons new-callback calls))))
- (set! (hook 'result) (reverse calls))))))))
+ (do ((calls ())
+ (chn 0 (+ 1 chn)))
+ ((= chn (channels snd))
+ (set! (hook 'result) (reverse calls)))
+ (let ((new-callback
+ (let* ((zy ((channel-widgets snd chn) 6))
+ (zy-div (max 10 (- (cadr (XtGetValues zy (list XmNmaximum 0)))
+ (cadr (XtGetValues zy (list XmNsliderSize 0))))))) ; this is relative to max size
+ (XtAddCallback zy
+ XmNdragCallback
+ (lambda (w data info)
+ (let ((v (/ (.value info) zy-div)))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels snd)))
+ (if (not (= i chn))
+ (begin
+ (set! (y-zoom-slider snd i) (* v v))
+ (set! (y-position-slider snd i) (y-position-slider snd chn)))))))))))
+ (set! calls (cons new-callback calls)))))))))
(define zync
(let ((documentation "(zync) ties each sound's y-zoom sliders together so that all change in parallel if one changes"))
@@ -1837,8 +1837,8 @@
(do ((i 0 (+ i 1)))
((= i chns))
(let* ((ampscr (find-child snd-amp (scroller-name i)))
- (ampvals (XmScrollBarGetValues ampscr)))
- (XmScrollBarSetValues ampscr (.value info) (cadr ampvals) (caddr ampvals) (cadddr ampvals) #t)
+ (ampvals (cdr (XmScrollBarGetValues ampscr))))
+ (XmScrollBarSetValues ampscr (.value info) (car ampvals) (cadr ampvals) (caddr ampvals) #t)
(set! (amp-control snd i) amp))))
(set! (amp-control snd chn) amp))))
@@ -1926,8 +1926,8 @@
(do ((i 1 (+ i 1)))
((= i chns))
(let* ((ampscr (find-child snd-amp (scroller-name i)))
- (ampvals (XmScrollBarGetValues ampscr)))
- (XmScrollBarSetValues ampscr (.value info) (cadr ampvals) (caddr ampvals) (cadddr ampvals) #t))))))))
+ (ampvals (cdr (XmScrollBarGetValues ampscr))))
+ (XmScrollBarSetValues ampscr (.value info) (car ampvals) (cadr ampvals) (caddr ampvals) #t))))))))
(let ((existing-controls (or (sound-property 'amp-controls snd) 1)))
(if (< existing-controls chns)
(begin
@@ -2051,16 +2051,13 @@
(XtAddCallback new-dialog XmNokCallback
(lambda (w c i)
(let ((new-name (XmTextFieldGetString rename-text)))
- (if (and (string? new-name)
- (> (length new-name) 0)
- (selected-sound))
- (let ();(current-name (file-name)))
- (save-sound-as new-name)
- (close-sound)
- ;(rename-file current-name new-name) ; was this from Guile?
- ;(system (format #f "mv ~A ~A" new-name current-name)) ; surely it should be (delete-file current-name)?
- (open-sound new-name)
- (XtUnmanageChild w))))))
+ (when (and (string? new-name)
+ (> (length new-name) 0)
+ (selected-sound))
+ (save-sound-as new-name)
+ (close-sound)
+ (open-sound new-name)
+ (XtUnmanageChild w)))))
(for-each XmStringFree (vector xhelp xok xdismiss titlestr))
(set! rename-dialog new-dialog)
@@ -2940,9 +2937,7 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"))
(define* (equalize-panes snd)
(define (equalize-sound ind)
- (let ((old-style (channel-style ind)))
- (set! (channel-style ind) channels-combined)
- (set! (channel-style ind) old-style)))
+ (let-temporarily (((channel-style ind) channels-combined))))
(if snd
(equalize-sound snd)
(for-each equalize-sound (sounds))))
diff --git a/snd-region.c b/snd-region.c
index 6cdffcc..221fabb 100644
--- a/snd-region.c
+++ b/snd-region.c
@@ -1518,8 +1518,12 @@ static void init_xen_region(void)
static Xen g_integer_to_region(Xen n)
{
#define H_integer_to_region "(" S_integer_to_region " n) returns a region object corresponding to the given integer"
+ region* r;
Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_region, "an integer");
- return(new_xen_region(Xen_integer_to_C_int(n)));
+ r = id_to_region(Xen_integer_to_C_int(n));
+ if (r)
+ return(new_xen_region(r->id));
+ return(Xen_false);
}
diff --git a/snd-snd.c b/snd-snd.c
index 2d187aa..d0d7346 100644
--- a/snd-snd.c
+++ b/snd-snd.c
@@ -348,6 +348,7 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
(cp->sound) &&
(cp->sound->inuse == SOUND_NORMAL) &&
(cp->sound->hdr) &&
+ (cp->sound->nchans <= 4) &&
(cp->sounds) &&
(cp->sounds[0] != NULL) &&
(cp->sounds[0]->io))
@@ -2329,8 +2330,12 @@ static void init_xen_sound(void)
static Xen g_integer_to_sound(Xen n)
{
#define H_integer_to_sound "(" S_integer_to_sound " n) returns a sound object corresponding to the given integer"
+ int index;
Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_sound, "an integer");
- return(new_xen_sound(Xen_integer_to_C_int(n)));
+ index = Xen_integer_to_C_int(n);
+ if (get_sp_1(index))
+ return(new_xen_sound(index));
+ return(Xen_false);
}
@@ -5988,29 +5993,19 @@ If it returns " PROC_TRUE ", the usual informative status babbling is squelched.
Xen_define_typed_procedure(S_finish_progress_report, g_finish_progress_report_w, 0, 2, 0, H_finish_progress_report, s7_make_signature(s7, 3, b, sd, i));
Xen_define_typed_procedure(S_progress_report, g_progress_report_w, 1, 2, 0, H_progress_report, s7_make_signature(s7, 4, r, r, sd, i));
- Xen_define_procedure(S_close_sound, g_close_sound_w, 0, 1, 0, H_close_sound);
- Xen_define_procedure(S_update_sound, g_update_sound_w, 0, 1, 0, H_update_sound);
- Xen_define_procedure(S_save_sound, g_save_sound_w, 0, 1, 0, H_save_sound);
- Xen_define_procedure(S_open_sound, g_open_sound_w, 1, 0, 0, H_open_sound); /* not "safe" procedure! */
- Xen_define_procedure(S_open_raw_sound, g_open_raw_sound_w, 0, 0, 1, H_open_raw_sound);
- Xen_define_procedure(S_view_sound, g_view_sound_w, 1, 0, 0, H_view_sound);
- Xen_define_procedure(S_new_sound, g_new_sound_w, 0, 0, 1, H_new_sound);
- Xen_define_procedure(S_revert_sound, g_revert_sound_w, 0, 1, 0, H_revert_sound);
- Xen_define_procedure(S_save_sound_as, g_save_sound_as_w, 0, 0, 1, H_save_sound_as);
-#if 0
/* open-sound is definitely not a safe procedure; probably the rest of these are similar
* [see snd-test 5 with tests=2 or more]
*/
- Xen_define_typed_procedure(S_close_sound, g_close_sound_w, 0, 1, 0, H_close_sound, s7_make_signature(s7, 2, t, t));
- Xen_define_typed_procedure(S_update_sound, g_update_sound_w, 0, 1, 0, H_update_sound, s7_make_signature(s7, 2, t, t));
- Xen_define_typed_procedure(S_save_sound, g_save_sound_w, 0, 1, 0, H_save_sound, s7_make_signature(s7, 2, sd, t));
- Xen_define_typed_procedure(S_open_sound, g_open_sound_w, 1, 0, 0, H_open_sound, s7_make_signature(s7, 2, sd, s));
- Xen_define_typed_procedure(S_open_raw_sound, g_open_raw_sound_w, 0, 0, 1, H_open_raw_sound, s7_make_circular_signature(s7, 0, 1, t));
- Xen_define_typed_procedure(S_view_sound, g_view_sound_w, 1, 0, 0, H_view_sound, s7_make_signature(s7, 2, sd, s));
- Xen_define_typed_procedure(S_new_sound, g_new_sound_w, 0, 0, 1, H_new_sound, s7_make_circular_signature(s7, 0, 1, t));
- Xen_define_typed_procedure(S_revert_sound, g_revert_sound_w, 0, 1, 0, H_revert_sound, s7_make_signature(s7, 2, sd, sd));
- Xen_define_typed_procedure(S_save_sound_as, g_save_sound_as_w, 0, 0, 1, H_save_sound_as, s7_make_circular_signature(s7, 0, 1, t));
-#endif
+ Xen_define_unsafe_typed_procedure(S_close_sound, g_close_sound_w, 0, 1, 0, H_close_sound, s7_make_signature(s7, 2, t, t));
+ Xen_define_unsafe_typed_procedure(S_update_sound, g_update_sound_w, 0, 1, 0, H_update_sound, s7_make_signature(s7, 2, t, t));
+ Xen_define_unsafe_typed_procedure(S_save_sound, g_save_sound_w, 0, 1, 0, H_save_sound, s7_make_signature(s7, 2, sd, t));
+ Xen_define_unsafe_typed_procedure(S_open_sound, g_open_sound_w, 1, 0, 0, H_open_sound, s7_make_signature(s7, 2, sd, s));
+ Xen_define_unsafe_typed_procedure(S_open_raw_sound, g_open_raw_sound_w, 0, 0, 1, H_open_raw_sound, s7_make_circular_signature(s7, 0, 1, t));
+ Xen_define_unsafe_typed_procedure(S_view_sound, g_view_sound_w, 1, 0, 0, H_view_sound, s7_make_signature(s7, 2, sd, s));
+ Xen_define_unsafe_typed_procedure(S_new_sound, g_new_sound_w, 0, 0, 1, H_new_sound, s7_make_circular_signature(s7, 0, 1, t));
+ Xen_define_unsafe_typed_procedure(S_revert_sound, g_revert_sound_w, 0, 1, 0, H_revert_sound, s7_make_signature(s7, 2, sd, sd));
+ Xen_define_unsafe_typed_procedure(S_save_sound_as, g_save_sound_as_w, 0, 0, 1, H_save_sound_as, s7_make_circular_signature(s7, 0, 1, t));
+
Xen_define_typed_procedure(S_apply_controls, g_apply_controls_w, 0, 4, 0, H_apply_controls, s7_make_signature(s7, 5, t, t, i, i, i));
Xen_define_typed_procedure(S_controls_to_channel, g_controls_to_channel_w, 0, 6, 0, H_controls_to_channel, s7_make_signature(s7, 7, p, p, i, i, t, t, s));
diff --git a/snd-test.scm b/snd-test.scm
index 9cb379b..c07a27b 100644
--- a/snd-test.scm
+++ b/snd-test.scm
@@ -1,61 +1,39 @@
;;; Snd tests
;;;
-;;; test 0: constants [401]
-;;; test 1: defaults [1063]
-;;; test 2: headers [1436]
-;;; test 3: variables [1751]
-;;; test 4: sndlib [2314]
-;;; test 5: simple overall checks [4163]
-;;; test 6: float-vectors [8880]
-;;; test 7: colors [9146]
-;;; test 8: clm [9650]
-;;; test 9: mix [21512]
-;;; test 10: marks [23266]
-;;; test 11: dialogs [24197]
-;;; test 12: extensions [24358]
-;;; test 13: menus, edit lists, hooks, etc [24616]
-;;; test 14: all together now [25895]
-;;; test 15: chan-local vars [26762]
-;;; test 16: regularized funcs [28472]
-;;; test 17: dialogs and graphics [32169]
-;;; test 18: save and restore [32276]
-;;; test 19: transforms [33901]
-;;; test 20: new stuff [35983]
-;;; test 21: optimizer [37166]
-;;; test 22: with-sound [39734]
-;;; test 23: X/Xt/Xm [42618]
-;;; test 24: GL [46218]
-;;; test 25: errors [46339]
-;;; test 26: s7 [47753]
-;;; test all done [47822]
-;;; test the end [47994]
+;;; test 0: constants [370]
+;;; test 1: defaults [1025]
+;;; test 2: headers [1396]
+;;; test 3: variables [1710]
+;;; test 4: sndlib [2271]
+;;; test 5: simple overall checks [4065]
+;;; test 6: float-vectors [8707]
+;;; test 7: colors [8968]
+;;; test 8: clm [9459]
+;;; test 9: mix [21162]
+;;; test 10: marks [22900]
+;;; test 11: dialogs [23827]
+;;; test 12: extensions [23988]
+;;; test 13: menus, edit lists, hooks, etc [24243]
+;;; test 14: all together now [25500]
+;;; test 15: chan-local vars [26308]
+;;; test 16: regularized funcs [27972]
+;;; test 17: dialogs and graphics [31632]
+;;; test 18: save and restore [31737]
+;;; test 19: transforms [33324]
+;;; test 20: new stuff [35364]
+;;; test 21: optimizer [36540]
+;;; test 22: with-sound [38881]
+;;; test 23: X/Xt/Xm [41657]
+;;; test 24: GL [45230]
+;;; test 25: errors [45351]
+;;; test 26: s7 [46780]
+;;; test all done [46916]
+;;; test the end [47088]
;;; (set! (hook-functions *load-hook*) (list (lambda (hook) (format *stderr* "loading ~S...~%" (hook 'name)))))
;(set! (*s7* 'gc-stats) #t)
-(define-macro (let-temporarily vars . body)
- `(with-let (#_inlet :orig (#_curlet)
- :saved (#_list ,@(map car vars))
- :new (#_list ,@(map cadr vars)))
- (dynamic-wind
- (lambda () #f)
- (lambda () ; this could be (with-let orig (let ,vars , at body)) but I want to handle stuff like individual vector locations
- ,@(map (let ((ctr -1))
- (lambda (v)
- (if (symbol? (car v))
- `(set! (orig ',(car v)) (list-ref new ,(set! ctr (+ ctr 1))))
- `(set! (with-let orig ,(car v)) (list-ref new ,(set! ctr (+ ctr 1)))))))
- vars)
- (with-let orig , at body))
- (lambda ()
- ,@(map (let ((ctr -1))
- (lambda (v)
- (if (symbol? (car v))
- `(set! (orig ',(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))
- `(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1)))))))
- vars)))))
-
(when (provided? 'pure-s7)
(define (make-polar mag ang)
(if (and (real? mag) (real? ang))
@@ -66,7 +44,8 @@
(define keep-going #f)
(define all-args #f)
(define test-at-random 0)
-(define hooked #t)
+(define hooked #f)
+(define base-length 1000)
(if (<= tests 0) (set! tests 1))
@@ -99,10 +78,9 @@
(define with-big-file #f)
(define big-file-name "/home/bil/zap/sounds/bigger.snd")
-(if with-big-file
- (begin
- (set! with-big-file (file-exists? big-file-name))
- (if (not with-big-file) (snd-display ";no big file"))))
+(when with-big-file
+ (set! with-big-file (file-exists? big-file-name))
+ (if (not with-big-file) (snd-display ";no big file")))
(define big-file-framples 0)
(define original-save-dir (or *save-dir* "~/zap/snd"))
@@ -128,32 +106,29 @@
(define home-dir (getenv "HOME"))
(define sf-dir "/sf1")
-(if (not (file-exists? (string-append home-dir "/cl/oboe.snd")))
- (cond ((file-exists? "/export/home/bil/cl/oboe.snd") (set! home-dir "/export/home/bil"))
- ((file-exists? "/Users/bil/cl/oboe.snd") (set! home-dir "/Users/bil"))
- ((file-exists? "/users/b/bil/cl/oboe.snd") (set! home-dir "/users/b/bil"))
- ((file-exists? "/usr/home/bil/cl/oboe.snd") (set! home-dir "/usr/home/bil"))))
+(cond ((file-exists? (string-append home-dir "/cl/oboe.snd")))
+ ((file-exists? "/export/home/bil/cl/oboe.snd") (set! home-dir "/export/home/bil"))
+ ((file-exists? "/Users/bil/cl/oboe.snd") (set! home-dir "/Users/bil"))
+ ((file-exists? "/users/b/bil/cl/oboe.snd") (set! home-dir "/users/b/bil"))
+ ((file-exists? "/usr/home/bil/cl/oboe.snd") (set! home-dir "/usr/home/bil")))
(define cwd (string-append (getcwd) "/"))
(define sf-dir1 (string-append home-dir sf-dir "/"))
-(if (not (file-exists? (string-append sf-dir1 "alaw.wav")))
- (begin
- (set! sf-dir "/sf")
- (set! sf-dir1 (string-append home-dir sf-dir "/"))
- (if (not (file-exists? (string-append sf-dir1 "alaw.wav")))
- (begin
- (snd-display ";;;can't find sf directory!")
- (set! sf-dir1 #f)))))
+(unless (file-exists? (string-append sf-dir1 "alaw.wav"))
+ (set! sf-dir "/sf")
+ (set! sf-dir1 (string-append home-dir sf-dir "/"))
+ (unless (file-exists? (string-append sf-dir1 "alaw.wav"))
+ (snd-display ";;;can't find sf directory!")
+ (set! sf-dir1 #f)))
(set! sf-dir sf-dir1)
(if (not (string=? (getcwd) (string-append home-dir "/cl")))
(for-each
(lambda (file)
- (if (not (file-exists? file))
- (begin
- (format () "copying ~A~%" file)
- (copy-file (string-append home-dir "/cl/" file) (string-append (getcwd) "/" file)))))
+ (unless (file-exists? file)
+ (format () "copying ~A~%" file)
+ (copy-file (string-append home-dir "/cl/" file) (string-append (getcwd) "/" file))))
'("4.aiff" "2.snd" "obtest.snd" "oboe.snd" "pistol.snd" "1a.snd" "now.snd" "fyow.snd"
"storm.snd" "z.snd" "1.snd" "cardinal.snd" "now.snd.scm" "2a.snd" "4a.snd" "zero.snd"
"loop.scm" "cmn-glyphs.lisp" "bullet.xpm" "mb.snd" "funcs.scm" "trumpet.snd" "1234.snd")))
@@ -291,8 +266,7 @@
(set! test-number n)
(if (> (length timings) n)
(set! (timings n) (real-time)))
- (snd-display ";test ~D" n)
- )))
+ (snd-display ";test ~D" n))))
(define (clear-save-state-files)
(for-each forget-region (regions))
@@ -310,10 +284,9 @@
(clear-save-state-files)
(clear-listener)
(set! *ask-about-unsaved-edits* #f)
- (if (pair? (sounds))
- (begin
- (snd-display ";end test ~D: open sounds: ~A" n (map short-file-name (sounds)))
- (for-each close-sound (sounds))))
+ (when (pair? (sounds))
+ (snd-display ";end test ~D: open sounds: ~A" n (map short-file-name (sounds)))
+ (for-each close-sound (sounds)))
(if (number? (vector-ref timings n))
(set! (timings n) (hundred (- (real-time) (vector-ref timings n))))))))
@@ -323,10 +296,10 @@
(define (log-mem tst)
(if (> tests 1) (snd-display ";test ~D:~D " test-number (+ 1 tst))))
-(define-macro (without-errors func)
+(define-macro (without-errors . func)
`(catch #t ; but this also squelches syntax errors!
(lambda ()
- ,func)
+ , at func)
(lambda args
(car args))))
@@ -363,26 +336,24 @@
(error 'wrong-type-arg "file->floats: ~A" v)))
-(if (and (> (length (script-args)) 0)
- (> (script-arg) 0))
- (let ((arg (script-arg))
- (args (script-args)))
- (if (not (string=? (args (- arg 1)) "-l"))
- (snd-display ";script-args[~A]: ~A (~A)?" (- arg 1) (args (- arg 1)) args))
- (if (not (string=? (args arg) "snd-test"))
- (snd-display ";script-args[~A]: ~A (~A)?" arg (args arg) args))
- (if (> (length args) (+ 1 arg))
- (begin
- ;; test-number tests
- (set! snd-test (string->number (args (+ 1 arg))))
- (set! test-at-random 0)
- (set! full-test (< snd-test 0))
- (set! with-exit #t)
- (set! (script-arg) (+ 1 arg))
- (if (> (length (script-args)) (+ arg 2))
- (begin
- (set! tests (string->number (args (+ arg 2))))
- (set! (script-arg) (+ arg 2))))))))
+(when (and (> (length (script-args)) 0)
+ (> (script-arg) 0))
+ (let ((arg (script-arg))
+ (args (script-args)))
+ (if (not (string=? (args (- arg 1)) "-l"))
+ (snd-display ";script-args[~A]: ~A (~A)?" (- arg 1) (args (- arg 1)) args))
+ (if (not (string=? (args arg) "snd-test"))
+ (snd-display ";script-args[~A]: ~A (~A)?" arg (args arg) args))
+ (when (> (length args) (+ 1 arg))
+ ;; test-number tests
+ (set! snd-test (string->number (args (+ 1 arg))))
+ (set! test-at-random 0)
+ (set! full-test (< snd-test 0))
+ (set! with-exit #t)
+ (set! (script-arg) (+ 1 arg))
+ (when (> (length (script-args)) (+ arg 2))
+ (set! tests (string->number (args (+ arg 2))))
+ (set! (script-arg) (+ arg 2))))))
(if (and (provided? 'snd-motif)
(provided? 'xm))
@@ -401,12 +372,11 @@
(define (snd_test_0)
(letrec ((test-constants
(lambda (lst)
- (if (pair? lst)
- (begin
- (if (not (= (cadr lst) (caddr lst)))
- (snd-display ";~A is not ~A (~A)~%"
- (car lst) (cadr lst) (caddr lst)))
- (test-constants (cdddr lst)))))))
+ (when (pair? lst)
+ (if (not (= (cadr lst) (caddr lst)))
+ (snd-display ";~A is not ~A (~A)~%"
+ (car lst) (cadr lst) (caddr lst)))
+ (test-constants (cdddr lst))))))
(if (or (pair? (sounds))
(pair? (mixes))
@@ -1079,16 +1049,15 @@
(when with-gui
(letrec ((test-defaults
(lambda (lst)
- (if (pair? lst)
- (begin
- (if (and (not (or (equal? (cadr lst) (caddr lst))
+ (when (pair? lst)
+ (if (and (not (or (equal? (cadr lst) (caddr lst))
(and (pair? (caddr lst))
(member (cadr lst) (caddr lst)))))
- (or (not (number? (caddr lst)))
- (rational? (caddr lst))
- (fneq (cadr lst) (caddr lst)))) ; right! not my fault!
- (snd-display ";~A is not ~A (~A)" (car lst) (caddr lst) (cadr lst)))
- (test-defaults (cdddr lst)))))))
+ (or (not (number? (caddr lst)))
+ (rational? (caddr lst))
+ (fneq (cadr lst) (caddr lst)))) ; right! not my fault!
+ (snd-display ";~A is not ~A (~A)" (car lst) (caddr lst) (cadr lst)))
+ (test-defaults (cdddr lst))))))
(for-each close-sound (sounds)) ; in case others opened elsewhere
(test-defaults
@@ -1254,8 +1223,7 @@
'with-pointer-focus *with-pointer-focus* '(#f #t)
'x-axis-style *x-axis-style* 0
'zero-pad *zero-pad* 0
- 'zoom-focus-style *zoom-focus-style* 2
- ))
+ 'zoom-focus-style *zoom-focus-style* 2))
(if *snd-opened-sound* (snd-display ";*snd-opened-sound*: ~A" *snd-opened-sound*))
(let ((s (open-sound "oboe.snd")))
@@ -1412,13 +1380,10 @@
(list 'zero-pad zero-pad 0 1 '*zero-pad*)
(list 'zoom-focus-style zoom-focus-style 2 1 '*zoom-focus-style*)
)))
- (close-sound s)
- ))
+ (close-sound s)))
(set! *ask-about-unsaved-edits* #f)
- (set! *remember-sound-state* #f)
- ))
-
+ (set! *remember-sound-state* #f)))
(set! (with-mix-tags) #t) ; assumed in test 16(!)
(set! *default-output-sample-type* mus-ldouble)
@@ -1734,8 +1699,7 @@
(snd-display ";mus-sound-mark-info forest: ~A" lst)))
(let ((lst (mus-sound-mark-info (string-append sf-dir "traffic.aiff"))))
(if (not (equal? lst '((4 1) (3 0) (2 171931) (1 99461))))
- (snd-display ";mus-sound-mark-info traffic: ~A" lst)))
- )))
+ (snd-display ";mus-sound-mark-info traffic: ~A" lst))))))
@@ -2019,13 +1983,6 @@
(snd-display ";window width: ~A is not 300?" (window-width)))
(if (<= (window-height) 30)
(snd-display ";window height: ~A is not 300?" (window-height)))
- ; (set! (window-x) 123)
- ; (set! (window-y) 321)
- ; (if (not (equal? (window-x) 123))
- ; (snd-display ";window x: ~A is not 123?" (window-x)))
- ; (if (not (equal? (window-y) 321))
- ; (snd-display ";window y: ~A is not 321?" (window-y)))
- ; (set! (window-y) 10) ; get it back out of harm's way
(set! *color-scale* 100.0)
(if (fneq *color-scale* 100.0) (snd-display ";color-scale to 100: ~A" *color-scale*))
@@ -2050,257 +2007,254 @@
(set! *enved-filter-order* 5)
(if (not (= *enved-filter-order* 6)) (snd-display ";set enved-filter-order 5: ~A" *enved-filter-order*))
- (if with-gui
- (begin
- (set! (enved-envelope) 'zero_to_one) ; funcs.scm above
- (if (not (feql (enved-envelope) zero_to_one)) (snd-display ";set symbol enved-envelope: ~A ~A" (enved-envelope) zero_to_one))
- (set! (enved-envelope) "mod_down")
- (if (not (feql (enved-envelope) mod_down)) (snd-display ";set string enved-envelope: ~A ~A" (enved-envelope) mod_down))))
-
+ (when with-gui
+ (set! (enved-envelope) 'zero_to_one) ; funcs.scm above
+ (if (not (feql (enved-envelope) zero_to_one)) (snd-display ";set symbol enved-envelope: ~A ~A" (enved-envelope) zero_to_one))
+ (set! (enved-envelope) "mod_down")
+ (if (not (feql (enved-envelope) mod_down)) (snd-display ";set string enved-envelope: ~A ~A" (enved-envelope) mod_down)))
(dismiss-all-dialogs))
(close-sound ind)
(let ((undef ())
- (names (list '*snd-opened-sound* 'abort 'add-colormap 'add-mark
- 'add-player 'add-sound-file-extension 'add-source-file-extension 'add-to-main-menu 'add-to-menu
- 'add-transform 'after-apply-controls-hook 'after-edit-hook 'after-graph-hook 'after-lisp-graph-hook
- 'after-open-hook 'after-save-as-hook 'after-save-state-hook 'after-transform-hook 'all-pass
- 'all-pass? 'amp-control 'amp-control-bounds 'amplitude-modulate
- 'apply-controls 'array->file 'array-interp 'as-one-edit 'ask-about-unsaved-edits
- 'ask-before-overwrite 'asymmetric-fm 'asymmetric-fm?
- 'auto-resize 'auto-update 'auto-update-interval 'autocorrelate 'autocorrelation
- 'axis-color 'axis-info 'axis-label-font 'axis-numbers-font
- 'bad-header-hook 'bartlett-window 'bartlett-hann-window 'basic-color 'beats-per-measure 'beats-per-minute
- 'before-close-hook 'before-exit-hook 'before-save-as-hook 'before-save-state-hook 'before-transform-hook
- 'bind-key 'blackman2-window 'blackman3-window 'blackman4-window
- 'blackman5-window 'blackman6-window 'blackman7-window 'blackman8-window 'blackman9-window 'blackman10-window
- 'bohman-window 'bold-peaks-font 'cauchy-window 'mlt-sine-window
- 'cepstrum 'change-samples-with-origin 'channel->float-vector 'channel-amp-envs
- 'channel-properties 'channel-property 'channel-style 'channel-widgets 'channels 'channels-combined
- 'channels-separate 'channels-superimposed 'chans 'clear-listener
- 'clip-hook 'clipping 'clm-channel
- 'clm-table-size 'clm-default-frequency 'close-hook 'close-sound 'color->list
- 'color-cutoff 'color-orientation-dialog 'color-hook 'color-inverted 'color-scale
- 'color? 'colormap 'colormap-name 'colormap-ref 'colormap-size
- 'colormap? 'comb 'comb? 'combined-data-color 'comment 'connes-window
- 'continue-frample->file 'continue-sample->file 'contrast-control 'contrast-control-amp 'contrast-control-bounds
- 'contrast-control? 'contrast-enhancement 'controls->channel 'convolution 'convolve
- 'convolve-files 'convolve-selection-with 'convolve-with 'convolve? 'copy-context
- 'copy-sampler 'current-edit-position
- 'current-font 'cursor 'cursor-color 'cursor-context 'cursor-cross
- 'cursor-in-middle 'cursor-in-view 'cursor-line 'cursor-location-offset 'cursor-on-left
- 'cursor-on-right 'cursor-position 'cursor-size 'cursor-style 'cursor-update-interval
- 'dac-combines-channels 'dac-size 'data-color 'sample-type
- 'data-location 'data-size 'db->linear 'default-output-chans 'default-output-sample-type
- 'default-output-header-type 'default-output-srate 'define-envelope 'degrees->radians 'delay
- 'delay-tick 'delay? 'delete-colormap
- 'delete-mark 'delete-marks 'delete-sample 'delete-samples 'delete-samples-and-smooth
- 'delete-selection 'delete-selection-and-smooth 'delete-transform 'dialog-widgets 'disk-kspace
- 'display-edits 'dolph-chebyshev-window 'dont-normalize
- 'dot-product 'dot-size 'draw-axes 'draw-dot 'draw-dots
- 'draw-line 'draw-lines 'draw-mark-hook 'draw-mix-hook 'draw-string 'drop-hook
- 'during-open-hook 'edit-fragment 'edit-header-dialog 'edit-hook 'edit-list->function
- 'edit-position 'edit-tree 'edits 'edot-product 'env
- 'env-channel 'env-channel-with-base 'env-interp 'env-selection 'env-sound
- 'env? 'enved-add-point 'enved-amplitude 'enved-base 'enved-clip?
- 'enved-delete-point 'enved-dialog 'enved-envelope 'enved-filter 'enved-filter-order
- 'enved-hook 'enved-in-dB 'enved-move-point 'enved-power 'enved-spectrum
- 'enved-srate 'enved-style 'enved-target 'enved-wave? 'enved-waveform-color
- 'envelope-exponential 'envelope-linear 'eps-bottom-margin 'eps-file
- 'eps-left-margin 'eps-size 'even-multiple 'even-weight 'exit 'exit-hook
- 'expand-control 'expand-control-bounds 'expand-control-hop 'expand-control-jitter 'expand-control-length
- 'expand-control-ramp 'expand-control? 'exponential-window 'fft 'fft-log-frequency
- 'fft-log-magnitude 'fft-window 'fft-window-alpha 'fft-window-beta 'fft-with-phases 'file->array
- 'file->frample 'file->frample? 'file->sample 'file->sample? 'file->string
- 'file-name 'file-write-date 'fill-polygon 'fill-rectangle 'filter
- 'filtered-comb 'filtered-comb?
- 'filter-channel 'filter-control-coeffs 'filter-control-envelope 'filter-control-in-dB 'filter-control-in-hz
- 'filter-control-order 'filter-control-waveform-color 'filter-control? 'filter-selection 'filter-sound
- 'filter? 'find-dialog 'find-mark 'find-sound
- 'finish-progress-report 'fir-filter 'fir-filter? 'flat-top-window 'focus-widget 'foreground-color
- 'forget-region 'formant 'formant-bank 'formant-bank? 'formant? 'firmant 'firmant?
- 'comb-bank 'comb-bank? 'all-pass-bank 'all-pass-bank? 'filtered-comb-bank 'filtered-comb-bank?
- 'make-comb-bank 'make-all-pass-bank 'make-filtered-comb-bank
- 'fourier-transform
- 'free-player 'free-sampler 'gaussian-window 'gc-off 'gc-on
- ;'gl-graph->ps 'glSpectrogram
- 'goto-listener-end 'granulate 'granulate?
- 'graph 'graph->ps 'graph-as-sonogram 'graph-as-spectrogram 'graph-as-wavogram
- 'graph-color 'graph-cursor 'graph-data 'graph-dots 'graph-dots-and-lines
- 'graph-filled 'graph-hook 'graph-lines 'graph-lollipops 'graph-once
- 'graph-style 'graphs-horizontal 'grid-density 'haar-transform 'hamming-window
- 'hann-poisson-window 'hann-window 'header-type 'help-dialog
- 'help-hook 'hide-widget 'highlight-color 'html-dir 'html-program
- 'hz->radians 'iir-filter 'iir-filter? 'in 'in-any
- 'ina 'inb 'info-dialog 'initial-graph-hook
- 'insert-file-dialog 'insert-region 'insert-sample 'insert-samples 'insert-samples-with-origin
- 'insert-selection 'insert-silence 'insert-sound 'just-sounds 'kaiser-window
- 'key 'key-binding 'key-press-hook 'keyboard-no-action 'peak-env-dir
-; 'ladspa-activate 'ladspa-cleanup 'ladspa-connect-port 'ladspa-deactivate 'ladspa-descriptor 'ladspa-dir
-; 'ladspa-instantiate 'ladspa-run 'ladspa-run-adding 'ladspa-set-run-adding-gain 'list-ladspa 'init-ladspa 'apply-ladspa 'analyse-ladspa
- 'left-sample
- 'linear->db 'lisp-graph 'lisp-graph-hook 'lisp-graph-style 'lisp-graph?
- 'listener-click-hook 'listener-color 'listener-font
- 'listener-prompt 'listener-selection 'listener-text-color 'little-endian? 'locsig
- 'locsig-ref 'locsig-reverb-ref 'locsig-reverb-set! 'locsig-set! 'locsig-type
- 'locsig? 'log-freq-start 'main-menu 'main-widgets 'make-all-pass
- 'make-asymmetric-fm 'make-moving-average 'make-moving-max 'make-moving-norm 'make-bezier 'make-color 'make-comb 'make-filtered-comb
- 'make-convolve 'make-delay 'make-env 'make-fft-window 'make-file->frample
- 'make-file->sample 'make-filter 'make-fir-coeffs 'make-fir-filter 'make-formant 'make-firmant 'make-formant-bank
- 'make-granulate 'make-graph-data 'make-iir-filter
- 'make-locsig 'make-mix-sampler 'make-move-sound 'make-notch 'make-one-pole 'make-one-pole-all-pass
- 'make-one-zero 'make-oscil 'make-phase-vocoder 'make-player 'make-polyshape 'make-polywave
- 'make-pulse-train 'make-rand 'make-rand-interp 'make-readin
- 'make-region 'make-region-sampler 'make-sample->file 'make-sampler 'make-sawtooth-wave
- 'make-nrxysin 'make-nrxycos 'make-rxyk!cos 'make-rxyk!sin
- 'make-snd->sample 'make-square-wave
- 'make-src 'make-ssb-am 'make-ncos 'make-nsin 'make-table-lookup
- 'make-triangle-wave 'make-two-pole 'make-two-zero
- 'make-variable-graph 'make-float-vector 'make-wave-train
- 'map-channel 'mark-click-hook 'mark-color 'mark-context
- 'mark-drag-hook 'mark-home 'mark-hook 'mark-name 'mark-properties 'mark-property
- 'mark-sample 'mark-sync 'mark-sync-max 'mark-tag-height 'mark-tag-width
- 'mark? 'marks 'max-regions 'max-transform-peaks 'maxamp
- 'maxamp-position 'menu-widgets 'min-dB 'mix
- 'mix-amp 'mix-amp-env 'mix-click-hook 'mix-color
- 'mix-dialog-mix 'mix-drag-hook 'mix-file-dialog 'mix-length 'mix-home
- 'mix-name 'mix-position 'mix-properties 'mix-property 'mix-region 'mix-release-hook 'mix-sync 'mix-sync-max
- 'mix-sampler? 'mix-selection 'mix-speed 'mix-tag-height
- 'mix-tag-width 'mix-tag-y
- 'mix-float-vector 'mix-waveform-height 'mix?
- 'mixes 'mouse-click-hook 'mouse-drag-hook 'mouse-enter-graph-hook
- 'mouse-enter-label-hook 'mouse-enter-listener-hook 'mouse-enter-text-hook 'mouse-leave-graph-hook 'mouse-leave-label-hook
- 'mouse-leave-listener-hook 'mouse-leave-text-hook 'mouse-press-hook 'move-locsig 'move-sound 'move-sound?
- 'moving-average 'moving-average? 'moving-max 'moving-max? 'moving-norm 'moving-norm?
- 'mus-aifc 'mus-aiff 'mus-alaw 'mus-alsa-buffer-size 'mus-alsa-buffers
- 'mus-alsa-capture-device 'mus-alsa-device 'mus-alsa-playback-device 'mus-alsa-squelch-warning 'mus-apply
- 'mus-array-print-length 'mus-float-equal-fudge-factor
- 'mus-b24int 'mus-bdouble 'mus-bdouble-unscaled
- 'mus-bfloat 'mus-bfloat-unscaled 'mus-bicsf 'mus-bint 'mus-bintn
- 'mus-bshort 'mus-byte 'mus-bytes-per-sample 'mus-caff 'mus-channel 'mus-channels
- 'mus-chebyshev-first-kind 'mus-chebyshev-second-kind 'mus-clipping 'mus-close
- 'mus-data 'mus-sample-type->string 'mus-sample-type-name 'mus-describe 'mus-error-hook
- 'mus-error-type->string 'mus-expand-filename 'mus-feedback 'mus-feedforward 'mus-fft
- 'mus-file-buffer-size 'mus-file-clipping 'mus-file-name
- 'mus-frequency 'mus-generator? 'mus-header-raw-defaults 'mus-header-type->string 'mus-header-type-name
- 'mus-hop 'mus-increment 'mus-input? 'mus-interp-all-pass 'mus-interp-bezier
- 'mus-interp-hermite 'mus-interp-lagrange 'mus-interp-linear 'mus-interp-none 'mus-interp-sinusoidal
- 'mus-interp-type 'mus-interpolate 'mus-ircam 'mus-l24int 'mus-ldouble
- 'mus-ldouble-unscaled 'mus-length 'mus-lfloat 'mus-lfloat-unscaled 'mus-lint
- 'mus-lintn 'mus-location 'mus-lshort 'mus-max-malloc 'mus-max-table-size
- 'mus-file-mix 'mus-mulaw 'mus-name
- 'mus-next 'mus-nist 'mus-offset 'mus-order 'mus-oss-set-buffers
- 'mus-out-format 'mus-output? 'mus-phase 'mus-ramp
- 'mus-rand-seed 'mus-random 'mus-raw 'mus-reset 'mus-riff
- 'mus-run 'mus-scaler 'mus-set-formant-radius-and-frequency 'mus-sound-chans
- 'mus-sound-comment 'mus-sound-sample-type 'mus-sound-data-location 'mus-sound-datum-size
- 'mus-sound-duration 'mus-sound-forget 'mus-sound-framples 'mus-sound-header-type 'mus-sound-length
- 'mus-sound-loop-info 'mus-sound-mark-info 'mus-sound-maxamp 'mus-sound-maxamp-exists? 'mus-sound-path
- 'mus-sound-prune 'mus-sound-report-cache 'mus-sound-samples
- 'mus-sound-srate 'mus-sound-type-specifier 'mus-sound-write-date
- 'mus-soundfont 'mus-srate 'mus-svx 'mus-ubshort
- 'mus-ubyte 'mus-ulshort 'mus-unknown-sample 'mus-unknown-header 'mus-voc
- 'mus-width 'mus-xcoeff 'mus-xcoeffs 'mus-ycoeff 'mus-ycoeffs
- 'name-click-hook 'new-sound 'new-sound-dialog 'new-sound-hook 'new-widget-hook
- 'next-sample 'normalize-by-channel 'normalize-by-sound 'normalize-channel 'normalize-globally
- 'notch 'notch? 'odd-multiple 'odd-weight 'one-pole 'one-pole? 'one-pole-all-pass 'one-pole-all-pass?
- 'one-zero 'one-zero? 'open-file-dialog 'open-file-dialog-directory 'open-hook 'open-raw-sound 'open-raw-sound-hook
- 'open-sound
- 'orientation-hook 'oscil 'oscil? 'out-any 'outa
- 'outb 'outc 'outd 'output-comment-hook
- 'override-samples-with-origin 'pad-channel 'partials->polynomial 'partials->wave
- 'parzen-window 'pausing 'peaks 'peaks-font
- 'phase-partials->wave 'phase-vocoder 'phase-vocoder-amp-increments 'phase-vocoder-amps 'phase-vocoder-freqs
- 'phase-vocoder-phase-increments 'phase-vocoder-phases 'phase-vocoder? 'play 'play-arrow-size
- 'play-hook 'player-home 'player? 'players
- 'playing 'poisson-window 'polar->rectangular 'polynomial 'polyshape 'polywave
- 'polyshape? 'polywave? 'position->x 'position->y 'position-color 'preferences-dialog
- 'previous-sample 'print-dialog 'print-length 'progress-report
- 'pulse-train
- 'pulse-train? 'radians->degrees 'radians->hz
- 'ramp-channel 'rand 'rand-interp 'rand-interp? 'rand?
- 'read-mix-sample 'read-only 'read-region-sample
- 'read-sample 'readin 'readin?
- 'rectangular->magnitudes 'rectangular->polar 'rectangular-window 'redo 'redo-edit
- 'region->float-vector 'region-chans 'region-home 'region-framples 'region-graph-style 'region-maxamp
- 'region-maxamp-position 'region-position 'region-sample 'region-sampler? 'region-srate
- 'region? 'regions 'remember-sound-state 'remove-from-menu 'status-report
- 'reset-controls 'reset-listener-cursor 'restore-controls 'restore-region
- '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-channel 'reverse-selection
- 'reverse-sound 'revert-sound 'riemann-window 'right-sample 'ring-modulate
- 'rv2-window 'rv3-window 'rv4-window
- 'samaraki-window 'sample 'sample->file
- 'sample->file? 'sampler-at-end? 'sampler-home 'sampler-position
- 'sampler? 'samples 'samples->seconds 'sash-color
- 'save-controls 'save-dir 'save-edit-history 'save-envelopes 'save-hook
- 'save-listener 'save-marks '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 'sawtooth-wave 'sawtooth-wave?
- 'scale-by 'scale-channel 'scale-selection-by 'scale-selection-to 'scale-to
- 'scan-channel 'script-arg 'script-args '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-chans 'selection-color 'selection-context 'selection-creates-region
- 'selection-framples 'selection-maxamp 'selection-maxamp-position 'selection-member? 'selection-position
- 'selection-srate 'selection?
- 'short-file-name 'show-all-axes 'show-all-axes-unlabelled 'show-bare-x-axis
- 'show-axes 'show-controls 'show-grid 'show-indices 'show-full-duration 'show-full-range 'initial-beg 'initial-dur
- 'show-listener 'show-marks 'show-mix-waveforms 'show-no-axes 'show-selection 'show-selection-transform
- 'show-sonogram-cursor 'show-transform-peaks 'show-widget 'show-x-axis 'show-x-axis-unlabelled
- 'show-y-zero 'sinc-width 'nrxysin 'nrxysin? 'nrxycos 'nrxycos? 'rxyk!cos 'rxyk!cos? 'rxyk!sin 'rxyk!sin?
- 'smooth-channel 'smooth-selection 'smooth-sound 'snd->sample 'snd->sample?
- 'snd-error 'snd-error-hook 'snd-gcs 'snd-help 'snd-font 'snd-color
- 'snd-print 'snd-spectrum 'snd-tempnam 'snd-url
- 'snd-urls 'snd-version 'snd-warning 'snd-warning-hook
- 'sound-file-extensions 'sound-file? 'sound-files-in-directory
- 'sound-loop-info 'sound-properties 'sound-property 'sound-widgets 'sound? 'soundfont-info
- 'sounds 'spectrum-end 'spectro-hop 'spectrum-start 'spectro-x-angle
- 'spectro-x-scale 'spectro-y-angle 'spectro-y-scale 'spectro-z-angle 'spectro-z-scale
- 'spectrum 'speed-control 'speed-control-as-float 'speed-control-as-ratio 'speed-control-as-semitone
- 'speed-control-bounds 'speed-control-style 'speed-control-tones 'square-wave 'square-wave?
- 'squelch-update 'srate 'src 'src-channel 'src-selection
- 'src-sound 'src? 'ssb-am 'ssb-am?
- 'start-playing 'start-playing-hook 'start-playing-selection-hook 'start-progress-report 'stdin-prompt
- 'stop-player 'stop-playing 'stop-playing-hook 'stop-playing-selection-hook 'ncos
- 'ncos? 'nsin 'nsin? 'swap-channels 'sync 'sync-style 'sync-none 'sync-all 'sync-by-sound
- 'sync-max 'syncd-marks 'table-lookup 'table-lookup? 'tap 'tap?
- 'temp-dir 'text-focus-color 'time-graph 'time-graph-style
- 'time-graph-type 'time-graph? 'tiny-font
- 'tracking-cursor-style 'transform->float-vector
- 'transform-dialog 'transform-framples 'transform-graph 'transform-graph-style 'transform-graph-type
- 'transform-graph? 'transform-normalization 'transform-sample 'transform-size 'transform-type
- 'transform? 'triangle-wave 'triangle-wave? 'tukey-window
- 'two-pole 'two-pole? 'two-zero 'two-zero? 'ultraspherical-window
- 'unbind-key 'undo 'undo-edit 'undo-hook 'unselect-all 'update-hook 'update-lisp-graph
- 'update-sound 'update-time-graph 'update-transform-graph 'variable-graph? 'float-vector
- 'float-vector* 'float-vector+ 'float-vector->channel
- 'float-vector->string 'float-vector-add!
- 'length 'float-vector-max 'float-vector-min 'float-vector-move!
- 'float-vector-multiply! 'float-vector-offset! 'float-vector-peak 'float-vector-ref 'reverse!
- 'float-vector-scale! 'float-vector-set! 'float-vector-subseq 'float-vector-subtract! 'float-vector?
- 'walsh-transform
- 'wave-train 'wave-train? 'wavelet-transform 'wavelet-type
- 'wavo-hop 'wavo-trace 'welch-window 'widget-position
- 'widget-size 'widget-text 'window-height
- 'window-width 'window-x 'window-y 'with-background-processes 'with-file-monitor 'with-gl
- 'with-mix-tags 'with-relative-panes 'with-tracking-cursor 'with-verbose-cursor
- 'with-inset-graph 'with-interrupts 'with-pointer-focus 'with-smpte-label 'with-toolbar 'with-tooltips 'with-menu-icons
- 'save-as-dialog-src 'save-as-dialog-auto-comment
- 'x->position 'x-axis-as-clock 'x-axis-as-percentage 'x-axis-in-beats 'x-axis-in-measures
- 'x-axis-in-samples 'x-axis-in-seconds 'x-axis-label 'x-axis-style 'x-bounds
- 'x-position-slider 'x-zoom-slider 'xramp-channel 'y->position 'y-axis-label
- 'y-bounds 'y-position-slider 'y-zoom-slider 'zero-pad 'zoom-color
- 'zoom-focus-active 'zoom-focus-left 'zoom-focus-middle 'zoom-focus-right 'zoom-focus-style)))
+ (names '(*snd-opened-sound* abort add-colormap add-mark
+ add-player add-sound-file-extension add-source-file-extension add-to-main-menu add-to-menu
+ add-transform after-apply-controls-hook after-edit-hook after-graph-hook after-lisp-graph-hook
+ after-open-hook after-save-as-hook after-save-state-hook after-transform-hook all-pass
+ all-pass? amp-control amp-control-bounds amplitude-modulate
+ apply-controls array->file array-interp as-one-edit ask-about-unsaved-edits
+ ask-before-overwrite asymmetric-fm asymmetric-fm?
+ auto-resize auto-update auto-update-interval autocorrelate autocorrelation
+ axis-color axis-info axis-label-font axis-numbers-font
+ bad-header-hook bartlett-window bartlett-hann-window basic-color beats-per-measure beats-per-minute
+ before-close-hook before-exit-hook before-save-as-hook before-save-state-hook before-transform-hook
+ bind-key blackman2-window blackman3-window blackman4-window
+ blackman5-window blackman6-window blackman7-window blackman8-window blackman9-window blackman10-window
+ bohman-window bold-peaks-font cauchy-window mlt-sine-window
+ cepstrum change-samples-with-origin channel->float-vector channel-amp-envs
+ channel-properties channel-property channel-style channel-widgets channels channels-combined
+ channels-separate channels-superimposed chans clear-listener
+ clip-hook clipping clm-channel
+ clm-table-size clm-default-frequency close-hook close-sound color->list
+ color-cutoff color-orientation-dialog color-hook color-inverted color-scale
+ color? colormap colormap-name colormap-ref colormap-size
+ colormap? comb comb? combined-data-color comment connes-window
+ continue-frample->file continue-sample->file contrast-control contrast-control-amp contrast-control-bounds
+ contrast-control? contrast-enhancement controls->channel convolution convolve
+ convolve-files convolve-selection-with convolve-with convolve? copy-context
+ copy-sampler current-edit-position
+ current-font cursor cursor-color cursor-context cursor-cross
+ cursor-in-middle cursor-in-view cursor-line cursor-location-offset cursor-on-left
+ cursor-on-right cursor-position cursor-size cursor-style cursor-update-interval
+ dac-combines-channels dac-size data-color sample-type
+ data-location data-size db->linear default-output-chans default-output-sample-type
+ default-output-header-type default-output-srate define-envelope degrees->radians delay
+ delay-tick delay? delete-colormap
+ delete-mark delete-marks delete-sample delete-samples delete-samples-and-smooth
+ delete-selection delete-selection-and-smooth delete-transform dialog-widgets disk-kspace
+ display-edits dolph-chebyshev-window dont-normalize
+ dot-product dot-size draw-axes draw-dot draw-dots
+ draw-line draw-lines draw-mark-hook draw-mix-hook draw-string drop-hook
+ during-open-hook edit-fragment edit-header-dialog edit-hook edit-list->function
+ edit-position edit-tree edits edot-product env
+ env-channel env-channel-with-base env-interp env-selection env-sound
+ env? enved-add-point enved-amplitude enved-base enved-clip?
+ enved-delete-point enved-dialog enved-envelope enved-filter enved-filter-order
+ enved-hook enved-in-dB enved-move-point enved-power enved-spectrum
+ enved-srate enved-style enved-target enved-wave? enved-waveform-color
+ envelope-exponential envelope-linear eps-bottom-margin eps-file
+ eps-left-margin eps-size even-multiple even-weight exit exit-hook
+ expand-control expand-control-bounds expand-control-hop expand-control-jitter expand-control-length
+ expand-control-ramp expand-control? exponential-window fft fft-log-frequency
+ fft-log-magnitude fft-window fft-window-alpha fft-window-beta fft-with-phases file->array
+ file->frample file->frample? file->sample file->sample? file->string
+ file-name file-write-date fill-polygon fill-rectangle filter
+ filtered-comb filtered-comb?
+ filter-channel filter-control-coeffs filter-control-envelope filter-control-in-dB filter-control-in-hz
+ filter-control-order filter-control-waveform-color filter-control? filter-selection filter-sound
+ filter? find-dialog find-mark find-sound
+ finish-progress-report fir-filter fir-filter? flat-top-window focus-widget foreground-color
+ forget-region formant formant-bank formant-bank? formant? firmant firmant?
+ comb-bank comb-bank? all-pass-bank all-pass-bank? filtered-comb-bank filtered-comb-bank?
+ make-comb-bank make-all-pass-bank make-filtered-comb-bank
+ fourier-transform
+ free-player free-sampler gaussian-window gc-off gc-on
+ ;gl-graph->ps glSpectrogram
+ goto-listener-end granulate granulate?
+ graph graph->ps graph-as-sonogram graph-as-spectrogram graph-as-wavogram
+ graph-color graph-cursor graph-data graph-dots graph-dots-and-lines
+ graph-filled graph-hook graph-lines graph-lollipops graph-once
+ graph-style graphs-horizontal grid-density haar-transform hamming-window
+ hann-poisson-window hann-window header-type help-dialog
+ help-hook hide-widget highlight-color html-dir html-program
+ hz->radians iir-filter iir-filter? in in-any
+ ina inb info-dialog initial-graph-hook
+ insert-file-dialog insert-region insert-sample insert-samples insert-samples-with-origin
+ insert-selection insert-silence insert-sound just-sounds kaiser-window
+ key key-binding key-press-hook keyboard-no-action peak-env-dir
+; ladspa-activate ladspa-cleanup ladspa-connect-port ladspa-deactivate ladspa-descriptor ladspa-dir
+; ladspa-instantiate ladspa-run ladspa-run-adding ladspa-set-run-adding-gain list-ladspa init-ladspa apply-ladspa analyse-ladspa
+ left-sample
+ linear->db lisp-graph lisp-graph-hook lisp-graph-style lisp-graph?
+ listener-click-hook listener-color listener-font
+ listener-prompt listener-selection listener-text-color little-endian? locsig
+ locsig-ref locsig-reverb-ref locsig-reverb-set! locsig-set! locsig-type
+ locsig? log-freq-start main-menu main-widgets make-all-pass
+ make-asymmetric-fm make-moving-average make-moving-max make-moving-norm make-bezier make-color make-comb make-filtered-comb
+ make-convolve make-delay make-env make-fft-window make-file->frample
+ make-file->sample make-filter make-fir-coeffs make-fir-filter make-formant make-firmant make-formant-bank
+ make-granulate make-graph-data make-iir-filter
+ make-locsig make-mix-sampler make-move-sound make-notch make-one-pole make-one-pole-all-pass
+ make-one-zero make-oscil make-phase-vocoder make-player make-polyshape make-polywave
+ make-pulse-train make-rand make-rand-interp make-readin
+ make-region make-region-sampler make-sample->file make-sampler make-sawtooth-wave
+ make-nrxysin make-nrxycos make-rxyk!cos make-rxyk!sin
+ make-snd->sample make-square-wave
+ make-src make-ssb-am make-ncos make-nsin make-table-lookup
+ make-triangle-wave make-two-pole make-two-zero
+ make-variable-graph make-float-vector make-wave-train
+ map-channel mark-click-hook mark-color mark-context
+ mark-drag-hook mark-home mark-hook mark-name mark-properties mark-property
+ mark-sample mark-sync mark-sync-max mark-tag-height mark-tag-width
+ mark? marks max-regions max-transform-peaks maxamp
+ maxamp-position menu-widgets min-dB mix
+ mix-amp mix-amp-env mix-click-hook mix-color
+ mix-dialog-mix mix-drag-hook mix-file-dialog mix-length mix-home
+ mix-name mix-position mix-properties mix-property mix-region mix-release-hook mix-sync mix-sync-max
+ mix-sampler? mix-selection mix-speed mix-tag-height
+ mix-tag-width mix-tag-y
+ mix-float-vector mix-waveform-height mix?
+ mixes mouse-click-hook mouse-drag-hook mouse-enter-graph-hook
+ mouse-enter-label-hook mouse-enter-listener-hook mouse-enter-text-hook mouse-leave-graph-hook mouse-leave-label-hook
+ mouse-leave-listener-hook mouse-leave-text-hook mouse-press-hook move-locsig move-sound move-sound?
+ moving-average moving-average? moving-max moving-max? moving-norm moving-norm?
+ mus-aifc mus-aiff mus-alaw mus-alsa-buffer-size mus-alsa-buffers
+ mus-alsa-capture-device mus-alsa-device mus-alsa-playback-device mus-alsa-squelch-warning mus-apply
+ mus-array-print-length mus-float-equal-fudge-factor
+ mus-b24int mus-bdouble mus-bdouble-unscaled
+ mus-bfloat mus-bfloat-unscaled mus-bicsf mus-bint mus-bintn
+ mus-bshort mus-byte mus-bytes-per-sample mus-caff mus-channel mus-channels
+ mus-chebyshev-first-kind mus-chebyshev-second-kind mus-clipping mus-close
+ mus-data mus-sample-type->string mus-sample-type-name mus-describe mus-error-hook
+ mus-error-type->string mus-expand-filename mus-feedback mus-feedforward mus-fft
+ mus-file-buffer-size mus-file-clipping mus-file-name
+ mus-frequency mus-generator? mus-header-raw-defaults mus-header-type->string mus-header-type-name
+ mus-hop mus-increment mus-input? mus-interp-all-pass mus-interp-bezier
+ mus-interp-hermite mus-interp-lagrange mus-interp-linear mus-interp-none mus-interp-sinusoidal
+ mus-interp-type mus-interpolate mus-ircam mus-l24int mus-ldouble
+ mus-ldouble-unscaled mus-length mus-lfloat mus-lfloat-unscaled mus-lint
+ mus-lintn mus-location mus-lshort mus-max-malloc mus-max-table-size
+ mus-file-mix mus-mulaw mus-name
+ mus-next mus-nist mus-offset mus-order mus-oss-set-buffers
+ mus-out-format mus-output? mus-phase mus-ramp
+ mus-rand-seed mus-random mus-raw mus-reset mus-riff
+ mus-run mus-scaler mus-set-formant-radius-and-frequency mus-sound-chans
+ mus-sound-comment mus-sound-sample-type mus-sound-data-location mus-sound-datum-size
+ mus-sound-duration mus-sound-forget mus-sound-framples mus-sound-header-type mus-sound-length
+ mus-sound-loop-info mus-sound-mark-info mus-sound-maxamp mus-sound-maxamp-exists? mus-sound-path
+ mus-sound-prune mus-sound-report-cache mus-sound-samples
+ mus-sound-srate mus-sound-type-specifier mus-sound-write-date
+ mus-soundfont mus-srate mus-svx mus-ubshort
+ mus-ubyte mus-ulshort mus-unknown-sample mus-unknown-header mus-voc
+ mus-width mus-xcoeff mus-xcoeffs mus-ycoeff mus-ycoeffs
+ name-click-hook new-sound new-sound-dialog new-sound-hook new-widget-hook
+ next-sample normalize-by-channel normalize-by-sound normalize-channel normalize-globally
+ notch notch? odd-multiple odd-weight one-pole one-pole? one-pole-all-pass one-pole-all-pass?
+ one-zero one-zero? open-file-dialog open-file-dialog-directory open-hook open-raw-sound open-raw-sound-hook
+ open-sound
+ orientation-hook oscil oscil? out-any outa
+ outb outc outd output-comment-hook
+ override-samples-with-origin pad-channel partials->polynomial partials->wave
+ parzen-window pausing peaks peaks-font
+ phase-partials->wave phase-vocoder phase-vocoder-amp-increments phase-vocoder-amps phase-vocoder-freqs
+ phase-vocoder-phase-increments phase-vocoder-phases phase-vocoder? play play-arrow-size
+ play-hook player-home player? players
+ playing poisson-window polar->rectangular polynomial polyshape polywave
+ polyshape? polywave? position->x position->y position-color preferences-dialog
+ previous-sample print-dialog print-length progress-report
+ pulse-train
+ pulse-train? radians->degrees radians->hz
+ ramp-channel rand rand-interp rand-interp? rand?
+ read-mix-sample read-only read-region-sample
+ read-sample readin readin?
+ rectangular->magnitudes rectangular->polar rectangular-window redo redo-edit
+ region->float-vector region-chans region-home region-framples region-graph-style region-maxamp
+ region-maxamp-position region-position region-sample region-sampler? region-srate
+ region? regions remember-sound-state remove-from-menu status-report
+ reset-controls reset-listener-cursor restore-controls restore-region
+ 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-channel reverse-selection
+ reverse-sound revert-sound riemann-window right-sample ring-modulate
+ rv2-window rv3-window rv4-window
+ samaraki-window sample sample->file
+ sample->file? sampler-at-end? sampler-home sampler-position
+ sampler? samples samples->seconds sash-color
+ save-controls save-dir save-edit-history save-envelopes save-hook
+ save-listener save-marks 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 sawtooth-wave sawtooth-wave?
+ scale-by scale-channel scale-selection-by scale-selection-to scale-to
+ scan-channel script-arg script-args 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-chans selection-color selection-context selection-creates-region
+ selection-framples selection-maxamp selection-maxamp-position selection-member? selection-position
+ selection-srate selection?
+ short-file-name show-all-axes show-all-axes-unlabelled show-bare-x-axis
+ show-axes show-controls show-grid show-indices show-full-duration show-full-range initial-beg initial-dur
+ show-listener show-marks show-mix-waveforms show-no-axes show-selection show-selection-transform
+ show-sonogram-cursor show-transform-peaks show-widget show-x-axis show-x-axis-unlabelled
+ show-y-zero sinc-width nrxysin nrxysin? nrxycos nrxycos? rxyk!cos rxyk!cos? rxyk!sin rxyk!sin?
+ smooth-channel smooth-selection smooth-sound snd->sample snd->sample?
+ snd-error snd-error-hook snd-gcs snd-help snd-font snd-color
+ snd-print snd-spectrum snd-tempnam snd-url
+ snd-urls snd-version snd-warning snd-warning-hook
+ sound-file-extensions sound-file? sound-files-in-directory
+ sound-loop-info sound-properties sound-property sound-widgets sound? soundfont-info
+ sounds spectrum-end spectro-hop spectrum-start spectro-x-angle
+ spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle spectro-z-scale
+ spectrum speed-control speed-control-as-float speed-control-as-ratio speed-control-as-semitone
+ speed-control-bounds speed-control-style speed-control-tones square-wave square-wave?
+ squelch-update srate src src-channel src-selection
+ src-sound src? ssb-am ssb-am?
+ start-playing start-playing-hook start-playing-selection-hook start-progress-report stdin-prompt
+ stop-player stop-playing stop-playing-hook stop-playing-selection-hook ncos
+ ncos? nsin nsin? swap-channels sync sync-style sync-none sync-all sync-by-sound
+ sync-max syncd-marks table-lookup table-lookup? tap tap?
+ temp-dir text-focus-color time-graph time-graph-style
+ time-graph-type time-graph? tiny-font
+ tracking-cursor-style transform->float-vector
+ transform-dialog transform-framples transform-graph transform-graph-style transform-graph-type
+ transform-graph? transform-normalization transform-sample transform-size transform-type
+ transform? triangle-wave triangle-wave? tukey-window
+ two-pole two-pole? two-zero two-zero? ultraspherical-window
+ unbind-key undo undo-edit undo-hook unselect-all update-hook update-lisp-graph
+ update-sound update-time-graph update-transform-graph variable-graph? float-vector
+ float-vector* float-vector+ float-vector->channel
+ float-vector->string float-vector-add!
+ length float-vector-max float-vector-min float-vector-move!
+ float-vector-multiply! float-vector-offset! float-vector-peak float-vector-ref reverse!
+ float-vector-scale! float-vector-set! float-vector-subseq float-vector-subtract! float-vector?
+ walsh-transform
+ wave-train wave-train? wavelet-transform wavelet-type
+ wavo-hop wavo-trace welch-window widget-position
+ widget-size widget-text window-height
+ window-width window-x window-y with-background-processes with-file-monitor with-gl
+ with-mix-tags with-relative-panes with-tracking-cursor with-verbose-cursor
+ with-inset-graph with-interrupts with-pointer-focus with-smpte-label with-toolbar with-tooltips with-menu-icons
+ save-as-dialog-src save-as-dialog-auto-comment
+ x->position x-axis-as-clock x-axis-as-percentage x-axis-in-beats x-axis-in-measures
+ x-axis-in-samples x-axis-in-seconds x-axis-label x-axis-style x-bounds
+ x-position-slider x-zoom-slider xramp-channel y->position y-axis-label
+ y-bounds y-position-slider y-zoom-slider zero-pad zoom-color
+ zoom-focus-active zoom-focus-left zoom-focus-middle zoom-focus-right zoom-focus-style)))
(for-each
(lambda (n)
(if (not (defined? n))
(set! undef (cons n undef))))
names)
(if (pair? undef)
- (snd-display ";undefined: ~A" undef)))
-
- ))
+ (snd-display ";undefined: ~A" undef)))))
+
;;; ---------------- test 4: sndlib ----------------
@@ -2317,6 +2271,7 @@
((= clmtest tests))
(log-mem clmtest)
(clear-listener)
+
(let ((mz (mus-sound-maxamp "z.snd")))
(if (or (not (= (car mz) 0))
(fneq (cadr mz) 0.0))
@@ -2402,11 +2357,11 @@
(if (not (string=? str "23-Nov 06:56 PST"))
(snd-display ";mus-sound-write-date pistol.snd: ~A?" str)))
- (let ((long-file-name (let ((name "test"))
- (do ((i 0 (+ i 1)))
- ((= i 10)) ; 40 is about the limit in Linux (256 char limit here from OS, not Snd)
- (set! name (string-append name "-test")))
- (string-append name ".snd"))))
+ (let ((long-file-name (do ((name "test")
+ (i 0 (+ i 1)))
+ ((= i 10)
+ (string-append name ".snd"))
+ (set! name (string-append name "-test")))))
(let ((index (open-sound "oboe.snd")))
(if (variable-graph? index) (snd-display ";variable-graph thinks anything is a graph..."))
(if (player? index) (snd-display ";player? thinks anything is a player..."))
@@ -2441,19 +2396,18 @@
(snd-display ";(mus-sound-path): ~A~%" ind)))))))
(let ((fsnd (string-append sf-dir "forest.aiff")))
- (if (file-exists? fsnd)
- (begin
- (system (format #f "cp ~A fmv.snd" fsnd))
- (let ((index (open-sound "fmv.snd")))
- (if (not (equal? (sound-loop-info index) (mus-sound-loop-info fsnd)))
- (snd-display ";loop-info: ~A ~A" (sound-loop-info index) (mus-sound-loop-info fsnd)))
- (set! (sound-loop-info index) (list 12000 14000 1 2 3 4))
- (if (not (equal? (sound-loop-info index) '(12000 14000 1 2 3 4 1 1)))
- (snd-display ";set loop-info: ~A" (sound-loop-info index)))
- (save-sound-as "fmv1.snd" index :header-type mus-aifc)
- (close-sound index)
- (if (not (equal? (mus-sound-loop-info "fmv1.snd") '(12000 14000 1 2 3 4 1 1)))
- (snd-display ";saved loop-info: ~A" (mus-sound-loop-info "fmv1.snd")))))))
+ (when (file-exists? fsnd)
+ (system (format #f "cp ~A fmv.snd" fsnd))
+ (let ((index (open-sound "fmv.snd")))
+ (if (not (equal? (sound-loop-info index) (mus-sound-loop-info fsnd)))
+ (snd-display ";loop-info: ~A ~A" (sound-loop-info index) (mus-sound-loop-info fsnd)))
+ (set! (sound-loop-info index) (list 12000 14000 1 2 3 4))
+ (if (not (equal? (sound-loop-info index) '(12000 14000 1 2 3 4 1 1)))
+ (snd-display ";set loop-info: ~A" (sound-loop-info index)))
+ (save-sound-as "fmv1.snd" index :header-type mus-aifc)
+ (close-sound index)
+ (if (not (equal? (mus-sound-loop-info "fmv1.snd") '(12000 14000 1 2 3 4 1 1)))
+ (snd-display ";saved loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))))
(let ((index (open-sound "oboe.snd")))
(save-sound-as "fmv.snd" index :header-type mus-aifc)
(close-sound index))
@@ -2479,95 +2433,80 @@
(let ((com (mus-sound-comment "oboe.snd")))
(if (not (equal? com "")) (snd-display ";oboe: mus-sound-comment ~A?" com))
(let ((fsnd (string-append sf-dir "nasahal8.wav")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "ICRD: 1997-02-22\nIENG: Paul R. Roger\nISFT: Sound Forge 4.0\n"))
- (snd-display ";mus-sound-comment \"nasahal8.wav\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "ICRD: 1997-02-22\nIENG: Paul R. Roger\nISFT: Sound Forge 4.0\n"))
+ (snd-display ";mus-sound-comment \"nasahal8.wav\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "8svx-8.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "File created by Sound Exchange "))
- (snd-display ";mus-sound-comment \"8svx-8.snd\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "File created by Sound Exchange "))
+ (snd-display ";mus-sound-comment \"8svx-8.snd\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "sun-16-afsp.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "AFspdate:1981/02/11 23:03:34 UTC"))
- (snd-display ";mus-sound-comment \"sun-16-afsp.snd\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "AFspdate:1981/02/11 23:03:34 UTC"))
+ (snd-display ";mus-sound-comment \"sun-16-afsp.snd\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "smp-16.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "Converted using Sox. "))
- (snd-display ";mus-sound-comment \"smp-16.snd\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "Converted using Sox. "))
+ (snd-display ";mus-sound-comment \"smp-16.snd\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "d40130.au")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "1994 Jesus Villena"))
- (snd-display ";mus-sound-comment \"d40130.au\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "1994 Jesus Villena"))
+ (snd-display ";mus-sound-comment \"d40130.au\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "wood.maud")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "file written by SOX MAUD-export "))
- (snd-display ";mus-sound-comment \"wood.maud\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "file written by SOX MAUD-export "))
+ (snd-display ";mus-sound-comment \"wood.maud\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "addf8.sf_mipseb")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" "))
- (snd-display ";mus-sound-comment \"addf8.sf_mipseb\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" "))
+ (snd-display ";mus-sound-comment \"addf8.sf_mipseb\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "mary-sun4.sig")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "MARY HAD A LITTLE LAMB\n"))
- (snd-display ";mus-sound-comment \"mary-sun4.sig\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "MARY HAD A LITTLE LAMB\n"))
+ (snd-display ";mus-sound-comment \"mary-sun4.sig\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "nasahal.pat")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "This patch saved with Sound Forge 3.0."))
- (snd-display ";mus-sound-comment \"nasahal.pat\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "This patch saved with Sound Forge 3.0."))
+ (snd-display ";mus-sound-comment \"nasahal.pat\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "next-16.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91"))
- (snd-display ";mus-sound-comment \"next-16.snd\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91"))
+ (snd-display ";mus-sound-comment \"next-16.snd\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "wood16.nsp")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "Created by Snack "))
- (snd-display ";mus-sound-comment \"wood16.nsp\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "Created by Snack "))
+ (snd-display ";mus-sound-comment \"wood16.nsp\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "wood.sdx")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "1994 Jesus Villena"))
- (snd-display ";mus-sound-comment \"wood.sdx\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "1994 Jesus Villena"))
+ (snd-display ";mus-sound-comment \"wood.sdx\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "clmcom.aif")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "this is a comment"))
- (snd-display ";mus-sound-comment \"clmcom.aif\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "this is a comment"))
+ (snd-display ";mus-sound-comment \"clmcom.aif\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "anno.aif")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "1994 Jesus Villena\n"))
- (snd-display ";mus-sound-comment \"anno.aif\") -> ~A?" com)))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "1994 Jesus Villena\n"))
+ (snd-display ";mus-sound-comment \"anno.aif\") -> ~A?" com))))
(let ((fsnd (string-append sf-dir "telephone.wav")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (not (equal? com "sample_byte_format -s2 01\nchannel_count -i 1\nsample_count -i 36461\nsample_rate -i 16000\nsample_n_bytes -i 2\nsample_sig_bits -i 16\n"))
- (snd-display ";mus-sound-comment \"telephone.wav\") -> ~A?" com))))))
+ (when (file-exists? fsnd)
+ (set! com (mus-sound-comment fsnd))
+ (if (not (equal? com "sample_byte_format -s2 01\nchannel_count -i 1\nsample_count -i 36461\nsample_rate -i 16000\nsample_n_bytes -i 2\nsample_sig_bits -i 16\n"))
+ (snd-display ";mus-sound-comment \"telephone.wav\") -> ~A?" com)))))
(if (not (string? (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
(snd-display ";mus-sound-comment traffic: ~A" (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
@@ -2576,7 +2515,6 @@
(snd-display ";oboe: mus-sound-type-specifier: ~X?" (mus-sound-type-specifier "oboe.snd")))
(if (not (string=? (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd"))) "23-Nov-2012 06:56"))
(snd-display ";oboe: file-write-date: ~A?" (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd")))))
- ; (mus-sound-forget "oboe.snd")
(let ((lasth (do ((i 1 (+ i 1)))
((string=? (mus-header-type-name i) "unknown") i))))
@@ -2699,10 +2637,9 @@
maxdiff maxpos
(v maxpos) (v1 maxpos))))
(let ((diff (abs (- (v i) (v1 i)))))
- (if (> diff maxdiff)
- (begin
- (set! maxdiff diff)
- (set! maxpos i)))))
+ (when (> diff maxdiff)
+ (set! maxdiff diff)
+ (set! maxpos i))))
(close-sound ind))))
(list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
@@ -3273,15 +3210,13 @@
"no feedforward method" "no feedback method" "no interp-type method" "no position method" "no order method" "no copy method"
"can't translate"
)))
- (let ((happy #t)
- (len (length errs)))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i len)))
- (if (not (string=? (errs i) (mus-error-type->string i)))
- (begin
- (snd-display ";mus-error-type->string ~D: ~A ~A" i (errs i) (mus-error-type->string i))
- (set! happy #f))))))
-
+ (do ((len (length errs))
+ (i 0 (+ i 1)))
+ ((or (= i len)
+ (not (string=? (errs i) (mus-error-type->string i))))
+ (if (not (= i len))
+ (snd-display ";mus-error-type->string ~D: ~A ~A" i (errs i) (mus-error-type->string i))))))
+
(let ((cur-srate (mus-sound-srate "oboe.snd"))
(cur-chans (mus-sound-chans "oboe.snd"))
(cur-format (mus-sound-sample-type "oboe.snd"))
@@ -3535,11 +3470,10 @@
(lambda ()
(open-sound "test.snd"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound garbage ~A: ~A -> ~A?" magic tag (file->string "test.snd"))
- (if (sound? tag) (close-sound tag)))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound garbage ~A: ~A -> ~A?" magic tag (file->string "test.snd"))
+ (if (sound? tag) (close-sound tag))))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
;; try plausible garbage
@@ -3553,11 +3487,10 @@
(lambda ()
(open-sound "test.snd"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound plausible garbage ~A: ~A?" magic tag)
- (if (sound? tag) (close-sound tag)))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound plausible garbage ~A: ~A?" magic tag)
+ (if (sound? tag) (close-sound tag))))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
;; write very plausible garbage
@@ -3566,18 +3499,15 @@
(display magic)
(do ((i 1 (+ i 1)))
((= i 12))
- (if (< (+ ctr i) len)
- (display (magic-words (+ ctr i)))
- (display (magic-words i))))))
+ (display (magic-words (if (< (+ ctr i) len) (+ ctr i) i))))))
(let ((tag (catch #t
(lambda ()
(open-sound "test.snd"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound very plausible garbage ~A: ~A?" magic tag)
- (if (sound? tag) (close-sound tag)))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound very plausible garbage ~A: ~A?" magic tag)
+ (if (sound? tag) (close-sound tag))))
(set! ctr (+ ctr 1)))
magic-words)))
(if (file-exists? "test.snd") (delete-file "test.snd"))
@@ -3599,11 +3529,10 @@
(lambda ()
(open-sound "test.snd"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound next bad location ~A: ~A?" (data-location tag) tag)
- (close-sound tag))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound next bad location ~A: ~A?" (data-location tag) tag)
+ (close-sound tag)))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
@@ -3646,11 +3575,10 @@
(lambda ()
(open-sound "test.aif"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound aifc no ssnd chunk ~A: ~A?" (data-location tag) tag)
- (close-sound tag))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound aifc no ssnd chunk ~A: ~A?" (data-location tag) tag)
+ (close-sound tag)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(make-aifc-file #o002 #o000 #o020)
@@ -3659,11 +3587,10 @@
(lambda ()
(open-sound "test.aif"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound aifc 0-len auth chunk ~A: ~A?" (data-location tag) tag)
- (close-sound tag))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound aifc 0-len auth chunk ~A: ~A?" (data-location tag) tag)
+ (close-sound tag)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(make-aifc-file #o002 #o150 #o120)
@@ -3671,11 +3598,10 @@
(lambda ()
(open-sound "test.aif"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound bits 80 ~A: ~A?" (sample-type tag) tag)
- (close-sound tag))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound bits 80 ~A: ~A?" (sample-type tag) tag)
+ (close-sound tag)))
(delete-file "test.aif")
(mus-sound-forget "test.aif"))
@@ -3803,11 +3729,10 @@
(lambda ()
(open-sound "test.aif"))
(lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display ";open-sound aifc 2 ssnd chunks ~A: ~A?" (data-location tag) tag)
- (close-sound tag))))
+ (when (and (number? tag)
+ (sound? tag))
+ (snd-display ";open-sound aifc 2 ssnd chunks ~A: ~A?" (data-location tag) tag)
+ (close-sound tag)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -3822,12 +3747,11 @@
(lambda ()
(open-sound "test.aif"))
(lambda args (car args)))))
- (if (not (eq? tag 'mus-error))
- (begin
- (snd-display ";open-sound aifc no comm chunk ~A?" tag)
- (if (and (number? tag)
- (sound? tag))
- (close-sound tag)))))
+ (unless (eq? tag 'mus-error)
+ (snd-display ";open-sound aifc no comm chunk ~A?" tag)
+ (if (and (number? tag)
+ (sound? tag))
+ (close-sound tag))))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -3997,10 +3921,9 @@
(let ((tag (catch #t
(lambda () (new-sound :size -1))
(lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (begin
- (snd-display ";new-sound :size -1: ~A" tag)
- (if (pair? (sounds)) (for-each close-sound (sounds))))))
+ (unless (eq? tag 'out-of-range)
+ (snd-display ";new-sound :size -1: ~A" tag)
+ (if (pair? (sounds)) (for-each close-sound (sounds)))))
(let ((ind (read-ascii (string-append sf-dir "caruso.asc"))))
(if (not (sound? ind))
@@ -4032,9 +3955,9 @@
(load (string-append cwd "test space.marks"))
(if (not (find-mark 1234 ind))
(snd-display ";space file name save marks: ~A" (marks ind)))
- (let ((rd (make-readin :file "test space.snd")))
- (if (not (string=? (mus-file-name rd) "test space.snd"))
- (snd-display ";file name with space readin: ~A" (mus-file-name rd))))
+ (let ((rdf (mus-file-name (make-readin :file "test space.snd"))))
+ (if (not (string=? rdf "test space.snd"))
+ (snd-display ";file name with space readin: ~A" rdf)))
(close-sound ind))
(if (file-exists? "test space.snd")
(delete-file "test space.snd"))
@@ -5375,12 +5298,11 @@ EDITS: 5
(sample (+ (left-sample) mid)))
(snd-display ";make-graph-data[~D]: ~A ~A" mid (data mid) (sample (+ (left-sample) mid)))))))
(let ((data (make-graph-data index 0 0 100 199)))
- (if (float-vector? data)
- (begin
- (if (not (= (length data) 100))
- (snd-display ";make-graph-data 100:199: ~A" (length data)))
- (if (fneq (data 50) (sample 50))
- (snd-display ";make-graph-data 50: ~A ~A" (data 50) (sample 50))))))
+ (when (float-vector? data)
+ (if (not (= (length data) 100))
+ (snd-display ";make-graph-data 100:199: ~A" (length data)))
+ (if (fneq (data 50) (sample 50))
+ (snd-display ";make-graph-data 50: ~A ~A" (data 50) (sample 50)))))
(set! (x-bounds) (list 0.0 0.1))
(update-transform-graph)
(catch 'no-such-axis
@@ -5410,7 +5332,7 @@ EDITS: 5
(line (read-line p)))
(if (not (string=? "Snd: fft peaks" (substring line 0 14)))
(snd-display ";peaks 1: ~A?" line))
- (set! line (read-line p))
+ (read-line p)
(set! line (read-line p))
(if (not (member line '(#<eof> "oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2"
"oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2\n")))
@@ -5454,15 +5376,14 @@ EDITS: 5
(key (char->integer #\a) 0))
(do ((i 0 (+ i 1)))
((= i 5))
- (if (string? *eps-file*)
- (begin
- (if (file-exists? *eps-file*)
- (delete-file *eps-file*))
- (set! *graph-style* i)
- (graph->ps)
- (if (file-exists? *eps-file*)
- (delete-file *eps-file*)
- (snd-display ";graph->ps: ~A?" *eps-file*)))))
+ (when (string? *eps-file*)
+ (if (file-exists? *eps-file*)
+ (delete-file *eps-file*))
+ (set! *graph-style* i)
+ (graph->ps)
+ (if (file-exists? *eps-file*)
+ (delete-file *eps-file*)
+ (snd-display ";graph->ps: ~A?" *eps-file*))))
(let ((err (catch 'cannot-print
(lambda ()
(graph->ps "/bad/bad.eps"))
@@ -5487,10 +5408,9 @@ EDITS: 5
(xz (x-zoom-slider))
(yz (y-zoom-slider))
(bnds (x-bounds index)))
- (if (= (channels index) 1)
- (begin
- (set! (channel-style index) channels-superimposed)
- (if (not (= (channel-style index) channels-separate)) (snd-display ";channel-style[0]->~D: ~A?" channels-separate (channel-style index)))))
+ (when (= (channels index) 1)
+ (set! (channel-style index) channels-superimposed)
+ (if (not (= (channel-style index) channels-separate)) (snd-display ";channel-style[0]->~D: ~A?" channels-separate (channel-style index))))
(set! (sync index) 32)
(if (not (= (sync index) 32)) (snd-display ";sync->32: ~A?" (sync index)))
(if (< (sync-max) 32) (snd-display ";sync-max 32: ~A" (sync-max)))
@@ -5597,10 +5517,9 @@ EDITS: 5
(lambda ()
(do ((i 0 (+ i 1)))
((= i 50827))
- (if (not (= ((if (odd? i) next-sample read-sample) vr) (samps1 i) (samps2 i)))
- (begin
- (snd-display ";readers disagree at ~D" i)
- (throw 'break)))))
+ (unless (= ((if (odd? i) next-sample read-sample) vr) (samps1 i) (samps2 i))
+ (snd-display ";readers disagree at ~D" i)
+ (throw 'break))))
(lambda args (car args)))
(free-sampler vr)))
(let ((var (catch #t (lambda () (make-sampler 0 index -1)) (lambda args args))))
@@ -5691,14 +5610,14 @@ EDITS: 5
(delete-samples 0 100 index)
(if (not (= (framples index) 50727)) (snd-display ";delete-samples: ~A?" (framples index)))
(revert-sound index)
- (let ((maxa (maxamp index)))
+ (let ((maxa (* 2.0 (maxamp index))))
(scale-to .5 index)
(let ((newmaxa (maxamp index)))
(if (fneq newmaxa .5) (snd-display ";scale-to: ~A?" newmaxa))
(undo 1 index)
(scale-by 2.0 index))
(let ((newmaxa (maxamp index)))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display ";scale-by: ~A?" newmaxa)))
+ (if (fneq newmaxa maxa) (snd-display ";scale-by: ~A?" newmaxa)))
(revert-sound index)
(scale-by -1 index)
(mix "oboe.snd")
@@ -5713,11 +5632,11 @@ EDITS: 5
(select-all index)
(scale-selection-by 2.0)
(let ((newmaxa (maxamp index)))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display ";scale-selection-by: ~A?" newmaxa))
+ (if (fneq newmaxa maxa) (snd-display ";scale-selection-by: ~A?" newmaxa))
(revert-sound index)
(with-temporary-selection (lambda () (scale-selection-by 2.0)) 0 (framples) index 0))
(let ((newmaxa (maxamp index)))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display ";with-temporary-selection: ~A?" newmaxa))))
+ (if (fneq newmaxa maxa) (snd-display ";with-temporary-selection: ~A?" newmaxa))))
(revert-sound index)
(let ((samp999 (sample 999 index 0))
(samp1001 (sample 1001 index 0)))
@@ -5775,19 +5694,18 @@ EDITS: 5
(set! (cursor index 0) 30)
(set! *cursor-style* cursor-line)
(set! (cursor index 0) 20)
- (if with-gui
- (begin
- (set! (cursor-style index 0)
- (lambda (snd chn ax)
- (let ((point (cursor-position)))
- (let ((x (car point))
- (y (cadr point))
- (size (floor (/ *cursor-size* 2)))
- (cr (make-cairo (car (channel-widgets snd chn)))))
- (draw-line (- x size) (- y size) (+ x size) (+ y size) snd chn cursor-context cr)
- (draw-line (- x size) (+ y size) (+ x size) (- y size) snd chn cursor-context cr)
- (free-cairo cr)))))
- (if (not (procedure? (cursor-style index 0))) (snd-display ";set cursor-style to proc: ~A" (cursor-style index 0)))))
+ (when with-gui
+ (set! (cursor-style index 0)
+ (lambda (snd chn ax)
+ (let ((point (cursor-position)))
+ (let ((x (car point))
+ (y (cadr point))
+ (size (floor (/ *cursor-size* 2)))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+ (draw-line (- x size) (- y size) (+ x size) (+ y size) snd chn cursor-context cr)
+ (draw-line (- x size) (+ y size) (+ x size) (- y size) snd chn cursor-context cr)
+ (free-cairo cr)))))
+ (if (not (procedure? (cursor-style index 0))) (snd-display ";set cursor-style to proc: ~A" (cursor-style index 0))))
(set! (cursor index) 50)
(insert-sound "fyow.snd" (cursor) 0 index 0)
(if (or (fneq (sample 40) s40) (not (fneq (sample 100) s100)) (fneq (sample 100) 0.001831))
@@ -5806,9 +5724,6 @@ EDITS: 5
(insert-region id 60 index)
(if (not (= (framples) (+ len 100))) (snd-display ";insert-region len: ~A?" (framples)))
(if (fneq (sample 100) s40) (snd-display ";insert-region: ~A ~A?" (sample 100) s40))
- (let ((var (catch #t (lambda () (insert-region (integer->region (+ 1000 (apply max (map region->integer (regions))))) 0)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-region))
- (snd-display ";insert-region bad id: ~A" var)))
(save-region id "fmv.snd")
(if (not (= (mus-sound-header-type "fmv.snd") mus-next))
(snd-display ";save-region header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
@@ -5875,12 +5790,12 @@ EDITS: 5
(snd-display ";saved silence 1: ~A ~A" (framples index 0) (framples index 1)))
(if (not (= (mus-sound-framples "fmv.snd") 1001))
(snd-display ";saved framers silence 1: ~A" (mus-sound-framples "fmv.snd")))
- (let ((v0 (channel->float-vector 0 1000 index 0))
- (v1 (channel->float-vector 0 1000 index 1)))
- (if (fneq (float-vector-peak v0) 0.0)
- (snd-display ";auto-pad 0: ~A" (float-vector-peak v0)))
- (if (fneq (float-vector-peak v1) 0.0)
- (snd-display ";silence 0: ~A" (float-vector-peak v1))))
+ (let ((v0 (float-vector-peak (channel->float-vector 0 1000 index 0)))
+ (v1 (float-vector-peak (channel->float-vector 0 1000 index 1))))
+ (if (fneq v0 0.0)
+ (snd-display ";auto-pad 0: ~A" v0))
+ (if (fneq v1 0.0)
+ (snd-display ";silence 0: ~A" v1)))
(close-sound index))
(delete-file "fmv.snd")
@@ -5889,12 +5804,12 @@ EDITS: 5
(if (not (and (= (framples index 0) 1)
(= (framples index 1) 1001)))
(snd-display ";pad-channel 1: ~A ~A" (framples index 0) (framples index 1)))
- (let ((v0 (channel->float-vector 0 1000 index 0))
- (v1 (channel->float-vector 0 1000 index 1)))
- (if (fneq (float-vector-peak v0) 0.0)
- (snd-display ";pad 0: ~A" (float-vector-peak v0)))
- (if (fneq (float-vector-peak v1) 0.0)
- (snd-display ";pad 1: ~A" (float-vector-peak v1))))
+ (let ((v0 (float-vector-peak (channel->float-vector 0 1000 index 0)))
+ (v1 (float-vector-peak (channel->float-vector 0 1000 index 1))))
+ (if (fneq v0 0.0)
+ (snd-display ";pad 0: ~A" v0))
+ (if (fneq v1 0.0)
+ (snd-display ";pad 1: ~A" v1)))
(map-channel (lambda (n) 1.0) 0 2 index 0)
(map-channel (lambda (n) 1.0) 0 1002 index 1)
(pad-channel 0 1000 index 0 1)
@@ -6144,17 +6059,17 @@ EDITS: 5
(50828 -2 0 0 0.0 0.0 0.0 0))))
(if (not (= (length tree) (length true-tree)))
(snd-display ";edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
- (let ((len (length tree)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((branch (tree i))
- (true-branch (true-tree i)))
- (if (not (and (= (car branch) (car true-branch))
- (= (cadr branch) (cadr true-branch))
- (= (caddr branch) (caddr true-branch))
- (= (cadddr branch) (cadddr true-branch))
- (<= (magnitude (- (branch 4) (true-branch 4))) .001)))
- (snd-display ";edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
+ (do ((len (length tree))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (let ((branch (tree i))
+ (true-branch (true-tree i)))
+ (if (not (and (= (car branch) (car true-branch))
+ (= (cadr branch) (cadr true-branch))
+ (= (caddr branch) (caddr true-branch))
+ (= (cadddr branch) (cadddr true-branch))
+ (<= (magnitude (- (branch 4) (true-branch 4))) .001)))
+ (snd-display ";edit trees disagree at ~D: ~A ~A" i branch true-branch))))))
(insert-silence 1001 8)
(insert-silence 900 50)
(insert-silence 2005 1)
@@ -6179,17 +6094,17 @@ EDITS: 5
(50889 -2 0 0 0.0 0.0 0.0 0))))
(if (not (= (length tree) (length true-tree)))
(snd-display ";silenced edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
- (let ((len (length tree)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((branch (tree i))
- (true-branch (true-tree i)))
- (if (not (and (= (car branch) (car true-branch))
- (= (cadr branch) (cadr true-branch))
- (= (caddr branch) (caddr true-branch))
- (= (cadddr branch) (cadddr true-branch))
- (<= (magnitude (- (branch 4) (true-branch 4))) .001)))
- (snd-display ";silenced edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
+ (do ((len (length tree))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (let ((branch (tree i))
+ (true-branch (true-tree i)))
+ (if (not (and (= (car branch) (car true-branch))
+ (= (cadr branch) (cadr true-branch))
+ (= (caddr branch) (caddr true-branch))
+ (= (cadddr branch) (cadddr true-branch))
+ (<= (magnitude (- (branch 4) (true-branch 4))) .001)))
+ (snd-display ";silenced edit trees disagree at ~D: ~A ~A" i branch true-branch))))))
(if (or (fneq (sample 998) -.03)
(fneq (sample 999) 0.0)
(fneq (sample 1000) 0.0)
@@ -6255,10 +6170,10 @@ EDITS: 5
(snd-display ";insert-selection: ~A?" (framples obind)))
(if (fneq (sample 2000) val)
(snd-display ";insert-selection val: ~A ~A" val (sample 2000))))
- (let ((val (sample 900)))
+ (let ((val (* 2 (sample 900))))
(mix-selection)
- (if (fneq (sample 900) (* 2 val))
- (snd-display ";mix-selection val: ~A ~A" (* 2 val) (sample 900)))
+ (if (fneq (sample 900) val)
+ (snd-display ";mix-selection val: ~A ~A" val (sample 900)))
(if (not (= (framples obind) (+ frs 1000)))
(snd-display ";mix-selection len: ~A?" (framples obind)))))
(close-sound obind))
@@ -6481,9 +6396,9 @@ EDITS: 5
(- y1 y0))))))
(select-channel 0)
(set! (cursor obind) 100)
- (let ((xy (cursor-position obind)))
- (if (fneq (position->x (car xy)) (/ (cursor obind) (srate obind)))
- (snd-display ";cursor-position: ~A ~A ~A?" (car xy) (position->x (car xy)) (/ (cursor obind) (srate obind)))))
+ (let ((xy (car (cursor-position obind))))
+ (if (fneq (position->x xy) (/ (cursor obind) (srate obind)))
+ (snd-display ";cursor-position: ~A ~A ~A?" xy (position->x xy) (/ (cursor obind) (srate obind)))))
(if (fneq (position->x (x->position xpos)) xpos)
(snd-display ";x<->position: ~A ~A?" (position->x (x->position xpos)) xpos))
(if (> (abs (- (position->y (y->position ypos)) ypos)) .5)
@@ -6789,9 +6704,9 @@ EDITS: 5
(make-selection 24000 25000)
(if (not (= (selection-maxamp-position) 971))
(snd-display ";selection maxamp position: ~A" (selection-maxamp-position)))
- (let ((reg (make-region 24000 25000)))
- (if (not (= (region-maxamp-position reg) 971))
- (snd-display ";region maxamp position: ~A" (region-maxamp-position reg))))
+ (let ((regp (region-maxamp-position (make-region 24000 25000))))
+ (if (not (= regp 971))
+ (snd-display ";region maxamp position: ~A" regp)))
(close-sound ind1))
(let ((ind1 (open-sound "oboe.snd")))
(test-edpos maxamp 'maxamp (lambda () (scale-by 2.0 ind1 0)) ind1)
@@ -6916,15 +6831,14 @@ EDITS: 5
(mn (float-vector-min data)))
(let ((mxdiff (abs (- mx (maxs e-bin))))
(mndiff (abs (- mn (mins e-bin)))))
- (if (or (> mxdiff diff)
- (> mndiff diff))
- (begin
- (snd-display ";~A: peak-env-equal? [bin ~D of ~D]: (~,4F to ~,4F), diff: ~,5F"
- name
- e-bin e-size
- mn mx
- (max mxdiff mndiff))
- (set! happy #f)))))))))
+ (when (or (> mxdiff diff)
+ (> mndiff diff))
+ (snd-display ";~A: peak-env-equal? [bin ~D of ~D]: (~,4F to ~,4F), diff: ~,5F"
+ name
+ e-bin e-size
+ mn mx
+ (max mxdiff mndiff))
+ (set! happy #f))))))))
(let ((mx (maxamp ind 0))
(e0 (channel-amp-envs ind 0)))
@@ -7084,11 +6998,11 @@ EDITS: 5
(mn (car peaks)))
(call-with-exit
(lambda (break)
- (let ((ln (- (length mn) 4)))
- (do ((i 0 (+ i 1)))
- ((= i ln))
- (if (< (mn i) 0.5) (begin (snd-display ";peak min: ~A ~A" (mn i) i) (break #f)))
- (if (< (mx i) 0.5) (begin (snd-display ";peak max: ~A ~A" (mx i) i) (break #f)))))))))
+ (do ((ln (- (length mn) 4))
+ (i 0 (+ i 1)))
+ ((= i ln))
+ (when (< (mn i) 0.5) (snd-display ";peak min: ~A ~A" (mn i) i) (break #f))
+ (when (< (mx i) 0.5) (snd-display ";peak max: ~A ~A" (mx i) i) (break #f)))))))
(undo 2)
(map-channel (lambda (y) -1.0) 0 50001)
(ramp-channel 0.5 1.0 1000 4000)
@@ -7100,76 +7014,76 @@ EDITS: 5
(i 0 (+ i 1)))
((or (not happy)
(= i ln)))
- (if (> (mn i) -0.5) (begin (snd-display ";1 peak min: ~A ~A" (mn i) i) (set! happy #f)))
- (if (> (mx i) -0.5) (begin (snd-display ";1 peak max: ~A ~A" (mx i) i) (set! happy #f))))))
+ (when (> (mn i) -0.5) (snd-display ";1 peak min: ~A ~A" (mn i) i) (set! happy #f))
+ (when (> (mx i) -0.5) (snd-display ";1 peak max: ~A ~A" (mx i) i) (set! happy #f)))))
(close-sound ind))
(let ((index (new-sound "fmv.snd" 2 22050 mus-ldouble mus-next "channel tests")))
(define (test-channel-func func val-func init-val)
- (let ((len (framples index))
- (chns (chans index))
- (val #f)
- (g-init-val init-val))
- (do ((k 0 (+ k 1)))
- ((= k 2))
- (set! val (val-func len))
- (set! (sync index) k)
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (map-channel (lambda (n) 0.0) 0 len index i)
- (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index i)
- (snd-display ";init scan: ~A?" (scan-channel (lambda (n) (> (abs n) 0.001))))))
- ;; now it's cleared
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (map-channel (lambda (n) g-init-val) 0 len index i)
- (func 0 len index i)
+ (do ((len (framples index))
+ (chns (chans index))
+ (val #f)
+ (g-init-val init-val)
+ (k 0 (+ k 1)))
+ ((= k 2))
+ (set! val (val-func len))
+ (set! (sync index) k)
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (map-channel (lambda (n) 0.0) 0 len index i)
+ (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index i)
+ (snd-display ";init scan: ~A?" (scan-channel (lambda (n) (> (abs n) 0.001))))))
+ ;; now it's cleared
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (map-channel (lambda (n) g-init-val) 0 len index i)
+ (func 0 len index i)
+ (do ((j 0 (+ j 1)))
+ ((= j chns))
+ (let ((vi (channel->float-vector 0 len index j)))
+ (if (= j i)
+ (if (not (mus-arrays-equal? vi val))
+ (snd-display ";chan func: ~A ~A" vi val))
+ (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index j)
+ (snd-display ";chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (map-channel (lambda (n) 0.0) 0 len index i))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (map-channel (lambda (n) g-init-val) 0 len index i)
+ (let ((ed (edit-position index i)))
+ (map-channel (lambda (n) (+ g-init-val 1.0)) 0 len index i)
+ (func 0 len index i ed)
(do ((j 0 (+ j 1)))
((= j chns))
(let ((vi (channel->float-vector 0 len index j)))
(if (= j i)
(if (not (mus-arrays-equal? vi val))
- (snd-display ";chan func: ~A ~A" vi val))
- (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index j)
- (snd-display ";chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
- (map-channel (lambda (n) 0.0) 0 len index i))
+ (snd-display ";ed chan func: ~A ~A" vi val))
+ (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
+ (snd-display ";ed chan func leaks? ~A ~A ~A: ~A" i j ed (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (map-channel (lambda (n) 0.0) 0 len index i)))
+ (let* ((beg (floor (/ len 3)))
+ (dur beg)
+ (nv (val-func dur)))
+ (fill! val 0.0)
+ (do ((i beg (+ i 1))
+ (j 0 (+ j 1)))
+ ((= j dur))
+ (set! (val i) (nv j)))
(do ((i 0 (+ i 1)))
((= i chns))
- (map-channel (lambda (n) g-init-val) 0 len index i)
- (let ((ed (edit-position index i)))
- (map-channel (lambda (n) (+ g-init-val 1.0)) 0 len index i)
- (func 0 len index i ed)
- (do ((j 0 (+ j 1)))
- ((= j chns))
- (let ((vi (channel->float-vector 0 len index j)))
- (if (= j i)
- (if (not (mus-arrays-equal? vi val))
- (snd-display ";ed chan func: ~A ~A" vi val))
- (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
- (snd-display ";ed chan func leaks? ~A ~A ~A: ~A" i j ed (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
- (map-channel (lambda (n) 0.0) 0 len index i)))
- (let* ((beg (floor (/ len 3)))
- (dur beg)
- (nv (val-func dur)))
- (fill! val 0.0)
- (do ((i beg (+ i 1))
- (j 0 (+ j 1)))
- ((= j dur))
- (set! (val i) (nv j)))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (map-channel (lambda (n) g-init-val) beg dur index i)
- (func beg dur index i)
- (add-mark beg index i)
- (do ((j 0 (+ j 1)))
- ((= j chns))
- (let ((vi (channel->float-vector 0 len index j)))
- (if (= j i)
- (if (not (mus-arrays-equal? vi val))
- (snd-display ";chan func n: ~A ~A" vi val))
- (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
- (snd-display ";dur chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
- (map-channel (lambda (n) 0.0) 0 len index i))))))
+ (map-channel (lambda (n) g-init-val) beg dur index i)
+ (func beg dur index i)
+ (add-mark beg index i)
+ (do ((j 0 (+ j 1)))
+ ((= j chns))
+ (let ((vi (channel->float-vector 0 len index j)))
+ (if (= j i)
+ (if (not (mus-arrays-equal? vi val))
+ (snd-display ";chan func n: ~A ~A" vi val))
+ (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
+ (snd-display ";dur chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (map-channel (lambda (n) 0.0) 0 len index i)))))
(insert-silence 0 10 index 0)
(insert-silence 0 10 index 1)
@@ -7177,12 +7091,11 @@ EDITS: 5
(test-channel-func (lambda* (beg dur index chan edpos)
(clm-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos))
(lambda (dur)
- (let ((e (make-env :envelope '(0 0 1 1) :length dur))
- (v (make-float-vector dur)))
- (do ((i 0 (+ i 1)))
- ((= i dur))
- (set! (v i) (env e)))
- v))
+ (do ((e (make-env :envelope '(0 0 1 1) :length dur))
+ (v (make-float-vector dur))
+ (i 0 (+ i 1)))
+ ((= i dur) v)
+ (set! (v i) (env e))))
0.0)
(test-channel-func (lambda* (beg dur index chan edpos)
@@ -7204,23 +7117,21 @@ EDITS: 5
(test-channel-func (lambda* (beg dur index chan edpos)
(env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos))
(lambda (dur)
- (let ((e (make-env :envelope '(0 0 1 1) :length dur))
- (v (make-float-vector dur)))
- (do ((i 0 (+ i 1)))
- ((= i dur))
- (set! (v i) (env e)))
- v))
+ (do ((e (make-env :envelope '(0 0 1 1) :length dur))
+ (v (make-float-vector dur))
+ (i 0 (+ i 1)))
+ ((= i dur) v)
+ (set! (v i) (env e))))
1.0)
(test-channel-func (lambda* (beg dur index chan edpos)
(env-channel '(0 0 1 1) beg dur index chan edpos))
(lambda (dur)
- (let ((e (make-env :envelope '(0 0 1 1) :length dur))
- (v (make-float-vector dur)))
- (do ((i 0 (+ i 1)))
- ((= i dur))
- (set! (v i) (env e)))
- v))
+ (do ((e (make-env :envelope '(0 0 1 1) :length dur))
+ (v (make-float-vector dur))
+ (i 0 (+ i 1)))
+ ((= i dur) v)
+ (set! (v i) (env e))))
1.0)
(test-channel-func (lambda* (beg dur index chan edpos)
@@ -7264,12 +7175,11 @@ EDITS: 5
(env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos)
(reverse-channel beg dur index chan))
(lambda (dur)
- (let ((e (make-env :envelope '(0 1 1 0) :length dur))
- (v (make-float-vector dur)))
- (do ((i 0 (+ i 1)))
- ((= i dur))
- (set! (v i) (env e)))
- v))
+ (do ((e (make-env :envelope '(0 1 1 0) :length dur))
+ (v (make-float-vector dur))
+ (i 0 (+ i 1)))
+ ((= i dur) v)
+ (set! (v i) (env e))))
1.0)
(test-channel-func (lambda* (beg dur index chan edpos)
@@ -7279,12 +7189,11 @@ EDITS: 5
(if (not (= beg 0))
(set! (sample (+ beg dur) index chan) 0.0)))
(lambda (dur)
- (let ((v (make-float-vector dur))
- (ipi (/ pi dur)))
- (do ((i 0 (+ i 1)))
- ((= i dur))
- (set! (v i) (+ 0.5 (* 0.5 (cos (+ pi (* ipi i)))))))
- v))
+ (do ((v (make-float-vector dur))
+ (ipi (/ pi dur))
+ (i 0 (+ i 1)))
+ ((= i dur) v)
+ (set! (v i) (+ 0.5 (* 0.5 (cos (+ pi (* ipi i))))))))
1.0)
(let ((old-max (maxamp index #t))
@@ -7389,15 +7298,15 @@ EDITS: 5
(src-channel (+ sr .00001))
(let ((v2 (channel->float-vector)))
(float-vector-abs! (float-vector-subtract! v1 v2))
- (let ((sum 0.0)
- (len (min (length v1) (length v2)))
- (mx (float-vector-peak v1)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! sum (+ sum (float-vector-ref v1 i))))
- (if (or (> sum .01) ; depends on sinc-width I think
- (> mx .002))
- (snd-display ";src-channel ~A: diff: ~A ~A~%" sr sum mx))))))
+ (do ((sum 0.0)
+ (len (min (length v1) (length v2)))
+ (mx (float-vector-peak v1))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (if (or (> sum .01) ; depends on sinc-width I think
+ (> mx .002))
+ (snd-display ";src-channel ~A: diff: ~A ~A~%" sr sum mx)))
+ (set! sum (+ sum (float-vector-ref v1 i)))))))
'(0.5 0.75 1.0 1.5 2.0))
(close-sound ind))
@@ -7693,13 +7602,12 @@ EDITS: 5
(new (read-sample new-reader) (read-sample new-reader))
(i 0 (+ i 1)))
((= i len))
- (if (or (and (or (> i 900) (<= i 700))
- (fneq old new))
- (and (> i 700) (<= i 900)
- (fneq new 0.0)))
- (begin
- (format () "~%;trouble in reverse read 2 at ~D ~A ~A" i old new)
- (quit)))))))
+ (when (or (and (or (> i 900) (<= i 700))
+ (fneq old new))
+ (and (> i 700) (<= i 900)
+ (fneq new 0.0)))
+ (format () "~%;trouble in reverse read 2 at ~D ~A ~A" i old new)
+ (quit))))))
(close-sound ind))
(let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
(insert-silence 0 150000)
@@ -7736,10 +7644,9 @@ EDITS: 5
(list val (- (sampler-position reader) 1))
(scan-again)))))
(define* (my-scan-channel proc)
- (if proc
- (begin
- (set! last-proc proc)
- (set! reader (make-sampler 0))))
+ (when proc
+ (set! last-proc proc)
+ (set! reader (make-sampler 0)))
(scan-again))
(let ((ind (open-sound "oboe.snd"))
(val #f))
@@ -8139,10 +8046,9 @@ EDITS: 5
(snd-display ";nested as-one-edit 7: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
(if (not (= (edit-position ind 0) 1))
(snd-display ";nested as-one-edit 7 edpos: ~A" (edit-position ind 0)))
- (if (squelch-update ind 0)
- (begin
- (snd-display ";nested as-one-edit 7 squelch is on")
- (set! (squelch-update) #f)))
+ (when (squelch-update ind 0)
+ (snd-display ";nested as-one-edit 7 squelch is on")
+ (set! (squelch-update) #f))
(if (not (equal? (edit-fragment 1 ind 0) '("set-sample 300 0.6000" "set" 100 204)))
(snd-display ";as-one-edit 7 edlist: ~A" (edit-fragment 1 ind 0)))
@@ -8280,32 +8186,32 @@ EDITS: 1
(snd-display ";as-one-edit edits: ~A" (display-edits ind 0)))
(revert-sound ind)
- (let ((m3 #f)
- (m4 #f))
- (let ((m2 #f))
- (let ((m1 #f))
- (as-one-edit
- (lambda ()
- (set! m1 (mix-float-vector (float-vector .1 .2 .3) 1234 ind 0))
- (set! (sample 1236 ind 0) .6)
- (as-one-edit
- (lambda ()
- (set! (sample 123 ind 0) .3)
- (set! m2 (mix-float-vector (float-vector .1 .2 .3) 1235 ind 0)))
- "as-one-edit inner 1")
- (if (not (mix? m1)) (snd-display ";as-one-edit stepped on m1: ~A" m1))
- (if (not (mix? m2)) (snd-display ";as-one-edit stepped on m2: ~A" m2))
- (as-one-edit
- (lambda ()
- (set! m3 (mix-float-vector (float-vector .1 .2 .3) 1238 ind 0))
- (set! (sample 1238 ind 0) .8))
- "as-one-edit inner 2")
- (set! (sample 1239 ind 0) .9)
- (set! m4 (mix-float-vector (float-vector .1 .2 .3) 1237 ind 0)))
- "outer as-one-edit")
- (if (not (mix? m1)) (snd-display ";second as-one-edit stepped on mx1: ~A" m1)))
- (if (not (mix? m2)) (snd-display ";second as-one-edit stepped on mx2: ~A" m2)))
- (if (not (mix? m3)) (snd-display ";second as-one-edit stepped on mx3: ~A" m3))
+ (let ((m4 #f))
+ (let ((m3 #f))
+ (let ((m2 #f))
+ (let ((m1 #f))
+ (as-one-edit
+ (lambda ()
+ (set! m1 (mix-float-vector (float-vector .1 .2 .3) 1234 ind 0))
+ (set! (sample 1236 ind 0) .6)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 123 ind 0) .3)
+ (set! m2 (mix-float-vector (float-vector .1 .2 .3) 1235 ind 0)))
+ "as-one-edit inner 1")
+ (if (not (mix? m1)) (snd-display ";as-one-edit stepped on m1: ~A" m1))
+ (if (not (mix? m2)) (snd-display ";as-one-edit stepped on m2: ~A" m2))
+ (as-one-edit
+ (lambda ()
+ (set! m3 (mix-float-vector (float-vector .1 .2 .3) 1238 ind 0))
+ (set! (sample 1238 ind 0) .8))
+ "as-one-edit inner 2")
+ (set! (sample 1239 ind 0) .9)
+ (set! m4 (mix-float-vector (float-vector .1 .2 .3) 1237 ind 0)))
+ "outer as-one-edit")
+ (if (not (mix? m1)) (snd-display ";second as-one-edit stepped on mx1: ~A" m1)))
+ (if (not (mix? m2)) (snd-display ";second as-one-edit stepped on mx2: ~A" m2)))
+ (if (not (mix? m3)) (snd-display ";second as-one-edit stepped on mx3: ~A" m3)))
(if (not (mix? m4)) (snd-display ";second as-one-edit stepped on mx4: ~A" m4))
(revert-sound ind))
@@ -8329,10 +8235,9 @@ EDITS: 1
(set! (sample 200 ind 0) .7)
(close-sound ind2))
"as-one-edit+close")
- (if (sound? ind2)
- (begin
- (snd-display ";as-one-edit didn't close sound? ~A ~A" ind2 (sounds))
- (close-sound ind2)))
+ (when (sound? ind2)
+ (snd-display ";as-one-edit didn't close sound? ~A ~A" ind2 (sounds))
+ (close-sound ind2))
(if (not (= (edit-position ind 0) 2)) (snd-display ";edpos as-one-edit close original sound: ~A" (edit-position ind 0)))
(if (not (string=? (display-edits ind 0) (string-append "
EDITS: 2
@@ -8679,9 +8584,9 @@ EDITS: 2
(snd-display ";copy selection unselected? ~A" (sounds))
(begin
(fill! (selection) 0.0)
- (let ((r1 (channel->float-vector 1000 1000 snd 0)))
- (if (> (float-vector-peak r1) 0.0)
- (snd-display ";fill! selection not 0.0? ~A" (float-vector-peak r1))))
+ (let ((r1 (float-vector-peak (channel->float-vector 1000 1000 snd 0))))
+ (if (> r1 0.0)
+ (snd-display ";fill! selection not 0.0? ~A" r1)))
(revert-sound snd)
(if (not (selection?))
(snd-display ";revert-sound selection unselected?")
@@ -8705,18 +8610,17 @@ EDITS: 2
(let ((mx-rd (make-mix-sampler mx 0))
(snd-rd (make-sampler 1000 snd 0))
(orig-rd (make-sampler 1000 snd 0 1 0)))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let ((mx-val (mx-rd))
- (snd-val (snd-rd))
- (orig-val (orig-rd)))
- (if (or (fneq mx-val snd-val)
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy)
+ (= i 1000)))
+ (let ((mx-val (mx-rd))
+ (snd-val (snd-rd))
+ (orig-val (orig-rd)))
+ (when (or (fneq mx-val snd-val)
(fneq snd-val orig-val))
- (begin
- (set! happy #f)
- (snd-display ";selection->mix at ~A: ~A ~A ~A" (+ i 1000) mx-val snd-val orig-val))))))
+ (set! happy #f)
+ (snd-display ";selection->mix at ~A: ~A ~A ~A" (+ i 1000) mx-val snd-val orig-val))))
(if (not (= (length mx) sel-len 1001)) (snd-display ";selection->mix mix length: ~A (~A)" (length mx) sel-len))
(if (fneq (maxamp mx) sel-max) (snd-display ";selection->mix maxamps: ~A ~A" (maxamp mx) sel-max)))))))
(for-each close-sound (sounds)))
@@ -8744,26 +8648,24 @@ EDITS: 2
(snd1-rd (make-sampler 2000 snd 1))
(orig0-rd (make-sampler 2000 snd 0 1 0))
(orig1-rd (make-sampler 2000 snd 1 1 0)))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let ((mx0-val (mx0-rd))
- (mx1-val (mx1-rd))
- (snd0-val (snd0-rd))
- (snd1-val (snd1-rd))
- (orig0-val (orig0-rd))
- (orig1-val (orig1-rd)))
- (if (or (fneq mx0-val snd0-val)
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy)
+ (= i 1000)))
+ (let ((mx0-val (mx0-rd))
+ (mx1-val (mx1-rd))
+ (snd0-val (snd0-rd))
+ (snd1-val (snd1-rd))
+ (orig0-val (orig0-rd))
+ (orig1-val (orig1-rd)))
+ (when (or (fneq mx0-val snd0-val)
(fneq snd0-val orig0-val))
- (begin
- (set! happy #f)
- (snd-display ";selection->mix stereo 0 at ~A: ~A ~A ~A" (+ i 2000) mx0-val snd0-val orig0-val)))
- (if (or (fneq mx1-val snd1-val)
+ (set! happy #f)
+ (snd-display ";selection->mix stereo 0 at ~A: ~A ~A ~A" (+ i 2000) mx0-val snd0-val orig0-val))
+ (when (or (fneq mx1-val snd1-val)
(fneq snd1-val orig1-val))
- (begin
- (set! happy #f)
- (snd-display ";selection->mix stereo 1 at ~A: ~A ~A ~A" (+ i 2000) mx1-val snd1-val orig1-val))))))))
+ (set! happy #f)
+ (snd-display ";selection->mix stereo 1 at ~A: ~A ~A ~A" (+ i 2000) mx1-val snd1-val orig1-val))))))
(if (not (= (length mx0) (length mx1) sel-len 1001))
(snd-display ";selection->mix stereo mix length: ~A ~A (~A)" (length mx0) (length mx1) sel-len))
(if (fneq (max (maxamp mx0) (maxamp mx1)) sel-max)
@@ -8800,7 +8702,7 @@ EDITS: 2
(if (equal? v0 v1) (snd-display ";float-vector equal? ~A ~A" v0 v1))
(if (eq? v0 v1) (snd-display ";float-vector eq? ~A ~A" v0 v1))
(if (fneq (float-vector-max v0) 1.0) (snd-display ";float-vector max ~A" (float-vector-max v0)))
- (if (fneq (float-vector-min v0) 1.0) (snd-display ";float-vector min ~A" (float-vector-max v0)))
+ (if (fneq (float-vector-min v0) 1.0) (snd-display ";float-vector min ~A" (float-vector-min v0)))
(let ((v3 (make-float-vector 10))
(v4 (make-float-vector 3)))
(fill! v3 0.5)
@@ -9028,27 +8930,24 @@ EDITS: 2
(snd-display ";float-vector s7 reverse: ~A" v))
(fill! v 12.0)
(if (not (vmus-arrays-equal? v (float-vector 12.0 12.0 12.0)))
- (snd-display ";float-vector s7 fill: ~A" (fill! v 12.0)))
- )
+ (snd-display ";float-vector s7 fill: ~A" (fill! v 12.0))))
(let ((sum 0))
(for-each (lambda (n) (set! sum (+ sum n))) (float-vector 1 2 3))
(if (not (morally-equal? sum 6.0))
(snd-display ";object for-each (float-vector): ~A" sum)))
- (let ((x (float-vector 0.0))
- (osc (make-oscil :frequency 440))
- (e1 (make-env '(0 0 1 1 2 0) :length 100)))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (float-vector-set! x 0 (* (env e1) (oscil osc (float-vector-ref x 0))))))
+ (do ((x (float-vector 0.0))
+ (osc (make-oscil :frequency 440))
+ (e1 (make-env '(0 0 1 1 2 0) :length 100))
+ (i 0 (+ i 1)))
+ ((= i 100))
+ (float-vector-set! x 0 (* (env e1) (oscil osc (float-vector-ref x 0)))))
(if (fneq (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .1) .0909)
(snd-display ";float-vector-equal? 0.0909: ~A" (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .1)))
(if (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .01)
- (snd-display ";float-vector-equal? #f: ~A" (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .01)))
-
- )))
+ (snd-display ";float-vector-equal? #f: ~A" (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .01))))))
;;; ---------------- test 7: colors ----------------
@@ -9090,7 +8989,6 @@ EDITS: 2
(lambda args #f))))
(if (not (equal? c1 c2)) (snd-display ";color not equal? ~A ~A?" c1 c2))
(if (not (eq? c1 c2)) (snd-display ";color not eq? ~A ~A?" c1 c2))
- ;(if (not (equal? c1 c3)) (snd-display ";diff color not equal? ~A ~A?" c1 c3))
(if (eq? c1 c3) (snd-display ";diff color eq? ~A ~A?" c1 c3))
(if (not (member (color->list c1) '((0.0 0.0 1.0) (0.0 0.0 1.0 1.0))))
(snd-display ";color->list: ~A ~A?" c1 (color->list c1))))
@@ -9105,7 +9003,6 @@ EDITS: 2
(lambda args #f))))
(if (not (equal? c1 c2)) (snd-display ";alpha color not equal? ~A ~A?" c1 c2))
(if (not (eq? c1 c2)) (snd-display ";alpha color not eq? ~A ~A?" c1 c2))
- ;(if (not (equal? c1 c3)) (snd-display ";alpha diff color not equal? ~A ~A?" c1 c3))
(if (eq? c1 c3) (snd-display ";alpha diff color eq? ~A ~A?" c1 c3))
(let ((c4 (catch 'no-such-color
(lambda () (make-color 0 0 1 0.0))
@@ -9144,8 +9041,7 @@ EDITS: 2
(list 'selected-graph-color selected-graph-color white)
(list 'selection-color selection-color lightsteelblue1)
(list 'text-focus-color text-focus-color white)
- (list 'zoom-color zoom-color ivory4)
- ))
+ (list 'zoom-color zoom-color ivory4)))
(let ((ind (open-sound "oboe.snd")))
(set! *selected-data-color* light-green)
@@ -9153,21 +9049,21 @@ EDITS: 2
(set! *selected-graph-color* black)
(let ((red (make-color-with-catch 1.0 0.0 0.0)))
(set! (foreground-color ind 0 cursor-context) red)
- (let ((col (foreground-color ind 0 cursor-context)))
- (if (not (feql (color->list col) (color->list red)))
- (snd-display ";set foreground cursor color: ~A ~A" (color->list col) (color->list red))))
+ (let ((col (color->list (foreground-color ind 0 cursor-context))))
+ (if (not (feql col (color->list red)))
+ (snd-display ";set foreground cursor color: ~A ~A" col (color->list red))))
(set! (foreground-color) blue)
- (let ((col (foreground-color)))
- (if (not (feql (color->list col) (color->list blue)))
- (snd-display ";set foreground-color: ~A ~A" (color->list col) (color->list blue))))
+ (let ((col (color->list (foreground-color))))
+ (if (not (feql col (color->list blue)))
+ (snd-display ";set foreground-color: ~A ~A" col (color->list blue))))
(set! (foreground-color ind) red)
- (let ((col (foreground-color ind)))
- (if (not (feql (color->list col) (color->list red)))
- (snd-display ";set foreground-color with ind (red): ~A ~A" (color->list col) (color->list red))))
+ (let ((col (color->list (foreground-color ind))))
+ (if (not (feql col (color->list red)))
+ (snd-display ";set foreground-color with ind (red): ~A ~A" col (color->list red))))
(set! (foreground-color ind) black)
- (let ((col (foreground-color ind)))
- (if (not (feql (color->list col) (color->list black)))
- (snd-display ";set foreground-color with ind (black): ~A ~A" (color->list col) (color->list black)))))
+ (let ((col (color->list (foreground-color ind))))
+ (if (not (feql col (color->list black)))
+ (snd-display ";set foreground-color with ind (black): ~A ~A" col (color->list black)))))
(set! *selected-graph-color* (make-color-with-catch 0.96 0.96 0.86))
(set! *data-color* black)
(set! *selected-data-color* blue)
@@ -9438,25 +9334,6 @@ EDITS: 2
(if (not (string=? (colormap-name ind) "white"))
(snd-display ";white colormap name: ~A" (colormap-name ind))))
- (let ((tag (catch #t (lambda () (delete-colormap (integer->colormap 1234))) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-colormap))
- (snd-display ";delete-colormap 1234: ~A" tag)))
- (let ((tag (catch #t (lambda () (colormap-ref (integer->colormap 1234) 0.5)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-colormap))
- (snd-display ";colormap-ref 1234: ~A" tag)))
- (let ((tag (catch #t (lambda () (colormap-ref (integer->colormap -1) 0.5)) (lambda args (car args)))))
- (if (not (memq tag '(no-such-colormap wrong-type-arg)))
- (snd-display ";colormap-ref -1: ~A" tag)))
- (let ((tag (catch #t (lambda () (set! *colormap* (integer->colormap 1234))) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-colormap))
- (snd-display "; set colormap 1234: ~A" tag)))
- (let ((tag (catch #t (lambda () (set! *colormap* (integer->colormap -1))) (lambda args (car args)))))
- (if (not (memq tag '(no-such-colormap wrong-type-arg)))
- (snd-display "; set colormap -1: ~A" tag)))
- (let ((tag (catch #t (lambda () (colormap-ref copper-colormap 2.0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (snd-display ";colormap-ref 2.0: ~A" tag)))
-
(set! *colormap-size* old-colormap-size)
(if (not (= *colormap-size* old-colormap-size))
(snd-display ";set colormap-size: ~A ~A" *colormap-size* old-colormap-size))
@@ -9542,8 +9419,7 @@ EDITS: 2
'(1024 256 2 512))
(set! *colormap-size* 512))
- (set! (hook-functions graph-hook) ())
- ))))
+ (set! (hook-functions graph-hook) ())))))
;;; ---------------- test 8: clm ----------------
@@ -9648,29 +9524,29 @@ EDITS: 2
(format () "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F~%" i o1 o2 o3 o4 o5 o6))))))
(define (test-simple-polywave n offset kind)
- (let ((p (let ((h (if offset (list offset 0) (list))))
- (do ((i 1 (+ i 1)))
- ((> i n))
- (set! h (cons (* i .1) (cons i h))))
- (make-polywave 400.0 (reverse h) kind)))
+ (let ((p (do ((h (if offset (list offset 0) (list)))
+ (i 1 (+ i 1)))
+ ((> i n)
+ (make-polywave 400.0 (reverse h) kind))
+ (set! h (cons (* i .1) (cons i h)))))
(vp (make-float-vector 200))
(vo (make-float-vector 200))
(ob (make-oscil-bank
- (apply float-vector (let ((frqs (if offset (list 0.0) (list))))
- (do ((i 1 (+ i 1)))
- ((> i n))
- (set! frqs (cons (hz->radians (* i 400.0)) frqs)))
- (reverse frqs)))
+ (apply float-vector (do ((frqs (if offset (list 0.0) (list)))
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse frqs))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs))))
(let ((phases (make-float-vector (+ n (if offset 1 0))
(if (= kind mus-chebyshev-second-kind) 0.0 (/ pi 2)))))
(if (and offset (= kind mus-chebyshev-second-kind))
(set! (phases 0) (/ pi 2)))
phases)
- (apply float-vector (let ((amps (if offset (list offset) (list))))
- (do ((i 1 (+ i 1)))
- ((> i n))
- (set! amps (cons (* i .1) amps)))
- (reverse amps)))
+ (apply float-vector (do ((amps (if offset (list offset) (list)))
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse amps))
+ (set! amps (cons (* i .1) amps))))
#t)))
(do ((i 0 (+ i 1)))
((= i 200))
@@ -9698,16 +9574,16 @@ EDITS: 2
vp vo
p ob)))
- (let ((t1 (with-sound ("test.snd")
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (outa i (polywave p)))))
- (t2 (with-sound ("tst.snd")
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (outa i (oscil-bank ob))))))
- (set! vp (channel->float-vector 0 200 (find-sound t1) 0))
- (set! vo (channel->float-vector 0 200 (find-sound t2) 0))
+ (let ((t1 (find-sound (with-sound ("test.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (outa i (polywave p))))))
+ (t2 (find-sound (with-sound ("tst.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (outa i (oscil-bank ob)))))))
+ (set! vp (channel->float-vector 0 200 t1 0))
+ (set! vo (channel->float-vector 0 200 t2 0))
(if (not (mus-arrays-equal? vp vo))
(format *stderr* ";simple polywave (with-sound) n: ~A, offset: ~A, type: ~A (len: ~D ~D): dist: ~A~% ~A~% ~A~%~A ~A~%"
@@ -9716,19 +9592,19 @@ EDITS: 2
(float-vector-peak (float-vector-subtract! (copy vp) vo))
vp vo
p ob))
- (close-sound (find-sound t1))
- (close-sound (find-sound t2)))))
+ (close-sound t1)
+ (close-sound t2))))
(define (test-simple-nsin n)
(let ((p (make-nsin 400.0 n))
(vp (make-float-vector 200))
(vo (make-float-vector 200))
(parts (apply float-vector
- (let ((frqs ()))
- (do ((i 1 (+ i 1)))
- ((> i n))
- (set! frqs (cons (hz->radians (* i 400.0)) frqs)))
- (reverse frqs)))))
+ (do ((frqs ())
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse frqs))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs))))))
(let ((ob (make-oscil-bank parts (make-float-vector n) (make-float-vector n (mus-scaler p)) #t)))
(do ((i 0 (+ i 1)))
((= i 200))
@@ -9748,11 +9624,11 @@ EDITS: 2
(vp (make-float-vector 200))
(vo (make-float-vector 200)))
(let ((ob (make-oscil-bank
- (apply float-vector (let ((frqs ()))
- (do ((i 1 (+ i 1)))
- ((> i n))
- (set! frqs (cons (hz->radians (* i 400.0)) frqs)))
- (reverse frqs)))
+ (apply float-vector (do ((frqs ())
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse frqs))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs))))
(make-float-vector n (/ pi 2.0))
(make-float-vector n (mus-scaler p))
#t)))
@@ -9848,12 +9724,11 @@ EDITS: 2
(define* (array-interp-sound-diff snd chn)
(define (envelope->float-vector e len)
- (let ((v (make-float-vector len))
- (e (make-env e :length len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v i) (env e)))
- v))
+ (do ((v (make-float-vector len))
+ (e (make-env e :length len))
+ (i 0 (+ i 1)))
+ ((= i len) v)
+ (set! (v i) (env e))))
(let ((tbl (envelope->float-vector '(0.0 -1.0 1.0 1.0) 1001))
(curpos (edit-position snd chn)))
@@ -9987,14 +9862,14 @@ EDITS: 2
(if (fneq umax .999) (snd-display ";unclip-channel 0 oboe maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-float-vector 100))
- (e (make-env '(0 0 1 .8 1.5 1.0 2.0 1.0 2.5 .8 3.5 0) :length 101))
- (o (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! (data i) (* 1.05 (env e) (oscil o))))
- (float-vector->channel data 0 100 ind 0)
- (float-vector->channel data 0 100 ind 1))
+ (do ((data (make-float-vector 100))
+ (e (make-env '(0 0 1 .8 1.5 1.0 2.0 1.0 2.5 .8 3.5 0) :length 101))
+ (o (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
+ (set! (data i) (* 1.05 (env e) (oscil o))))
(let* ((vals (unclip-channel ind 1))
(umax (vals 1))
@@ -10005,14 +9880,14 @@ EDITS: 2
(if (fneq umax .999) (snd-display ";unclip-channel 1 sine maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-float-vector 100))
- (e (make-env '(0 0 1 .8 1.75 1.0 2.0 1.0 2.25 .8 3.5 0) :length 101))
- (o (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! (data i) (* 1.1 (env e) (oscil o))))
- (float-vector->channel data 0 100 ind 0)
- (float-vector->channel data 0 100 ind 1))
+ (do ((data (make-float-vector 100))
+ (e (make-env '(0 0 1 .8 1.75 1.0 2.0 1.0 2.25 .8 3.5 0) :length 101))
+ (o (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
+ (set! (data i) (* 1.1 (env e) (oscil o))))
(let* ((vals (unclip-channel ind 1))
(umax (vals 1))
@@ -10023,15 +9898,15 @@ EDITS: 2
(if (fneq umax .999) (snd-display ";unclip-channel 2 sine maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-float-vector 100))
- (e (make-env '(0 0 1 .8 1.85 1.0 2.0 1.0 2.15 .8 3.5 0) :length 101))
- (o1 (make-oscil 1000))
- (o2 (make-oscil 2000)))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! (data i) (* 1.2 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
- (float-vector->channel data 0 100 ind 0)
- (float-vector->channel data 0 100 ind 1))
+ (do ((data (make-float-vector 100))
+ (e (make-env '(0 0 1 .8 1.85 1.0 2.0 1.0 2.15 .8 3.5 0) :length 101))
+ (o1 (make-oscil 1000))
+ (o2 (make-oscil 2000))
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
+ (set! (data i) (* 1.2 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
(let* ((vals (unclip-channel ind 1))
(umax (vals 1))
@@ -10042,15 +9917,15 @@ EDITS: 2
(if (fneq umax .999) (snd-display ";unclip-channel 3 sine maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-float-vector 100))
- (e (make-env '(0 0 40 .75 45 1.0 50 1.25 55 1.0 60 .75 100 0.0) :length 101))
- (o1 (make-oscil 1000))
- (o2 (make-oscil 2000)))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! (data i) (* 1.5 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
- (float-vector->channel data 0 100 ind 0)
- (float-vector->channel data 0 100 ind 1))
+ (do ((data (make-float-vector 100))
+ (e (make-env '(0 0 40 .75 45 1.0 50 1.25 55 1.0 60 .75 100 0.0) :length 101))
+ (o1 (make-oscil 1000))
+ (o2 (make-oscil 2000))
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
+ (set! (data i) (* 1.5 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
(let* ((vals (unclip-channel ind 1))
(umax (vals 1))
@@ -10252,12 +10127,12 @@ EDITS: 2
(let ((vals (butterworth-prototype i)))
(if (not (mus-arrays-equal? (cadr vals) (poles k)))
(snd-display ";butterworth prototype poles ~A: ~A (~A)" i (cadr vals) (poles k)))
- (let ((zeros (make-float-vector (* (+ k 1) 3))))
- (do ((j 2 (+ j 3)))
- ((>= j (* (+ k 1) 3)))
- (set! (zeros j) 1.0))
- (if (not (mus-arrays-equal? (car vals) zeros))
- (snd-display ";butterworth prototype zeros ~A: ~A (~A)" i (car vals) zeros)))))
+ (do ((zeros (make-float-vector (* (+ k 1) 3)))
+ (j 2 (+ j 3)))
+ ((>= j (* (+ k 1) 3))
+ (if (not (mus-arrays-equal? (car vals) zeros))
+ (snd-display ";butterworth prototype zeros ~A: ~A (~A)" i (car vals) zeros)))
+ (set! (zeros j) 1.0))))
(do ((cutoff .1 (+ cutoff .1))
(m 0 (+ 1 m)))
@@ -10393,12 +10268,12 @@ EDITS: 2
(i 2 (+ i 2))
(k 0 (+ k 1)))
((>= i 12))
- (let ((vals (chebyshev-prototype i .01)))
- (if (not (mus-arrays-equal?1 (cadr vals) (poles-01 k)))
- (snd-display ";chebyshev prototype .01 poles ~A: ~A (~A)" i (cadr vals) (poles-01 k))))
- (let ((vals (chebyshev-prototype i .1)))
- (if (not (mus-arrays-equal?1 (cadr vals) (poles-1 k)))
- (snd-display ";chebyshev prototype .1 poles ~A: ~A (~A)" i (cadr vals) (poles-1 k))))
+ (let ((vals (cadr (chebyshev-prototype i .01))))
+ (if (not (mus-arrays-equal?1 vals (poles-01 k)))
+ (snd-display ";chebyshev prototype .01 poles ~A: ~A (~A)" i vals (poles-01 k))))
+ (let ((vals (cadr (chebyshev-prototype i .1))))
+ (if (not (mus-arrays-equal?1 vals (poles-1 k)))
+ (snd-display ";chebyshev prototype .1 poles ~A: ~A (~A)" i vals (poles-1 k))))
(let ((vals (chebyshev-prototype i)))
(if (not (mus-arrays-equal?1 (cadr vals) (poles-10 k)))
(snd-display ";chebyshev prototype 1 poles ~A: ~A (~A)" i (cadr vals) (poles-10 k)))
@@ -10450,12 +10325,12 @@ EDITS: 2
(if (ffneq (car vals) .55) (snd-display ";chebyshev hp 12 max: ~A" (car vals)))
(if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.299 0.554 0.509 0.509 0.500 0.509)))
(snd-display ";chebyshev hp 12 .25 spect: ~A" (cadr vals))))
- (let ((vals (sweep->bins (make-chebyshev-highpass 10 .4))))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.297 0.786 0.677))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.301 0.788 0.660))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.322 0.861 0.724))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.262 0.571 0.509))))
- (snd-display ";chebyshev hp 10 .4 spect: ~A" (cadr vals))))
+ (let ((vals (cadr (sweep->bins (make-chebyshev-highpass 10 .4)))))
+ (if (not (or (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.297 0.786 0.677))
+ (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.301 0.788 0.660))
+ (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.322 0.861 0.724))
+ (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.262 0.571 0.509))))
+ (snd-display ";chebyshev hp 10 .4 spect: ~A" vals)))
(let ((vals (sweep->bins (make-chebyshev-highpass 8 .1 .01))))
(if (ffneq (car vals) .49) (snd-display ";chebyshev hp 8 .1 .01 max: ~A" (car vals)))
@@ -10697,11 +10572,11 @@ EDITS: 2
(if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 4 max: ~A" (car vals)))
(if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.004 0.438 0.516 0.499 0.502 0.495 0.478 0.463 0.453 0.447)))
(snd-display ";elliptic hp 4 .1 spect: ~A" (cadr vals))))
- (let ((vals (sweep->bins (make-elliptic-highpass 12 .25))))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.001 0.001 0.001 0.026 0.934 0.518 0.495 0.503 0.477))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.001 0.001 0.001 0.033 1.185 0.519 0.495 0.503 0.477))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.001 0.001 0.001 0.018 0.788 0.520 0.495 0.503 0.477))))
- (snd-display ";elliptic hp 12 .25 spect: ~A" (cadr vals))))
+ (let ((vals (cadr (sweep->bins (make-elliptic-highpass 12 .25)))))
+ (if (not (or (mus-arrays-equal?1 vals (float-vector 0.000 0.001 0.001 0.001 0.026 0.934 0.518 0.495 0.503 0.477))
+ (mus-arrays-equal?1 vals (float-vector 0.000 0.001 0.001 0.001 0.033 1.185 0.519 0.495 0.503 0.477))
+ (mus-arrays-equal?1 vals (float-vector 0.000 0.001 0.001 0.001 0.018 0.788 0.520 0.495 0.503 0.477))))
+ (snd-display ";elliptic hp 12 .25 spect: ~A" vals)))
(let ((vals (sweep->bins (make-elliptic-highpass 12 .25 .01 90))))
(if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 12 90 max: ~A" (car vals)))
(if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.499 0.517 0.503 0.501 0.500 0.500)))
@@ -10832,34 +10707,35 @@ EDITS: 2
(snd-display ";poly-roots 2 -2 -2 2: ~A" val)))
;; degree=4
- ; (let ((vals (poly-roots (float-vector -15 8 14 -8 1))))
- ; (if (not (ceql vals '(5.0 3.0 1.0 -1.0))) (snd-display ";poly-roots -15 8 14 -8 1: ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 8 1) (float-vector -9 1)))))))
- ; (if (not (ceql vals '(9.0 3.0 -2.0 -8.0))) (snd-display ";poly-roots 4(1): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector .2 1) (float-vector -3 1)) (poly* (float-vector .8 1) (float-vector -9 1)))))))
- ; (if (not (ceql vals '(9.0 3.0 -0.2 -0.8))) (snd-display ";poly-roots 4(2): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector .02 1) (float-vector -32 1)) (poly* (float-vector .8 1) (float-vector -9 1)))))))
- ; (if (not (ceql vals '(32.0 9.0 -0.02 -0.8))) (snd-display ";poly-roots 4(3): ~A" vals)))
+ ;; (let ((vals (poly-roots (float-vector -15 8 14 -8 1))))
+ ;; (if (not (ceql vals '(5.0 3.0 1.0 -1.0))) (snd-display ";poly-roots -15 8 14 -8 1: ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 8 1) (float-vector -9 1)))))))
+ ;; (if (not (ceql vals '(9.0 3.0 -2.0 -8.0))) (snd-display ";poly-roots 4(1): ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector .2 1) (float-vector -3 1)) (poly* (float-vector .8 1) (float-vector -9 1)))))))
+ ;; (if (not (ceql vals '(9.0 3.0 -0.2 -0.8))) (snd-display ";poly-roots 4(2): ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector .02 1) (float-vector -32 1)) (poly* (float-vector .8 1) (float-vector -9 1)))))))
+ ;; (if (not (ceql vals '(32.0 9.0 -0.02 -0.8))) (snd-display ";poly-roots 4(3): ~A" vals)))
;; degree>4
- ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector -1 1) (float-vector -2 1))))))))
- ; (if (not (ceql vals '(3.0 2.0 -1.0 -2.0 1.0)))
- ; (snd-display ";poly-roots n(1): ~A from ~A ~A ~A"
- ; vals
- ; (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector -1 1) (float-vector -2 1)))))
- ; *mus-float-equal-fudge-factor*
- ; poly-roots-epsilon)))
-
- ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 8 1) (float-vector -9 1))))))))
- ; (if (not (ceql vals '(9.0 3.0 -2.0 -8.0 -1.0))) (snd-display ";poly-roots n(2): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector 9 1) (float-vector -3 1)) (poly* (float-vector -10 1) (float-vector -2 1))))))))
- ; (if (not (ceql vals '(10.0 3.0 -1.0 -9.0 2.0 1.0))) (snd-display ";poly-roots n(3): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector -4 0 1) (float-vector -3 1)) (poly* (float-vector -10 1) (float-vector -9 0 1))))))))
- ; (if (not (ceql vals '(10.0 3.0 -2.0 -3.0 -1.0 3.0 2.0 1.0))) (snd-display ";poly-roots n(4): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector -4 0 1) (float-vector -16 0 1)) (poly* (float-vector -25 0 1) (float-vector -9 0 1))))))))
- ; (if (not (ceql vals '(5.0 -3.0 -4.0 -5.0 4.0 -2.0 3.0 -1.0 2.0 1.0))) (snd-display ";poly-roots n(5): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 1 1) (float-vector -2 1))))))))
- ; (if (not (ceql vals '(3.0 -1.0 -1.0 -2.0 2.0))) (snd-display ";poly-roots n(6): ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector -1 1) (float-vector -2 1))))))))
+ ;; (if (not (ceql vals '(3.0 2.0 -1.0 -2.0 1.0)))
+ ;; (snd-display ";poly-roots n(1): ~A from ~A ~A ~A"
+ ;; vals
+ ;; (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector -1 1) (float-vector -2 1)))))
+ ;; *mus-float-equal-fudge-factor*
+ ;; poly-roots-epsilon)))
+
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 8 1) (float-vector -9 1))))))))
+ ;; (if (not (ceql vals '(9.0 3.0 -2.0 -8.0 -1.0))) (snd-display ";poly-roots n(2): ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector 9 1) (float-vector -3 1)) (poly* (float-vector -10 1) (float-vector -2 1))))))))
+ ;; (if (not (ceql vals '(10.0 3.0 -1.0 -9.0 2.0 1.0))) (snd-display ";poly-roots n(3): ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector -4 0 1) (float-vector -3 1)) (poly* (float-vector -10 1) (float-vector -9 0 1))))))))
+ ;; (if (not (ceql vals '(10.0 3.0 -2.0 -3.0 -1.0 3.0 2.0 1.0))) (snd-display ";poly-roots n(4): ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector -4 0 1) (float-vector -16 0 1)) (poly* (float-vector -25 0 1) (float-vector -9 0 1))))))))
+ ;; (if (not (ceql vals '(5.0 -3.0 -4.0 -5.0 4.0 -2.0 3.0 -1.0 2.0 1.0))) (snd-display ";poly-roots n(5): ~A" vals)))
+ ;; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 1 1) (float-vector -2 1))))))))
+ ;; (if (not (ceql vals '(3.0 -1.0 -1.0 -2.0 2.0))) (snd-display ";poly-roots n(6): ~A" vals)))
+
(let ((vals (poly-roots (float-vector -64 0 0 0 0 0 1))))
(if (not (ceql vals '(0.999999999999999-1.73205080756888i -1.0-1.73205080756888i -2.0 -1.0+1.73205080756888i 1.0+1.73205080756888i 2.0)))
(snd-display ";poly-roots 64 6: ~A" vals)))
@@ -10874,23 +10750,18 @@ EDITS: 2
(if (not (mus-arrays-equal? vals1 vals2))
(snd-display ";poly* convolve: ~A ~A" vals1 vals2)))
-
- (do ((i 0 (+ i 1))) ((= i 10))
- (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
- (complex (mus-random 1.0) (mus-random 1.0)))))
- (do ((i 0 (+ i 1))) ((= i 10))
- (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
- (complex (mus-random 1.0) (mus-random 1.0))
- (complex (mus-random 1.0) (mus-random 1.0)))))
-
- (do ((i 0 (+ i 1))) ((= i 10))
- (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
-
- (do ((i 0 (+ i 1))) ((= i 10))
- (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
- (complex (mus-random 1.0) (mus-random 1.0))
- (complex (mus-random 1.0) (mus-random 1.0))
- (complex (mus-random 1.0) (mus-random 1.0)))))
+ (let ((random-complex (lambda () (complex (mus-random 1.0) (mus-random 1.0)))))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-as-vector-roots (vector (random-complex) (random-complex))))
+
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-as-vector-roots (vector (random-complex) (random-complex) (random-complex))))
+
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-as-vector-roots (vector (random-complex) (random-complex) (random-complex) (random-complex)))))
(do ((i 3 (+ i 1))) ((= i 20))
(let ((v (make-float-vector i)))
@@ -10925,8 +10796,7 @@ EDITS: 2
(snd-display ";poly-roots 0..5 3: ~A" vals)))
(let ((vals (poly-roots (poly* (poly* (poly* (float-vector -1 1) (float-vector 1 1)) (poly* (float-vector -2 1) (float-vector 2 1))) (poly* (float-vector -3 1) (float-vector 3 1))))))
(if (not (ceql vals '(-3.0 3.0 -1.0 1.0 -2.0 2.0)))
- (snd-display ";cube in 2: ~A" vals)))
- ))
+ (snd-display ";cube in 2: ~A" vals)))))
;; -----------------
(define (test-fm-components)
@@ -10953,15 +10823,15 @@ EDITS: 2
(let ((documentation "(fltit) returns a time-varying filter: (map-channel (fltit))"))
(lambda ()
(let ((flt (make-fir-filter 8 (float-vector .1 .2 .3 .4 .4 .3 .2 .1))))
- (let ((xcof (mus-xcoeffs flt)) ; maybe a copy?
- (es (make-float-vector 8)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (set! (es i) 0.9994)) ; something like (+ 1.0 (/ (log 1e-5) (* 0.5 *clm-srate*)))
- (set! (es 5) 1.00002)
- (lambda (x)
- (float-vector-multiply! xcof es)
- (fir-filter flt x)))))))
+ (do ((xcof (mus-xcoeffs flt)) ; maybe a copy?
+ (es (make-float-vector 8))
+ (i 0 (+ i 1)))
+ ((= i 8)
+ (set! (es 5) 1.00002)
+ (lambda (x)
+ (float-vector-multiply! xcof es)
+ (fir-filter flt x)))
+ (set! (es i) 0.9994)))))) ; something like (+ 1.0 (/ (log 1e-5) (* 0.5 *clm-srate*)))
;;; (with-sound ("test.snd") (let ((p (make-pulse-train 1000))) (do ((i 0 (+ i 1))) ((= i 44100)) (outa i (* .5 (pulse-train p))))))
;;; (map-channel (fltit))
@@ -10973,15 +10843,14 @@ EDITS: 2
(fq (make-one-pole 1.0 -1.0))
(incr (/ pi (* dur 1.05 *clm-srate*)))
(len (framples)))
- (let ((data (make-float-vector len)))
- (do ((i 2 (+ i 1)))
- ((= i len))
- (set! (data i) (sin (one-pole ph (one-pole fq incr)))))
- (float-vector->channel (float-vector-scale! data 0.5)))))
+ (do ((data (make-float-vector len))
+ (i 2 (+ i 1)))
+ ((= i len)
+ (float-vector->channel (float-vector-scale! data 0.5)))
+ (set! (data i) (sin (one-pole ph (one-pole fq incr)))))))
;; ----------------
-
(define make-ssb-am-1
(let ()
(defgenerator sa1 freq (coscar #f) (sincar #f) (dly #f) (hlb #f))
@@ -11109,213 +10978,213 @@ EDITS: 2
(define (numerical-reality-checks)
;; a few reality checks from John Burkardt test_values.C
- (let ((vals (vector 1.6709637479564564156 1.5707963267948966192 1.4706289056333368229 1.3694384060045658278 1.2661036727794991113
- 1.1592794807274085998 1.0471975511965977462 0.92729521800161223243 0.79539883018414355549 0.64350110879328438680
- 0.45102681179626243254 0.00000000000000000000))
- (args (vector -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 12))
- (set! max-bad (max max-bad (abs (- (acos (vector-ref args i))
- (vector-ref vals i))))))
- (if (> max-bad 1.0e-15)
- (snd-display ";acos: ~A" max-bad)))
-
- (let ((vals (vector 0.0000000000000000000 0.14130376948564857735 0.44356825438511518913 0.62236250371477866781 0.75643291085695958624
- 0.86701472649056510395 0.96242365011920689500 1.3169578969248167086 1.7627471740390860505 1.8115262724608531070
- 2.0634370688955605467 2.2924316695611776878 2.9932228461263808979 5.2982923656104845907 7.6009022095419886114))
- (args (vector 1.0 1.01 1.1 1.2 1.3 1.4 1.5 2.0 3.0 3.1415926535897932385 4.0 5.0 10.0 100.0 1000.0))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 15))
- (let ((nval (acosh (vector-ref args i))))
- (set! max-bad (max max-bad (abs (- nval (vector-ref vals i)))))))
- (if (> max-bad 1.0e-15)
- (snd-display ";acosh: ~A" max-bad)))
-
- (let ((vals (vector -0.10016742116155979635 0.00000000000000000000 0.10016742116155979635 0.20135792079033079146 0.30469265401539750797
- 0.41151684606748801938 0.52359877559829887308 0.64350110879328438680 0.77539749661075306374 0.92729521800161223243
- 1.1197695149986341867 1.5707963267948966192))
- (args (vector -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 12))
- (set! max-bad (max max-bad (abs (- (asin (vector-ref args i))
- (vector-ref vals i))))))
- (if (> max-bad 1.0e-15)
- (snd-display ";asin: ~A" max-bad)))
-
- (let ((vals (vector -2.3124383412727526203 -0.88137358701954302523 0.00000000000000000000 0.099834078899207563327 0.19869011034924140647
- 0.29567304756342243910 0.39003531977071527608 0.48121182505960344750 0.56882489873224753010 0.65266656608235578681
- 0.73266825604541086415 0.80886693565278246251 0.88137358701954302523 1.4436354751788103425 1.8184464592320668235
- 2.0947125472611012942 2.3124383412727526203 2.9982229502979697388 5.2983423656105887574 7.6009027095419886115))
- (args (vector -5.0 -1.0 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 2.0 3.0 4.0 5.0 10.0 100.0 1000.0))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (let* ((nval (asinh (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> max-bad 1.0e-14)
- (snd-display ";asinh(~A): ~A ~A -> ~A" (vector-ref args i) nval (vector-ref vals i) max-bad)))))
-
- (let ((vals (vector 0.00000000000000000000 0.24497866312686415417 0.32175055439664219340 0.46364760900080611621 0.78539816339744830962
- 1.1071487177940905030 1.2490457723982544258 1.3258176636680324651 1.3734007669450158609 1.4711276743037345919 1.5208379310729538578))
- (args (vector 0.00000000000000000000 0.25000000000000000000 0.33333333333333333333 0.50000000000000000000 1.0000000000000000000
- 2.0000000000000000000 3.0000000000000000000 4.0000000000000000000 5.0000000000000000000 10.000000000000000000 20.000000000000000000))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! max-bad (max max-bad (abs (- (atan (vector-ref args i))
- (vector-ref vals i))))))
- (if (> max-bad 1.0e-15)
- (snd-display ";atan: ~A" max-bad)))
-
- (let ((vals (vector -0.54930614433405484570 0.00000000000000000000 0.0010000003333335333335 0.10033534773107558064 0.20273255405408219099
- 0.30951960420311171547 0.42364893019360180686 0.54930614433405484570 0.69314718055994530942 0.86730052769405319443
- 1.0986122886681096914 1.4722194895832202300 2.6466524123622461977 3.8002011672502000318 7.2543286192620472067))
- (args (vector -0.5 0.0 0.001 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.99 0.999 0.999999))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 15))
- (let* ((nval (atanh (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> diff 1.0e-10) ; one is > e-11
- (snd-display ";atanh(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
-
- (let ((vals (vector 0.1000000000000000E+01 0.1010025027795146E+01 0.1040401782229341E+01 0.1092045364317340E+01 0.1166514922869803E+01
- 0.1266065877752008E+01 0.1393725584134064E+01 0.1553395099731217E+01 0.1749980639738909E+01 0.1989559356618051E+01
- 0.2279585302336067E+01 0.3289839144050123E+01 0.4880792585865024E+01 0.7378203432225480E+01 0.1130192195213633E+02
- 0.1748117185560928E+02 0.2723987182360445E+02 0.6723440697647798E+02 0.4275641157218048E+03 0.2815716628466254E+04))
- (args (vector 0.00E+00 0.20E+00 0.40E+00 0.60E+00 0.80E+00 0.10E+01 0.12E+01 0.14E+01 0.16E+01 0.18E+01 0.20E+01 0.25E+01 0.30E+01
- 0.35E+01 0.40E+01 0.45E+01 0.50E+01 0.60E+01 0.80E+01
- 0.10E+02))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (let* ((nval (bes-i0 (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> diff 1.0e-4)
- (snd-display ";bes-i0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
-
- (let ((vals (vector -0.1775967713143383E+00 -0.3971498098638474E+00 -0.2600519549019334E+00 0.2238907791412357E+00 0.7651976865579666E+00
- 0.1000000000000000E+01 0.7651976865579666E+00 0.2238907791412357E+00 -0.2600519549019334E+00 -0.3971498098638474E+00
- -0.1775967713143383E+00 0.1506452572509969E+00 0.3000792705195556E+00 0.1716508071375539E+00 -0.9033361118287613E-01
- -0.2459357644513483E+00 -0.1711903004071961E+00 0.4768931079683354E-01 0.2069261023770678E+00 0.1710734761104587E+00 -0.1422447282678077E-01))
- (args (vector -5.0E+00 -4.0E+00 -3.0E+00 -2.0E+00 -1.0E+00 0.0E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00
- 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 21))
- (let* ((nval (bes-j0 (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> diff 1.0e-15)
- (snd-display ";bes-j0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
-
- (let ((vals (vector 0.3275791375914652E+00 0.6604332802354914E-01 -0.3390589585259365E+00 -0.5767248077568734E+00 -0.4400505857449335E+00
- 0.0000000000000000E+00 0.4400505857449335E+00 0.5767248077568734E+00 0.3390589585259365E+00 -0.6604332802354914E-01
- -0.3275791375914652E+00 -0.2766838581275656E+00 -0.4682823482345833E-02 0.2346363468539146E+00 0.2453117865733253E+00
- 0.4347274616886144E-01 -0.1767852989567215E+00 -0.2234471044906276E+00 -0.7031805212177837E-01 0.1333751546987933E+00 0.2051040386135228E+00))
- (args (vector -5.0E+00 -4.0E+00 -3.0E+00 -2.0E+00 -1.0E+00 0.0E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00
- 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 21))
- (let* ((nval (bes-j1 (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> diff 1.0e-15)
- (snd-display ";bes-j1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
-
- (let ((vals (vector 0.1149034849319005E+00 0.3528340286156377E+00 0.4656511627775222E-01 0.2546303136851206E+00 -0.5971280079425882E-01
- 0.2497577302112344E-03 0.7039629755871685E-02 0.2611405461201701E+00 -0.2340615281867936E+00 -0.8140024769656964E-01
- 0.2630615123687453E-09 0.2515386282716737E-06 0.1467802647310474E-02 0.2074861066333589E+00 -0.1138478491494694E+00
- 0.3873503008524658E-24 0.3918972805090754E-18 0.2770330052128942E-10 0.1151336924781340E-04 -0.1167043527595797E+00))
- (ns (vector 2 2 2 2 2 5 5 5 5 5 10 10 10 10 10 20 20 20 20 20))
- (args (vector 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00
- 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (let* ((nval (bes-jn (vector-ref ns i) (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> diff 1.0e-15)
- (snd-display ";bes-jn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff)))))
-
- (let ((vals (vector -0.1534238651350367E+01 0.8825696421567696E-01 0.5103756726497451E+00 0.3768500100127904E+00 -0.1694073932506499E-01
- -0.3085176252490338E+00 -0.2881946839815792E+00 -0.2594974396720926E-01 0.2235214893875662E+00 0.2499366982850247E+00
- 0.5567116728359939E-01 -0.1688473238920795E+00 -0.2252373126343614E+00 -0.7820786452787591E-01 0.1271925685821837E+00 0.2054642960389183E+00))
- (args (vector 0.1E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 16))
- (let* ((nval (bes-y0 (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> diff 1.0e-15)
- (snd-display ";bes-y0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
-
- (let ((vals (vector -0.6458951094702027E+01 -0.7812128213002887E+00 -0.1070324315409375E+00 0.3246744247918000E+00 0.3979257105571000E+00
- 0.1478631433912268E+00 -0.1750103443003983E+00 -0.3026672370241849E+00 -0.1580604617312475E+00 0.1043145751967159E+00
- 0.2490154242069539E+00 0.1637055374149429E+00 -0.5709921826089652E-01 -0.2100814084206935E+00 -0.1666448418561723E+00 0.2107362803687351E-01))
- (args (vector 0.1E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 16))
- (let* ((nval (bes-y1 (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (> diff 1.0e-14)
- (snd-display ";bes-y1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
-
- (let ((vals (vector -0.1650682606816254E+01 -0.6174081041906827E+00 0.3676628826055245E+00 -0.5868082442208615E-02 0.9579316872759649E-01
- -0.2604058666258122E+03 -0.9935989128481975E+01 -0.4536948224911019E+00 0.1354030476893623E+00 -0.7854841391308165E-01
- -0.1216180142786892E+09 -0.1291845422080393E+06 -0.2512911009561010E+02 -0.3598141521834027E+00 0.5723897182053514E-02
- -40816513889983664.0 -0.5933965296914321E+09 -0.1597483848269626E+04 0.1644263394811578E-01))
-
- ;; yn(20, 2.0) prints -40816513889983664.0 but I guess due to float inaccuracies (bes-yn 20 2.0) is -40816513889983672.0?
-
- (ns (vector 2 2 2 2 2 5 5 5 5 5 10 10 10 10 10 20 20 20 20))
- (args (vector 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00
- 50.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00))
- (max-bad 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 19))
- (let* ((nval (bes-yn (vector-ref ns i) (vector-ref args i)))
- (diff (abs (- nval (vector-ref vals i)))))
- (set! max-bad (max max-bad diff))
- (if (and (> diff 1.0e-6)
- (not (= i 15))) ; see above
- (snd-display ";bes-yn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (do ((vals (vector 1.6709637479564564156 1.5707963267948966192 1.4706289056333368229 1.3694384060045658278 1.2661036727794991113
+ 1.1592794807274085998 1.0471975511965977462 0.92729521800161223243 0.79539883018414355549 0.64350110879328438680
+ 0.45102681179626243254 0.00000000000000000000))
+ (args (vector -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 12)
+ (if (> max-bad 1.0e-15)
+ (snd-display ";acos: ~A" max-bad)))
+ (set! max-bad (max max-bad (abs (- (acos (vector-ref args i))
+ (vector-ref vals i))))))
+
+ (do ((vals (vector 0.0000000000000000000 0.14130376948564857735 0.44356825438511518913 0.62236250371477866781 0.75643291085695958624
+ 0.86701472649056510395 0.96242365011920689500 1.3169578969248167086 1.7627471740390860505 1.8115262724608531070
+ 2.0634370688955605467 2.2924316695611776878 2.9932228461263808979 5.2982923656104845907 7.6009022095419886114))
+ (args (vector 1.0 1.01 1.1 1.2 1.3 1.4 1.5 2.0 3.0 3.1415926535897932385 4.0 5.0 10.0 100.0 1000.0))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 15)
+ (if (> max-bad 1.0e-15)
+ (snd-display ";acosh: ~A" max-bad)))
+ (let ((nval (acosh (vector-ref args i))))
+ (set! max-bad (max max-bad (abs (- nval (vector-ref vals i)))))))
+
+ (do ((vals (vector -0.10016742116155979635 0.00000000000000000000 0.10016742116155979635 0.20135792079033079146 0.30469265401539750797
+ 0.41151684606748801938 0.52359877559829887308 0.64350110879328438680 0.77539749661075306374 0.92729521800161223243
+ 1.1197695149986341867 1.5707963267948966192))
+ (args (vector -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 12)
+ (if (> max-bad 1.0e-15)
+ (snd-display ";asin: ~A" max-bad)))
+ (set! max-bad (max max-bad (abs (- (asin (vector-ref args i))
+ (vector-ref vals i))))))
+
+ (do ((vals (vector -2.3124383412727526203 -0.88137358701954302523 0.00000000000000000000 0.099834078899207563327 0.19869011034924140647
+ 0.29567304756342243910 0.39003531977071527608 0.48121182505960344750 0.56882489873224753010 0.65266656608235578681
+ 0.73266825604541086415 0.80886693565278246251 0.88137358701954302523 1.4436354751788103425 1.8184464592320668235
+ 2.0947125472611012942 2.3124383412727526203 2.9982229502979697388 5.2983423656105887574 7.6009027095419886115))
+ (args (vector -5.0 -1.0 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 2.0 3.0 4.0 5.0 10.0 100.0 1000.0))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (let* ((nval (asinh (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> max-bad 1.0e-14)
+ (snd-display ";asinh(~A): ~A ~A -> ~A" (vector-ref args i) nval (vector-ref vals i) max-bad))))
+
+ (do ((vals (vector 0.00000000000000000000 0.24497866312686415417 0.32175055439664219340 0.46364760900080611621 0.78539816339744830962
+ 1.1071487177940905030 1.2490457723982544258 1.3258176636680324651 1.3734007669450158609 1.4711276743037345919 1.5208379310729538578))
+ (args (vector 0.00000000000000000000 0.25000000000000000000 0.33333333333333333333 0.50000000000000000000 1.0000000000000000000
+ 2.0000000000000000000 3.0000000000000000000 4.0000000000000000000 5.0000000000000000000 10.000000000000000000 20.000000000000000000))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (> max-bad 1.0e-15)
+ (snd-display ";atan: ~A" max-bad)))
+ (set! max-bad (max max-bad (abs (- (atan (vector-ref args i))
+ (vector-ref vals i))))))
+
+ (do ((vals (vector -0.54930614433405484570 0.00000000000000000000 0.0010000003333335333335 0.10033534773107558064 0.20273255405408219099
+ 0.30951960420311171547 0.42364893019360180686 0.54930614433405484570 0.69314718055994530942 0.86730052769405319443
+ 1.0986122886681096914 1.4722194895832202300 2.6466524123622461977 3.8002011672502000318 7.2543286192620472067))
+ (args (vector -0.5 0.0 0.001 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.99 0.999 0.999999))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 15))
+ (let* ((nval (atanh (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> diff 1.0e-10) ; one is > e-11
+ (snd-display ";atanh(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff))))
+
+ (do ((vals (vector 0.1000000000000000E+01 0.1010025027795146E+01 0.1040401782229341E+01 0.1092045364317340E+01 0.1166514922869803E+01
+ 0.1266065877752008E+01 0.1393725584134064E+01 0.1553395099731217E+01 0.1749980639738909E+01 0.1989559356618051E+01
+ 0.2279585302336067E+01 0.3289839144050123E+01 0.4880792585865024E+01 0.7378203432225480E+01 0.1130192195213633E+02
+ 0.1748117185560928E+02 0.2723987182360445E+02 0.6723440697647798E+02 0.4275641157218048E+03 0.2815716628466254E+04))
+ (args (vector 0.00E+00 0.20E+00 0.40E+00 0.60E+00 0.80E+00 0.10E+01 0.12E+01 0.14E+01 0.16E+01 0.18E+01 0.20E+01 0.25E+01 0.30E+01
+ 0.35E+01 0.40E+01 0.45E+01 0.50E+01 0.60E+01 0.80E+01
+ 0.10E+02))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (let* ((nval (bes-i0 (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> diff 1.0e-4)
+ (snd-display ";bes-i0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff))))
+
+ (do ((vals (vector -0.1775967713143383E+00 -0.3971498098638474E+00 -0.2600519549019334E+00 0.2238907791412357E+00 0.7651976865579666E+00
+ 0.1000000000000000E+01 0.7651976865579666E+00 0.2238907791412357E+00 -0.2600519549019334E+00 -0.3971498098638474E+00
+ -0.1775967713143383E+00 0.1506452572509969E+00 0.3000792705195556E+00 0.1716508071375539E+00 -0.9033361118287613E-01
+ -0.2459357644513483E+00 -0.1711903004071961E+00 0.4768931079683354E-01 0.2069261023770678E+00 0.1710734761104587E+00 -0.1422447282678077E-01))
+ (args (vector -5.0E+00 -4.0E+00 -3.0E+00 -2.0E+00 -1.0E+00 0.0E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00
+ 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 21))
+ (let* ((nval (bes-j0 (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> diff 1.0e-15)
+ (snd-display ";bes-j0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff))))
+
+ (do ((vals (vector 0.3275791375914652E+00 0.6604332802354914E-01 -0.3390589585259365E+00 -0.5767248077568734E+00 -0.4400505857449335E+00
+ 0.0000000000000000E+00 0.4400505857449335E+00 0.5767248077568734E+00 0.3390589585259365E+00 -0.6604332802354914E-01
+ -0.3275791375914652E+00 -0.2766838581275656E+00 -0.4682823482345833E-02 0.2346363468539146E+00 0.2453117865733253E+00
+ 0.4347274616886144E-01 -0.1767852989567215E+00 -0.2234471044906276E+00 -0.7031805212177837E-01 0.1333751546987933E+00 0.2051040386135228E+00))
+ (args (vector -5.0E+00 -4.0E+00 -3.0E+00 -2.0E+00 -1.0E+00 0.0E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00
+ 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 21))
+ (let* ((nval (bes-j1 (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> diff 1.0e-15)
+ (snd-display ";bes-j1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff))))
+
+ (do ((vals (vector 0.1149034849319005E+00 0.3528340286156377E+00 0.4656511627775222E-01 0.2546303136851206E+00 -0.5971280079425882E-01
+ 0.2497577302112344E-03 0.7039629755871685E-02 0.2611405461201701E+00 -0.2340615281867936E+00 -0.8140024769656964E-01
+ 0.2630615123687453E-09 0.2515386282716737E-06 0.1467802647310474E-02 0.2074861066333589E+00 -0.1138478491494694E+00
+ 0.3873503008524658E-24 0.3918972805090754E-18 0.2770330052128942E-10 0.1151336924781340E-04 -0.1167043527595797E+00))
+ (ns (vector 2 2 2 2 2 5 5 5 5 5 10 10 10 10 10 20 20 20 20 20))
+ (args (vector 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00
+ 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (let* ((nval (bes-jn (vector-ref ns i) (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> diff 1.0e-15)
+ (snd-display ";bes-jn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff))))
+
+ (do ((vals (vector -0.1534238651350367E+01 0.8825696421567696E-01 0.5103756726497451E+00 0.3768500100127904E+00 -0.1694073932506499E-01
+ -0.3085176252490338E+00 -0.2881946839815792E+00 -0.2594974396720926E-01 0.2235214893875662E+00 0.2499366982850247E+00
+ 0.5567116728359939E-01 -0.1688473238920795E+00 -0.2252373126343614E+00 -0.7820786452787591E-01 0.1271925685821837E+00 0.2054642960389183E+00))
+ (args (vector 0.1E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 16))
+ (let* ((nval (bes-y0 (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> diff 1.0e-15)
+ (snd-display ";bes-y0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff))))
+
+ (do ((vals (vector -0.6458951094702027E+01 -0.7812128213002887E+00 -0.1070324315409375E+00 0.3246744247918000E+00 0.3979257105571000E+00
+ 0.1478631433912268E+00 -0.1750103443003983E+00 -0.3026672370241849E+00 -0.1580604617312475E+00 0.1043145751967159E+00
+ 0.2490154242069539E+00 0.1637055374149429E+00 -0.5709921826089652E-01 -0.2100814084206935E+00 -0.1666448418561723E+00 0.2107362803687351E-01))
+ (args (vector 0.1E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 16))
+ (let* ((nval (bes-y1 (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (> diff 1.0e-14)
+ (snd-display ";bes-y1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff))))
+
+ (do ((vals (vector -0.1650682606816254E+01 -0.6174081041906827E+00 0.3676628826055245E+00 -0.5868082442208615E-02 0.9579316872759649E-01
+ -0.2604058666258122E+03 -0.9935989128481975E+01 -0.4536948224911019E+00 0.1354030476893623E+00 -0.7854841391308165E-01
+ -0.1216180142786892E+09 -0.1291845422080393E+06 -0.2512911009561010E+02 -0.3598141521834027E+00 0.5723897182053514E-02
+ -40816513889983664.0 -0.5933965296914321E+09 -0.1597483848269626E+04 0.1644263394811578E-01))
+
+ ;; yn(20, 2.0) prints -40816513889983664.0 but I guess due to float inaccuracies (bes-yn 20 2.0) is -40816513889983672.0?
+
+ (ns (vector 2 2 2 2 2 5 5 5 5 5 10 10 10 10 10 20 20 20 20))
+ (args (vector 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00
+ 50.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00))
+ (max-bad 0.0)
+ (i 0 (+ i 1)))
+ ((= i 19))
+ (let* ((nval (bes-yn (vector-ref ns i) (vector-ref args i)))
+ (diff (abs (- nval (vector-ref vals i)))))
+ (set! max-bad (max max-bad diff))
+ (if (and (> diff 1.0e-6)
+ (not (= i 15))) ; see above
+ (snd-display ";bes-yn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff))))
;; one (20 1.0) is off by a lot but the val is 1e22
;; numerics stuff
- (let ((ns (vector 1 6 6 6 15 15 15 15 15 15 15))
- (ks (vector 0 1 3 5 1 3 5 7 9 11 13))
- (vals (vector 1 6 20 6 15 455 3003 6435 5005 1365 105)))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (let ((nval (binomial-direct (vector-ref ns i) (vector-ref ks i)))
- (mval (n-choose-k (vector-ref ns i) (vector-ref ks i))))
- (if (not (= nval mval (vector-ref vals i)))
- (snd-display ";binomial(~A ~A): ~A ~A ~A" (vector-ref ns i) (vector-ref ks i) nval mval (vector-ref vals i))))))
-
- (let ((ls (vector 1 1 1 1 1 2 2 2 3 3 3 3 4 5 6 7 8 9 10))
- (ms (vector 0 0 0 0 1 0 1 2 0 1 2 3 2 2 3 3 4 4 5))
- (vals (vector 0.000000 0.500000 0.707107 1.000000 -0.866025 -0.125000 -1.29904 2.25000 -0.437500 -0.324759 5.62500 -9.74278
- 4.21875 -4.92187 12.7874 116.685 -1050.67 -2078.49 30086.2))
- (xs (vector 0.0 0.5 0.7071067 1.0 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 19))
- (let ((val (plgndr (vector-ref ls i) (vector-ref ms i) (vector-ref xs i))))
- (if (not (and (real? val)
- (real? (vector-ref vals i))
- (<= (abs (- val (vector-ref vals i))) 0.1)))
- (snd-display ";plgndr(~A ~A ~A) = ~A (~A)" (vector-ref ls i) (vector-ref ms i) (vector-ref xs i) val (vector-ref vals i))))))
+ (do ((ns (vector 1 6 6 6 15 15 15 15 15 15 15))
+ (ks (vector 0 1 3 5 1 3 5 7 9 11 13))
+ (vals (vector 1 6 20 6 15 455 3003 6435 5005 1365 105))
+ (i 0 (+ i 1)))
+ ((= i 11))
+ (let ((nval (binomial-direct (vector-ref ns i) (vector-ref ks i)))
+ (mval (n-choose-k (vector-ref ns i) (vector-ref ks i))))
+ (if (not (= nval mval (vector-ref vals i)))
+ (snd-display ";binomial(~A ~A): ~A ~A ~A" (vector-ref ns i) (vector-ref ks i) nval mval (vector-ref vals i)))))
+
+ (do ((ls (vector 1 1 1 1 1 2 2 2 3 3 3 3 4 5 6 7 8 9 10))
+ (ms (vector 0 0 0 0 1 0 1 2 0 1 2 3 2 2 3 3 4 4 5))
+ (vals (vector 0.000000 0.500000 0.707107 1.000000 -0.866025 -0.125000 -1.29904 2.25000 -0.437500 -0.324759 5.62500 -9.74278
+ 4.21875 -4.92187 12.7874 116.685 -1050.67 -2078.49 30086.2))
+ (xs (vector 0.0 0.5 0.7071067 1.0 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5))
+ (i 0 (+ i 1)))
+ ((= i 19))
+ (let ((val (plgndr (vector-ref ls i) (vector-ref ms i) (vector-ref xs i))))
+ (if (not (and (real? val)
+ (real? (vector-ref vals i))
+ (<= (abs (- val (vector-ref vals i))) 0.1)))
+ (snd-display ";plgndr(~A ~A ~A) = ~A (~A)" (vector-ref ls i) (vector-ref ms i) (vector-ref xs i) val (vector-ref vals i)))))
(let ((vals (vector 1.0000000000 0.8000000000 0.2800000000 -0.3520000000 -0.8432000000 -0.9971200000
-0.7521920000 -0.2063872000 0.4219724800 0.8815431680 0.9884965888 0.7000513741 0.1315856097))
@@ -11386,29 +11255,27 @@ EDITS: 2
(snd-display ";gegenbauer 5 ~A ~A: ~A ~A" x alpha val1 val2))))
)
- (let ((vals (vector 1.0000000000 0.0000000000 -0.5000000000 -0.6666666667 -0.6250000000 -0.4666666667
- -0.2569444444 -0.0404761905 0.1539930556 0.3097442681 0.4189459325 0.4801341791
- 0.4962122235 -0.4455729167 0.8500000000 -3.1666666667 34.3333333333))
- (ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12 5 5 5 5))
- (xs (vector 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 0.5 3.0 5.0 10.0)))
- (do ((i 0 (+ i 1)))
- ((= i 17))
- (let ((val (laguerre (vector-ref ns i) (vector-ref xs i))))
- (if (fneq val (vector-ref vals i))
- (snd-display ";laguerre ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
- )
-
- (let ((vals (vector 1.0 10.0 98.0 940.0 8812.0 80600.0
- 717880.0 6211600.0 52065680.0 ; was off by factor of 10?
- 421271200 3275529760.0 24329873600.0 171237081280.0 41.0 -8.0 3816.0 3041200.0))
- (ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12 5 5 5 5))
- (xs (vector 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 0.5 1.0 3.0 10.0)))
- (do ((i 0 (+ i 1)))
- ((= i 13))
- (let ((val (hermite (vector-ref ns i) (vector-ref xs i))))
- (if (fneq val (vector-ref vals i))
- (snd-display ";hermite ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
- )
+ (do ((vals (vector 1.0000000000 0.0000000000 -0.5000000000 -0.6666666667 -0.6250000000 -0.4666666667
+ -0.2569444444 -0.0404761905 0.1539930556 0.3097442681 0.4189459325 0.4801341791
+ 0.4962122235 -0.4455729167 0.8500000000 -3.1666666667 34.3333333333))
+ (ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12 5 5 5 5))
+ (xs (vector 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 0.5 3.0 5.0 10.0))
+ (i 0 (+ i 1)))
+ ((= i 17))
+ (let ((val (laguerre (vector-ref ns i) (vector-ref xs i))))
+ (if (fneq val (vector-ref vals i))
+ (snd-display ";laguerre ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
+
+ (do ((vals (vector 1.0 10.0 98.0 940.0 8812.0 80600.0
+ 717880.0 6211600.0 52065680.0 ; was off by factor of 10?
+ 421271200 3275529760.0 24329873600.0 171237081280.0 41.0 -8.0 3816.0 3041200.0))
+ (ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12 5 5 5 5))
+ (xs (vector 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 0.5 1.0 3.0 10.0))
+ (i 0 (+ i 1)))
+ ((= i 13))
+ (let ((val (hermite (vector-ref ns i) (vector-ref xs i))))
+ (if (fneq val (vector-ref vals i))
+ (snd-display ";hermite ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
(do ((i 0 (+ i 1)))
((= i 10))
@@ -11508,8 +11375,7 @@ EDITS: 2
((fneq v2 v22) (snd-display ";laguerre 2 ~A: ~A ~A" x v2 v22))
((fneq va1 va11) (snd-display ";laguerre 1a ~A ~A: ~A ~A" x a va1 va11))
((fneq va2 va22) (snd-display ";laguerre 2a ~A ~A: ~A ~A" x a va2 va22))
- ((fneq va3 va33) (snd-display ";laguerre 3a ~A ~A: ~A ~A" x a va3 va33))))))
- )
+ ((fneq va3 va33) (snd-display ";laguerre 3a ~A ~A: ~A ~A" x a va3 va33)))))))
;; ----------------
;; start of test
@@ -11621,7 +11487,7 @@ EDITS: 2
(snd-display ";cos cheb 7 1.0: ~A ~A" (polynomial lv7 1.0) (cos (* 7 (acos 1.0)))))
(do ((lv8 (partials->polynomial '(7 1) mus-chebyshev-second-kind))
(sa (sin (acos 0.5)))
- (ca (acos 0.5))
+ (ca (sin (* 7 (acos 0.5))))
(i 0 (+ i 1)))
((= i 10))
(let* ((val (mus-random 1.0))
@@ -11633,8 +11499,8 @@ EDITS: 2
(if (fneq (polynomial lv8 val) (/ (sin (* 7 aval)) (sin aval)))
(snd-display ";acos cheb 7 ~A: ~A ~A" val (polynomial lv8 val) (/ (sin (* 7 aval)) (sin aval)))))
(if (not (mus-arrays-equal? lv8 (float-vector -1.000 0.000 24.000 0.000 -80.000 0.000 64.000 0.000))) (snd-display ";partials->polynomial(9): ~A?" lv8))
- (if (fneq (polynomial lv8 0.5) (/ (sin (* 7 ca)) sa))
- (snd-display ";acos cheb 7 1.0: ~A ~A" (polynomial lv8 0.5) (/ (sin (* 7 ca)) sa)))))
+ (if (fneq (polynomial lv8 0.5) (/ ca sa))
+ (snd-display ";acos cheb 7 1.0: ~A ~A" (polynomial lv8 0.5) (/ ca sa)))))
;; G&R 8.943 p 984 uses n+1 where we use n in Un? (our numbering keeps harmonics aligned between Tn and Un)
(if (not (mus-arrays-equal? (normalize-partials (list 1 1 2 1)) (float-vector 1.000 0.500 2.000 0.500)))
@@ -11779,22 +11645,22 @@ EDITS: 2
(if (not (mus-arrays-equal? v0 (float-vector 1.000 1.118 2.028 3.010 4.005 5.003 6.002 7.001)))
(snd-display ";rectangular->magnitudes v0: ~A" v0)))
- (let ((v0 (make-float-vector 8))
- (v1 (make-float-vector 8))
- (v2 (make-float-vector 8))
- (v3 (make-float-vector 8)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (let ((val1 (random 1.0))
- (val2 (random 1.0)))
- (set! (v0 i) val1)
- (float-vector-set! v2 i val1)
- (float-vector-set! v1 i val2)
- (float-vector-set! v3 i val2)))
- (rectangular->magnitudes v0 v1)
- (rectangular->polar v2 v3)
- (if (not (mus-arrays-equal? v0 v2))
- (snd-display ";rectangular->magnitudes|polar: ~A ~A" v0 v2)))
+ (do ((v0 (make-float-vector 8))
+ (v1 (make-float-vector 8))
+ (v2 (make-float-vector 8))
+ (v3 (make-float-vector 8))
+ (i 0 (+ i 1)))
+ ((= i 8)
+ (rectangular->magnitudes v0 v1)
+ (rectangular->polar v2 v3)
+ (if (not (mus-arrays-equal? v0 v2))
+ (snd-display ";rectangular->magnitudes|polar: ~A ~A" v0 v2)))
+ (let ((val1 (random 1.0))
+ (val2 (random 1.0)))
+ (set! (v0 i) val1)
+ (float-vector-set! v2 i val1)
+ (float-vector-set! v1 i val2)
+ (float-vector-set! v3 i val2)))
(when (defined? 'edot-product) ; needs complex numbers in C
(let* ((vals (make-float-vector 1 1.0))
@@ -12149,12 +12015,12 @@ EDITS: 2
(let ((del (make-delay 5 :max-size 8)))
(delay del 1.0)
(do ((i 0 (+ i 1))) ((= i 4)) (delay del 0.0))
- (let ((v0 (make-float-vector 5)))
- (do ((i 0 (+ i 1)))
- ((= i 5))
- (set! (v0 i) (delay del 0.0 0.4)))
- (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000)))
- (snd-display ";zdelay: ~A" v0)))
+ (do ((v0 (make-float-vector 5))
+ (i 0 (+ i 1)))
+ ((= i 5)
+ (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000)))
+ (snd-display ";zdelay: ~A" v0)))
+ (set! (v0 i) (delay del 0.0 0.4)))
(delay del 1.0)
(delay del 0.0 0.4)
(if (not (string=? (mus-describe del) "delay line[5,8, linear]: [0 0 1 0 0]"))
@@ -12624,12 +12490,12 @@ EDITS: 2
(let ((del (make-comb 0.0 5 :max-size 8)))
(comb del 1.0)
(do ((i 0 (+ i 1))) ((= i 4)) (comb del 0.0))
- (let ((v0 (make-float-vector 5)))
- (do ((i 0 (+ i 1)))
- ((= i 5))
- (set! (v0 i) (comb del 0.0 0.4)))
- (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
- (snd-display ";zcomb: ~A" v0)))
+ (do ((v0 (make-float-vector 5))
+ (i 0 (+ i 1)))
+ ((= i 5)
+ (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
+ (snd-display ";zcomb: ~A" v0)))
+ (set! (v0 i) (comb del 0.0 0.4)))
(comb del 1.0)
(comb del 0.0 0.4)
(if (not (string=? (mus-describe del) "comb scaler: 0.000, line[5,8, linear]: [0 0 1 0 0]"))
@@ -12644,11 +12510,11 @@ EDITS: 2
"filtered-comb"
"filtered-comb scaler: 0.400, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.300, a1: 0.700, x1: 0.000]")
(let ((v0 (make-float-vector 20)))
- (let ((val 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (set! (v0 i) (filtered-comb gen val))
- (set! val 0.0)))
+ (do ((val 1.0)
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (set! (v0 i) (filtered-comb gen val))
+ (set! val 0.0))
(if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.120 0.280 0.000 0.000 0.000 0.014 0.067 0.078 0.000 0.000)))
(snd-display ";filtered-comb: ~A" v0)))
(if (not (filtered-comb? gen)) (snd-display ";~A not filtered-comb?" gen))
@@ -12661,11 +12527,11 @@ EDITS: 2
(print-and-check gen
"filtered-comb"
"filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]")
- (let ((val 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (set! (v0 i) (filtered-comb gen val))
- (set! val 0.0)))
+ (do ((val 1.0)
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (set! (v0 i) (filtered-comb gen val))
+ (set! val 0.0))
(if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.450 0.450 0.000 0.000 0.000 0.202 0.405 0.202 0.000 0.000)))
(snd-display ";filtered-comb .5 .5: ~A" v0)))
@@ -12674,11 +12540,11 @@ EDITS: 2
(print-and-check gen
"filtered-comb"
"filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [fir-filter order: 5, xs: [0.1 0.2 0.3 0.2 0.1]]")
- (let ((val 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (set! (v0 i) (filtered-comb gen val))
- (set! val 0.0)))
+ (do ((val 1.0)
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (set! (v0 i) (filtered-comb gen val))
+ (set! val 0.0))
(if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.090 0.180 0.270 0.180 0.090 0.008 0.032 0.081 0.130 0.154)))
(snd-display ";filtered-comb fir: ~A" v0)))
@@ -12698,12 +12564,12 @@ EDITS: 2
(let ((del (make-filtered-comb 0.0 5 :max-size 8 :filter (make-one-zero .5 .5))))
(filtered-comb del 1.0)
(do ((i 0 (+ i 1))) ((= i 4)) (filtered-comb del 0.0))
- (let ((v0 (make-float-vector 5)))
- (do ((i 0 (+ i 1)))
- ((= i 5))
- (set! (v0 i) (filtered-comb del 0.0 0.4)))
- (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
- (snd-display ";zfiltered-comb: ~A" v0)))
+ (do ((v0 (make-float-vector 5))
+ (i 0 (+ i 1)))
+ ((= i 5)
+ (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
+ (snd-display ";zfiltered-comb: ~A" v0)))
+ (set! (v0 i) (filtered-comb del 0.0 0.4)))
(filtered-comb del 1.0)
(filtered-comb del 0.0 0.4)
(if (not (string=? (mus-describe del)
@@ -12716,9 +12582,7 @@ EDITS: 2
(let ((gen (make-notch .4 3))
(v0 (make-float-vector 10)))
- (print-and-check gen
- "notch"
- "notch scaler: 0.400, line[3, step]: [0 0 0]")
+ (print-and-check gen "notch" "notch scaler: 0.400, line[3, step]: [0 0 0]")
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v0 i) (notch gen 1.0)))
@@ -13267,11 +13131,11 @@ EDITS: 2
(print-and-check gen
"oscil"
"oscil freq: 440.000Hz, phase: 0.000")
- (let ((gen1 (make-oscil 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v0 i) (oscil gen 0.0))
- (set! (v1 i) (mus-apply gen1 0.0 0.0))))
+ (do ((gen1 (make-oscil 440.0))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v0 i) (oscil gen 0.0))
+ (set! (v1 i) (mus-apply gen1 0.0 0.0)))
(let ((v2 (make-float-vector 10)))
(let ((gen2 (make-oscil 440.0)))
(fill-float-vector v2 (if (oscil? gen2) (oscil gen2 0.0) -1.0)))
@@ -13313,15 +13177,14 @@ EDITS: 2
(set! (v2 i) (oscil o4 x2 x1)))
(let ()
(define (hi)
- (let ((o2 (make-oscil 1000.0))
- (o3 (make-oscil 1000.0))
- (v1 (make-float-vector 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10) v1)
- (float-vector-set! v1 i (oscil o2 (oscil o3) (oscil o3))))))
+ (do ((o2 (make-oscil 1000.0))
+ (o3 (make-oscil 1000.0))
+ (v1 (make-float-vector 10))
+ (i 0 (+ i 1)))
+ ((= i 10) v1)
+ (float-vector-set! v1 i (oscil o2 (oscil o3) (oscil o3)))))
(hi)
(let ((v1 (hi)))
-
(if (not (or (mus-arrays-equal? v v1)
(mus-arrays-equal? v2 v1)))
(format *stderr* ":orig: ~A~%; v1: ~A~%; v2: ~A~%" v v1 v2))))))
@@ -13336,23 +13199,23 @@ EDITS: 2
(test-simple-polywave i #f mus-chebyshev-second-kind)
(test-simple-polywave i .1 mus-chebyshev-second-kind))
- (let ((gen1 (make-oscil 100.0))
- (gen2 (make-oscil -100.0))
- (mx 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! mx (max mx (abs (+ (gen1) (gen2))))))
- (if (fneq mx 0.0)
- (snd-display ";oscil +-: ~A" mx)))
-
- (let ((gen1 (make-oscil 100.0 (* pi 0.5)))
- (gen2 (make-oscil -100.0 (* pi 0.5)))
- (mx 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! mx (max mx (abs (- (gen1) (gen2))))))
- (if (fneq mx 0.0)
- (snd-display ";cosil +-: ~A" mx)))
+ (do ((gen1 (make-oscil 100.0))
+ (gen2 (make-oscil -100.0))
+ (mx 0.0)
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (if (fneq mx 0.0)
+ (snd-display ";oscil +-: ~A" mx)))
+ (set! mx (max mx (abs (+ (gen1) (gen2))))))
+
+ (do ((gen1 (make-oscil 100.0 (* pi 0.5)))
+ (gen2 (make-oscil -100.0 (* pi 0.5)))
+ (mx 0.0)
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (if (fneq mx 0.0)
+ (snd-display ";cosil +-: ~A" mx)))
+ (set! mx (max mx (abs (- (gen1) (gen2))))))
(let ((frqs (float-vector 0.0 0.0))
(amps (float-vector 0.0 0.0))
@@ -13372,26 +13235,17 @@ EDITS: 2
(let ((x (oscil-bank ob)))
(if (not (morally-equal? x 0.08965057448242633)) (snd-display ";oscil-bank 0.09: ~A~%" x)))))
- (fm-test (make-oscil))
- (fm-test (make-nrxysin))
- (fm-test (make-nrxycos))
- (fm-test (make-square-wave))
- (fm-test (make-triangle-wave))
- (fm-test (make-ncos))
- (fm-test (make-nsin))
- (fm-test (make-sawtooth-wave))
- (fm-test (make-rand))
- (fm-test (make-rand-interp))
- (fm-test (make-pulse-train))
+ (for-each fm-test (vector (make-oscil) (make-nrxysin) (make-nrxycos) (make-square-wave) (make-triangle-wave) (make-ncos)
+ (make-nsin) (make-sawtooth-wave) (make-rand) (make-rand-interp) (make-pulse-train)))
- (let ((gen (make-oscil 440.0))
- (gen1 (make-oscil 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (let ((oval (oscil gen .1))
- (mval (mus-run gen1 .1)))
- (if (fneq oval mval)
- (snd-display ";mus-run ~A but oscil ~A?" mval oval)))))
+ (do ((gen (make-oscil 440.0))
+ (gen1 (make-oscil 440.0))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (let ((oval (oscil gen .1))
+ (mval (mus-run gen1 .1)))
+ (if (fneq oval mval)
+ (snd-display ";mus-run ~A but oscil ~A?" mval oval))))
(let ((gen (make-oscil 440.0))
(gen1 (make-oscil 440.0))
@@ -13414,76 +13268,75 @@ EDITS: 2
(test-gen-equal (make-oscil 440.0) (make-oscil 440.0) (make-oscil 100.0))
(test-gen-equal (make-oscil 440.0) (make-oscil 440.0) (make-oscil 440.0 1.0))
- (let ((gen (make-oscil 440.0))
- (gen1 (make-oscil 440.0))
- (pm-index 2.0)
- (v0 (make-float-vector 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v0 i) (gen 0.0 (* pm-index (gen1 0.0)))))
- (if (or (fneq (v0 1) 0.367) (fneq (v0 6) 0.854) (fneq (v0 8) 0.437))
- (snd-display ";oscil pm output: ~A" v0)))
+ (do ((gen (make-oscil 440.0))
+ (gen1 (make-oscil 440.0))
+ (pm-index 2.0)
+ (v0 (make-float-vector 10))
+ (i 0 (+ i 1)))
+ ((= i 10)
+ (if (or (fneq (v0 1) 0.367) (fneq (v0 6) 0.854) (fneq (v0 8) 0.437))
+ (snd-display ";oscil pm output: ~A" v0)))
+ (set! (v0 i) (gen 0.0 (* pm-index (gen1 0.0)))))
- (let ((gen (make-oscil 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 1100))
- (let ((val1 (sin (mus-phase gen)))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (snd-display ";oscil: ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-oscil 440.0))
+ (i 0 (+ i 1)))
+ ((= i 1100))
+ (let ((val1 (sin (mus-phase gen)))
+ (val2 (gen 0.0)))
+ (if (fneq val1 val2)
+ (snd-display ";oscil: ~A: ~A ~A" i val1 val2))))
- (let ((gen (make-oscil 440.0 :initial-phase (* pi 0.5)))
- (incr (/ (* 2 pi 440.0) 22050.0)))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((= i 900))
- (let ((val1 (cos a))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (snd-display ";oscil (cos): ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-oscil 440.0 :initial-phase (* pi 0.5)))
+ (incr (/ (* 2 pi 440.0) 22050.0))
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 900))
+ (let ((val1 (cos a))
+ (val2 (gen 0.0)))
+ (if (fneq val1 val2)
+ (snd-display ";oscil (cos): ~A: ~A ~A" i val1 val2))))
- (let ((gen (make-oscil 0.0))
- (gen1 (make-oscil 40.0))
- (incr (/ (* 2 pi 40.0) 22050.0)))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((= i 1100))
- (let ((val1 (sin (sin a)))
- (val2 (oscil gen 0.0 (oscil gen1 0.0))))
- (if (fneq val1 val2)
- (snd-display ";oscil pm: ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-oscil 0.0))
+ (gen1 (make-oscil 40.0))
+ (incr (/ (* 2 pi 40.0) 22050.0))
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 1100))
+ (let ((val1 (sin (sin a)))
+ (val2 (oscil gen 0.0 (oscil gen1 0.0))))
+ (if (fneq val1 val2)
+ (snd-display ";oscil pm: ~A: ~A ~A" i val1 val2))))
- (let ((gen (make-oscil 0.0))
- (gen1 (make-oscil 40.0))
- (incr (/ (* 2 pi 40.0) 22050.0))
- (a1 0.0))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((= i 100))
- (let ((fm (sin a))
- (val1 (sin a1))
- (val2 (oscil gen (oscil gen1 0.0))))
- (set! a1 (+ a1 fm))
- (if (fneq val1 val2)
- (snd-display ";oscil fm: ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-oscil 0.0))
+ (gen1 (make-oscil 40.0))
+ (incr (/ (* 2 pi 40.0) 22050.0))
+ (a1 0.0)
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 100))
+ (let ((fm (sin a))
+ (val1 (sin a1))
+ (val2 (oscil gen (oscil gen1 0.0))))
+ (set! a1 (+ a1 fm))
+ (if (fneq val1 val2)
+ (snd-display ";oscil fm: ~A: ~A ~A" i val1 val2))))
(let ()
(define (oscil-1-1)
- (let ((osc (make-oscil 440.0)))
- (let ((v1 (make-vector 10 0.0))
- (v2 (make-vector 10 0.0)))
- (set! (v1 0) (oscil osc))
- (set! (v1 1) (oscil osc))
- (let ((osc (make-oscil 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v2 i) (oscil osc))))
- (do ((i 2 (+ i 1)))
- ((= i 10))
- (set! (v1 i) (oscil osc)))
-
- (if (not (equal? v1 v2))
- (snd-display ";oscil-1 shadowing test1: ~A ~A" v1 v2)))))
+ (let ((osc (make-oscil 440.0))
+ (v1 (make-vector 10 0.0))
+ (v2 (make-vector 10 0.0)))
+ (set! (v1 0) (oscil osc))
+ (set! (v1 1) (oscil osc))
+ (do ((osc (make-oscil 440.0))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v2 i) (oscil osc)))
+ (do ((i 2 (+ i 1)))
+ ((= i 10))
+ (set! (v1 i) (oscil osc)))
+ (if (not (equal? v1 v2))
+ (snd-display ";oscil-1 shadowing test1: ~A ~A" v1 v2))))
(define (oscil-1-2)
(define (ho-1 osc v i)
@@ -13513,10 +13366,10 @@ EDITS: 2
(v2 (make-vector 10 0.0)))
(set! (v1 0) (o1))
(set! (v1 1) (o1))
- (let ((o2 (ho)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v2 i) (o2))))
+ (do ((o2 (ho))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v2 i) (o2)))
(do ((i 2 (+ i 1)))
((= i 10))
(set! (v1 i) (o1)))
@@ -13555,19 +13408,19 @@ EDITS: 2
(let ((size 1000))
(define (test-pm beg end freq amp mc-ratio index)
- (let ((pm (make-oscil (* freq mc-ratio)))
- (carrier (make-oscil freq)))
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil carrier 0.0 (* index (oscil pm))))))))
+ (do ((pm (make-oscil (* freq mc-ratio)))
+ (carrier (make-oscil freq))
+ (i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil carrier 0.0 (* index (oscil pm)))))))
(define (test-fm beg end freq amp mc-ratio index)
- (let ((fm (make-oscil (* freq mc-ratio) :initial-phase (/ pi 2.0)))
- (carrier (make-oscil freq))
- (fm-index (* (hz->radians freq) mc-ratio index)))
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil carrier (* fm-index (oscil fm))))))))
+ (do ((fm (make-oscil (* freq mc-ratio) :initial-phase (/ pi 2.0)))
+ (carrier (make-oscil freq))
+ (fm-index (* (hz->radians freq) mc-ratio index))
+ (i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil carrier (* fm-index (oscil fm)))))))
;; there's an initial-phase confusion here, so by making the srate high and freq low, we minimize uninteresting off-by-1 troubles
@@ -13611,29 +13464,29 @@ EDITS: 2
(test-gen-equal (make-ncos 440.0 3) (make-ncos 440.0 3) (make-ncos 440.0 5))
(test-gen-equal (make-ncos 440.0 3) (make-ncos 440.0 3) (make-ncos 400.0 3))
- (let ((gen (make-ncos 440 10)))
- (do ((i 0 (+ i 1)))
- ((= i 1100))
- (let ((val1 (let ((den (sin (* (mus-phase gen) 0.5))))
- (if (= 0.0 den)
- 1.0
- (min 1.0 (* (mus-scaler gen)
- (- (/ (sin (* (mus-phase gen)
- (+ (mus-length gen) 0.5)))
- (* 2.0 den))
- 0.5))))))
- (val2 (gen 0.0)))
- (if (> (abs (- val1 val2)) .002)
- (snd-display ";ncos: ~A: ~A ~A" i val1 val2)))))
-
- (let ((gen1 (make-ncos 100.0 10))
- (gen2 (make-ncos -100.0 10))
- (mx 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! mx (max mx (abs (- (gen1) (gen2))))))
- (if (fneq mx 0.0)
- (snd-display ";ncos +-: ~A" mx)))
+ (do ((gen (make-ncos 440 10))
+ (i 0 (+ i 1)))
+ ((= i 1100))
+ (let ((val1 (let ((den (sin (* (mus-phase gen) 0.5))))
+ (if (= 0.0 den)
+ 1.0
+ (min 1.0 (* (mus-scaler gen)
+ (- (/ (sin (* (mus-phase gen)
+ (+ (mus-length gen) 0.5)))
+ (* 2.0 den))
+ 0.5))))))
+ (val2 (gen 0.0)))
+ (if (> (abs (- val1 val2)) .002)
+ (snd-display ";ncos: ~A: ~A ~A" i val1 val2))))
+
+ (do ((gen1 (make-ncos 100.0 10))
+ (gen2 (make-ncos -100.0 10))
+ (mx 0.0)
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (if (fneq mx 0.0)
+ (snd-display ";ncos +-: ~A" mx)))
+ (set! mx (max mx (abs (- (gen1) (gen2))))))
(test-simple-ncos 1)
(test-simple-ncos 3)
@@ -13666,14 +13519,14 @@ EDITS: 2
(test-gen-equal (make-nsin 440.0 3) (make-nsin 440.0 3) (make-nsin 440.0 5))
(test-gen-equal (make-nsin 440.0 3) (make-nsin 440.0 3) (make-nsin 400.0 3))
- (let ((gen1 (make-nsin 100.0 10))
- (gen2 (make-nsin -100.0 10))
- (mx 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! mx (max mx (abs (+ (gen1) (gen2))))))
- (if (fneq mx 0.0)
- (snd-display ";nsin +-: ~A" mx)))
+ (do ((gen1 (make-nsin 100.0 10))
+ (gen2 (make-nsin -100.0 10))
+ (mx 0.0)
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (if (fneq mx 0.0)
+ (snd-display ";nsin +-: ~A" mx)))
+ (set! mx (max mx (abs (+ (gen1) (gen2))))))
(test-simple-nsin 1)
(test-simple-nsin 3)
@@ -13707,10 +13560,10 @@ EDITS: 2
(let ((v1 (make-float-vector 10)))
(with-sound (v1 :srate 44100)
- (let ((gen (make-nrxysin 1000 :n 10 :r .99)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (outa i (nrxysin gen)))))
+ (do ((gen (make-nrxysin 1000 :n 10 :r .99))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (outa i (nrxysin gen))))
(if (not (mus-arrays-equal? v1 (float-vector 0.000 0.671 0.637 0.186 0.017 0.169 0.202 0.048 0.007 0.105)))
(snd-display ";ws nrxysin output: ~A" v1)))
@@ -13741,10 +13594,10 @@ EDITS: 2
(test-gen-equal (make-nrxycos 440.0) (make-nrxycos 440.0) (make-nrxycos 440.0 :n 3))
(let ((v1 (with-sound ((make-float-vector 10) :srate 44100)
- (let ((gen (make-nrxycos 1000 :n 10 :r .99)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (outa i (nrxycos gen)))))))
+ (do ((gen (make-nrxycos 1000 :n 10 :r .99))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (outa i (nrxycos gen))))))
(if (not (mus-arrays-equal? v1 (float-vector 1.000 0.602 -0.067 -0.242 -0.007 0.071 -0.087 -0.128 -0.007 0.012)))
(snd-display ";ws nrxycos output: ~A" v1)))
@@ -13777,27 +13630,26 @@ EDITS: 2
(test-gen-equal (make-asymmetric-fm 440.0) (make-asymmetric-fm 440.0) (make-asymmetric-fm 440.0 1.0))
(test-gen-equal (make-asymmetric-fm 440.0) (make-asymmetric-fm 440.0) (make-asymmetric-fm 440.0 0.0 3))
- (let ((gen1 (make-asymmetric-fm 1000 0 1.0 0.1))
- (gen2 (make-oscil 1000 :initial-phase (* 0.5 pi)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 100)))
- (let ((ss (asymmetric-fm gen1 0.0))
- (os (oscil gen2 0.0)))
- (if (fneq ss os)
- (begin
- (snd-display ";asymmetric-fm 1: ~A: os: ~A ss: ~A" i os ss)
- (set! happy #f))))))
+ (do ((gen1 (make-asymmetric-fm 1000 0 1.0 0.1))
+ (gen2 (make-oscil 1000 :initial-phase (* 0.5 pi)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 100)))
+ (let ((ss (asymmetric-fm gen1 0.0))
+ (os (oscil gen2 0.0)))
+ (when (fneq ss os)
+ (snd-display ";asymmetric-fm 1: ~A: os: ~A ss: ~A" i os ss)
+ (set! happy #f))))
(for-each
(lambda (index)
(for-each
(lambda (r)
(let ((peak (float-vector-peak (with-sound (:clipped #f :output (make-float-vector 1000))
- (let ((gen (make-asymmetric-fm 2000.0 :ratio .1 :r r)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (asymmetric-fm gen index))))))))
+ (do ((gen (make-asymmetric-fm 2000.0 :ratio .1 :r r))
+ (i 0 (+ i 1)))
+ ((= i 1000))
+ (outa i (asymmetric-fm gen index)))))))
(if (> (abs (- peak 1.0)) .1)
(snd-display ";asymmetric-fm peak: ~A, index: ~A, r: ~A" peak index r))))
'(-10.0 -1.5 -0.5 0.5 1.0 1.5 10.0)))
@@ -13819,10 +13671,9 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((or (not happy)
(= i 512)))
- (if (> (abs (- (spectr1 i) (spectr2 i))) .02)
- (begin
- (snd-display ";asymmetric-fm 2: ~A: ~A ~A" i (spectr1 i) (spectr2 i))
- (set! happy #f))))))
+ (when (> (abs (- (spectr1 i) (spectr2 i))) .02)
+ (snd-display ";asymmetric-fm 2: ~A: ~A ~A" i (spectr1 i) (spectr2 i))
+ (set! happy #f)))))
(let ((gen (make-asymmetric-fm 40.0 0.0 1.0 0.1))
(gen1 (make-asyfm :frequency 40.0 :ratio .1 :index 2.0))
@@ -13893,14 +13744,14 @@ EDITS: 2
(do ((k 0 (+ k 1)))
((= k i))
(set! (v k) (expt 1.2 (- k))))
- (let ((f (make-fir-filter i v)))
- (do ((k 0 (+ k 1))
- (x 1.0 0.0))
- ((= k i))
- (let ((val (fir-filter f x))
- (exval (expt 1.2 (- k))))
- (if (> (abs (- val exval)) 1e-12)
- (format *stderr* ";for-filter ~D at ~D: ~A ~A~%" i k val exval)))))))
+ (do ((f (make-fir-filter i v))
+ (k 0 (+ k 1))
+ (x 1.0 0.0))
+ ((= k i))
+ (let ((val (fir-filter f x))
+ (exval (expt 1.2 (- k))))
+ (if (> (abs (- val exval)) 1e-12)
+ (format *stderr* ";for-filter ~D at ~D: ~A ~A~%" i k val exval))))))
(let ((f (make-fir-filter 3 (float-vector 1.0 .5 .25)))
(v (make-float-vector 10)))
@@ -13945,16 +13796,15 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.600000 -0.140000 -0.016000 0.019600 0.032240 0.039256 0.045286
- -0.048376 -0.021312 -0.001324 0.006140 0.007033 0.004780 0.000657 -0.005043
- -0.002420 0.000256 0.001217 0.001013 0.000350 -0.000292 -0.000579 -0.000219
- 0.000109 0.000192 0.000115 0.000002 -0.000067 -0.000065)))
- (begin
- (format *stderr* ";i7: ")
- (do ((i 0 (+ i 1)))
- ((= i 30))
- (format *stderr* "~,6f " (v i)))
- (format *stderr* "~%"))))
+ (unless (mus-arrays-equal? v (float-vector 1.000000 -0.600000 -0.140000 -0.016000 0.019600 0.032240 0.039256 0.045286
+ -0.048376 -0.021312 -0.001324 0.006140 0.007033 0.004780 0.000657 -0.005043
+ -0.002420 0.000256 0.001217 0.001013 0.000350 -0.000292 -0.000579 -0.000219
+ 0.000109 0.000192 0.000115 0.000002 -0.000067 -0.000065))
+ (format *stderr* ";i7: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%")))
(let ((x (make-float-vector 3))
(y (make-float-vector 3)))
@@ -13969,13 +13819,12 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 10))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 -0.166667 0.049383 0.041152 -0.049383 0.014632 0.012193 -0.014632)))
- (begin
- (format *stderr* ";g3: ")
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (format *stderr* "~,6f " (v i)))
- (format *stderr* "~%")))))
+ (unless (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 -0.166667 0.049383 0.041152 -0.049383 0.014632 0.012193 -0.014632))
+ (format *stderr* ";g3: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%"))))
(let ((x (make-float-vector 9))
(y (make-float-vector 9)))
@@ -13990,14 +13839,13 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
- 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (begin
- (format *stderr* ";g9: ")
- (do ((i 0 (+ i 1)))
- ((= i 30))
- (format *stderr* "~,6f " (v i)))
- (format *stderr* "~%")))))
+ (unless (mus-arrays-equal? v (float-vector 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
+ 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
+ (format *stderr* ";g9: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%"))))
(let ((x (make-float-vector 9))
(y (make-float-vector 9)))
@@ -14012,16 +13860,15 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 0.115741 0.096451 0.080376 0.066980 0.055816 0.046514
- -0.129033 0.004335 0.003613 0.003011 0.002509 0.002091 0.001742 0.001452 0.001210
- -0.003356 0.000113 0.000094 0.000078 0.000065 0.000054 0.000045 0.000038 0.000031
- -0.000087 0.000003 0.000002)))
- (begin
- (format *stderr* ";g9e: ")
- (do ((i 0 (+ i 1)))
- ((= i 30))
- (format *stderr* "~,6f " (v i)))
- (format *stderr* "~%")))))
+ (unless (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 0.115741 0.096451 0.080376 0.066980 0.055816 0.046514
+ -0.129033 0.004335 0.003613 0.003011 0.002509 0.002091 0.001742 0.001452 0.001210
+ -0.003356 0.000113 0.000094 0.000078 0.000065 0.000054 0.000045 0.000038 0.000031
+ -0.000087 0.000003 0.000002))
+ (format *stderr* ";g9e: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%"))))
(let ((x (make-float-vector 8))
(y (make-float-vector 8)))
@@ -14036,16 +13883,15 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632
- 0.183795 -0.038761 -0.025841 -0.017227 -0.011485 -0.007657 -0.005104 -0.003403
- 0.042745 -0.009015 -0.006010 -0.004007 -0.002671 -0.001781 -0.001187 -0.000791
- 0.009941 -0.002097 -0.001398 -0.000932 -0.000621 -0.000414)))
- (begin
- (format *stderr* ";g-8: ")
- (do ((i 0 (+ i 1)))
- ((= i 30))
- (format *stderr* "~,6f " (v i)))
- (format *stderr* "~%")))))
+ (unless (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632
+ 0.183795 -0.038761 -0.025841 -0.017227 -0.011485 -0.007657 -0.005104 -0.003403
+ 0.042745 -0.009015 -0.006010 -0.004007 -0.002671 -0.001781 -0.001187 -0.000791
+ 0.009941 -0.002097 -0.001398 -0.000932 -0.000621 -0.000414))
+ (format *stderr* ";g-8: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%"))))
(let ((x (make-float-vector 18))
(y (make-float-vector 18)))
@@ -14060,16 +13906,15 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632 -0.009755
- -0.006503 -0.004335 -0.002890 -0.001927 -0.001285 -0.000856 -0.000571 -0.000381 -0.000254
- 0.036715 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237 -0.000824 -0.000550 -0.000366
- -0.000244 -0.000163 -0.000109)))
- (begin
- (format *stderr* ";g-18: ")
- (do ((i 0 (+ i 1)))
- ((= i 30))
- (format *stderr* "~,6f " (v i)))
- (format *stderr* "~%")))))
+ (unless (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632 -0.009755
+ -0.006503 -0.004335 -0.002890 -0.001927 -0.001285 -0.000856 -0.000571 -0.000381 -0.000254
+ 0.036715 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237 -0.000824 -0.000550 -0.000366
+ -0.000244 -0.000163 -0.000109))
+ (format *stderr* ";g-18: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%"))))
(let ((x (make-float-vector 9))
(y (make-float-vector 9)))
@@ -14084,17 +13929,16 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922
- -0.021948 -0.014632 -0.009755 0.161291 -0.032301 -0.021534
- -0.014356 -0.009571 -0.006380 -0.004254 -0.002836 -0.001891
- 0.031259 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237
- -0.000824 -0.000550 -0.000366 0.006058 -0.001213 -0.000809)))
- (begin
- (format *stderr* ";g-9: ")
- (do ((i 0 (+ i 1)))
- ((= i 30))
- (format *stderr* "~,6f " (v i)))
- (format *stderr* "~%")))))
+ (unless (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922
+ -0.021948 -0.014632 -0.009755 0.161291 -0.032301 -0.021534
+ -0.014356 -0.009571 -0.006380 -0.004254 -0.002836 -0.001891
+ 0.031259 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237
+ -0.000824 -0.000550 -0.000366 0.006058 -0.001213 -0.000809))
+ (format *stderr* ";g-9: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%"))))
(let ((gen (make-fir-filter 3 (float-vector .5 .25 .125)))
@@ -14163,19 +14007,18 @@ EDITS: 2
(float-vector-move! xs (- xlen 1) (- xlen 2) #t)
(set! (xs 0) x)
(dot-product coeffs xs xlen))))))
- (let ((fir1 (make-fir-filter 3 (float-vector 1.0 0.4 0.1)))
- (fir2 (make-f-filter (float-vector 1.0 0.4 0.1)))
- (x 1.0)
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 10)))
- (let ((val1 (fir-filter fir1 x))
- (val2 (f-filter fir2 x)))
- (set! x 0.0)
- (if (fneq val1 val2)
- (begin
- (snd-display ";f-filter ~A -> ~A ~A" i val1 val2)
- (set! happy #f)))))))
+ (do ((fir1 (make-fir-filter 3 (float-vector 1.0 0.4 0.1)))
+ (fir2 (make-f-filter (float-vector 1.0 0.4 0.1)))
+ (x 1.0)
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 10)))
+ (let ((val1 (fir-filter fir1 x))
+ (val2 (f-filter fir2 x)))
+ (set! x 0.0)
+ (when (fneq val1 val2)
+ (snd-display ";f-filter ~A -> ~A ~A" i val1 val2)
+ (set! happy #f)))))
(let ((gen (make-spencer-filter)))
(if (not (fir-filter? gen))
@@ -14185,20 +14028,20 @@ EDITS: 2
(if (not (mus-arrays-equal? (mus-xcoeffs gen) (float-vector -0.009 -0.019 -0.016 0.009 0.066 0.144 0.209 0.231 0.209 0.144 0.066 0.009 -0.016 -0.019 -0.009)))
(snd-display ";make-spencer-filter coeffs: ~A" (mus-xcoeffs gen))))))
- (let ((flt (make-savitzky-golay-filter 5 2)))
- (if (not (mus-arrays-equal? (mus-xcoeffs flt) (float-vector -0.086 0.343 0.486 0.343 -0.086)))
- (snd-display ";sg 5 2: ~A" (mus-xcoeffs flt))))
- (let ((flt (make-savitzky-golay-filter 11 2)))
- (if (not (mus-arrays-equal? (mus-xcoeffs flt) (float-vector -0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084)))
- (snd-display ";sg 11 2: ~A" (mus-xcoeffs flt))))
- (let ((flt (make-savitzky-golay-filter 11 4)))
- (if (not (mus-arrays-equal? (mus-xcoeffs flt) (float-vector 0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042)))
- (snd-display ";sg 11 4: ~A" (mus-xcoeffs flt))))
- (let ((flt (make-savitzky-golay-filter 25 2)))
- (if (not (mus-arrays-equal? (mus-xcoeffs flt) (float-vector -0.049 -0.027 -0.006 0.012 0.028 0.043 0.055 0.066 0.075 0.082 0.086
- 0.089 0.090 0.089 0.086 0.082 0.075 0.066 0.055 0.043
- 0.028 0.012 -0.006 -0.027 -0.049)))
- (snd-display ";sg 25 2: ~A" (mus-xcoeffs flt))))
+ (let ((flt (mus-xcoeffs (make-savitzky-golay-filter 5 2))))
+ (if (not (mus-arrays-equal? flt (float-vector -0.086 0.343 0.486 0.343 -0.086)))
+ (snd-display ";sg 5 2: ~A" flt)))
+ (let ((flt (mus-xcoeffs (make-savitzky-golay-filter 11 2))))
+ (if (not (mus-arrays-equal? flt (float-vector -0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084)))
+ (snd-display ";sg 11 2: ~A" flt)))
+ (let ((flt (mus-xcoeffs (make-savitzky-golay-filter 11 4))))
+ (if (not (mus-arrays-equal? flt (float-vector 0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042)))
+ (snd-display ";sg 11 4: ~A" flt)))
+ (let ((flt (mus-xcoeffs (make-savitzky-golay-filter 25 2))))
+ (if (not (mus-arrays-equal? flt (float-vector -0.049 -0.027 -0.006 0.012 0.028 0.043 0.055 0.066 0.075 0.082 0.086
+ 0.089 0.090 0.089 0.086 0.082 0.075 0.066 0.055 0.043
+ 0.028 0.012 -0.006 -0.027 -0.049)))
+ (snd-display ";sg 25 2: ~A" flt)))
(let ((gen (make-iir-filter 3 (float-vector .5 .25 .125)))
(v0 (make-float-vector 10)))
@@ -14289,8 +14132,8 @@ EDITS: 2
(let ((f2 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f2 1.0) f2)
(let ((f3 (make-filter 3 (float-vector .5 .5 .125) (float-vector .5 .25 .0625)))) (filter f3 1.0) f3))
- (let ((fr (make-fir-filter 6 (float-vector 0 1 2 3 4 5))))
- (if (not (= (mus-length fr) 6)) (snd-display ";filter-length: ~A" (mus-length fr))))
+ (let ((fr (mus-length (make-fir-filter 6 (float-vector 0 1 2 3 4 5)))))
+ (if (not (= fr 6)) (snd-display ";filter-length: ~A" fr)))
(let ((val (cascade->canonical (list (float-vector 1.0 0.0 0.0) (float-vector 1.0 0.5 0.25)))))
(if (not (mus-arrays-equal? val (float-vector 1.000 0.500 0.250 0.000 0.000)))
@@ -14632,14 +14475,14 @@ EDITS: 2
(test-gen-equal (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0 1.0 1.0))
(test-gen-equal (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0 0.5))
- (let ((gen1 (make-sawtooth-wave 100.0))
- (gen2 (make-sawtooth-wave -100.0))
- (mx 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! mx (max mx (abs (+ (gen1) (gen2))))))
- (if (fneq mx 0.0)
- (snd-display ";sawtooth +-: ~A" mx)))
+ (do ((gen1 (make-sawtooth-wave 100.0))
+ (gen2 (make-sawtooth-wave -100.0))
+ (mx 0.0)
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (if (fneq mx 0.0)
+ (snd-display ";sawtooth +-: ~A" mx)))
+ (set! mx (max mx (abs (+ (gen1) (gen2))))))
(let ((gen (make-square-wave 440.0)))
(print-and-check gen
@@ -14695,22 +14538,22 @@ EDITS: 2
(if (not (mus-arrays-equal? v0 v1)) (snd-display ";map triangle-wave: ~A ~A" v0 v1)))
(if (not (triangle-wave? gen)) (snd-display ";~A not triangle-wave?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display ";triangle-wave phase: ~F?" (mus-phase gen)))
- (let ((gen1 (make-triangle-wave 440.0 1.0 pi)))
- (if (fneq (mus-phase gen1) pi) (snd-display ";init triangle-wave phase: ~F?" (mus-phase gen1))))
+ (let ((gen1 (mus-phase (make-triangle-wave 440.0 1.0 pi))))
+ (if (fneq gen1 pi) (snd-display ";init triangle-wave phase: ~F?" gen1)))
(if (fneq (mus-frequency gen) 440.0) (snd-display ";triangle-wave frequency: ~F?" (mus-frequency gen)))
(if (fneq (mus-scaler gen) 1.0) (snd-display ";triangle-wave scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display ";set! triangle-wave scaler: ~F?" (mus-scaler gen)))
(if (or (fneq (v0 1) 0.080) (fneq (v0 8) 0.639)) (snd-display ";triangle-wave output: ~A" v0)))
- (let ((gen1 (make-triangle-wave 100.0))
- (gen2 (make-triangle-wave -100.0))
- (mx 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! mx (max mx (abs (+ (gen1) (gen2))))))
- (if (fneq mx 0.0)
- (snd-display ";triangle +-: ~A" mx)))
+ (do ((gen1 (make-triangle-wave 100.0))
+ (gen2 (make-triangle-wave -100.0))
+ (mx 0.0)
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (if (fneq mx 0.0)
+ (snd-display ";triangle +-: ~A" mx)))
+ (set! mx (max mx (abs (+ (gen1) (gen2))))))
(test-gen-equal (make-triangle-wave 440.0) (make-triangle-wave 440.0) (make-triangle-wave 120.0))
(test-gen-equal (make-triangle-wave 440.0) (make-triangle-wave 440.0) (make-triangle-wave 440.0 1.0 1.0))
@@ -14996,18 +14839,18 @@ EDITS: 2
(let ((window (car window-data))
(func (caddr window-data))
(name (cadr window-data)))
- (let ((v1 (make-fft-window window 16))
- (v2 (make-float-vector 16))
- (incr (/ (* 2 pi) 16.0)))
- (do ((i 0 (+ i 1))
- (j 15 (- j 1))
- (ang 0.0 (+ ang incr)))
- ((> i 8)) ; yikes -- even size + smallness = questionable code...
- (let ((val (func ang)))
- (set! (v2 i) val)
- (set! (v2 j) val)))
- (if (not (mus-arrays-equal? v1 v2))
- (snd-display ";~A by hand:~%; mus: ~A~%; loc: ~A" name v1 v2)))))
+ (do ((v1 (make-fft-window window 16))
+ (v2 (make-float-vector 16))
+ (incr (/ (* 2 pi) 16.0))
+ (i 0 (+ i 1))
+ (j 15 (- j 1))
+ (ang 0.0 (+ ang incr)))
+ ((> i 8) ; yikes -- even size + smallness = questionable code...
+ (if (not (mus-arrays-equal? v1 v2))
+ (snd-display ";~A by hand:~%; mus: ~A~%; loc: ~A" name v1 v2)))
+ (let ((val (func ang)))
+ (set! (v2 i) val)
+ (set! (v2 j) val)))))
(list
(list hann-window "hann" (lambda (ang)
@@ -15180,31 +15023,28 @@ EDITS: 2
(lambda (ang)
(let ((result (- expsum 1.0)))
(set! expsum (* expsum (+ 1.0 (/ (log 2) 8.0))))
- result))))
- ))
-
- (let ((win (make-fft-window bartlett-hann-window 32))
- (unhappy #f))
- (do ((i 0 (+ i 1)))
- ((or unhappy (= i 32)))
- (let ((val (+ 0.62 (* -0.48 (abs (- (/ i 31) 0.5))) (* 0.38 (cos (* 2 pi (- (/ i 31) 0.5)))))))
- (if (> (abs (- val (win i))) .03)
- (begin
- (set! unhappy #t)
- (snd-display ";bartlett-hann at ~D: ~A ~A" i val (win i)))))))
- (let ((win (make-fft-window flat-top-window 32))
- (unhappy #f))
- (do ((i 0 (+ i 1)))
- ((or unhappy (= i 32)))
- (let ((val (+ 0.2156
- (* -0.4160 (cos (/ (* 2 pi i) 31)))
- (* 0.2781 (cos (/ (* 4 pi i) 31)))
- (* -0.0836 (cos (/ (* 6 pi i) 31)))
- (* 0.0069 (cos (/ (* 8 pi i) 31))))))
- (if (> (abs (- val (win i))) .1) ; error is much less, of course, in a bigger window
- (begin
- (set! unhappy #t)
- (snd-display ";flat-top at ~D: ~A ~A" i val (win i)))))))
+ result))))))
+
+ (do ((win (make-fft-window bartlett-hann-window 32))
+ (unhappy #f)
+ (i 0 (+ i 1)))
+ ((or unhappy (= i 32)))
+ (let ((val (+ 0.62 (* -0.48 (abs (- (/ i 31) 0.5))) (* 0.38 (cos (* 2 pi (- (/ i 31) 0.5)))))))
+ (when (> (abs (- val (win i))) .03)
+ (set! unhappy #t)
+ (snd-display ";bartlett-hann at ~D: ~A ~A" i val (win i)))))
+ (do ((win (make-fft-window flat-top-window 32))
+ (unhappy #f)
+ (i 0 (+ i 1)))
+ ((or unhappy (= i 32)))
+ (let ((val (+ 0.2156
+ (* -0.4160 (cos (/ (* 2 pi i) 31)))
+ (* 0.2781 (cos (/ (* 4 pi i) 31)))
+ (* -0.0836 (cos (/ (* 6 pi i) 31)))
+ (* 0.0069 (cos (/ (* 8 pi i) 31))))))
+ (when (> (abs (- val (win i))) .1) ; error is much less, of course, in a bigger window
+ (set! unhappy #t)
+ (snd-display ";flat-top at ~D: ~A ~A" i val (win i)))))
(catch #t
(lambda ()
(let ((gen (make-fft-window samaraki-window 16)))
@@ -15341,13 +15181,13 @@ EDITS: 2
((= i 5))
(let ((val (env gen)))
(if (fneq val (- (/ i 5.0) 1.0)) (snd-display ";neg env: ~D ~A" (+ i 5) val)))))
- (let ((gen (make-env '(0 0 1 -1 2 0) :length 11 :base 0.5))
- (v (float-vector 0.0 -0.14869 -0.31950 -0.51571 -0.74110 -1.0 -0.74110 -0.51571 -0.31950 -0.14869)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (let ((val (env gen)))
- (if (fneq val (v i)) (snd-display ";neg exp env: ~D ~A" i val))))
- (mus-apply gen)))
+ (do ((gen (make-env '(0 0 1 -1 2 0) :length 11 :base 0.5))
+ (v (float-vector 0.0 -0.14869 -0.31950 -0.51571 -0.74110 -1.0 -0.74110 -0.51571 -0.31950 -0.14869))
+ (i 0 (+ i 1)))
+ ((= i 10)
+ (mus-apply gen))
+ (let ((val (env gen)))
+ (if (fneq val (v i)) (snd-display ";neg exp env: ~D ~A" i val)))))
(let ((v (make-float-vector 10)))
(let ((e (make-env '(0 0 1 1) :length 10)))
@@ -15356,15 +15196,15 @@ EDITS: 2
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display ";simple ramp: ~A" v)))
- (let* ((v (make-float-vector 10))
- (e (make-env '(0 0 1 1) :base 0 :length 8)))
+ (let ((v (make-float-vector 10))
+ (e (make-env '(0 0 1 1) :base 0 :length 8)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
(snd-display ";simple ramp, base 0: ~A" v)))
- (let* ((v (make-float-vector 10))
- (e (make-env '(0 0 1 1 2 .5) :base 0 :length 8)))
+ (let ((v (make-float-vector 10))
+ (e (make-env '(0 0 1 1 2 .5) :base 0 :length 8)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
@@ -15420,15 +15260,15 @@ EDITS: 2
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display ";simple ramp: ~A" v)))
- (let* ((v (make-float-vector 10))
- (e (make-env (float-vector 0 0 1 1) :base 0 :length 8)))
+ (let ((v (make-float-vector 10))
+ (e (make-env (float-vector 0 0 1 1) :base 0 :length 8)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
(snd-display ";simple ramp, base 0: ~A" v)))
- (let* ((v (make-float-vector 10))
- (e (make-env (float-vector 0 0 1 1 2 .5) :base 0 :length 8)))
+ (let ((v (make-float-vector 10))
+ (e (make-env (float-vector 0 0 1 1 2 .5) :base 0 :length 8)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
@@ -15460,45 +15300,45 @@ EDITS: 2
(snd-display ";simple pyr -.5: ~A" v))))
(let ((v (make-float-vector 10)))
- (let ((e (make-env (vector 0 0 1 1) :length 10)))
+ (let ((e (make-env #(0 0 1 1) :length 10)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display ";simple ramp: ~A" v)))
- (let* ((v (make-float-vector 10))
- (e (make-env (vector 0 0 1 1) :base 0 :length 8)))
+ (let ((v (make-float-vector 10))
+ (e (make-env #(0 0 1 1) :base 0 :length 8)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
(snd-display ";simple ramp, base 0: ~A" v)))
- (let* ((v (make-float-vector 10))
- (e (make-env (vector 0 0 1 1 2 .5) :base 0 :length 8)))
+ (let ((v (make-float-vector 10))
+ (e (make-env #(0 0 1 1 2 .5) :base 0 :length 8)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
(snd-display ";two-step, base 0: ~A" v)))
- (let ((e (make-env (vector 0 1 1 0) :length 10)))
+ (let ((e (make-env #(0 1 1 0) :length 10)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
(snd-display ";simple ramp down: ~A" v)))
- (let ((e (make-env (vector 0 0 1 1 2 0) :length 10)))
+ (let ((e (make-env #(0 0 1 1 2 0) :length 10)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display ";simple pyr: ~A" v)))
- (let ((e (make-env (vector 0 0 1 1 2 -.5) :length 10)))
+ (let ((e (make-env #(0 0 1 1 2 -.5) :length 10)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
(if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display ";simple pyr -.5: ~A" v)))
- (let ((e (make-env (vector 0 0 1 1 2 -.5) :length 10)))
+ (let ((e (make-env #(0 0 1 1 2 -.5) :length 10)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
@@ -15515,34 +15355,34 @@ EDITS: 2
((= i 10))
(let ((val (env e)))
(if (fneq val (* i .111111)) (snd-display ";ramp env over 10: ~A at ~A" val i)))))
- (let ((e (make-env '(0 0 .5 .5 1 1) :base 32 :length 10))
- (v (float-vector 0.0 0.0243 0.0667 0.1412 0.2716 0.5000 0.5958 0.7090 0.8425 1.0)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.11111)))
- ((= i 10))
- (let ((val (env-interp x e)))
- (if (fneq val (v i)) (snd-display ";(0 .5 1) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
- (let ((e (make-env '(0 -1.0 1 1) :base 32 :length 10))
- (v (float-vector -1.0 -0.9697 -0.9252 -0.8597 -0.7635 -0.6221 -0.4142 -0.1088 0.34017 1.0)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.11111)))
- ((= i 10))
- (let ((val (env-interp x e)))
- (if (fneq val (v i)) (snd-display ";(-1 1) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
- (let ((e (make-env '(0 -1.0 .5 .5 1 0) :base 32 :length 10))
- (v (float-vector -1.0 -0.952 -0.855 -0.661 -0.274 0.5 0.356 0.226 0.107 0.0)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.11111)))
- ((= i 10))
- (let ((val (env-interp x e)))
- (if (fneq val (v i)) (snd-display ";(-1 .5 0) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
- (let ((e (make-env '(0 0.0 .5 .5 1 -1.0) :base 32 :length 10))
- (v (float-vector 0.0 0.085 0.177 0.276 0.384 0.5 -0.397 -0.775 -0.933 -1.0)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.11111)))
- ((= i 10))
- (let ((val (env-interp x e)))
- (if (fneq val (v i)) (snd-display ";(0 .5 -1) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
+ (do ((e (make-env '(0 0 .5 .5 1 1) :base 32 :length 10))
+ (v (float-vector 0.0 0.0243 0.0667 0.1412 0.2716 0.5000 0.5958 0.7090 0.8425 1.0))
+ (i 0 (+ i 1))
+ (x 0.0 (+ x 0.11111)))
+ ((= i 10))
+ (let ((val (env-interp x e)))
+ (if (fneq val (v i)) (snd-display ";(0 .5 1) env-interp over 10: ~A at ~A (~A)" val i (v i)))))
+ (do ((e (make-env '(0 -1.0 1 1) :base 32 :length 10))
+ (v (float-vector -1.0 -0.9697 -0.9252 -0.8597 -0.7635 -0.6221 -0.4142 -0.1088 0.34017 1.0))
+ (i 0 (+ i 1))
+ (x 0.0 (+ x 0.11111)))
+ ((= i 10))
+ (let ((val (env-interp x e)))
+ (if (fneq val (v i)) (snd-display ";(-1 1) env-interp over 10: ~A at ~A (~A)" val i (v i)))))
+ (do ((e (make-env '(0 -1.0 .5 .5 1 0) :base 32 :length 10))
+ (v (float-vector -1.0 -0.952 -0.855 -0.661 -0.274 0.5 0.356 0.226 0.107 0.0))
+ (i 0 (+ i 1))
+ (x 0.0 (+ x 0.11111)))
+ ((= i 10))
+ (let ((val (env-interp x e)))
+ (if (fneq val (v i)) (snd-display ";(-1 .5 0) env-interp over 10: ~A at ~A (~A)" val i (v i)))))
+ (do ((e (make-env '(0 0.0 .5 .5 1 -1.0) :base 32 :length 10))
+ (v (float-vector 0.0 0.085 0.177 0.276 0.384 0.5 -0.397 -0.775 -0.933 -1.0))
+ (i 0 (+ i 1))
+ (x 0.0 (+ x 0.11111)))
+ ((= i 10))
+ (let ((val (env-interp x e)))
+ (if (fneq val (v i)) (snd-display ";(0 .5 -1) env-interp over 10: ~A at ~A (~A)" val i (v i)))))
(let ((e (make-env '(0 0 1 1) :length 10 :base 4.0)))
(if (fneq (env-interp 1.0 e) 1.0) (snd-display ";env-interp 0011 4 at 1: ~A" (env-interp 1.0 e)))
(if (fneq (env-interp 0.0 e) 0.0) (snd-display ";env-interp 0011 4 at 0: ~A" (env-interp 0.0 e)))
@@ -15554,7 +15394,7 @@ EDITS: 2
(let ((val (let ((e (make-env '(0 0 1 1) :length 10 :offset 2.0))) (set! (mus-offset e) 3.0) (mus-offset e))))
(if (fneq val 3.0) (snd-display ";set mus-offset env: ~A" val)))
-
+
(let ((e (make-env '(0 0 1 1 2 0) :length 10))
(v (make-float-vector 10)))
(do ((i 0 (+ i 1)))
@@ -15593,51 +15433,51 @@ EDITS: 2
(if (fneq (mus-scaler e) 2.0) (snd-display ";e set off 3 scl: ~A" (mus-scaler e)))
(if (fneq (mus-offset e) 1.0) (snd-display ";e set off 3 off: ~A" (mus-offset e))))
- (let ((e (make-env (float-vector 0 0 1 1 2 0) :length 10))
- (v (make-float-vector 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v i) (env e)))
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";e from float-vector: ~A" v)))
+ (do ((e (make-env (float-vector 0 0 1 1 2 0) :length 10))
+ (v (make-float-vector 10))
+ (i 0 (+ i 1)))
+ ((= i 10)
+ (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display ";e from float-vector: ~A" v)))
+ (set! (v i) (env e)))
- (let ((e1 (make-env '(0 0 1 1) :base 32.0 :length 11))
- (v (float-vector 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.00)))
- (do ((i 0 (+ i 1)))
- ((> i 10))
- (let ((val (env e1)))
- (if (fneq val (v i))
- (snd-display ";exp env direct (32.0): ~A ~A" val (v i))))))
+ (do ((e1 (make-env '(0 0 1 1) :base 32.0 :length 11))
+ (v (float-vector 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.00))
+ (i 0 (+ i 1)))
+ ((> i 10))
+ (let ((val (env e1)))
+ (if (fneq val (v i))
+ (snd-display ";exp env direct (32.0): ~A ~A" val (v i)))))
- (let ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
- (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
- (do ((i 0 (+ i 1)))
- ((> i 10))
- (let ((val (env e1)))
- (if (fneq val (v i))
- (snd-display ";exp env direct (32.0) offset: ~A ~A" val (v i))))))
- (let ((e1 (make-env '((0 1) (1 2)) :base 32.0 :length 11))
- (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
- (do ((i 0 (+ i 1)))
- ((> i 10))
- (let ((val (env e1)))
- (if (fneq val (v i))
- (snd-display ";exp env direct (32.0) offset embedded: ~A ~A" val (v i))))))
- (let ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
- (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
- (do ((i 0 (+ i 1)))
- ((> i 10))
- (let ((val (env e1)))
- (if (fneq val (v i))
- (snd-display ";exp env direct (32.0) offset (and dur): ~A ~A" val (v i))))))
+ (do ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
+ (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
+ (i 0 (+ i 1)))
+ ((> i 10))
+ (let ((val (env e1)))
+ (if (fneq val (v i))
+ (snd-display ";exp env direct (32.0) offset: ~A ~A" val (v i)))))
+ (do ((e1 (make-env '((0 1) (1 2)) :base 32.0 :length 11))
+ (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
+ (i 0 (+ i 1)))
+ ((> i 10))
+ (let ((val (env e1)))
+ (if (fneq val (v i))
+ (snd-display ";exp env direct (32.0) offset embedded: ~A ~A" val (v i)))))
+ (do ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
+ (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
+ (i 0 (+ i 1)))
+ ((> i 10))
+ (let ((val (env e1)))
+ (if (fneq val (v i))
+ (snd-display ";exp env direct (32.0) offset (and dur): ~A ~A" val (v i)))))
- (let ((e1 (make-env '(0 0 1 1) :base 0.032 :length 11))
- (v (float-vector 0.000 0.301 0.514 0.665 0.772 0.848 0.902 0.940 0.967 0.986 1.0)))
- (do ((i 0 (+ i 1)))
- ((> i 10))
- (let ((val (env e1)))
- (if (fneq val (v i))
- (snd-display ";exp env direct (.032): ~A ~A" val (v i))))))
+ (do ((e1 (make-env '(0 0 1 1) :base 0.032 :length 11))
+ (v (float-vector 0.000 0.301 0.514 0.665 0.772 0.848 0.902 0.940 0.967 0.986 1.0))
+ (i 0 (+ i 1)))
+ ((> i 10))
+ (let ((val (env e1)))
+ (if (fneq val (v i))
+ (snd-display ";exp env direct (.032): ~A ~A" val (v i)))))
(let ((e1 (make-env '(0 0 1 1) :base .03125 :length 11))
(e2 (make-env '(0 0 1 1 2 0) :base 32.0 :length 11))
@@ -15678,7 +15518,7 @@ EDITS: 2
(set! (mus-location gen) 6)
(let ((val (env gen)))
(if (fneq val 0.8) (snd-display ";set! mus-location 6 -> ~A (0.8)?" val)))))
-
+
(let ((gen (make-env '(0 0 1 1) :base .032 :length 12)))
(set! (mus-location gen) 5)
(let ((val (env gen)))
@@ -15758,22 +15598,22 @@ EDITS: 2
;; assume sine-env square-env blackman4-env and multi-exp-env are available from generators.scm (8)
(let ((val1 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (sine-env e))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (sine-env e)))))
(val2 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (sine-env e))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (sine-env e)))))
(val3 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (sine-env-1 e)))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (sine-env-1 e))))))
(if (not (mus-arrays-equal? val1 val2))
(snd-display ";sine-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (mus-arrays-equal? val1 val3))
@@ -15781,90 +15621,90 @@ EDITS: 2
(let ((val1 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (square-env e))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (square-env e)))))
(val2 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (square-env e))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (square-env e)))))
(val3 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (square-env-1 e)))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (square-env-1 e))))))
(if (not (mus-arrays-equal? val1 val2))
(snd-display ";square-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (mus-arrays-equal? val1 val3))
(snd-display ";square-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
(let ((val1 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (blackman4-env e))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (blackman4-env e)))))
(val3 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (blackman4-env-1 e)))))))
+ (do ((e (make-env env-any-env :length 20))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (blackman4-env-1 e))))))
(if (not (mus-arrays-equal? val1 val3))
(snd-display ";blackman4-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
(let ((val1 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20))
- (bases (float-vector 32.0 0.3 1.5)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (multi-expt-env e bases))))))
+ (do ((e (make-env env-any-env :length 20))
+ (bases (float-vector 32.0 0.3 1.5))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (multi-expt-env e bases)))))
(val2 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20))
- (bases (float-vector 32.0 0.3 1.5)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (multi-expt-env e bases))))))
+ (do ((e (make-env env-any-env :length 20))
+ (bases (float-vector 32.0 0.3 1.5))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (multi-expt-env e bases)))))
(val3 (with-sound ((make-float-vector 20))
- (let ((e (make-env env-any-env :length 20))
- (bases (float-vector 32.0 0.3 1.5)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (outa i (multi-expt-env-1 e bases)))))))
+ (do ((e (make-env env-any-env :length 20))
+ (bases (float-vector 32.0 0.3 1.5))
+ (i 0 (+ i 1)))
+ ((= i 20))
+ (outa i (multi-expt-env-1 e bases))))))
(if (not (mus-arrays-equal? val1 val2))
(snd-display ";multi-expt-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (mus-arrays-equal? val1 val3))
(snd-display ";multi-expt-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
(let ((val1 (with-sound ((make-float-vector 220))
- (let ((e1 (make-env env-any-env :length 220))
- (e2 (make-env env-any-env :length 220)))
- (do ((i 0 (+ i 1)))
- ((= i 220))
- (outa i (env-any e1
- (lambda (y1)
- (* y1 (env-any e2
- (lambda (y2)
- y2))))))))))
+ (do ((e1 (make-env env-any-env :length 220))
+ (e2 (make-env env-any-env :length 220))
+ (i 0 (+ i 1)))
+ ((= i 220))
+ (outa i (env-any e1
+ (lambda (y1)
+ (* y1 (env-any e2
+ (lambda (y2)
+ y2)))))))))
(val2 (with-sound ((make-float-vector 220))
- (let ((e1 (make-env env-any-env :length 220))
- (e2 (make-env env-any-env :length 220)))
- (do ((i 0 (+ i 1)))
- ((= i 220))
- (outa i (env-any e1 ; try it with and without "declare"
- (lambda (y1)
- (* y1 (env-any e2
- (lambda (y2)
- y2)))))))))))
+ (do ((e1 (make-env env-any-env :length 220))
+ (e2 (make-env env-any-env :length 220))
+ (i 0 (+ i 1)))
+ ((= i 220))
+ (outa i (env-any e1 ; try it with and without "declare"
+ (lambda (y1)
+ (* y1 (env-any e2
+ (lambda (y2)
+ y2))))))))))
(if (not (mus-arrays-equal? val1 val2))
(snd-display ";env-any recursive: ~%; ~A~%; ~A" val1 val2))))
-
+
(let ((ind (new-sound :size 20)))
(select-sound ind)
(map-channel (lambda (y) 1.0))
@@ -15914,13 +15754,13 @@ EDITS: 2
"table-lookup"
"table-lookup freq: 440.000Hz, phase: 0.000, length: 512, interp: linear")
(if (not (= (mus-length gen) 512)) (snd-display ";table-lookup length: ~A?" (mus-length gen)))
- (let ((gen3 (make-table-lookup)))
- (if (not (= (mus-length gen3) 512)) (snd-display ";default table-lookup length: ~A?" (mus-length gen3))))
- (let ((gen1 (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1) (make-float-vector 512)))))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v0 i) (table-lookup gen 0.0))
- (set! (v1 i) (mus-apply gen1 0.0))))
+ (let ((gen3 (mus-length (make-table-lookup))))
+ (if (not (= gen3 512)) (snd-display ";default table-lookup length: ~A?" gen3)))
+ (do ((gen1 (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1) (make-float-vector 512))))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v0 i) (table-lookup gen 0.0))
+ (set! (v1 i) (mus-apply gen1 0.0)))
(let ((v2 (make-float-vector 10)))
(let ((gen4 (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1)))))
(fill-float-vector v2 (if (table-lookup? gen4) (table-lookup gen4 0.0) -1.0))
@@ -15941,7 +15781,7 @@ EDITS: 2
((= i 10))
(if (fneq (v0 i) (v1 i))
(snd-display ";mus-apply table-lookup at ~D: ~A ~A?" i (v0 i) (v1 i)))))
-
+
(let ((gen (make-table-lookup 440.0 :wave (phase-partials->wave (list 1 1 0 2 1 (* pi .5)))))
(v0 (make-float-vector 10)))
(do ((i 0 (+ i 1)))
@@ -15961,31 +15801,31 @@ EDITS: 2
(let ((tag (catch #t (lambda () (phase-partials->wave (list))) (lambda args (car args)))))
(if (not (eq? tag 'no-data)) (snd-display ";nil list to phase-partials->wave: ~A" tag)))
- (let ((vals (phase-partials->wave '(1 1 0) (make-float-vector 16) #f)))
- (do ((i 0 (+ i 1)))
- ((= i 16))
- (if (fneq (vals i) (sin (/ (* 2 pi i) 16)))
- (snd-display ";phase-partials->wave 1 1 0 at ~D: ~A ~A" i (vals i) (sin (/ (* 2 pi i) 16))))))
+ (do ((vals (phase-partials->wave '(1 1 0) (make-float-vector 16) #f))
+ (i 0 (+ i 1)))
+ ((= i 16))
+ (if (fneq (vals i) (sin (/ (* 2 pi i) 16)))
+ (snd-display ";phase-partials->wave 1 1 0 at ~D: ~A ~A" i (vals i) (sin (/ (* 2 pi i) 16)))))
- (let ((vals (phase-partials->wave (list 1 1 (* .25 pi)) (make-float-vector 16) #f)))
- (do ((i 0 (+ i 1)))
- ((= i 16))
- (if (fneq (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))
- (snd-display ";phase-partials->wave 1 1 .25 at ~D: ~A ~A" i (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16)))))))
+ (do ((vals (phase-partials->wave (list 1 1 (* .25 pi)) (make-float-vector 16) #f))
+ (i 0 (+ i 1)))
+ ((= i 16))
+ (if (fneq (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))
+ (snd-display ";phase-partials->wave 1 1 .25 at ~D: ~A ~A" i (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))))
- (let ((vals (phase-partials->wave (float-vector 1 1 0 2 1 0) (make-float-vector 16) #f)))
- (do ((i 0 (+ i 1)))
- ((= i 16))
- (if (fneq (vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16))))
- (snd-display ";phase-partials->wave 1 1 0 2 1 0 at ~D: ~A ~A" i (vals i)
- (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16)))))))
+ (do ((vals (phase-partials->wave (float-vector 1 1 0 2 1 0) (make-float-vector 16) #f))
+ (i 0 (+ i 1)))
+ ((= i 16))
+ (if (fneq (vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16))))
+ (snd-display ";phase-partials->wave 1 1 0 2 1 0 at ~D: ~A ~A" i (vals i)
+ (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16))))))
- (let ((vals (phase-partials->wave (float-vector 1 1 0 2 1 (* .5 pi)) (make-float-vector 16) #f)))
- (do ((i 0 (+ i 1)))
- ((= i 16))
- (if (fneq (vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16)))))
- (snd-display ";phase-partials->wave 1 1 0 2 1 .5 at ~D: ~A ~A" i (vals i)
- (+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16))))))))
+ (do ((vals (phase-partials->wave (float-vector 1 1 0 2 1 (* .5 pi)) (make-float-vector 16) #f))
+ (i 0 (+ i 1)))
+ ((= i 16))
+ (if (fneq (vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16)))))
+ (snd-display ";phase-partials->wave 1 1 0 2 1 .5 at ~D: ~A ~A" i (vals i)
+ (+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16)))))))
(test-gen-equal (make-table-lookup 440.0 :wave (partials->wave (float-vector 1 1 2 1)))
(make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1)))
@@ -15999,54 +15839,54 @@ EDITS: 2
(let ((tag (catch #t (lambda () (partials->wave '(.5 .3 .2))) (lambda args (car args)))))
(if (not (eq? tag 'bad-type)) (snd-display ";odd length arg to partials->wave: ~A" tag)))
- (let ((hi (make-table-lookup :size 256)))
- (if (not (= (mus-length hi) 256)) (snd-display ";table-lookup set length: ~A?" (mus-length hi))))
+ (let ((hi (mus-length (make-table-lookup :size 256))))
+ (if (not (= hi 256)) (snd-display ";table-lookup set length: ~A?" hi)))
(let ((tag (catch #t (lambda () (make-table-lookup :size 0)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range)) (snd-display ";table-lookup size 0: ~A" tag)))
- (let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 1))))
- (incr (/ (* 2 pi 440.0) 22050.0)))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((= i 1100))
- (let ((val1 (sin a))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (snd-display ";table lookup (1 1): ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 1))))
+ (incr (/ (* 2 pi 440.0) 22050.0))
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 1100))
+ (let ((val1 (sin a))
+ (val2 (gen 0.0)))
+ (if (fneq val1 val2)
+ (snd-display ";table lookup (1 1): ~A: ~A ~A" i val1 val2))))
- (let ((gen (make-table-lookup 4.0 :wave (partials->wave '(1 1))))
- (incr (/ (* 2 pi 4.0) 22050.0)))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((= i 1100))
- (let ((val1 (sin a))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (snd-display ";table lookup (1 1) 4: ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-table-lookup 4.0 :wave (partials->wave '(1 1))))
+ (incr (/ (* 2 pi 4.0) 22050.0))
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 1100))
+ (let ((val1 (sin a))
+ (val2 (gen 0.0)))
+ (if (fneq val1 val2)
+ (snd-display ";table lookup (1 1) 4: ~A: ~A ~A" i val1 val2))))
- (let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 .75 3 .25))))
- (incr (/ (* 2 pi 440.0) 22050.0)))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((= i 1100))
- (let ((val1 (+ (* .75 (sin a)) (* .25 (sin (* 3 a)))))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (snd-display ";table lookup (1 .75 3 .25): ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 .75 3 .25))))
+ (incr (/ (* 2 pi 440.0) 22050.0))
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 1100))
+ (let ((val1 (+ (* .75 (sin a)) (* .25 (sin (* 3 a)))))
+ (val2 (gen 0.0)))
+ (if (fneq val1 val2)
+ (snd-display ";table lookup (1 .75 3 .25): ~A: ~A ~A" i val1 val2))))
- (let ((gen (make-table-lookup 0.0 :wave (partials->wave '(1 1))))
- (gen1 (make-table-lookup 40.0 :wave (partials->wave '(1 1))))
- (incr (/ (* 2 pi 40.0) 22050.0))
- (a1 0.0))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((= i 100))
- (let ((fm (sin a))
- (val1 (sin a1))
- (val2 (table-lookup gen (table-lookup gen1 0.0))))
- (set! a1 (+ a1 fm))
- (if (fneq val1 val2)
- (snd-display ";lookup/lookup fm: ~A: ~A ~A" i val1 val2)))))
+ (do ((gen (make-table-lookup 0.0 :wave (partials->wave '(1 1))))
+ (gen1 (make-table-lookup 40.0 :wave (partials->wave '(1 1))))
+ (incr (/ (* 2 pi 40.0) 22050.0))
+ (a1 0.0)
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 100))
+ (let ((fm (sin a))
+ (val1 (sin a1))
+ (val2 (table-lookup gen (table-lookup gen1 0.0))))
+ (set! a1 (+ a1 fm))
+ (if (fneq val1 val2)
+ (snd-display ";lookup/lookup fm: ~A: ~A ~A" i val1 val2))))
(for-each
(lambda (args)
@@ -16074,25 +15914,25 @@ EDITS: 2
(let ((size 1000))
(define (test-tbl beg end freq amp mc-ratio index)
- (let* ((sine (let ((tbl-size 1024))
- (do ((v (make-float-vector tbl-size))
- (xp (/ (* 2 pi) tbl-size))
- (i 0 (+ i 1))
- (x 0.0 (+ x xp)))
- ((= i tbl-size) v)
- (set! (v i) (sin x)))))
- (fm (make-table-lookup (* mc-ratio freq) :wave sine))
- (carrier (make-table-lookup freq :wave sine)))
- (do ((i beg (+ i 1)))
+ (let ((sine (let ((tbl-size 1024))
+ (do ((v (make-float-vector tbl-size))
+ (xp (/ (* 2 pi) tbl-size))
+ (i 0 (+ i 1))
+ (x 0.0 (+ x xp)))
+ ((= i tbl-size) v)
+ (set! (v i) (sin x))))))
+ (do ((fm (make-table-lookup (* mc-ratio freq) :wave sine))
+ (carrier (make-table-lookup freq :wave sine))
+ (i beg (+ i 1)))
((= i end))
(outa i (* amp (table-lookup carrier (* index (table-lookup fm))))))))
(define (test-fm1 beg end freq amp mc-ratio index)
- (let ((fm (make-oscil (* mc-ratio freq)))
- (carrier (make-oscil freq)))
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil carrier (* index (oscil fm))))))))
+ (do ((fm (make-oscil (* mc-ratio freq)))
+ (carrier (make-oscil freq))
+ (i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil carrier (* index (oscil fm)))))))
(let ((v1 (with-sound ((make-float-vector size) :srate 44100) (test-tbl 0 size 200 1 1 1)))
(v2 (with-sound ((make-float-vector size) :srate 44100) (test-fm1 0 size 200 1 1 1))))
@@ -16153,64 +15993,60 @@ EDITS: 2
(test-gen-equal (make-polyshape 440.0 :partials '(1 1))
(make-polyshape 440.0 :partials (float-vector 1 1))
(make-polyshape 440.0 :partials '(1 .5)))
- (test-gen-equal (make-polyshape 440.0 :partials (list 1 .1 2 1 3 .5))
+ (test-gen-equal (make-polyshape 440.0 :partials '(1 .1 2 1 3 .5))
(make-polyshape 440.0 :partials (float-vector 1 .1 2 1 3 .5))
(make-polyshape 440.0 :partials '(1 .1 2 .1 3 .5)))
- (let ((gen (make-polyshape 440.0 :partials '(1 1)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1100)))
- (let* ((val1 (cos (mus-phase gen)))
- (val2 (gen 1.0 0.0)))
- (if (fneq val1 val2)
- (begin
- (snd-display ";polyshaper (1 1) ~A: ~A ~A" i val1 val2)
- (set! happy #f))))))
-
- (let ((gen (make-polyshape 440.0)) ; check default for partials: '(1 1)
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1100)))
- (let* ((val1 (cos (mus-phase gen)))
- (val2 (gen 1.0 0.0)))
- (if (fneq val1 val2)
- (begin
- (snd-display ";polyshaper default: '(1 1) ~A: ~A ~A" i val1 val2)
- (set! happy #f))))))
-
- (let ((gen (make-polyshape 440.0 :partials (float-vector 1 1)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1100)))
- (let* ((val1 (* .5 (cos (mus-phase gen))))
- (val2 (gen 0.5 0.0)))
- (if (fneq val1 val2)
- (begin
- (snd-display ";polyshaper (1 1) .5 index ~A: ~A ~A" i val1 val2)
- (set! happy #f))))))
+ (do ((gen (make-polyshape 440.0 :partials '(1 1)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1100)))
+ (let* ((val1 (cos (mus-phase gen)))
+ (val2 (gen 1.0 0.0)))
+ (when (fneq val1 val2)
+ (snd-display ";polyshaper (1 1) ~A: ~A ~A" i val1 val2)
+ (set! happy #f))))
+
+ (do ((gen (make-polyshape 440.0)) ; check default for partials: '(1 1)
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy)
+ (= i 1100)))
+ (let* ((val1 (cos (mus-phase gen)))
+ (val2 (gen 1.0 0.0)))
+ (when (fneq val1 val2)
+ (snd-display ";polyshaper default: '(1 1) ~A: ~A ~A" i val1 val2)
+ (set! happy #f))))
+
+ (do ((gen (make-polyshape 440.0 :partials (float-vector 1 1)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1100)))
+ (let* ((val1 (* .5 (cos (mus-phase gen))))
+ (val2 (gen 0.5 0.0)))
+ (when (fneq val1 val2)
+ (snd-display ";polyshaper (1 1) .5 index ~A: ~A ~A" i val1 val2)
+ (set! happy #f))))
(let ((var (catch #t (lambda () (make-polyshape 440.0 :coeffs 3.14)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
(snd-display ";make-polyshape bad coeffs: ~A" var)))
- (let ((gen (make-polyshape 0.0 :coeffs (partials->polynomial '(1 1))))
- (gen1 (make-polyshape 40.0 :coeffs (partials->polynomial '(1 1))))
- (a1 0.0)
- (incr (/ (* 2 pi 40.0) 22050.0))
- (happy #t))
- (do ((i 0 (+ i 1))
- (a 0.0 (+ a incr)))
- ((or (not happy) (= i 400)))
- (let ((fm (cos a))
- (val1 (cos a1))
- (val2 (polyshape gen 1.0 (polyshape gen1 1.0))))
- (set! a1 (+ a1 fm))
- (if (> (abs (- val1 val2)) .002)
- (begin
- (snd-display ";polyshape fm: ~A: ~A ~A" i val1 val2)
- (set! happy #f))))))
+ (do ((gen (make-polyshape 0.0 :coeffs (partials->polynomial '(1 1))))
+ (gen1 (make-polyshape 40.0 :coeffs (partials->polynomial '(1 1))))
+ (a1 0.0)
+ (incr (/ (* 2 pi 40.0) 22050.0))
+ (happy #t)
+ (i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((or (not happy) (= i 400)))
+ (let ((fm (cos a))
+ (val1 (cos a1))
+ (val2 (polyshape gen 1.0 (polyshape gen1 1.0))))
+ (set! a1 (+ a1 fm))
+ (when (> (abs (- val1 val2)) .002)
+ (snd-display ";polyshape fm: ~A: ~A ~A" i val1 val2)
+ (set! happy #f))))
(for-each
(lambda (amps name)
@@ -16233,11 +16069,11 @@ EDITS: 2
(float-vector-set! data3 i (cos angle)))
(float-vector-scale! data3 (float-vector-ref amps k))
(float-vector-add! data2 data3))
-
+
(let-temporarily ((*mus-float-equal-fudge-factor* .0001))
(if (not (mus-arrays-equal? data1 data2))
(snd-display "~A: ~A~%~A~%" name data1 data2)))))
-
+
(list (float-vector 0.0 1.0)
(float-vector 0.0 0.5 0.25 0.25)
(make-float-vector 100 0.01)
@@ -16246,7 +16082,7 @@ EDITS: 2
three-cos
hundred-cos
thousand-cos))
-
+
(for-each
(lambda (amps name)
(let ((data1 (make-float-vector 100))
@@ -16268,11 +16104,11 @@ EDITS: 2
(float-vector-set! data3 i (sin angle)))
(float-vector-scale! data3 (float-vector-ref amps k))
(float-vector-add! data2 data3))
-
+
(let-temporarily ((*mus-float-equal-fudge-factor* .0001))
(if (not (mus-arrays-equal? data1 data2))
(snd-display "~A: ~A~%~A~%" name data1 data2)))))
-
+
(list (float-vector 0.0 1.0)
(float-vector 0.0 0.5 0.25 0.25)
(make-float-vector 100 0.01)
@@ -16281,7 +16117,7 @@ EDITS: 2
three-sin
hundred-sin
thousand-sin))
-
+
(for-each
(lambda (camps samps name)
(let ((data1 (make-float-vector 100))
@@ -16309,11 +16145,11 @@ EDITS: 2
(float-vector-set! data3 i (cos angle)))
(float-vector-scale! data3 (float-vector-ref camps k))
(float-vector-add! data2 data3))
-
+
(let-temporarily ((*mus-float-equal-fudge-factor* .0001))
(if (not (mus-arrays-equal? data1 data2))
(snd-display "~A: ~A~%~A~%" name data1 data2)))))
-
+
(list (float-vector 0.0 1.0)
(float-vector 0.0 0.25 0.0 0.25)
(make-float-vector 100 .004)
@@ -16335,13 +16171,13 @@ EDITS: 2
"polywave freq: 440.000Hz, phase: 0.000, coeffs[2]: [0 1]")
(if (not (= (mus-length gen) 2)) (snd-display ";polywave length: ~A?" (mus-length gen)))
- (let ((gen0 (make-polywave 440.0 '(1 1))))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (let ((val0 (polywave gen0 0.0))
- (val (polywave gen 0.0)))
- (if (fneq val val0) (snd-display ";polywave: ~A is not ~F?" val val0))
- (set! (v0 i) val))))
+ (do ((gen0 (make-polywave 440.0 '(1 1)))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (let ((val0 (polywave gen0 0.0))
+ (val (polywave gen 0.0)))
+ (if (fneq val val0) (snd-display ";polywave: ~A is not ~F?" val val0))
+ (set! (v0 i) val)))
(let ((gen1 (make-polywave 440.0))
(v1 (make-float-vector 10)))
(fill-float-vector v1 (if (polywave? gen1) (polywave gen1 0.0) -1.0))
@@ -16368,31 +16204,29 @@ EDITS: 2
(test-gen-equal (make-polywave 440.0 '(1 1))
(make-polywave 440.0 (float-vector 1 1))
(make-polywave 440.0 '(1 .5)))
- (test-gen-equal (make-polywave 440.0 (list 1 .1 2 1 3 .5))
+ (test-gen-equal (make-polywave 440.0 '(1 .1 2 1 3 .5))
(make-polywave 440.0 (float-vector 1 .1 2 1 3 .5))
(make-polywave 440.0 '(1 .1 2 .1 3 .5)))
- (let ((gen (make-polywave 440.0 '(1 1)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1100)))
- (let* ((val1 (cos (mus-phase gen)))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (begin
- (snd-display ";polywaver (1 1) ~A: ~A ~A" i val1 val2)
- (set! happy #f))))))
-
- (let ((gen (make-polywave 440.0)) ; check default for partials: '(1 1)
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1100)))
- (let* ((val1 (cos (mus-phase gen)))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (begin
- (snd-display ";polywaver default: '(1 1) ~A: ~A ~A" i val1 val2)
- (set! happy #f))))))
+ (do ((gen (make-polywave 440.0 '(1 1)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1100)))
+ (let* ((val1 (cos (mus-phase gen)))
+ (val2 (gen 0.0)))
+ (when (fneq val1 val2)
+ (snd-display ";polywaver (1 1) ~A: ~A ~A" i val1 val2)
+ (set! happy #f))))
+
+ (do ((gen (make-polywave 440.0)) ; check default for partials: '(1 1)
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1100)))
+ (let* ((val1 (cos (mus-phase gen)))
+ (val2 (gen 0.0)))
+ (when (fneq val1 val2)
+ (snd-display ";polywaver default: '(1 1) ~A: ~A ~A" i val1 val2)
+ (set! happy #f))))
(let ((gen (make-polywave 440.0 (float-vector 1 1)))
(happy #t))
@@ -16401,10 +16235,9 @@ EDITS: 2
((or (not happy) (= i 1100)))
(let* ((val1 (* .5 (cos (mus-phase gen))))
(val2 (gen 0.0)))
- (if (fneq val1 val2)
- (begin
- (snd-display ";polywaver (1 1) .5 index ~A: ~A ~A" i val1 val2)
- (set! happy #f))))))
+ (when (fneq val1 val2)
+ (snd-display ";polywaver (1 1) .5 index ~A: ~A ~A" i val1 val2)
+ (set! happy #f)))))
(let-temporarily ((*clm-srate* 44100))
(let ((v0 (make-float-vector 4410))
@@ -16429,121 +16262,117 @@ EDITS: 2
(for-each
(lambda (n)
- (let ((gen1 (make-polywave 100.0 (list n 1.0)))
- (gen2 (make-oscil (* n 100.0) (/ pi 2)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1000)))
- (let ((val1 (polywave gen1))
- (val2 (oscil gen2)))
- (if (fneq val1 val2)
- (begin
- (set! happy #f)
- (snd-display ";polywave ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (do ((gen1 (make-polywave 100.0 (list n 1.0)))
+ (gen2 (make-oscil (* n 100.0) (/ pi 2)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1000)))
+ (let ((val1 (polywave gen1))
+ (val2 (oscil gen2)))
+ (when (fneq val1 val2)
+ (set! happy #f)
+ (snd-display ";polywave ~A at ~A: ~A ~A" n i val1 val2)))))
'(1 8 50 128))
(for-each
(lambda (n)
- (let ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-second-kind))
- (gen2 (make-oscil (* n 100.0)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1000)))
- (let ((val1 (polywave gen1))
- (val2 (oscil gen2)))
- (if (fneq val1 val2)
- (begin
- (set! happy #f)
- (snd-display ";polywave second ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (do ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-second-kind))
+ (gen2 (make-oscil (* n 100.0)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1000)))
+ (let ((val1 (polywave gen1))
+ (val2 (oscil gen2)))
+ (when (fneq val1 val2)
+ (set! happy #f)
+ (snd-display ";polywave second ~A at ~A: ~A ~A" n i val1 val2)))))
'(1 8 50 128))
(for-each
(lambda (n)
- (let ((gen1 (make-polyshape 100.0 :partials (list n 1.0)))
- (gen2 (make-oscil (* n 100.0) (/ pi 2)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1000)))
- (let ((val1 (polyshape gen1))
- (val2 (oscil gen2)))
- (if (fneq val1 val2)
- (begin
- (set! happy #f)
- (snd-display ";polyshape ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (do ((gen1 (make-polyshape 100.0 :partials (list n 1.0)))
+ (gen2 (make-oscil (* n 100.0) (/ pi 2)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1000)))
+ (let ((val1 (polyshape gen1))
+ (val2 (oscil gen2)))
+ (when (fneq val1 val2)
+ (set! happy #f)
+ (snd-display ";polyshape ~A at ~A: ~A ~A" n i val1 val2)))))
'(1 8 16))
(for-each
(lambda (n)
- (let ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-second-kind))
- (gen2 (make-oscil (* n 100.0)))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1000)))
- (let ((val1 (polyshape gen1))
- (val2 (oscil gen2)))
- (if (fneq val1 val2)
- (begin
- (set! happy #f)
- (snd-display ";polyshape second ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (do ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-second-kind))
+ (gen2 (make-oscil (* n 100.0)))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1000)))
+ (let ((val1 (polyshape gen1))
+ (val2 (oscil gen2)))
+ (when (fneq val1 val2)
+ (set! happy #f)
+ (snd-display ";polyshape second ~A at ~A: ~A ~A" n i val1 val2)))))
'(1 8 16))
(for-each
(lambda (n)
- (let ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-first-kind))
- (gen2 (make-oscil (* n 100.0) (/ pi 2)))
- (max-dist 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (let ((val1 (polywave gen1))
- (val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2))))))
- (if (fneq max-dist 0.0)
- (snd-display ";polywave run ~A: ~A" n max-dist))))
+ (do ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-first-kind))
+ (gen2 (make-oscil (* n 100.0) (/ pi 2)))
+ (max-dist 0.0)
+ (i 0 (+ i 1)))
+ ((= i 1000)
+ (if (fneq max-dist 0.0)
+ (snd-display ";polywave run ~A: ~A" n max-dist)))
+ (let ((val1 (polywave gen1))
+ (val2 (oscil gen2)))
+ (set! max-dist (max max-dist (abs (- val1 val2)))))))
'(1 3 30 200))
(for-each
(lambda (n)
- (let ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-second-kind))
- (gen2 (make-oscil (* n 100.0)))
- (max-dist 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (let ((val1 (polywave gen1))
- (val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2))))))
- (if (fneq max-dist 0.0)
- (snd-display ";polywave second run ~A: ~A" n max-dist))))
+ (do ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-second-kind))
+ (gen2 (make-oscil (* n 100.0)))
+ (max-dist 0.0)
+ (i 0 (+ i 1)))
+ ((= i 1000)
+ (if (fneq max-dist 0.0)
+ (snd-display ";polywave second run ~A: ~A" n max-dist)))
+ (let ((val1 (polywave gen1))
+ (val2 (oscil gen2)))
+ (set! max-dist (max max-dist (abs (- val1 val2)))))))
'(1 3 30 200))
(for-each
(lambda (n)
- (let ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-first-kind))
- (gen2 (make-oscil (* n 100.0) (/ pi 2)))
- (max-dist 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (let ((val1 (polyshape gen1))
- (val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2))))))
- (if (fneq max-dist 0.0)
- (snd-display ";polyshape run ~A: ~A" n max-dist))))
+ (do ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-first-kind))
+ (gen2 (make-oscil (* n 100.0) (/ pi 2)))
+ (max-dist 0.0)
+ (i 0 (+ i 1)))
+ ((= i 1000)
+ (if (fneq max-dist 0.0)
+ (snd-display ";polyshape run ~A: ~A" n max-dist)))
+ (let ((val1 (polyshape gen1))
+ (val2 (oscil gen2)))
+ (set! max-dist (max max-dist (abs (- val1 val2)))))))
'(1 3 25))
(for-each
(lambda (n)
- (let ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-second-kind))
- (gen2 (make-oscil (* n 100.0)))
- (max-dist 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (let ((val1 (polyshape gen1))
- (val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2))))))
- (if (fneq max-dist 0.0)
- (snd-display ";polyshape second run ~A: ~A" n max-dist))))
+ (do ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-second-kind))
+ (gen2 (make-oscil (* n 100.0)))
+ (max-dist 0.0)
+ (i 0 (+ i 1)))
+ ((= i 1000)
+ (if (fneq max-dist 0.0)
+ (snd-display ";polyshape second run ~A: ~A" n max-dist)))
+ (let ((val1 (polyshape gen1))
+ (val2 (oscil gen2)))
+ (set! max-dist (max max-dist (abs (- val1 val2)))))))
'(1 3 25))
- (let* ((gen (make-polywave 100.0 (list 1 .9 3 .1 4 0.0)))
+ (let* ((gen (make-polywave 100.0 '(1 .9 3 .1 4 0.0)))
(vals (mus-data gen)))
(if (not (and (float-vector? vals)
(mus-arrays-equal? vals (float-vector 0.000 0.900 0.000 0.100 0.00))))
@@ -16551,29 +16380,28 @@ EDITS: 2
(begin
(float-vector-set! (mus-data gen) 2 .1)
(float-vector-set! (mus-data gen) 3 0.0)
- (let ((happy #t)
- (gen1 (make-oscil 100.0 (/ pi 2)))
- (gen2 (make-oscil 200.0 (/ pi 2))))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 1000)))
- (let ((val1 (polywave gen))
- (val2 (+ (* .9 (oscil gen1))
- (* .1 (oscil gen2)))))
- (if (fneq val1 val2)
- (begin
- (set! happy #f)
- (snd-display ";polywave set mus-data at ~A: ~A ~A" i val1 val2))))))))))
+ (do ((happy #t)
+ (gen1 (make-oscil 100.0 (/ pi 2)))
+ (gen2 (make-oscil 200.0 (/ pi 2)))
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 1000)))
+ (let ((val1 (polywave gen))
+ (val2 (+ (* .9 (oscil gen1))
+ (* .1 (oscil gen2)))))
+ (when (fneq val1 val2)
+ (set! happy #f)
+ (snd-display ";polywave set mus-data at ~A: ~A ~A" i val1 val2))))))))
;; check dc
(do ((i 2 (+ i 1)))
((= i 7))
- (let ((cfs (make-list (* 2 i) 0.1)))
- (do ((k 0 (+ k 2)))
- ((>= k (length cfs)))
- (set! (cfs k) (/ k 2)))
- (let ((val (polywave (make-polywave 100.0 cfs mus-chebyshev-second-kind))))
- (if (fneq val 0.1)
- (snd-display ";polywave ~D order second 0-coeff: ~A" i val)))))
-
+ (do ((cfs (make-list (* 2 i) 0.1))
+ (k 0 (+ k 2)))
+ ((>= k (length cfs))
+ (let ((val (polywave (make-polywave 100.0 cfs mus-chebyshev-second-kind))))
+ (if (fneq val 0.1)
+ (snd-display ";polywave ~D order second 0-coeff: ~A" i val))))
+ (set! (cfs k) (/ k 2))))
+
(do ((i 2 (+ i 1)))
((= i 7))
(let ((cfs (make-list (* 2 i) 0.1)))
@@ -16751,27 +16579,27 @@ EDITS: 2
(snd-display ";wt 4 data 440: ~A" (channel->float-vector 440 30)))
(undo)
- (let* ((gen (make-wave-train 1000.0 :wave (make-float-vector 10 .1)))
- (base-freq (mus-frequency gen))
- (e (make-env '(0 1 1 2) :length 1001)))
- (map-channel
- (lambda (y)
- (let ((result (wave-train gen)))
- (set! (mus-frequency gen) (* base-freq (env e)))
- result))))
+ (let ((gen (make-wave-train 1000.0 :wave (make-float-vector 10 .1))))
+ (let ((base-freq (mus-frequency gen))
+ (e (make-env '(0 1 1 2) :length 1001)))
+ (map-channel
+ (lambda (y)
+ (let ((result (wave-train gen)))
+ (set! (mus-frequency gen) (* base-freq (env e)))
+ result)))))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display ";wt 5 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
- 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
+ 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
(snd-display ";wt 5 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.100
- 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.100)))
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.100
+ 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.100)))
(snd-display ";wt 5 data 440: ~A" (channel->float-vector 440 30)))
(if (not (mus-arrays-equal? (channel->float-vector 900 30)
- (float-vector 0.100 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100
- 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100 0.100)))
+ (float-vector 0.100 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100
+ 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100 0.100)))
(snd-display ";wt 5 data 900: ~A" (channel->float-vector 900 30)))
(undo)
@@ -16906,11 +16734,11 @@ EDITS: 2
(let* ((ind (open-sound "2.snd"))
(gen (make-snd->sample ind)))
- (let ((v0 (make-float-vector 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v0 i) (snd->sample gen (+ 1490 i) 0))
- (set! (v0 i) (snd->sample gen (+ 1490 i) 1))))
+ (do ((v0 (make-float-vector 10))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v0 i) (snd->sample gen (+ 1490 i) 0))
+ (set! (v0 i) (snd->sample gen (+ 1490 i) 1)))
(print-and-check gen
"snd->sample"
"snd->sample reading 2.snd (2 chans) at 1499:[#<sampler: 2.snd[0: 0] from 1490, at 1500, forward>, #<sampler: 2.snd[1: 0] from 1490, at 1500, forward>]")
@@ -17111,13 +16939,13 @@ EDITS: 2
(if (not (eq? (car var) 'out-of-range))
(snd-display ";make-sample->file bad type: ~A" var)))
- (let ((v (vector 1.0 0.5 0.25 0.125 0.0))
- (v1 (make-float-vector 5)))
- (do ((i 0 (+ i 1)))
- ((= i 5))
- (set! (v1 i) (in-any i 0 v)))
- (if (not (mus-arrays-equal? v1 (float-vector 1.0 0.5 0.25 0.125 0.0)))
- (snd-display ";vector in-any -> ~A?" v1)))
+ (do ((v (vector 1.0 0.5 0.25 0.125 0.0))
+ (v1 (make-float-vector 5))
+ (i 0 (+ i 1)))
+ ((= i 5)
+ (if (not (mus-arrays-equal? v1 (float-vector 1.0 0.5 0.25 0.125 0.0)))
+ (snd-display ";vector in-any -> ~A?" v1)))
+ (set! (v1 i) (in-any i 0 v)))
(let ((invals (make-float-vector 10)))
(do ((i 0 (+ i 1)))
@@ -17143,10 +16971,10 @@ EDITS: 2
(for-each close-sound (sounds))
- (let ((vals (with-sound ((make-float-vector 4410))
- (fm-violin 0 .1 440 .1))))
- (if (fneq (float-vector-peak vals) .1)
- (snd-display ";locsig to float-vector fm-violin peak: ~A" (float-vector-peak vals))))
+ (let ((vals (float-vector-peak (with-sound ((make-float-vector 4410))
+ (fm-violin 0 .1 440 .1)))))
+ (if (fneq vals .1)
+ (snd-display ";locsig to float-vector fm-violin peak: ~A" vals)))
(let ((mxs (maxamp (with-sound ((make-float-vector '(2 4410)))
(fm-violin 0 .1 440 .1 :degree 30)))))
@@ -17213,11 +17041,10 @@ EDITS: 2
((or (not happy) (= i 10)))
(let ((c0 (file->sample rd i 0))
(c1 (file->sample rd i 1)))
- (if (or (fneq c0 (* i .1))
- (fneq c1 (* i .01)))
- (begin
- (snd-display ";sample->file->sample at ~A: ~A ~A" i c0 c1)
- (set! happy #f)))))
+ (when (or (fneq c0 (* i .1))
+ (fneq c1 (* i .01)))
+ (snd-display ";sample->file->sample at ~A: ~A ~A" i c0 c1)
+ (set! happy #f))))
(mus-close rd))
(let ((sf (continue-sample->file "fmv.snd")))
@@ -17287,12 +17114,11 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((or (not happy) (= i 10)))
(file->frample rd i f0)
- (if (or (not (= (mus-length f0) 2))
- (fneq (f0 0) (* i .1))
- (fneq (f0 1) (* i .01)))
- (begin
- (snd-display ";frample->file->frample at ~A: ~A" i f0)
- (set! happy #f))))
+ (when (or (not (= (mus-length f0) 2))
+ (fneq (f0 0) (* i .1))
+ (fneq (f0 1) (* i .01)))
+ (snd-display ";frample->file->frample at ~A: ~A" i f0)
+ (set! happy #f)))
(mus-close rd))
(let ((sf (continue-frample->file "fmv.snd")))
(do ((i 0 (+ i 1)))
@@ -17324,10 +17150,10 @@ EDITS: 2
(mus-sound-forget "fmv.snd")
(let ((v0 (make-float-vector 1000)))
- (let ((os (make-oscil 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (set! (v0 i) (* .1 (oscil os)))))
+ (do ((os (make-oscil 440.0))
+ (i 0 (+ i 1)))
+ ((= i 1000))
+ (set! (v0 i) (* .1 (oscil os))))
(array->file "fmv3.snd" v0 10000 22050 1) ; 10000 deliberate
(let ((v1 (make-float-vector 1000)))
(file->array "fmv3.snd" 0 0 1000 v1)
@@ -17408,12 +17234,12 @@ EDITS: 2
; (test-gen-equal (make-rand 1000) (make-rand 1000) (make-rand 500))
; (test-gen-equal (make-rand 1000) (make-rand 1000) (make-rand 1000 0.5))
- (let ((gen (make-rand-interp 100.0 0.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (let ((val (rand-interp gen)))
+ (do ((gen (make-rand-interp 100.0 0.0))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (let ((val (rand-interp gen)))
(if (not (zero? val))
- (snd-display ";rand-interp 0 amp: ~A" val)))))
+ (snd-display ";rand-interp 0 amp: ~A" val))))
(let ((gen (make-rand-interp 4000.0))
(v0 (make-float-vector 10)))
@@ -17445,17 +17271,17 @@ EDITS: 2
(= (mus-length gen) 512)))
(snd-display ";(dist) rand-interp data: ~A ~A" (mus-length gen) (mus-data gen))))
- (let ((gen (make-rand 10000.0 1.0))
- (gen1 (make-rand-interp 10000.0 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (let ((val1 (gen 0.0))
- (val2 (gen1 0.0)))
- (if (not (>= 1.0 val1 -1.0))
- (snd-display ";rand: ~A ~A" val1 gen))
- (if (not (>= 1.0 val2 -1.0))
- (snd-display ";rand-interp: ~A ~A" val2 gen1)))))
-
+ (do ((gen (make-rand 10000.0 1.0))
+ (gen1 (make-rand-interp 10000.0 1.0))
+ (i 0 (+ i 1)))
+ ((= i 1000))
+ (let ((val1 (gen 0.0))
+ (val2 (gen1 0.0)))
+ (if (not (>= 1.0 val1 -1.0))
+ (snd-display ";rand: ~A ~A" val1 gen))
+ (if (not (>= 1.0 val2 -1.0))
+ (snd-display ";rand-interp: ~A ~A" val2 gen1))))
+
(let ((gen (make-rand 10000.0 :distribution (inverse-integrate '(0 0 1 1))))
(v0 (make-float-vector 10)))
(print-and-check gen
@@ -17564,14 +17390,14 @@ EDITS: 2
((= i n))
(let ((y (floor (+ 5 (mus-random 5.0)))))
(set! (hits y) (+ 1 (vector-ref hits y)))))
- (let ((sum 0.0)
- (p (/ n 10.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10)
- (if (< sum 3.0)
- (snd-display ";mus-random not so random? ~A (chi)" sum)))
- (let ((num (- (vector-ref hits i) p)))
- (set! sum (+ sum (/ (* num num) p)))))))
+ (do ((sum 0.0)
+ (p (/ n 10.0))
+ (i 0 (+ i 1)))
+ ((= i 10)
+ (if (< sum 3.0)
+ (snd-display ";mus-random not so random? ~A (chi)" sum)))
+ (let ((num (- (vector-ref hits i) p)))
+ (set! sum (+ sum (/ (* num num) p))))))
;; (v 10000)
;; #(999 1017 1002 1024 1048 971 963 1000 980 996) 5.8
;; if less than 3 complain
@@ -17583,14 +17409,14 @@ EDITS: 2
((= i n))
(let ((y (floor (+ 5 (rand gen)))))
(set! (hits y) (+ 1 (vector-ref hits y)))))
- (let ((sum 0.0)
- (p (/ n 10.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10)
- (if (< sum 3.5)
- (snd-display ";rand not so random? ~A (chi)" sum)))
- (let ((num (- (vector-ref hits i) p)))
- (set! sum (+ sum (/ (* num num) p)))))))
+ (do ((sum 0.0)
+ (p (/ n 10.0))
+ (i 0 (+ i 1)))
+ ((= i 10)
+ (if (< sum 3.5)
+ (snd-display ";rand not so random? ~A (chi)" sum)))
+ (let ((num (- (vector-ref hits i) p)))
+ (set! sum (+ sum (/ (* num num) p))))))
;; (v1 10000)
;; #(979 1015 977 1008 954 1049 997 1020 1015 986) 6.606
@@ -17644,9 +17470,9 @@ EDITS: 2
(snd-display ";locsig gen2 outn: ~A" (mus-data gen1)))
(if (not (mus-arrays-equal? (mus-data gen2) (float-vector 0.333 0.667 0.000 0.000)))
(snd-display ";locsig gen2 outn: ~A" (mus-data gen2))))
- (let ((gen200 (make-locsig 200.0 :channels 4)))
- (if (not (mus-arrays-equal? (mus-data gen200) (float-vector 0.000 0.000 0.778 0.222)))
- (snd-display ";locsig gen200 outn: ~A" (mus-data gen200))))
+ (let ((gen200 (mus-data (make-locsig 200.0 :channels 4))))
+ (if (not (mus-arrays-equal? gen200 (float-vector 0.000 0.000 0.778 0.222)))
+ (snd-display ";locsig gen200 outn: ~A" gen200)))
(locsig-set! gen 0 .25)
(if (not (mus-arrays-equal? (mus-data gen) (float-vector 0.250 0.333)))
(snd-display ";locsig gen .25 outn: ~A" (mus-data gen)))
@@ -17881,15 +17707,14 @@ EDITS: 2
(print-and-check (make-locsig 0 :channels 1 :output (make-float-vector 10))
"locsig"
"locsig chans 1, outn: [1.000], interp: linear")
- (let* ((locsig-data
- (lambda (gen)
- (let* ((chans (mus-channels gen))
- (dat (make-float-vector chans)))
- (do ((i 0 (+ i 1)))
- ((= i chans))
- (set! (dat i) (locsig-ref gen i)))
- dat)))
- (gen (make-locsig -.1 :channels 8)))
+ (let ((locsig-data
+ (lambda (gen)
+ (let ((chans (mus-channels gen)))
+ (do ((dat (make-float-vector chans))
+ (i 0 (+ i 1)))
+ ((= i chans) dat)
+ (set! (dat i) (locsig-ref gen i))))))
+ (gen (make-locsig -.1 :channels 8)))
(if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
(snd-display ";locsig -.1(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -359.9 :channels 8))
@@ -17947,7 +17772,7 @@ EDITS: 2
(set! (v left) (- 1.0 frac))
(set! (v right) frac))
(let ((ldeg (* (/ pi 2) (- 0.5 frac))))
- (let ((norm (/ (sqrt 2.0) 2.0))
+ (let ((norm (/ (sqrt 2.0)))
(c (cos ldeg))
(s (sin ldeg)))
(set! (v left) (* norm (+ c s)))
@@ -17976,13 +17801,12 @@ EDITS: 2
(do ((sq (/ .1 (sqrt 2)))
(i 0 (+ i 1)))
((or (not happy) (= i rev-chans)))
- (if (fneq (locsig-reverb-ref gen i) (* sq (revs i)))
- (begin
- (snd-display ";mono locrev[~A] ~A at ~A: ~A ~A"
- type gen deg
- (locsig-reverb-ref gen i)
- (* sq (revs i)))
- (set! happy #f)))))))
+ (when (fneq (locsig-reverb-ref gen i) (* sq (revs i)))
+ (snd-display ";mono locrev[~A] ~A at ~A: ~A ~A"
+ type gen deg
+ (locsig-reverb-ref gen i)
+ (* sq (revs i)))
+ (set! happy #f))))))
'(0.0 45.0 90.0 1234.0))
(for-each
@@ -18005,20 +17829,18 @@ EDITS: 2
(revs (if revfile (locsig-scalers rev-chans deg type))))
(do ((i 0 (+ i 1)))
((or (not happy) (= i chans)))
- (if (fneq (locsig-ref gen i) (scalers i))
- (begin
- (snd-display ";locsig[~A] ~A at ~A: ~A ~A" type gen deg (locsig-ref gen i) (scalers i))
- (set! happy #f))))
+ (when (fneq (locsig-ref gen i) (scalers i))
+ (snd-display ";locsig[~A] ~A at ~A: ~A ~A" type gen deg (locsig-ref gen i) (scalers i))
+ (set! happy #f)))
(if revfile
(do ((i 0 (+ i 1)))
((or (not happy) (= i rev-chans)))
- (if (fneq (locsig-reverb-ref gen i) (* .1 (revs i)))
- (begin
- (snd-display ";locrev[~A] ~A at ~A: ~A ~A"
- type gen deg
- (locsig-reverb-ref gen i)
- (* .1 (revs i)))
- (set! happy #f))))))))
+ (when (fneq (locsig-reverb-ref gen i) (* .1 (revs i)))
+ (snd-display ";locrev[~A] ~A at ~A: ~A ~A"
+ type gen deg
+ (locsig-reverb-ref gen i)
+ (* .1 (revs i)))
+ (set! happy #f)))))))
'(0.0 45.0 90.0 120.0 180.0 275.0 315.0 300.0 15.0 1234.0)))
'(2 3 4 5 8 12 16 24))
@@ -18034,20 +17856,18 @@ EDITS: 2
(revs (if revfile (locsig-scalers rev-chans deg ltype))))
(do ((i 0 (+ i 1)))
((or (not happy) (= i chans)))
- (if (fneq (locsig-ref gen i) (scalers i))
- (begin
- (snd-display ";locsig[~A] ~A at ~A: ~A ~A" ltype gen deg (locsig-ref gen i) (scalers i))
- (set! happy #f))))
+ (when (fneq (locsig-ref gen i) (scalers i))
+ (snd-display ";locsig[~A] ~A at ~A: ~A ~A" ltype gen deg (locsig-ref gen i) (scalers i))
+ (set! happy #f)))
(if revfile
(do ((i 0 (+ i 1)))
((or (not happy) (= i rev-chans)))
- (if (fneq (locsig-reverb-ref gen i) (* .1 (revs i)))
- (begin
- (snd-display ";locrev[~A] ~A at ~A: ~A ~A"
- type gen deg
- (locsig-reverb-ref gen i)
- (* .1 (revs i)))
- (set! happy #f))))))))
+ (when (fneq (locsig-reverb-ref gen i) (* .1 (revs i)))
+ (snd-display ";locrev[~A] ~A at ~A: ~A ~A"
+ type gen deg
+ (locsig-reverb-ref gen i)
+ (* .1 (revs i)))
+ (set! happy #f)))))))
'(0.0 45.0 90.0 120.0 180.0 275.0 315.0 300.0 15.0 1234.0)))
(list mus-interp-linear mus-interp-sinusoidal)))
'(2 3 4 5 8 12 16 24))
@@ -18231,14 +18051,14 @@ EDITS: 2
(if (not (= (mus-channels gen2) 4)) (snd-display ";mus-channels move-sound (4): ~A" (mus-channels gen2)))
(mus-reset gen1) ; a no-op
- (let ((v (make-float-vector 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v i) (+ (move-sound gen1 i 0.5)
- (gen2 i 0.25)
- (move-sound gen3 i 0.125))))
- (if (not (mus-arrays-equal? v (make-float-vector 10 0.875)))
- (snd-display ";move-sound output: ~A" v)))
+ (do ((v (make-float-vector 10))
+ (i 0 (+ i 1)))
+ ((= i 10)
+ (if (not (mus-arrays-equal? v (make-float-vector 10 0.875)))
+ (snd-display ";move-sound output: ~A" v)))
+ (set! (v i) (+ (move-sound gen1 i 0.5)
+ (gen2 i 0.25)
+ (move-sound gen3 i 0.125))))
(let ((var (catch #t (lambda () (make-move-sound (list 0 1000 1 0 (make-oscil 32) (make-env '(0 0 1 1) :length 1001)
(make-env '(0 0 1 1) :length 1001) (vector (make-delay 32))
@@ -19280,10 +19100,9 @@ EDITS: 2
(if (> (maxamp) .04) (snd-display ";ssb-bank cancelled: ~A" (maxamp))))
(close-sound ind))
- (if *output*
- (begin
- (snd-display ";*output* ~A" *output*)
- (set! *output* #f)))
+ (when *output*
+ (snd-display ";*output* ~A" *output*)
+ (set! *output* #f))
(let ((nind (new-sound "fmv.snd" 1 22050 mus-bshort mus-aifc "this is a comment")))
(time (mix-float-vector (with-temp-sound (:output (make-float-vector 22050)) (fm-violin 0 1 440 .1)) 0 nind 0))
@@ -19304,13 +19123,13 @@ EDITS: 2
(map-channel (fltit))
(close-sound oboe-index))
(if (not (sound? nind)) (snd-display ";close sound clobbered ~A?" nind))
- (let ((fr (framples nind 0)))
- (do ((k 0 (+ k 1)))
- ((= k 10))
- (delete-samples 10 100 nind 0)
- (save-sound nind)) ;flush out memory leaks here
- (if (not (= (framples nind 0) (- fr 1000)))
- (snd-display ";delete-samples: ~A ~A" fr (framples nind 0))))
+ (do ((fr (framples nind 0))
+ (k 0 (+ k 1)))
+ ((= k 10)
+ (if (not (= (framples nind 0) (- fr 1000)))
+ (snd-display ";delete-samples: ~A ~A" fr (framples nind 0))))
+ (delete-samples 10 100 nind 0)
+ (save-sound nind)) ;flush out memory leaks here
(revert-sound nind)
(close-sound nind))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
@@ -19448,13 +19267,12 @@ EDITS: 2
(file->array "fmv.snd" 0 0 12 v0)
;; v0: #(0.1 0.11 0.12 0.13 0.14 0.15 0.16 0.17 0.18 0.19 0.2 0.21)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 12)))
- (if (fneq (v0 i) (+ 0.1 (* i .01)))
- (begin
- (snd-display ";~D mus-file-mix(1->1): ~A?" k v0)
- (set! happy #f)))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 12)))
+ (when(fneq (v0 i) (+ 0.1 (* i .01)))
+ (snd-display ";~D mus-file-mix(1->1): ~A?" k v0)
+ (set! happy #f)))
(mus-file-mix-1 k (make-mix-input "fmv2.snd" k) 3 9 0 (float-vector 0.3 0.0 0.7 0.0))
(file->array "fmv.snd" 0 0 12 v0)
@@ -19909,12 +19727,11 @@ EDITS: 2
(float-vector-add! amps paincrs)
(float-vector-add! ppincrs freqs)
(float-vector-add! phases ppincrs)
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i N2))
- (if (> (amps i) .75)
- (set! sum (+ sum (* (amps i) (if (> (modulo (phases i) two-pi) pi) 1.0 -1.0))))))
- sum))))
+ (do ((sum 0.0)
+ (i 0 (+ i 1)))
+ ((= i N2) sum)
+ (if (> (amps i) .75)
+ (set! sum (+ sum (* (amps i) (if (> (modulo (phases i) two-pi) pi) 1.0 -1.0)))))))))
(make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4
:edit efunc
:synthesize sfunc
@@ -19997,10 +19814,9 @@ EDITS: 2
(let* ((inval (sin (* .1 i)))
(o1o (ssb-am o1 inval))
(o2o (ssb-am-1 o2 inval)))
- (if (fneq o1o o2o)
- (begin
- (snd-display ";ssb-am (up): ~A ~A at ~A" o1o o2o i)
- (set! happy #f))))))
+ (when (fneq o1o o2o)
+ (snd-display ";ssb-am (up): ~A ~A at ~A" o1o o2o i)
+ (set! happy #f)))))
(let ((o1 (make-ssb-am 400.0))
(o2 (make-ssb-am-1 400.0))
@@ -20011,10 +19827,9 @@ EDITS: 2
(fmval (sin (* .2 i)))
(o1o (ssb-am o1 inval fmval))
(o2o (ssb-am-1 o2 inval fmval)))
- (if (fneq o1o o2o)
- (begin
- (snd-display ";ssb-am + fm (up): ~A ~A at ~A" o1o o2o i)
- (set! happy #f))))))
+ (when (fneq o1o o2o)
+ (snd-display ";ssb-am + fm (up): ~A ~A at ~A" o1o o2o i)
+ (set! happy #f)))))
(let ((o1 (make-ssb-am -100.0))
(o2 (make-ssb-am-1 -100.0))
@@ -20024,10 +19839,9 @@ EDITS: 2
(let* ((inval (random 1.0))
(o1o (ssb-am o1 inval))
(o2o (ssb-am-1 o2 inval)))
- (if (fneq o1o o2o)
- (begin
- (snd-display ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
- (set! happy #f))))))
+ (when (fneq o1o o2o)
+ (snd-display ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
+ (set! happy #f)))))
(let ((o1 (make-ssb-am 1000.0 100))
(o2 (make-ssb-am-1 1000.0 100))
@@ -20037,10 +19851,9 @@ EDITS: 2
(let* ((inval (random 1.0))
(o1o (ssb-am o1 inval))
(o2o (ssb-am-1 o2 inval)))
- (if (fneq o1o o2o)
- (begin
- (snd-display ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
- (set! happy #f))))))
+ (when (fneq o1o o2o)
+ (snd-display ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
+ (set! happy #f)))))
(let ((index (open-sound "pistol.snd"))
(data (channel->float-vector 0 100)))
@@ -20356,13 +20169,13 @@ EDITS: 2
(snd-display ";moving-max: ~A ~A" ov tv)))
(set! (ov i) (moving-max gen (iv i))))
- (let ((g1 (make-moving-max 10)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (let ((val (moving-max g1 (random 1.0)))
- (pk (float-vector-peak (mus-data g1))))
- (if (not (= pk val))
- (snd-display ";moving-max ~A ~A" pk val)))))
+ (do ((g1 (make-moving-max 10))
+ (i 0 (+ i 1)))
+ ((= i 1000))
+ (let ((val (moving-max g1 (random 1.0)))
+ (pk (float-vector-peak (mus-data g1))))
+ (if (not (= pk val))
+ (snd-display ";moving-max ~A ~A" pk val))))
(let ((odata (make-float-vector 15))
(data (float-vector 1.0 0.0 -1.1 1.1001 0.1 -1.1 1.0 1.0 0.5 -0.01 0.02 0.0 0.0 0.0 0.0))
@@ -20415,12 +20228,13 @@ EDITS: 2
(do ((i -3 (+ i 1))
(k 0 (+ k 1)))
((= i 8))
- (let ((sum 0.0))
- (do ((j 0 (+ j 1)))
- ((= j 4))
- (if (>= (+ i j) 0)
- (set! sum (+ sum (* (data (+ i j)) (data (+ i j)))))))
- (if (fneq (odata k) (sqrt sum)) (snd-display ";moving length ran: ~A ~A" (odata k) (sqrt sum)))))
+ (do ((sum 0.0)
+ (j 0 (+ j 1)))
+ ((= j 4)
+ (if (fneq (odata k) (sqrt sum))
+ (snd-display ";moving length ran: ~A ~A" (odata k) (sqrt sum))))
+ (if (>= (+ i j) 0)
+ (set! sum (+ sum (* (data (+ i j)) (data (+ i j))))))))
(do ((i 0 (+ i 1)))
((= i 10))
@@ -20430,12 +20244,13 @@ EDITS: 2
(do ((i -3 (+ i 1))
(k 0 (+ k 1)))
((= i 8))
- (let ((sum 0.0))
- (do ((j 0 (+ j 1)))
- ((= j 4))
- (if (>= (+ i j) 0)
- (set! sum (+ sum (abs (data (+ i j)))))))
- (if (fneq (odata k) sum) (snd-display ";moving sum ran: ~A ~A" (odata k) sum))))
+ (do ((sum 0.0)
+ (j 0 (+ j 1)))
+ ((= j 4)
+ (if (fneq (odata k) sum)
+ (snd-display ";moving sum ran: ~A ~A" (odata k) sum)))
+ (if (>= (+ i j) 0)
+ (set! sum (+ sum (abs (data (+ i j))))))))
(do ((i 0 (+ i 1)))
((= i 10))
@@ -20445,12 +20260,13 @@ EDITS: 2
(do ((i -3 (+ i 1))
(k 0 (+ k 1)))
((= i 8))
- (let ((sum 0.0))
- (do ((j 0 (+ j 1)))
- ((= j 4))
- (if (>= (+ i j) 0)
- (set! sum (+ sum (* (data (+ i j)) (data (+ i j)))))))
- (if (fneq (odata k) (sqrt (/ sum 4))) (snd-display ";moving rms ran: ~A ~A" (odata k) (sqrt (/ sum 4))))))))
+ (do ((sum 0.0)
+ (j 0 (+ j 1)))
+ ((= j 4)
+ (if (fneq (odata k) (sqrt (/ sum 4)))
+ (snd-display ";moving rms ran: ~A ~A" (odata k) (sqrt (/ sum 4)))))
+ (if (>= (+ i j) 0)
+ (set! sum (+ sum (* (data (+ i j)) (data (+ i j))))))))))
(let ((ind (open-sound "oboe.snd")))
(harmonicizer 550.0 '(1 .5 2 .3 3 .2) 10)
@@ -20477,78 +20293,77 @@ EDITS: 2
(let ((v1 (make-float-vector 10 .1)))
- (let ((g1 (make-table-lookup :wave v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";table-lookup data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";table-lookup data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";table-lookup data not equal?: ~A ~A" v1 (mus-data g1)))
+ (let ((g1 (mus-data (make-table-lookup :wave v1))))
+ (if (not (eq? v1 g1)) (snd-display ";table-lookup data not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";table-lookup data not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";table-lookup data not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-data g1) 1) .3) (snd-display ";table-lookup float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
- (float-vector-set! (mus-data g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";table-lookup float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
-
- (let ((g1 (make-wave-train :wave v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";wave-train data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";wave-train data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";wave-train data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (fneq (g1 1) .3) (snd-display ";table-lookup float-vector-set: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";table-lookup float-vector-ref: ~A ~A" (v1 1) (g1 1))))
+
+ (let ((g1 (mus-data (make-wave-train :wave v1))))
+ (if (not (eq? v1 g1)) (snd-display ";wave-train data not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";wave-train data not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";wave-train data not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-data g1) 1) .3) (snd-display ";wave-train float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
- (float-vector-set! (mus-data g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";wave-train float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
-
- (let ((g1 (make-polyshape :coeffs v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";polyshape data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";polyshape data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";polyshape data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (fneq (g1 1) .3) (snd-display ";wave-train float-vector-set: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";wave-train float-vector-ref: ~A ~A" (v1 1) (g1 1))))
+
+ (let ((g1 (mus-data (make-polyshape :coeffs v1))))
+ (if (not (eq? v1 g1)) (snd-display ";polyshape data not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";polyshape data not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";polyshape data not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-data g1) 1) .3) (snd-display ";polyshape float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
- (float-vector-set! (mus-data g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";polyshape float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
-
- (let ((g1 (make-delay :initial-contents v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";delay data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";delay data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";delay data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (fneq (g1 1) .3) (snd-display ";polyshape float-vector-set: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";polyshape float-vector-ref: ~A ~A" (v1 1) (g1 1))))
+
+ (let ((g1 (mus-data (make-delay :initial-contents v1))))
+ (if (not (eq? v1 g1)) (snd-display ";delay data not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";delay data not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";delay data not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-data g1) 1) .3) (snd-display ";delay float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
- (float-vector-set! (mus-data g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";delay float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
-
- (let ((g1 (make-filtered-comb :scaler .5 :initial-contents v1 :filter (make-one-zero .1 .2))))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";filtered-comb data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";filtered-comb data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";filtered-comb data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (fneq (g1 1) .3) (snd-display ";delay float-vector-set: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";delay float-vector-ref: ~A ~A" (v1 1) (g1 1))))
+
+ (let ((g1 (mus-data (make-filtered-comb :scaler .5 :initial-contents v1 :filter (make-one-zero .1 .2)))))
+ (if (not (eq? v1 g1)) (snd-display ";filtered-comb data not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";filtered-comb data not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";filtered-comb data not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-data g1) 1) .3) (snd-display ";filtered-comb float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
- (float-vector-set! (mus-data g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";filtered-comb float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
-
- (let ((g1 (make-rand :distribution v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";rand data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";rand data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";rand data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (fneq (g1 1) .3) (snd-display ";filtered-comb float-vector-set: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";filtered-comb float-vector-ref: ~A ~A" (v1 1) (g1 1))))
+
+ (let ((g1 (mus-data (make-rand :distribution v1))))
+ (if (not (eq? v1 g1)) (snd-display ";rand data not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";rand data not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";rand data not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-data g1) 1) .3) (snd-display ";rand float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
- (float-vector-set! (mus-data g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";rand float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
-
- (let ((g1 (make-fir-filter :xcoeffs v1)))
- (if (not (eq? v1 (mus-xcoeffs g1))) (snd-display ";fir-filter xcoeffs not eq?: ~A ~A" v1 (mus-xcoeffs g1)))
- (if (not (eqv? v1 (mus-xcoeffs g1))) (snd-display ";fir-filter xcoeffs not eqv?: ~A ~A" v1 (mus-xcoeffs g1)))
- (if (not (equal? v1 (mus-xcoeffs g1))) (snd-display ";fir-filter xcoeffs not equal?: ~A ~A" v1 (mus-xcoeffs g1)))
+ (if (fneq (g1 1) .3) (snd-display ";rand float-vector-set: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";rand float-vector-ref: ~A ~A" (v1 1) (g1 1))))
+
+ (let ((g1 (mus-xcoeffs (make-fir-filter :xcoeffs v1))))
+ (if (not (eq? v1 g1)) (snd-display ";fir-filter xcoeffs not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";fir-filter xcoeffs not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";fir-filter xcoeffs not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-xcoeffs g1) 1) .3) (snd-display ";fir-filter float-vectorset: ~A ~A" (v1 1) ((mus-xcoeffs g1) 1)))
- (float-vector-set! (mus-xcoeffs g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";fir-filter float-vectorref: ~A ~A" (v1 1) ((mus-xcoeffs g1) 1))))
-
- (let ((g1 (make-iir-filter :ycoeffs v1)))
- (if (not (eq? v1 (mus-ycoeffs g1))) (snd-display ";iir-filter ycoeffs not eq?: ~A ~A" v1 (mus-ycoeffs g1)))
- (if (not (eqv? v1 (mus-ycoeffs g1))) (snd-display ";iir-filter ycoeffs not eqv?: ~A ~A" v1 (mus-ycoeffs g1)))
- (if (not (equal? v1 (mus-ycoeffs g1))) (snd-display ";iir-filter ycoeffs not equal?: ~A ~A" v1 (mus-ycoeffs g1)))
+ (if (fneq (g1 1) .3) (snd-display ";fir-filter float-vectorset: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";fir-filter float-vectorref: ~A ~A" (v1 1) (g1 1))))
+
+ (let ((g1 (mus-ycoeffs (make-iir-filter :ycoeffs v1))))
+ (if (not (eq? v1 g1)) (snd-display ";iir-filter ycoeffs not eq?: ~A ~A" v1 g1))
+ (if (not (eqv? v1 g1)) (snd-display ";iir-filter ycoeffs not eqv?: ~A ~A" v1 g1))
+ (if (not (equal? v1 g1)) (snd-display ";iir-filter ycoeffs not equal?: ~A ~A" v1 g1))
(set! (v1 1) .3)
- (if (fneq ((mus-ycoeffs g1) 1) .3) (snd-display ";iir-filter float-vectorset: ~A ~A" (v1 1) ((mus-ycoeffs g1) 1)))
- (float-vector-set! (mus-ycoeffs g1) 1 .5)
- (if (fneq (v1 1) .5) (snd-display ";iir-filter float-vectorref: ~A ~A" (v1 1) ((mus-ycoeffs g1) 1))))
- )
+ (if (fneq (g1 1) .3) (snd-display ";iir-filter float-vector-set: ~A ~A" (v1 1) (g1 1)))
+ (float-vector-set! g1 1 .5)
+ (if (fneq (v1 1) .5) (snd-display ";iir-filter float-vector-ref: ~A ~A" (v1 1) (g1 1)))))
(let ((tanh-1 (lambda (x)
(* x (+ 1 (* x x (- (* x x (+ 2/15 (* x x (- (* x x (+ 62/2835 (* x x -1382/155925))) 17/315)))) 1/3))))))
@@ -20570,24 +20385,23 @@ EDITS: 2
'(1.0 0.1 0.1 0.333)))
(if all-args
- (let ((maxerr 0.0)
- (max-case #f)
- (cases 0))
- (do ((n 1 (+ n 1)))
- ((= n 100))
- (do ((m 1 (+ m 1)))
- ((= m 4))
- (let ((val (sin (/ (* m pi) n)))
- (expr (sin-m*pi/n m n)))
- (if expr
- (let ((err (magnitude (- val (eval expr)))))
- (set! cases (+ cases 1))
- (if (> err maxerr)
- (begin
- (set! maxerr err)
- (set! max-case (/ m n)))))))))
- (if (> maxerr 1e-12)
- (snd-display "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case))))
+ (do ((maxerr 0.0)
+ (max-case #f)
+ (cases 0)
+ (n 1 (+ n 1)))
+ ((= n 100)
+ (if (> maxerr 1e-12)
+ (snd-display "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case)))
+ (do ((m 1 (+ m 1)))
+ ((= m 4))
+ (let ((val (sin (/ (* m pi) n)))
+ (expr (sin-m*pi/n m n)))
+ (if expr
+ (let ((err (magnitude (- val (eval expr)))))
+ (set! cases (+ cases 1))
+ (when (> err maxerr)
+ (set! maxerr err)
+ (set! max-case (/ m n)))))))))
(let ((tag (catch #t
(lambda () (with-sound () (outa -1 .1)))
@@ -20610,14 +20424,13 @@ EDITS: 2
(let ((v (with-sound () (catch #t (lambda ()
(outa -1 .1))
(lambda args 'error)))))
- (if (file-exists? v)
- (begin
- (if (> (cadr (mus-sound-maxamp v)) 0.0)
- (snd-display ";outa to file at -1: ~A" v))
- (if (> (mus-sound-chans v) 1)
- (snd-display ";outa to file at -1 chans: ~A" (mus-sound-chans v)))
- (cond ((find-sound v) => close-sound))
- (delete-file v))))
+ (when (file-exists? v)
+ (if (> (cadr (mus-sound-maxamp v)) 0.0)
+ (snd-display ";outa to file at -1: ~A" v))
+ (if (> (mus-sound-chans v) 1)
+ (snd-display ";outa to file at -1 chans: ~A" (mus-sound-chans v)))
+ (cond ((find-sound v) => close-sound))
+ (delete-file v)))
(let ((v (with-sound ((make-float-vector 10)) (catch #t (lambda ()
(outa -1 .1))
(lambda args 'error)))))
@@ -20632,395 +20445,390 @@ EDITS: 2
(if (not (= (signum -32) -1)) (snd-display ";signum -32: ~A" (signum -32)))
- (let ((c1 (make-comb .5 3))
- (c2 (make-comb-bank (vector (make-comb .5 3)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 20))
- (let ((x0 (comb c1 x))
- (x1 (comb-bank c2 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(comb .5 3) ~A, comb: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-comb .5 3))
- (c2 (make-comb .2 10))
- (c3 (make-comb-bank (vector (make-comb .5 3)
- (make-comb .2 10)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 30))
- (let ((x0 (+ (comb c1 x) (comb c2 x)))
- (x1 (comb-bank c3 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(comb .5 3) + (comb .2 10) ~A, comb: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-comb .5 3))
- (c2 (make-comb .2 10))
- (c3 (make-comb -.7 11))
- (c4 (make-comb-bank (vector (make-comb .5 3)
- (make-comb .2 10)
- (make-comb -.7 11)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (comb c1 x) (comb c2 x) (comb c3 x)))
- (x1 (comb-bank c4 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(comb .5 3) + (comb .2 10) + (comb -.7 11) ~A, comb: ~A, bank: ~A" i x0 x1)))))
-
-
- (let ((c1 (make-all-pass -.5 .5 3))
- (c2 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 20))
- (let ((x0 (all-pass c1 x))
- (x1 (all-pass-bank c2 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(all-pass -.5 .5 3) ~A, all-pass: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-all-pass -.5 .5 3))
- (c2 (make-all-pass -.2 .2 10))
- (c3 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)
- (make-all-pass -.2 .2 10)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 30))
- (let ((x0 (all-pass c1 (all-pass c2 x)))
- (x1 (all-pass-bank c3 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(all-pass -.5 .5 3) + (all-pass -.2 .2 10) ~A, all-pass: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-all-pass -.5 .5 3))
- (c2 (make-all-pass -.2 .2 10))
- (c3 (make-all-pass -.7 .1 11))
- (c4 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)
- (make-all-pass -.2 .2 10)
- (make-all-pass -.7 .1 11)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (all-pass c1 (all-pass c2 (all-pass c3 x))))
- (x1 (all-pass-bank c4 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(all-pass -.5 .5 3) + (all-pass -.2 .2 10) + (all-pass -.7 .1 11) ~A, all-pass: ~A, bank: ~A" i x0 x1)))))
+ (do ((c1 (make-comb .5 3))
+ (c2 (make-comb-bank (vector (make-comb .5 3))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 20))
+ (let ((x0 (comb c1 x))
+ (x1 (comb-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(comb .5 3) ~A, comb: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-comb .5 3))
+ (c2 (make-comb .2 10))
+ (c3 (make-comb-bank (vector (make-comb .5 3)
+ (make-comb .2 10))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 30))
+ (let ((x0 (+ (comb c1 x) (comb c2 x)))
+ (x1 (comb-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(comb .5 3) + (comb .2 10) ~A, comb: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-comb .5 3))
+ (c2 (make-comb .2 10))
+ (c3 (make-comb -.7 11))
+ (c4 (make-comb-bank (vector (make-comb .5 3)
+ (make-comb .2 10)
+ (make-comb -.7 11))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (comb c1 x) (comb c2 x) (comb c3 x)))
+ (x1 (comb-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(comb .5 3) + (comb .2 10) + (comb -.7 11) ~A, comb: ~A, bank: ~A" i x0 x1))))
+ (do ((c1 (make-all-pass -.5 .5 3))
+ (c2 (make-all-pass-bank (vector (make-all-pass -.5 .5 3))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 20))
+ (let ((x0 (all-pass c1 x))
+ (x1 (all-pass-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(all-pass -.5 .5 3) ~A, all-pass: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-all-pass -.5 .5 3))
+ (c2 (make-all-pass -.2 .2 10))
+ (c3 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)
+ (make-all-pass -.2 .2 10))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 30))
+ (let ((x0 (all-pass c1 (all-pass c2 x)))
+ (x1 (all-pass-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(all-pass -.5 .5 3) + (all-pass -.2 .2 10) ~A, all-pass: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-all-pass -.5 .5 3))
+ (c2 (make-all-pass -.2 .2 10))
+ (c3 (make-all-pass -.7 .1 11))
+ (c4 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)
+ (make-all-pass -.2 .2 10)
+ (make-all-pass -.7 .1 11))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (all-pass c1 (all-pass c2 (all-pass c3 x))))
+ (x1 (all-pass-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(all-pass -.5 .5 3) + (all-pass -.2 .2 10) + (all-pass -.7 .1 11) ~A, all-pass: ~A, bank: ~A" i x0 x1))))
- (let ((c1 (make-filtered-comb .5 3))
- (c2 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 20))
- (let ((x0 (filtered-comb c1 x))
- (x1 (filtered-comb-bank c2 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(filtered-comb .5 3) ~A, filtered-comb: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-filtered-comb .5 3))
- (c2 (make-filtered-comb .2 10))
- (c3 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)
- (make-filtered-comb .2 10)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 30))
- (let ((x0 (+ (filtered-comb c1 x) (filtered-comb c2 x)))
- (x1 (filtered-comb-bank c3 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(filtered-comb .5 3) + (filtered-comb .2 10) ~A, filtered-comb: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-filtered-comb .5 3))
- (c2 (make-filtered-comb .2 10))
- (c3 (make-filtered-comb -.7 11))
- (c4 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)
- (make-filtered-comb .2 10)
- (make-filtered-comb -.7 11)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (filtered-comb c1 x) (filtered-comb c2 x) (filtered-comb c3 x)))
- (x1 (filtered-comb-bank c4 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(filtered-comb .5 3) + (filtered-comb .2 10) + (filtered-comb -.7 11) ~A, filtered-comb: ~A, bank: ~A" i x0 x1)))))
+ (do ((c1 (make-filtered-comb .5 3))
+ (c2 (make-filtered-comb-bank (vector (make-filtered-comb .5 3))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 20))
+ (let ((x0 (filtered-comb c1 x))
+ (x1 (filtered-comb-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(filtered-comb .5 3) ~A, filtered-comb: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-filtered-comb .5 3))
+ (c2 (make-filtered-comb .2 10))
+ (c3 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)
+ (make-filtered-comb .2 10))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 30))
+ (let ((x0 (+ (filtered-comb c1 x) (filtered-comb c2 x)))
+ (x1 (filtered-comb-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(filtered-comb .5 3) + (filtered-comb .2 10) ~A, filtered-comb: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-filtered-comb .5 3))
+ (c2 (make-filtered-comb .2 10))
+ (c3 (make-filtered-comb -.7 11))
+ (c4 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)
+ (make-filtered-comb .2 10)
+ (make-filtered-comb -.7 11))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (filtered-comb c1 x) (filtered-comb c2 x) (filtered-comb c3 x)))
+ (x1 (filtered-comb-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(filtered-comb .5 3) + (filtered-comb .2 10) + (filtered-comb -.7 11) ~A, filtered-comb: ~A, bank: ~A" i x0 x1))))
;; make-formant-bank tests
- (let ((c1 (make-formant 440.0 .5))
- (c2 (make-formant-bank (vector (make-formant 440.0 .5)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (formant c1 x))
- (x1 (formant-bank c2 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(formant 440.0 .5) ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .5))
- (c2 (make-formant 1000.0 .2))
- (c3 (make-formant-bank (vector (make-formant 440.0 .5)
- (make-formant 1000.0 .2)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (formant c1 x) (formant c2 x)))
- (x1 (formant-bank c3 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(formant 440.0 .5) + (formant 1000.0 .2) ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .5))
- (c2 (make-formant 1000.0 .2))
- (c3 (make-formant 34.0 .1))
- (c4 (make-formant-bank (vector (make-formant 440.0 .5)
- (make-formant 1000.0 .2)
- (make-formant 34.0 .1)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
- (x1 (formant-bank c4 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(formant 440.0 .5) + (formant 1000.0 .2) + (formant 34.0 .1) ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .75))
- (c2 (make-formant 1000.0 .75))
- (c3 (make-formant 34.0 .75))
- (c4 (make-formant-bank (vector (make-formant 440.0 .75)
- (make-formant 1000.0 .75)
- (make-formant 34.0 .75)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
- (x1 (formant-bank c4 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";(formant 440.0 .75) + (formant 1000.0 .75) + (formant 34.0 .75) ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .5))
- (c2 (make-formant 1000.0 .2))
- (c3 (make-formant 34.0 .1))
- (c4 (make-formant-bank (vector (make-formant 440.0 .5)
- (make-formant 1000.0 .2)
- (make-formant 34.0 .1))
- (float-vector .5 .3 .4))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
- (x1 (formant-bank c4 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3 with amps at ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .9))
- (c2 (make-formant 1000.0 .9))
- (c3 (make-formant 34.0 .9))
- (c4 (make-formant-bank (vector (make-formant 440.0 .9)
- (make-formant 1000.0 .9)
- (make-formant 34.0 .9))
- (float-vector .5 .3 .4))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
- (x1 (formant-bank c4 x)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3 with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .5))
- (c2 (make-formant 1000.0 .2))
- (c3 (make-formant 34.0 .1))
- (inputs (make-float-vector 3 1.0))
- (c4 (make-formant-bank (vector (make-formant 440.0 .5)
- (make-formant 1000.0 .2)
- (make-formant 34.0 .1)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
- (x1 (formant-bank c4 inputs)))
- (fill! inputs 0.0)
- (if (not (morally-equal? x0 x1))
- (snd-display ";many (formant 440.0 .5) + (formant 1000.0 .2) + (formant 34.0 .1) ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .75))
- (c2 (make-formant 1000.0 .75))
- (c3 (make-formant 34.0 .75))
- (inputs (make-float-vector 3 1.0))
- (c4 (make-formant-bank (vector (make-formant 440.0 .75)
- (make-formant 1000.0 .75)
- (make-formant 34.0 .75)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
- (x1 (formant-bank c4 inputs)))
- (fill! inputs 0.0)
- (if (not (morally-equal? x0 x1))
- (snd-display ";many (formant 440.0 .75) + (formant 1000.0 .75) + (formant 34.0 .75) ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
-
- (let ((c1 (make-formant 440.0 .5))
- (c2 (make-formant 1000.0 .2))
- (c3 (make-formant 34.0 .1))
- (inputs (make-float-vector 3 1.0))
- (c4 (make-formant-bank (vector (make-formant 440.0 .5)
- (make-formant 1000.0 .2)
- (make-formant 34.0 .1))
- (float-vector .5 .3 .4))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
- (x1 (formant-bank c4 inputs)))
- (fill! inputs 0.0)
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3 with amps at ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .9))
- (c2 (make-formant 1000.0 .9))
- (c3 (make-formant 34.0 .9))
- (inputs (make-float-vector 3 1.0))
- (c4 (make-formant-bank (vector (make-formant 440.0 .9)
- (make-formant 1000.0 .9)
- (make-formant 34.0 .9))
- (float-vector .5 .3 .4))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0))
- ((= i 40))
- (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
- (x1 (formant-bank c4 inputs)))
- (fill! inputs 0.0)
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3 with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))
-
- (let ((c1 (make-formant 440.0 .9))
- (c2 (make-formant 1000.0 .9))
- (c3 (make-formant 34.0 .9))
- (inputs (make-float-vector 3 1.0))
- (c4 (make-formant-bank (vector (make-formant 440.0 .9)
- (make-formant 1000.0 .9)
- (make-formant 34.0 .9))
- (float-vector .5 .3 .4))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0)
- (y 1.0 0.0)
- (z 1.0 0.0))
- ((= i 40))
- (cond ((< i 10)
- (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
- (x1 (formant-bank c4 inputs)))
- (fill! inputs 0.0)
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3(1) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
- ((< i 20)
- (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
- (x1 (formant-bank c4 0.0)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3(2) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
- ((< i 30)
- (set! x 0.5)
- (set! y 0.25)
- (set! z 0.125)
- (set! (inputs 0) x)
- (set! (inputs 1) y)
- (set! (inputs 2) z)
- (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
- (x1 (formant-bank c4 inputs)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3(3) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
- (else
- (set! x 0.25)
- (set! y 0.25)
- (set! z 0.25)
- (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
- (x1 (formant-bank c4 0.25)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 3(4) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))))
-
- (let ((c1 (make-formant 440.0 .9))
- (c2 (make-formant 1000.0 .9))
- (c3 (make-formant 34.0 .9))
- (c4 (make-formant 340.0 .9))
- (c5 (make-formant 2000.0 .9))
- (inputs (make-float-vector 5 1.0))
- (c6 (make-formant-bank (vector (make-formant 440.0 .9)
- (make-formant 1000.0 .9)
- (make-formant 34.0 .9)
- (make-formant 340.0 .9)
- (make-formant 2000.0 .9)))))
- (do ((i 0 (+ i 1))
- (x 1.0 0.0)
- (y 1.0 0.0)
- (z 1.0 0.0)
- (a 1.0 0.0)
- (b 1.0 0.0))
- ((= i 40))
- (cond ((< i 10)
- (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
- (x1 (formant-bank c6 inputs)))
- (fill! inputs 0.0)
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 5(1) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
- ((< i 20)
- (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
- (x1 (formant-bank c6 0.0)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 5(2) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
- ((< i 30)
- (set! x 0.5)
- (set! y 0.25)
- (set! z 0.125)
- (set! a 0.1)
- (set! b 0.3)
- (set! (inputs 0) x)
- (set! (inputs 1) y)
- (set! (inputs 2) z)
- (set! (inputs 3) a)
- (set! (inputs 4) b)
- (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
- (x1 (formant-bank c6 inputs)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 5(3) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
- (else
- (set! x 0.25)
- (set! y 0.25)
- (set! z 0.25)
- (set! a 0.25)
- (set! b 0.25)
- (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
- (x1 (formant-bank c6 0.25)))
- (if (not (morally-equal? x0 x1))
- (snd-display ";fb 5(4) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))))
+ (do ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant-bank (vector (make-formant 440.0 .5))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (formant c1 x))
+ (x1 (formant-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(formant 440.0 .5) ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x)))
+ (x1 (formant-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(formant 440.0 .5) + (formant 1000.0 .2) ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(formant 440.0 .5) + (formant 1000.0 .2) + (formant 34.0 .1) ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .75))
+ (c2 (make-formant 1000.0 .75))
+ (c3 (make-formant 34.0 .75))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .75)
+ (make-formant 1000.0 .75)
+ (make-formant 34.0 .75))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";(formant 440.0 .75) + (formant 1000.0 .75) + (formant 34.0 .75) ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1))
+ (float-vector .5 .3 .4)))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3 with amps at ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9))
+ (float-vector .5 .3 .4)))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3 with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";many (formant 440.0 .5) + (formant 1000.0 .2) + (formant 34.0 .1) ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .75))
+ (c2 (make-formant 1000.0 .75))
+ (c3 (make-formant 34.0 .75))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .75)
+ (make-formant 1000.0 .75)
+ (make-formant 34.0 .75))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";many (formant 440.0 .75) + (formant 1000.0 .75) + (formant 34.0 .75) ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+
+ (do ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1))
+ (float-vector .5 .3 .4)))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3 with amps at ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9))
+ (float-vector .5 .3 .4)))
+ (i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3 with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+
+ (do ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9))
+ (float-vector .5 .3 .4)))
+ (i 0 (+ i 1))
+ (x 1.0 0.0)
+ (y 1.0 0.0)
+ (z 1.0 0.0))
+ ((= i 40))
+ (cond ((< i 10)
+ (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3(1) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ ((< i 20)
+ (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
+ (x1 (formant-bank c4 0.0)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3(2) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ ((< i 30)
+ (set! x 0.5)
+ (set! y 0.25)
+ (set! z 0.125)
+ (set! (inputs 0) x)
+ (set! (inputs 1) y)
+ (set! (inputs 2) z)
+ (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
+ (x1 (formant-bank c4 inputs)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3(3) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ (else
+ (set! x 0.25)
+ (set! y 0.25)
+ (set! z 0.25)
+ (let ((x0 (+ (* 0.5 (formant c1 x)) (* 0.3 (formant c2 y)) (* 0.4 (formant c3 z))))
+ (x1 (formant-bank c4 0.25)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 3(4) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))))
+
+ (do ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (c4 (make-formant 340.0 .9))
+ (c5 (make-formant 2000.0 .9))
+ (inputs (make-float-vector 5 1.0))
+ (c6 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9)
+ (make-formant 340.0 .9)
+ (make-formant 2000.0 .9))))
+ (i 0 (+ i 1))
+ (x 1.0 0.0)
+ (y 1.0 0.0)
+ (z 1.0 0.0)
+ (a 1.0 0.0)
+ (b 1.0 0.0))
+ ((= i 40))
+ (cond ((< i 10)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 5(1) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ ((< i 20)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 0.0)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 5(2) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ ((< i 30)
+ (set! x 0.5)
+ (set! y 0.25)
+ (set! z 0.125)
+ (set! a 0.1)
+ (set! b 0.3)
+ (set! (inputs 0) x)
+ (set! (inputs 1) y)
+ (set! (inputs 2) z)
+ (set! (inputs 3) a)
+ (set! (inputs 4) b)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 inputs)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 5(3) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ (else
+ (set! x 0.25)
+ (set! y 0.25)
+ (set! z 0.25)
+ (set! a 0.25)
+ (set! b 0.25)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 0.25)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display ";fb 5(4) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))))
(set! *clm-srate* 44100)
- (if (file-exists? "jcrev-ip.snd")
- (begin
- (with-sound (:reverb jc-reverb) (outa 0 .1) (outa 0 .5 *reverb*))
- (let ((s1 (find-sound "test.snd"))
- (s2 (open-sound "jcrev-ip.snd")))
- (if (not (= (channel-distance s1 0 s2 0) 0.0))
- (snd-display ";jcrev ip: ~A" (channel-distance s1 0 s2 0)))
- (close-sound s1)
- (close-sound s2))))
-
- (if (file-exists? "nrev-ip.snd")
- (begin
- (with-sound (:reverb nrev) (outa 0 .1) (outa 0 .5 *reverb*))
- (let ((s1 (find-sound "test.snd"))
- (s2 (open-sound "nrev-ip.snd")))
- (if (not (= (channel-distance s1 0 s2 0) 0.0))
- (snd-display ";nrev ip: ~A" (channel-distance s1 0 s2 0)))
- (close-sound s1)
- (close-sound s2))))
-
- (if (file-exists? "freeverb-ip.snd")
- (begin
- (with-sound (:reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*))
- (let ((s1 (find-sound "test.snd"))
- (s2 (open-sound "freeverb-ip.snd")))
- (if (not (= (channel-distance s1 0 s2 0) 0.0))
- (snd-display ";freeverb ip: ~A" (channel-distance s1 0 s2 0)))
- (close-sound s1)
- (close-sound s2))))
+ (when (file-exists? "jcrev-ip.snd")
+ (with-sound (:reverb jc-reverb) (outa 0 .1) (outa 0 .5 *reverb*))
+ (let ((s1 (find-sound "test.snd"))
+ (s2 (open-sound "jcrev-ip.snd")))
+ (if (not (= (channel-distance s1 0 s2 0) 0.0))
+ (snd-display ";jcrev ip: ~A" (channel-distance s1 0 s2 0)))
+ (close-sound s1)
+ (close-sound s2)))
+
+ (when (file-exists? "nrev-ip.snd")
+ (with-sound (:reverb nrev) (outa 0 .1) (outa 0 .5 *reverb*))
+ (let ((s1 (find-sound "test.snd"))
+ (s2 (open-sound "nrev-ip.snd")))
+ (if (not (= (channel-distance s1 0 s2 0) 0.0))
+ (snd-display ";nrev ip: ~A" (channel-distance s1 0 s2 0)))
+ (close-sound s1)
+ (close-sound s2)))
+
+ (when (file-exists? "freeverb-ip.snd")
+ (with-sound (:reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*))
+ (let ((s1 (find-sound "test.snd"))
+ (s2 (open-sound "freeverb-ip.snd")))
+ (if (not (= (channel-distance s1 0 s2 0) 0.0))
+ (snd-display ";freeverb ip: ~A" (channel-distance s1 0 s2 0)))
+ (close-sound s1)
+ (close-sound s2)))
(let ()
(defgenerator (old-rxyk!sin
@@ -21076,19 +20884,19 @@ EDITS: 2
(k n 1)))
(define (rxyk!cos-direct x y a terms)
- (let ((sum 0.0))
- (do ((k 0 (+ k 1)))
- ((= k terms) (/ sum (exp (abs a))))
- (set! sum (+ sum (* (/ (expt a k) (kfactorial k))
- (cos (+ x (* k y)))))))))
+ (do ((sum 0.0)
+ (k 0 (+ k 1)))
+ ((= k terms) (/ sum (exp (abs a))))
+ (set! sum (+ sum (* (/ (expt a k) (kfactorial k))
+ (cos (+ x (* k y))))))))
(define (rxyk!sin-direct x y a terms)
- (let ((sum 0.0))
- (do ((k 0 (+ k 1)))
- ((= k terms) (/ sum (exp (abs a))))
- (set! sum (+ sum (* (/ (expt a k) (kfactorial k))
- (sin (+ x (* k y)))))))))
-
+ (do ((sum 0.0)
+ (k 0 (+ k 1)))
+ ((= k terms) (/ sum (exp (abs a))))
+ (set! sum (+ sum (* (/ (expt a k) (kfactorial k))
+ (sin (+ x (* k y))))))))
+
(let ((g1 (make-rxyk!cos 100.0))
(g2 (make-old-rxyk!cos 100.0))
@@ -21229,46 +21037,47 @@ EDITS: 2
0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000)))
(snd-display ";pulsed-env: ~A" v))))
-
- (copy-test (make-oscil 330.0))
- (copy-test (make-ncos 440.0 10))
- (copy-test (make-nsin 440.0 10))
- (copy-test (make-nrxycos 330.0 0.9 10))
- (copy-test (make-nrxysin 330.0 0.9 10))
- (copy-test (make-rxyk!cos 440.0))
- (copy-test (make-rxyk!sin 440.0))
- (copy-test (make-sawtooth-wave 100))
- (copy-test (make-pulse-train 100))
- (copy-test (make-triangle-wave 100))
- (copy-test (make-square-wave 100))
- (copy-test (make-one-zero .1 .2))
- (copy-test (make-one-pole .1 .2))
- (copy-test (make-two-zero .9 .1 .2))
- (copy-test (make-two-pole .9 .1 .2))
- (copy-test (make-polywave 440.0 '(1 .5 2 .5)))
- (copy-test (make-polyshape 440.0 :coeffs (partials->polynomial '(1 1.0))))
- (copy-test (make-oscil-bank (float-vector 100 200 300) (float-vector 0.0 1.0 2.0) (float-vector 0.5 0.25 0.125)))
- (copy-test (make-delay 10))
- (copy-test (make-comb .7 10))
- (copy-test (make-notch .7 10))
- (copy-test (make-all-pass .8 .7 10))
- (copy-test (make-moving-average 10))
- (copy-test (make-moving-norm 10))
- (copy-test (make-moving-max 10))
- (copy-test (make-comb-bank (vector (make-comb 0.742 99) (make-comb 0.733 49) (make-comb 0.715 53))))
- (copy-test (make-all-pass-bank (vector (make-all-pass -0.700 0.700 51) (make-all-pass -0.700 0.700 33) (make-all-pass -0.700 0.700 11))))
- (copy-test (make-filtered-comb .4 5 :filter (make-one-zero .3 .7)))
- (copy-test (make-filtered-comb-bank (vector (make-filtered-comb .5 3) (make-filtered-comb .2 10) (make-filtered-comb -.7 11))))
- (copy-test (make-formant 1200.0 0.9))
- (copy-test (make-firmant 1200.0 0.9))
- (copy-test (make-fir-filter 4 (float-vector 0.4 0.3 0.2 0.1)))
- (copy-test (make-iir-filter 4 (float-vector 0.4 0.3 0.2 0.1)))
- (copy-test (make-filter 4 (float-vector 0.4 0.3 0.2 0.1)))
- (copy-test (make-one-pole-all-pass 8 .5))
- (copy-test (make-readin "oboe.snd"))
- (copy-test (make-env '(0 0 1 1) :length 10))
- (copy-test (make-pulsed-env '(0 0 1 1) .001 1000))
-
+
+ (for-each copy-test
+ (vector (make-oscil 330.0)
+ (make-ncos 440.0 10)
+ (make-nsin 440.0 10)
+ (make-nrxycos 330.0 0.9 10)
+ (make-nrxysin 330.0 0.9 10)
+ (make-rxyk!cos 440.0)
+ (make-rxyk!sin 440.0)
+ (make-sawtooth-wave 100)
+ (make-pulse-train 100)
+ (make-triangle-wave 100)
+ (make-square-wave 100)
+ (make-one-zero .1 .2)
+ (make-one-pole .1 .2)
+ (make-two-zero .9 .1 .2)
+ (make-two-pole .9 .1 .2)
+ (make-polywave 440.0 '(1 .5 2 .5))
+ (make-polyshape 440.0 :coeffs (partials->polynomial '(1 1.0)))
+ (make-oscil-bank (float-vector 100 200 300) (float-vector 0.0 1.0 2.0) (float-vector 0.5 0.25 0.125))
+ (make-delay 10)
+ (make-comb .7 10)
+ (make-notch .7 10)
+ (make-all-pass .8 .7 10)
+ (make-moving-average 10)
+ (make-moving-norm 10)
+ (make-moving-max 10)
+ (make-comb-bank (vector (make-comb 0.742 99) (make-comb 0.733 49) (make-comb 0.715 53)))
+ (make-all-pass-bank (vector (make-all-pass -0.700 0.700 51) (make-all-pass -0.700 0.700 33) (make-all-pass -0.700 0.700 11)))
+ (make-filtered-comb .4 5 :filter (make-one-zero .3 .7))
+ (make-filtered-comb-bank (vector (make-filtered-comb .5 3) (make-filtered-comb .2 10) (make-filtered-comb -.7 11)))
+ (make-formant 1200.0 0.9)
+ (make-firmant 1200.0 0.9)
+ (make-fir-filter 4 (float-vector 0.4 0.3 0.2 0.1))
+ (make-iir-filter 4 (float-vector 0.4 0.3 0.2 0.1))
+ (make-filter 4 (float-vector 0.4 0.3 0.2 0.1))
+ (make-one-pole-all-pass 8 .5)
+ (make-readin "oboe.snd")
+ (make-env '(0 0 1 1) :length 10)
+ (make-pulsed-env '(0 0 1 1) .001 1000)))
+
;; formant-bank isn't really testing equality yet
(let* ((o (make-rand 100.0))
@@ -21391,14 +21200,14 @@ EDITS: 2
;; Columbia, Gem of the Ocean
(define (seg data) ; SEG functions expected data in (y x) pairs.
- (let ((unseg ())
- (len (length data)))
- (do ((i 0 (+ i 2)))
- ((>= i len)
- (reverse unseg))
- (let ((x (data (+ i 1)))
- (y (data i)))
- (set! unseg (cons y (cons x unseg)))))))
+ (do ((unseg ())
+ (len (length data))
+ (i 0 (+ i 2)))
+ ((>= i len)
+ (reverse unseg))
+ (let ((x (data (+ i 1)))
+ (y (data i)))
+ (set! unseg (cons y (cons x unseg))))))
(let ((oldie (find-sound "test.snd")))
(if (sound? oldie)
@@ -22022,14 +21831,12 @@ EDITS: 2
((or (not happy) (= i 10)))
(let ((ho-val (ho))
(hi-val (hi)))
- (if (fneq hi-val (* i -.01))
- (begin
- (snd-display ";mix-reader at ~A from 0: ~A" i hi-val)
- (set! happy #f)))
- (if (fneq ho-val (* (+ i 5) -.01))
- (begin
- (snd-display ";mix-reader at ~A from 5: ~A" i ho-val)
- (set! happy #f)))))))
+ (when (fneq hi-val (* i -.01))
+ (snd-display ";mix-reader at ~A from 0: ~A" i hi-val)
+ (set! happy #f))
+ (when (fneq ho-val (* (+ i 5) -.01))
+ (snd-display ";mix-reader at ~A from 5: ~A" i ho-val)
+ (set! happy #f))))))
(revert-sound ind)
(set! v (make-float-vector 21))
(fill! v 0.5)
@@ -22043,14 +21850,12 @@ EDITS: 2
((or (not happy) (= i 10)))
(let ((ho-val (ho))
(hi-val (hi)))
- (if (fneq hi-val (* i .025))
- (begin
- (snd-display ";mix-reader env'd at ~A from 0: ~A" i hi-val)
- (set! happy #f)))
- (if (fneq ho-val (* (+ i 10) .025))
- (begin
- (snd-display ";mix-reader env'd at ~A from 10: ~A" i ho-val)
- (set! happy #f)))))))
+ (when (fneq hi-val (* i .025))
+ (snd-display ";mix-reader env'd at ~A from 0: ~A" i hi-val)
+ (set! happy #f))
+ (when (fneq ho-val (* (+ i 10) .025))
+ (snd-display ";mix-reader env'd at ~A from 10: ~A" i ho-val)
+ (set! happy #f))))))
(close-sound ind))
(let ((ind (open-sound "oboe.snd"))
@@ -22707,7 +22512,7 @@ EDITS: 2
(set! *with-mix-tags* #t)
(let ((ind (open-sound "oboe.snd"))
- (fr (mus-sound-framples "1a.snd")))
+ (fr (+ 1000 (mus-sound-framples "1a.snd"))))
(mix-float-vector (make-float-vector 100 .1) 1000)
(for-each
(lambda (mtest)
@@ -22734,9 +22539,9 @@ EDITS: 2
(list (lambda () (insert-samples 1110 100 (make-float-vector 100 .2))) 1000 #f 'insert1110)
(list (lambda () (insert-samples 2000 100 (make-float-vector 100 .2))) 1000 #f 'insert2000)
- (list (lambda () (insert-sound "1a.snd" 0)) (+ fr 1000) #f 'inserts0)
- (list (lambda () (insert-sound "1a.snd" 800)) (+ fr 1000) #f 'inserts800)
- (list (lambda () (insert-sound "1a.snd" 990)) (+ fr 1000) #f 'inserts990)
+ (list (lambda () (insert-sound "1a.snd" 0)) fr #f 'inserts0)
+ (list (lambda () (insert-sound "1a.snd" 800)) fr #f 'inserts800)
+ (list (lambda () (insert-sound "1a.snd" 990)) fr #f 'inserts990)
(list (lambda () (insert-sound "1a.snd" 1010)) 1000 #t 'inserts1010)
(list (lambda () (insert-sound "1a.snd" 1050)) 1000 #t 'inserts1050)
(list (lambda () (insert-sound "1a.snd" 1110)) 1000 #f 'inserts1110)
@@ -23047,16 +22852,14 @@ EDITS: 2
(= i 1000)))
(let ((x1 (rd1))
(x2 (rd2)))
- (if (or (fneq x1 x2) (fneq x1 (* i .001)))
- (begin
- (set! happy #f)
- (snd-display ";copy mix at ~A: ~A ~A ~A" i x1 x2 (* i .001))))))))
+ (when (or (fneq x1 x2) (fneq x1 (* i .001)))
+ (set! happy #f)
+ (snd-display ";copy mix at ~A: ~A ~A ~A" i x1 x2 (* i .001)))))))
(close-sound snd))
- (if all-args
- (begin
- (close-sound (make-waltz))
- (close-sound (make-bagatelle))))
+ (when all-args
+ (close-sound (make-waltz))
+ (close-sound (make-bagatelle)))
))
@@ -23078,10 +22881,10 @@ EDITS: 2
maxval))
(define (data-max2 snd)
- (let ((maxval 0.0))
- (do ((i 0 (+ i 1)))
- ((= i (chans snd)) maxval)
- (set! maxval (max maxval (float-vector-peak (samples 0 9 snd i)))))))
+ (do ((maxval 0.0)
+ (i 0 (+ i 1)))
+ ((= i (chans snd)) maxval)
+ (set! maxval (max maxval (float-vector-peak (samples 0 9 snd i))))))
(define (data-max1 snd chn)
(float-vector-peak (samples 0 9 snd chn)))
@@ -23307,8 +23110,6 @@ EDITS: 2
(set! (mark-property :hiho m1) 123)
(if (not (= (mark-property :hiho m1) 123)) (snd-display ";mark-property: ~A" (mark-property :hiho m1)))
(if (mark-property :not-there m1) (snd-display ";mark-not-property: ~A" (mark-property :not-there m1)))
- (if (not (eq? (without-errors (mark-sample (integer->mark 12345678))) 'no-such-mark))
- (snd-display ";mark-sample err: ~A?" (without-errors (mark-sample 12345678))))
(if (not (eq? (without-errors (add-mark 123 123)) 'no-such-sound))
(snd-display ";add-mark err: ~A?" (without-errors (add-mark 123 123))))
(let ((m2 (without-errors (add-mark 12345 fd 0))))
@@ -24065,11 +23866,11 @@ EDITS: 2
(string-equal-ignoring-white-space str1 "A raised cosine")))
(snd-display ";snd-help hamming-window: ~A ~A" str1 str2)))
- (let ((vals (snd-urls)))
- (do ((i 0 (+ i 1)))
- ((= i 25)) ; need to cycle the 8's
- (if (defined? (string->symbol (car (vals i))))
- (snd-help (car (vals i)) #f))))
+ (do ((vals (snd-urls))
+ (i 0 (+ i 1)))
+ ((= i 25)) ; need to cycle the 8's
+ (if (defined? (string->symbol (car (vals i))))
+ (snd-help (car (vals i)) #f)))
(set! *show-indices* #t)
(let ((ind (open-sound "oboe.snd")))
@@ -24241,10 +24042,9 @@ EDITS: 2
(snd-display ";~A ~A ~A" name ht df)
-1))
-1)))))
- (if (not (eqv? fd -1))
- (begin
- (set! open-ctr (+ open-ctr 1))
- (set! open-files (cons fd open-files)))))
+ (unless (eqv? fd -1)
+ (set! open-ctr (+ open-ctr 1))
+ (set! open-files (cons fd open-files))))
(if (and (> len 0) (> (random 1.0) 0.3))
(let ((fd (open-files (floor (random (* 1.0 (length open-files)))))))
(close-sound fd)
@@ -24532,12 +24332,10 @@ EDITS: 2
(set! (cursor fd) 2000)
(set! *transform-graph-type* graph-once)
(set! (transform-graph? fd) #t)
- (if (not clm_buffer_added)
- (begin
- (add-to-menu mb "not here" (lambda () (snd-display ";oops")))
- (remove-from-menu mb "not here")
- (add-to-menu 3 "Denoise" (lambda () (status-report "denoise")))))
-
+ (unless clm_buffer_added
+ (add-to-menu mb "not here" (lambda () (snd-display ";oops")))
+ (remove-from-menu mb "not here")
+ (add-to-menu 3 "Denoise" (lambda () (status-report "denoise"))))
(set! clm_buffer_added #t)))
(set! (hook-functions help-hook) ())
@@ -24599,11 +24397,11 @@ EDITS: 2
(set! (x-axis-style (hook 'snd) #t) x-axis-as-percentage)))
(hook-push initial-graph-hook
(lambda (hook)
- (let ((snd (hook 'snd))
+ (let ((snd (file-name (hook 'snd)))
(chn (hook 'chn))
(dur (hook 'duration)))
- (if (mus-sound-maxamp-exists? (file-name snd))
- (let ((max-val ((mus-sound-maxamp (file-name snd)) (+ (* chn 2) 1)))) ; implicit index
+ (if (mus-sound-maxamp-exists? snd)
+ (let ((max-val ((mus-sound-maxamp snd) (+ (* chn 2) 1)))) ; implicit index
(set! (hook 'result) (list 0.0 dur (- max-val) max-val)))
(set! (hook 'result) (list 0.0 dur -1.0 1.0))))))
(set! (hook-functions after-open-hook) ())
@@ -24652,10 +24450,9 @@ EDITS: 2
(dismiss-all-dialogs)
(set! (hook-functions close-hook) ())
(for-each close-sound (sounds))
- (if (sound? fd)
- (begin
- (snd-display ";close all didn't? ~A ~A ~A ~A ~A" fd (sound? fd) (short-file-name fd) (hook-functions close-hook) (sounds))
- (close-sound fd))))
+ (when (sound? fd)
+ (snd-display ";close all didn't? ~A ~A ~A ~A ~A" fd (sound? fd) (short-file-name fd) (hook-functions close-hook) (sounds))
+ (close-sound fd)))
(let ((fd (open-sound "obtest.snd")))
(set! *with-background-processes* #f)
@@ -25024,10 +24821,9 @@ EDITS: 2
(hook-push open-hook (lambda (hook) (set! (hook 'result) #t)))
(let ((pistol (open-sound "pistol.snd")))
- (if pistol
- (begin
- (snd-display ";open-hook #t, but open-sound -> ~A" pistol)
- (if (sound? pistol) (close-sound pistol)))))
+ (when pistol
+ (snd-display ";open-hook #t, but open-sound -> ~A" pistol)
+ (if (sound? pistol) (close-sound pistol))))
(set! (hook-functions open-hook) ())
(let ((gr #f)
@@ -25300,10 +25096,9 @@ EDITS: 2
(set! (hook 'result) #t)))
(save-sound-as "baddy.snd" ind)
(if (not sh) (snd-display ";save-hook not called?"))
- (if (file-exists? "baddy.snd")
- (begin
- (snd-display ";save-hook didn't cancel save?")
- (delete-file "baddy.snd")))
+ (when (file-exists? "baddy.snd")
+ (snd-display ";save-hook didn't cancel save?")
+ (delete-file "baddy.snd"))
(set! (hook-functions save-hook) ()))
;; after-transform-hooks require some way to force the fft to run to completion
@@ -25612,18 +25407,11 @@ EDITS: 2
(hook-push before-save-as-hook
(lambda (hook)
(let ((index (hook 'snd))
- ;(filename (hook 'name))
- ;(selection (hook 'selection))
- (sr (hook 'sampling-rate))
- ;(type (hook 'header-type))
- ;(dformat (hook 'sample-type))
- ;(comment (hook 'comment))
- )
+ (sr (hook 'sampling-rate)))
(set! need-save-as-undo #f)
- (if (not (= sr (srate index)))
- (begin
- (src-sound (* 1.0 (/ (srate index) sr)) 1.0 index)
- (set! need-save-as-undo #t))))))
+ (unless (= sr (srate index))
+ (src-sound (* 1.0 (/ (srate index) sr)) 1.0 index)
+ (set! need-save-as-undo #t)))))
(hook-push after-save-as-hook
(lambda (hook)
(if need-save-as-undo (undo)))))
@@ -25759,10 +25547,9 @@ EDITS: 2
(do ((chn 1 (+ chn 1)))
((= chn chns))
(set! mxpos (+ mxpos (edit-position snd chn)))))
- (if (or (> mxpos 100) (> chns 4))
- (begin
- (snd-display ";revert ~A at ~A" (file-name snd) mxpos)
- (revert-sound snd)))))
+ (when (or (> mxpos 100) (> chns 4))
+ (snd-display ";revert ~A at ~A" (file-name snd) mxpos)
+ (revert-sound snd))))
(sounds))))
(log-mem test-ctr)
@@ -25771,10 +25558,9 @@ EDITS: 2
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
(for-each
(lambda (s)
- (if (> (chans s) 4)
- (begin
- (set! open-files (test-remove-if (lambda (a) (= a s)) open-files))
- (close-sound s))))
+ (when (> (chans s) 4)
+ (set! open-files (test-remove-if (lambda (a) (= a s)) open-files))
+ (close-sound s)))
(sounds))
(save-state "s61.scm")
(for-each close-sound (sounds))
@@ -25809,14 +25595,13 @@ EDITS: 2
(duration (lambda (ind)
(/ (framples ind) (srate ind)))))
- (if (> (duration curfd) 0.0)
- (begin
- (set! (x-bounds curfd) (list 0.0 (min (duration curfd) 1.0)))
- (when with-gui
- (let ((xb (x-bounds curfd)))
- (if (or (fneq (car xb) 0.0)
- (fneq (cadr xb) (min (duration curfd) 1.0)))
- (snd-display ";x-bounds: ~A?" xb))))))
+ (when (> (duration curfd) 0.0)
+ (set! (x-bounds curfd) (list 0.0 (min (duration curfd) 1.0)))
+ (when with-gui
+ (let ((xb (x-bounds curfd)))
+ (if (or (fneq (car xb) 0.0)
+ (fneq (cadr xb) (min (duration curfd) 1.0)))
+ (snd-display ";x-bounds: ~A?" xb)))))
(set! (y-bounds curfd) (list -0.5 0.5))
(let ((yb (y-bounds curfd)))
(when (and with-gui
@@ -25824,11 +25609,10 @@ EDITS: 2
(snd-display ";y-bounds: ~A?" yb)))
(set! (cursor curfd 0) curloc)
(let ((cl (cursor curfd 0)))
- (if (and (not (= cl curloc))
- (> (framples curfd 0) curloc))
- (begin
- (snd-display ";cursor ~A is not ~A (framples: ~A)?" cl curloc (framples curfd 0))
- (set! curloc (cursor curfd 0)))))
+ (when (and (not (= cl curloc))
+ (> (framples curfd 0) curloc))
+ (snd-display ";cursor ~A is not ~A (framples: ~A)?" cl curloc (framples curfd 0))
+ (set! curloc (cursor curfd 0))))
(if (>= curloc (framples curfd 0)) (set! curloc 0))
(let ((id (catch #t (lambda () (add-mark curloc curfd)) (lambda args -1))))
(when (and (number? id) (not (= id -1)))
@@ -25852,20 +25636,19 @@ EDITS: 2
(if (not (= cl (max 0 (- curloc 100)))) (snd-display ";set mark ~A is not ~A?" cl curloc))
(delete-mark id)))
(if (> (duration curfd) 1.2) (set! (x-bounds curfd) '(1.0 1.1)))
- (if (> (framples curfd) 25)
- (begin
- (add-mark 10 curfd)
- (add-mark 20 curfd)
- (key (char->integer #\m) 0 curfd)
- (set! (cursor curfd) 0)
- (let ((new-marks (length (marks curfd 0))))
- (delete-marks curfd)
- (if (> (duration curfd) 0.0)
- (set! (x-bounds curfd) (list 0.0 (min (duration curfd) 0.1))))
- (set! (y-bounds curfd) '(-1.0 1.0))
- (if (or (> (length (marks curfd 0)) 0)
- (not (= new-marks (+ old-marks 3))))
- (snd-display ";delete marks: ~A ~A?" new-marks old-marks))))))))
+ (when (> (framples curfd) 25)
+ (add-mark 10 curfd)
+ (add-mark 20 curfd)
+ (key (char->integer #\m) 0 curfd)
+ (set! (cursor curfd) 0)
+ (let ((new-marks (length (marks curfd 0))))
+ (delete-marks curfd)
+ (if (> (duration curfd) 0.0)
+ (set! (x-bounds curfd) (list 0.0 (min (duration curfd) 0.1))))
+ (set! (y-bounds curfd) '(-1.0 1.0))
+ (if (or (> (length (marks curfd 0)) 0)
+ (not (= new-marks (+ old-marks 3))))
+ (snd-display ";delete marks: ~A ~A?" new-marks old-marks)))))))
(revert-sound)
(let-temporarily ((*selection-creates-region* #t))
@@ -25890,29 +25673,28 @@ EDITS: 2
(status-report "hi")
(without-errors
- (begin
- (let ((cfd (choose-fd)))
- (safe-make-selection cfd)
- (src-selection .5)
- (undo 1 cfd))
- (let ((cfd (choose-fd)))
- (safe-make-selection cfd)
- (src-selection -1.5)
- (undo 1 cfd))
- (let ((cfd (choose-fd)))
- (safe-make-selection cfd)
- (scale-selection-by .5)
- (undo 1 cfd))
- (let ((cfd (choose-fd)))
- (safe-make-selection cfd)
- (env-selection '(0 0 1 1 2 0))
- (undo 1 cfd))
- (let ((cfd (choose-fd)))
- (safe-make-selection cfd)
- (scale-selection-to .5)
- (reverse-selection)
- (undo 2 cfd))
- (if (> (length (regions)) 2) (forget-region ((regions) 2)))))
+ (let ((cfd (choose-fd)))
+ (safe-make-selection cfd)
+ (src-selection .5)
+ (undo 1 cfd))
+ (let ((cfd (choose-fd)))
+ (safe-make-selection cfd)
+ (src-selection -1.5)
+ (undo 1 cfd))
+ (let ((cfd (choose-fd)))
+ (safe-make-selection cfd)
+ (scale-selection-by .5)
+ (undo 1 cfd))
+ (let ((cfd (choose-fd)))
+ (safe-make-selection cfd)
+ (env-selection '(0 0 1 1 2 0))
+ (undo 1 cfd))
+ (let ((cfd (choose-fd)))
+ (safe-make-selection cfd)
+ (scale-selection-to .5)
+ (reverse-selection)
+ (undo 2 cfd))
+ (if (> (length (regions)) 2) (forget-region ((regions) 2))))
(for-each revert-sound open-files)
(without-errors
@@ -25970,25 +25752,23 @@ EDITS: 2
(pad-channel 0 100 ind 0)
(func1 0)
(revert-sound ind)
- (if (> (chans ind) 1)
- (begin
- (pad-channel 0 100 ind 1)
- (func 0)
- (pad-channel 0 100 ind 1)
- (func1 0)
- (revert-sound ind)))
+ (when (> (chans ind) 1)
+ (pad-channel 0 100 ind 1)
+ (func 0)
+ (pad-channel 0 100 ind 1)
+ (func1 0)
+ (revert-sound ind))
(delete-samples 0 1000 ind 0)
(func (* 2 (framples ind 0)))
(delete-samples 0 10000 ind 0)
(func1 (* 2 (framples ind 0)))
(revert-sound ind)
- (if (> (chans ind) 1)
- (begin
- (delete-samples 0 1000 ind 1)
- (func (* 2 (framples ind 1)))
- (delete-samples 0 10000 ind 1)
- (func1 (* 2 (framples ind 1)))
- (revert-sound ind))))
+ (when (> (chans ind) 1)
+ (delete-samples 0 1000 ind 1)
+ (func (* 2 (framples ind 1)))
+ (delete-samples 0 10000 ind 1)
+ (func1 (* 2 (framples ind 1)))
+ (revert-sound ind)))
(list (lambda (beg) (insert-sound "2a.snd" beg))
(lambda (beg) (reverse-sound))
(lambda (beg) (if (< (framples ind) 10000) (convolve-with "2a.snd" 0.5) (scale-by 2.0)))
@@ -26069,20 +25849,18 @@ EDITS: 2
(lambda ()
(mix s8-snd 24000)
(let ((reg (select-all)))
- (if (selection?)
- (begin
- (filter-selection '(0 0 .2 1 .5 0 1 0) 40)
- (delete-selection)
- (mix-region reg))))))
+ (when (selection?)
+ (filter-selection '(0 0 .2 1 .5 0 1 0) 40)
+ (delete-selection)
+ (mix-region reg)))))
(if (not (= (edit-position) 1)) (snd-display ";as-one-edit mix zz: ~A -> ~A" editctr (edit-position)))
(close-sound zz))))
(let ((s8 (view-sound s8-snd)))
(select-sound s8)
- (if (= (channels s8) 8)
- (begin
- (select-channel 5)
- (if (not (eqv? (selected-channel) 5))
- (snd-display ";select-channel: ~A?" (selected-channel)))))
+ (when (= (channels s8) 8)
+ (select-channel 5)
+ (if (not (eqv? (selected-channel) 5))
+ (snd-display ";select-channel: ~A?" (selected-channel))))
(let ((editctr (edit-position)))
(as-one-edit
(lambda ()
@@ -26261,12 +26039,11 @@ EDITS: 2
(set! (x-bounds) '(.1 .2))
(hook-push lisp-graph-hook display-energy)
(set! (hook-functions graph-hook) ())
- (if (= (channels) 2)
- (begin
- (hook-push graph-hook display-correlation)
- (set! (x-bounds) '(.1 .12))
- (set! (x-bounds) '(.1 .2))
- (hook-remove graph-hook display-correlation)))
+ (when (= (channels) 2)
+ (hook-push graph-hook display-correlation)
+ (set! (x-bounds) '(.1 .12))
+ (set! (x-bounds) '(.1 .2))
+ (hook-remove graph-hook display-correlation))
(set! (lisp-graph?) #f)
(let ((mapf (let ((buffer (make-delay 128))
(gen (make-moving-average 128))
@@ -26280,12 +26057,12 @@ EDITS: 2
(if (not (= current-sample chan-samples))
old-y
;; at end return trailing samples as long as it looks like sound
- (let ((temp-buffer (make-delay 128)))
- (do ((i 0 (+ i 1))
- (fy (delay buffer 0.0) (delay buffer 0.0)))
- ((= i 128)
- (mus-data temp-buffer))
- (delay temp-buffer (if (> (moving-average gen 0.0) .01) fy 0.0)))))))))))
+ (do ((temp-buffer (make-delay 128))
+ (i 0 (+ i 1))
+ (fy (delay buffer 0.0) (delay buffer 0.0)))
+ ((= i 128)
+ (mus-data temp-buffer))
+ (delay temp-buffer (if (> (moving-average gen 0.0) .01) fy 0.0))))))))))
(map-channel mapf 0 20))
(let ((maxval1 (+ (maxamp) .01)))
@@ -26461,10 +26238,9 @@ EDITS: 2
(list 'zero-pad zero-pad #f 0 2)
(list 'zoom-focus-style zoom-focus-style #f 0 3))))
- (if (not (equal? *transform-type* fourier-transform))
- (begin
- (set! (transform-graph? #t #t) #f)
- (set! *transform-size* (min *transform-size* 128)))))
+ (unless (equal? *transform-type* fourier-transform)
+ (set! (transform-graph? #t #t) #f)
+ (set! *transform-size* (min *transform-size* 128))))
(set! *sinc-width* 10)
(if (pair? open-files) (for-each close-sound open-files))
(set! *sync-style* sync-none)
@@ -26499,14 +26275,14 @@ EDITS: 2
(define (snd_test_15)
(define (smoother y0 y1)
- (let ((v (make-float-vector 11))
- (angle (if (> y1 y0) pi 0.0))
- (off (* .5 (+ y0 y1)))
- (incr (/ pi 10))
- (scale (* 0.5 (abs (- y1 y0)))))
- (do ((i 0 (+ i 1)))
- ((= i 10) v)
- (set! (v i) (+ off (* scale (cos (+ angle (* i incr)))))))))
+ (do ((v (make-float-vector 11))
+ (angle (if (> y1 y0) pi 0.0))
+ (off (* .5 (+ y0 y1)))
+ (incr (/ pi 10))
+ (scale (* 0.5 (abs (- y1 y0))))
+ (i 0 (+ i 1)))
+ ((= i 10) v)
+ (set! (v i) (+ off (* scale (cos (+ angle (* i incr))))))))
(define prefix-it
(lambda (n id)
@@ -26519,9 +26295,9 @@ EDITS: 2
(define prefix-uit
(lambda (n id)
- (let* ((ns (number->string n))
- (digits (length ns)))
- (do ((i 0 (+ i 1)))
+ (let ((ns (number->string n)))
+ (do ((digits (length ns))
+ (i 0 (+ i 1)))
((= i digits))
(key (char->integer (ns i)) 0 id)))))
@@ -26616,35 +26392,34 @@ EDITS: 2
(srate))
size)
peak0))
- (if (> (spectr i) peak0)
- (begin
- (set! peak0 (spectr i))
- (set! pk0loc i))))))
+ (when (> (spectr i) peak0)
+ (set! peak0 (spectr i))
+ (set! pk0loc i)))))
(define (test-selection ind beg len scaler)
(set! (selection-member? ind 0) #t)
(set! (selection-position) beg)
(set! (selection-framples) len)
(scale-selection-by scaler)
- (let* ((diff 0.0)
- (pos (edit-position ind 0))
- (old-reader (make-sampler beg ind 0 1 (- pos 1)))
- (new-reader (make-sampler beg ind 0 1 pos))
- (incr (make-one-pole 1.0 -1.0)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (one-pole incr (abs (- (* scaler (next-sample old-reader)) (next-sample new-reader)))))
- (set! diff (one-pole incr 0.0))
- (if (> diff 0.0) (snd-display ";diff (~D ~D): ~A" beg len diff))
- (set! diff 0.0)
- (set! incr (make-one-pole 1.0 -1.0))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (one-pole incr (abs (- (next-sample old-reader) (next-sample new-reader)))))
- (set! diff (one-pole incr 0.0))
- (if (> diff 0.0) (snd-display ";zdiff (~D ~D): ~A" beg len diff))
- (free-sampler old-reader)
- (free-sampler new-reader)))
+ (let ((diff 0.0)
+ (pos (edit-position ind 0)))
+ (let ((old-reader (make-sampler beg ind 0 1 (- pos 1)))
+ (new-reader (make-sampler beg ind 0 1 pos))
+ (incr (make-one-pole 1.0 -1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (one-pole incr (abs (- (* scaler (next-sample old-reader)) (next-sample new-reader)))))
+ (set! diff (one-pole incr 0.0))
+ (if (> diff 0.0) (snd-display ";diff (~D ~D): ~A" beg len diff))
+ (set! diff 0.0)
+ (set! incr (make-one-pole 1.0 -1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (one-pole incr (abs (- (next-sample old-reader) (next-sample new-reader)))))
+ (set! diff (one-pole incr 0.0))
+ (if (> diff 0.0) (snd-display ";zdiff (~D ~D): ~A" beg len diff))
+ (free-sampler old-reader)
+ (free-sampler new-reader))))
(define (test-selection-to ind beg len maxval)
(set! (selection-member? ind 0) #t)
@@ -26655,26 +26430,25 @@ EDITS: 2
(if (fneq newmax maxval)
(snd-display ";scale-selection-to (~D ~D) ~A: ~A?" beg len maxval newmax))))
- (define play-with-amps
- (lambda (sound . amps)
- (let ((chans (chans sound)))
- (do ((chan 0 (+ 1 chan)))
- ((= chan chans))
- (let ((player (make-player sound chan)))
- (if (not (player? player)) (snd-display ";player? ~A -> #f?" player))
- (if (not (member player (players))) (snd-display ";player: ~A, but players: ~A" player (players)))
- (if (not (equal? (player-home player) (list sound chan)))
- (snd-display ";player-home ~A ~A?" (player-home player) (list sound chan)))
- (set! (amp-control player) (amps chan))
- (set! (speed-control player) .5)
- (set! (expand-control? player) #t)
- (set! (expand-control player) 2.0)
- (set! (contrast-control? player) #t)
- (set! (contrast-control player) 1.0)
- (set! (reverb-control? player) #t)
- (set! (reverb-control-scale player) .02)
- (add-player player)))
- (start-playing chans (srate sound) #f))))
+ (define (play-with-amps sound . amps)
+ (do ((chans (chans sound))
+ (chan 0 (+ 1 chan)))
+ ((= chan chans)
+ (start-playing chans (srate sound) #f))
+ (let ((player (make-player sound chan)))
+ (if (not (player? player)) (snd-display ";player? ~A -> #f?" player))
+ (if (not (member player (players))) (snd-display ";player: ~A, but players: ~A" player (players)))
+ (if (not (equal? (player-home player) (list sound chan)))
+ (snd-display ";player-home ~A ~A?" (player-home player) (list sound chan)))
+ (set! (amp-control player) (amps chan))
+ (set! (speed-control player) .5)
+ (set! (expand-control? player) #t)
+ (set! (expand-control player) 2.0)
+ (set! (contrast-control? player) #t)
+ (set! (contrast-control player) 1.0)
+ (set! (reverb-control? player) #t)
+ (set! (reverb-control-scale player) .02)
+ (add-player player))))
;; examp.scm (commented out)
(define (sound-via-sound snd1 snd2) ; "sound composition"??
@@ -26824,23 +26598,21 @@ EDITS: 2
(s2 (sample 1000 s2i 1)))
(set! (sync s2i) 4)
(select-all)
- (if (not (= (selection-chans) 2))
- (begin
- (snd-display ";selection-chans(2): ~A?" (selection-chans))
- (for-each
- (lambda (snd)
- (do ((i 0 (+ i 1)))
- ((= i (chans snd)))
- (if (selection-member? snd i)
- (snd-display "; ~A[~A] at ~A" (short-file-name snd) i (selection-position snd i)))))
- (sounds))))
+ (unless (= (selection-chans) 2)
+ (snd-display ";selection-chans(2): ~A?" (selection-chans))
+ (for-each
+ (lambda (snd)
+ (do ((i 0 (+ i 1)))
+ ((= i (chans snd)))
+ (if (selection-member? snd i)
+ (snd-display "; ~A[~A] at ~A" (short-file-name snd) i (selection-position snd i)))))
+ (sounds)))
(if (not (= (selection-srate) (srate s2i))) (snd-display ";selection-srate: ~A ~A?" (selection-srate) (srate s2i)))
- (if (= (selection-chans) 2)
- (begin
- (swap-selection-channels)
- (if (or (fneq s1 (sample 1000 s2i 1))
- (fneq s2 (sample 1000 s2i 0)))
- (snd-display ";swap-selection-channels: ~A?" (list s1 s2 (sample 1000 s2i 0) (sample 1000 s2i 1)))))))
+ (when (= (selection-chans) 2)
+ (swap-selection-channels)
+ (if (or (fneq s1 (sample 1000 s2i 1))
+ (fneq s2 (sample 1000 s2i 0)))
+ (snd-display ";swap-selection-channels: ~A?" (list s1 s2 (sample 1000 s2i 0) (sample 1000 s2i 1))))))
(revert-sound s2i)
(close-sound s2i)))
@@ -27186,10 +26958,9 @@ EDITS: 2
(let tests-1 ((f funcs)
(fn func-names)
(nv new-values))
- (if (pair? f)
- (begin
- (test-history-channel (car f) (car fn) (car nv) snd1 snd2 snd3)
- (tests-1 (cdr f) (cdr fn) (cdr nv)))))
+ (when (pair? f)
+ (test-history-channel (car f) (car fn) (car nv) snd1 snd2 snd3)
+ (tests-1 (cdr f) (cdr fn) (cdr nv))))
(close-sound snd1)
(close-sound snd2))
@@ -27257,21 +27028,21 @@ EDITS: 2
(let-temporarily ((*with-background-processes* #f))
(let* ((ind (open-sound "1a.snd"))
(player (make-player ind 0))
- (len (framples ind 0))
- (e (make-env '(0 0 1 1) :length (+ 1 (floor (* 1.0 (/ len *dac-size*))))))
- (samp 0))
- (add-player player 0 -1 -1
- (lambda (reason)
- (set! (hook-functions play-hook) ())
- (close-sound ind)))
- (hook-push play-hook
- (lambda (hook)
- (set! (amp-control player) (env e))
- (if (fneq (amp-control ind) 1.0) (snd-display ";amp-control snd: ~A" (amp-control ind)))
- (if (> (abs (- (amp-control player) (* 1.0 (/ samp len)))) 1.0)
- (snd-display ";amp-control player: ~A ~A" (amp-control player) (* 1.0 (/ samp len))))
- (set! samp (+ samp *dac-size*))))
- (start-playing 1 (srate ind)))
+ (len (framples ind 0)))
+ (let ((e (make-env '(0 0 1 1) :length (+ 1 (floor (* 1.0 (/ len *dac-size*))))))
+ (samp 0))
+ (add-player player 0 -1 -1
+ (lambda (reason)
+ (set! (hook-functions play-hook) ())
+ (close-sound ind)))
+ (hook-push play-hook
+ (lambda (hook)
+ (set! (amp-control player) (env e))
+ (if (fneq (amp-control ind) 1.0) (snd-display ";amp-control snd: ~A" (amp-control ind)))
+ (if (> (abs (- (amp-control player) (* 1.0 (/ samp len)))) 1.0)
+ (snd-display ";amp-control player: ~A ~A" (amp-control player) (* 1.0 (/ samp len))))
+ (set! samp (+ samp *dac-size*))))
+ (start-playing 1 (srate ind))))
(if (find-sound "1a.snd") (snd-display ";stop proc didn't close?")))
(let ((ind (open-sound "pistol.snd")))
@@ -27607,8 +27378,8 @@ EDITS: 2
(key (char->integer #\o) 4 ind)
(if (not (= (framples ind) (+ 100 len)))
(snd-display ";C-o len: ~A? " (framples)))
- (let ((data (channel->float-vector 1200 100 ind)))
- (if (fneq (float-vector-peak data) 0.0) (snd-display ";C-o: ~A?" (float-vector-peak data))))
+ (let ((data (float-vector-peak (channel->float-vector 1200 100 ind))))
+ (if (fneq data 0.0) (snd-display ";C-o: ~A?" data)))
(revert-sound ind)
(set! (cursor ind) 1200)
(key (char->integer #\u) 4 ind)
@@ -27618,8 +27389,8 @@ EDITS: 2
(key (char->integer #\z) 4 ind)
(if (not (= (framples ind) len))
(snd-display ";C-z len: ~A? " (framples)))
- (let ((data (channel->float-vector 1200 100 ind)))
- (if (fneq (float-vector-peak data) 0.0) (snd-display ";C-z: ~A?" (float-vector-peak data))))
+ (let ((data (float-vector-peak (channel->float-vector 1200 100 ind))))
+ (if (fneq data 0.0) (snd-display ";C-z: ~A?" data)))
(set! (cursor ind) 0)
(key (char->integer #\u) 4 ind)
(key (char->integer #\3) 0 ind)
@@ -27636,8 +27407,8 @@ EDITS: 2
(key (char->integer #\o) 4 ind)
(if (not (= (framples ind) (+ (srate ind) len)))
(snd-display ";C-o 1.0 len: ~A? " (framples)))
- (let ((data (channel->float-vector 1200 (srate ind) ind)))
- (if (fneq (float-vector-peak data) 0.0) (snd-display ";C-o 1.0: ~A?" (float-vector-peak data))))
+ (let ((data (float-vector-peak (channel->float-vector 1200 (srate ind) ind))))
+ (if (fneq data 0.0) (snd-display ";C-o 1.0: ~A?" data)))
(revert-sound ind)
(set! (cursor ind) 1200)
(key (char->integer #\u) 4 ind)
@@ -27647,8 +27418,8 @@ EDITS: 2
(key (char->integer #\z) 4 ind)
(if (not (= (framples ind) len))
(snd-display ";C-z 1.0 len: ~A? " (framples)))
- (let ((data (channel->float-vector 1200 (srate ind) ind)))
- (if (fneq (float-vector-peak data) 0.0) (snd-display ";C-z 1.0: ~A?" (float-vector-peak data))))
+ (let ((data (float-vector-peak (channel->float-vector 1200 (srate ind) ind))))
+ (if (fneq data 0.0) (snd-display ";C-z 1.0: ~A?" data)))
(close-sound ind))
(let ((ind (open-sound "2.snd")))
@@ -27797,18 +27568,12 @@ EDITS: 2
(gc)
(let* ((oboe (open-sound "oboe.snd"))
(a4 (open-sound "4.aiff"))
- (sr (srate oboe))
- ;(fr (framples oboe 0))
- ;(typ (header-type oboe))
- ;(frm (sample-type oboe))
- ;(loc (data-location oboe))
- ;(com (comment oboe))
- )
+ (sr (* 2 (srate oboe))))
(save-sound-as "test.aif" oboe :header-type mus-aifc)
(let ((oboe-aif (open-sound "test.aif")))
(if (not (= (header-type oboe-aif) mus-aifc)) (snd-display ";oboe-aif header: ~A?" (mus-header-type-name (header-type oboe-aif))))
- (set! (srate oboe-aif) (* sr 2.0))
- (if (fneq (* sr 2.0) (srate oboe-aif)) (snd-display ";set! srate: ~A ~A" (* sr 2.0) (srate oboe-aif)))
+ (set! (srate oboe-aif) (* sr 2))
+ (if (fneq (* 2 sr) (srate oboe-aif)) (snd-display ";set! srate: ~A ~A" sr (srate oboe-aif)))
(set! (header-type oboe-aif) mus-next)
(if (not (= (header-type oboe-aif) mus-next)) (snd-display ";set! header: ~A?" (mus-header-type-name (header-type oboe-aif))))
(set! (data-location oboe-aif) 28)
@@ -28041,61 +27806,47 @@ EDITS: 2
;; framples mus-length framples mix-length region-framples
(let ((snd (open-sound "oboe.snd"))
- (v (float-vector .1 .2 .3))
- (vc (vector .1 .2 .3 .4))
- (lst (list 1 2 3 4 5))
- (hsh (make-hash-table 100))
- (sd (make-float-vector '(1 10)))
- (str "123456"))
- (let ((mxv (mix-float-vector v 1000))
- (reg (make-region 0 100))
- (dly (make-delay 32))
- (ply (make-player snd 0))
- )
+ (sd (framples (make-float-vector '(1 10)))))
+ (let ((mxv (length (mix-float-vector (make-float-vector 3) 1000)))
+ (reg (length (make-region 0 100)))
+ (dly (length (make-delay 32)))
+ (ply (length (make-player snd 0))))
(if (not (= (length snd) 50828)) (snd-display ";length of sound: ~A" (length snd)))
- (if (not (= (length v) 3)) (snd-display ";length of float-vector: ~A" (length v)))
- (if (not (= (length vc) 4)) (snd-display ";length of vector: ~A" (length vc)))
- (if (not (= (length lst) 5)) (snd-display ";length of list: ~A" (length lst)))
- (if (not (= (length str) 6)) (snd-display ";length of string: ~A" (length str)))
- (if (not (= (framples sd) 10)) (snd-display ";length of vector2: ~A" (framples sd)))
- (if (< (length hsh) 100) (snd-display ";length of hash-table: ~A" (length hsh)))
- (if (not (= (length mxv) 3)) (snd-display ";length of mix: ~A" (length mxv)))
- (if (not (= (length reg) 101)) (snd-display ";length of region: ~A" (length reg)))
- (if (not (= (length dly) 32)) (snd-display ";length of delay: ~A" (length dly)))
- (if (not (= (length ply) 50828)) (snd-display ";length of player: ~A" (length ply)))
- )
+ (if (not (= sd 10)) (snd-display ";length of vector2: ~A" sd))
+ (if (not (= mxv 3)) (snd-display ";length of mix: ~A" mxv))
+ (if (not (= reg 101)) (snd-display ";length of region: ~A" reg))
+ (if (not (= dly 32)) (snd-display ";length of delay: ~A" dly))
+ (if (not (= ply 50828)) (snd-display ";length of player: ~A" ply)))
(close-sound snd))
;; srate as generic: mus-sound-srate region-srate srate
(let ((snd (open-sound "oboe.snd")))
- (let ((reg (make-region 0 100))
- (ply (make-player snd 0)))
+ (let ((reg (srate (make-region 0 100)))
+ (ply (srate (make-player snd 0))))
(if (not (= (srate snd) 22050)) (snd-display ";srate of sound: ~A" (srate snd)))
- (let ((str "oboe.snd"))
- (if (not (= (srate str) 22050)) (snd-display ";srate of string: ~A" (srate str))))
- (if (not (= (srate reg) 22050)) (snd-display ";srate of region: ~A" (srate reg)))
- (if (not (= (srate ply) 22050)) (snd-display ";srate of player: ~A" (srate ply))))
+ (let ((str (srate "oboe.snd")))
+ (if (not (= str 22050)) (snd-display ";srate of string: ~A" str)))
+ (if (not (= reg 22050)) (snd-display ";srate of region: ~A" reg))
+ (if (not (= ply 22050)) (snd-display ";srate of player: ~A" ply)))
(close-sound snd))
-
;; channels as generic: mus-sound-chans region-chans chans mus-channels mix/etc
(let ((snd (open-sound "oboe.snd"))
(v (float-vector .1 .2 .3))
- (sd (make-float-vector '(2 10))))
- (let ((mxv (mix-float-vector v 1000))
- (reg (make-region 0 100))
- (ply (make-player snd 0))
- )
+ (sd (channels (make-float-vector '(2 10)))))
+ (let ((mxv (channels (mix-float-vector v 1000)))
+ (reg (channels (make-region 0 100)))
+ (ply (channels (make-player snd 0))))
(if (not (= (channels snd) 1)) (snd-display ";channels of sound: ~A" (channels snd)))
(if (not (= (channels v) 1)) (snd-display ";channels of float-vector: ~A" (channels v)))
- (let ((str "oboe.snd"))
- (if (not (= (channels str) 1)) (snd-display ";channels of string: ~A" (channels str))))
- (if (not (= (channels sd) 2)) (snd-display ";channels of vector2: ~A" (channels sd)))
- (if (not (= (channels mxv) 1)) (snd-display ";channels of mix: ~A" (channels mxv)))
- (if (not (= (channels reg) 1)) (snd-display ";channels of region: ~A" (channels reg)))
- (if (not (= (channels ply) 1)) (snd-display ";channels of player: ~A" (channels ply)))
+ (let ((str (channels "oboe.snd")))
+ (if (not (= str 1)) (snd-display ";channels of string: ~A" str)))
+ (if (not (= sd 2)) (snd-display ";channels of vector2: ~A" sd))
+ (if (not (= mxv 1)) (snd-display ";channels of mix: ~A" mxv))
+ (if (not (= reg 1)) (snd-display ";channels of region: ~A" reg))
+ (if (not (= ply 1)) (snd-display ";channels of player: ~A" ply))
)
(close-sound snd))
@@ -28103,20 +27854,20 @@ EDITS: 2
(let ((snd (open-sound "oboe.snd"))
(v (float-vector .1 .2 .3))
- (sd (make-float-vector '(1 10))))
- (let ((mxv (mix-float-vector v 1000))
- (reg (make-region 0 100))
- (dly (make-delay 32))
- (ply (make-player snd 0)))
+ (sd (framples (make-float-vector '(1 10)))))
+ (let ((mxv (framples (mix-float-vector v 1000)))
+ (reg (framples (make-region 0 100)))
+ (dly (framples (make-delay 32)))
+ (ply (framples (make-player snd 0))))
(if (not (= (framples snd) 50828)) (snd-display ";framples of sound: ~A" (framples snd)))
(if (not (= (framples v) 3)) (snd-display ";framples of float-vector: ~A" (framples v)))
- (let ((str "oboe.snd"))
- (if (not (= (framples str) 50828)) (snd-display ";framples of string: ~A" (framples str))))
- (if (not (= (framples sd) 10)) (snd-display ";framples of vector2: ~A" (framples sd)))
- (if (not (= (framples mxv) 3)) (snd-display ";framples of mix: ~A" (framples mxv)))
- (if (not (= (framples reg) 101)) (snd-display ";framples of region: ~A" (framples reg)))
- (if (not (= (framples dly) 32)) (snd-display ";framples of delay: ~A" (framples dly)))
- (if (not (= (framples ply) 50828)) (snd-display ";framples of player: ~A" (framples ply))))
+ (let ((str (framples "oboe.snd")))
+ (if (not (= str 50828)) (snd-display ";framples of string: ~A" str)))
+ (if (not (= sd 10)) (snd-display ";framples of vector2: ~A" sd))
+ (if (not (= mxv 3)) (snd-display ";framples of mix: ~A" mxv))
+ (if (not (= reg 101)) (snd-display ";framples of region: ~A" reg))
+ (if (not (= dly 32)) (snd-display ";framples of delay: ~A" dly))
+ (if (not (= ply 50828)) (snd-display ";framples of player: ~A" ply)))
(close-sound snd))
;; file-name as generic
@@ -28124,15 +27875,15 @@ EDITS: 2
(let ((snd (open-sound "oboe.snd"))
(frm (make-file->sample "oboe.snd"))
(prt (open-output-file "tst.dat")))
- (let ((mxv (car (mix "pistol.snd" 1000)))
- (reg (make-region 0 100)))
+ (let ((mxv (file-name (car (mix "pistol.snd" 1000))))
+ (reg (file-name (make-region 0 100))))
(if (not (string=? (file-name snd) (string-append (getcwd) "/oboe.snd"))) (snd-display ";file-name of sound: ~A" (file-name snd)))
- (let ((str "oboe.snd"))
- (if (not (string=? (file-name str) (string-append (getcwd) "/oboe.snd"))) (snd-display ";file-name of string: ~A" (file-name str))))
+ (let ((str (file-name "oboe.snd")))
+ (if (not (string=? str (string-append (getcwd) "/oboe.snd"))) (snd-display ";file-name of string: ~A" str)))
(if (not (string=? (file-name frm) "oboe.snd")) (snd-display ";file-name of file->sample: ~A" (file-name frm)))
(if (not (string=? (file-name prt) "tst.dat")) (snd-display ";file-name of output port: ~A" (file-name prt)))
- (if (not (string=? (file-name mxv) (string-append (getcwd) "/pistol.snd"))) (snd-display ";file-name of mix: ~A" (file-name mxv)))
- (if (not (string=? (file-name reg) "oboe.snd")) (snd-display ";file-name of region: ~A" (file-name reg))))
+ (if (not (string=? mxv (string-append (getcwd) "/pistol.snd"))) (snd-display ";file-name of mix: ~A" mxv))
+ (if (not (string=? reg "oboe.snd")) (snd-display ";file-name of region: ~A" reg)))
(close-output-port prt)
(mus-close frm)
(close-sound snd))
@@ -28159,21 +27910,21 @@ EDITS: 2
(let ((snd (open-sound "oboe.snd"))
(v (float-vector .1 .2 .3)))
- (let ((mxv (mix-float-vector v 1000))
- (reg (make-region 0 900)))
+ (let ((mxv (maxamp (mix-float-vector v 1000)))
+ (reg (maxamp (make-region 0 900))))
(if (fneq (maxamp snd) .334) (snd-display ";maxamp of sound: ~A" (maxamp snd)))
(if (fneq (maxamp snd 0) .334) (snd-display ";maxamp of sound (0): ~A" (maxamp snd)))
(if (fneq (maxamp snd 0 0) .14724) (snd-display ";maxamp of sound (0 0): ~A" (maxamp snd)))
(if (fneq (maxamp v) .3) (snd-display ";maxamp of float-vector: ~A" (maxamp v)))
- (let ((vc (vector .1 .2 .3 .4)))
- (if (fneq (maxamp vc) .4) (snd-display ";maxamp of vector: ~A" (maxamp vc))))
- (let ((str "pistol.snd")) ; can't use oboe.snd since we messed with mus-sound-maxamp above
- (if (fneq (maxamp str) .49267) (snd-display ";maxamp of string: ~A" (maxamp str))))
+ (let ((vc (maxamp #(.1 .2 .3 .4))))
+ (if (fneq vc .4) (snd-display ";maxamp of vector: ~A" vc)))
+ (let ((str (maxamp "pistol.snd"))) ; can't use oboe.snd since we messed with mus-sound-maxamp above
+ (if (fneq str .49267) (snd-display ";maxamp of string: ~A" str)))
(let ((sd (make-float-vector '(1 10))))
(set! (sd 0 1) .1)
(if (fneq (maxamp sd) 0.1) (snd-display ";maxamp of vector2: ~A" (maxamp sd))))
- (if (fneq (maxamp mxv) .3) (snd-display ";maxamp of mix: ~A" (maxamp mxv)))
- (if (fneq (maxamp reg) .02139) (snd-display ";maxamp of region: ~A" (maxamp reg)))
+ (if (fneq mxv .3) (snd-display ";maxamp of mix: ~A" mxv))
+ (if (fneq reg .02139) (snd-display ";maxamp of region: ~A" reg))
(let ((dly (make-delay 32)))
(delay dly .1)
(delay dly .2)
@@ -28190,16 +27941,15 @@ EDITS: 2
(define (undo-env s c)
(let ((len (car (edits s c))))
(and (> len 0)
- (let ((unhappy #f))
- (do ((i 1 (+ i 1)))
- ((or unhappy (> i len))
- unhappy)
- (let ((ed (edit-fragment i s c)))
- (if (and (pair? ed)
+ (do ((unhappy #f)
+ (i 1 (+ i 1)))
+ ((or unhappy (> i len))
+ unhappy)
+ (let ((ed (edit-fragment i s c)))
+ (when (and (pair? ed)
(string=? (cadr ed) "env"))
- (begin
- (set! (edit-position s c) (- i 1))
- (set! unhappy #t)))))))))
+ (set! (edit-position s c) (- i 1))
+ (set! unhappy #t)))))))
(let* ((cursnd (let ((snds (sounds))) (snds (random (length snds)))))
(curchn (random (chans cursnd)))
@@ -28231,15 +27981,14 @@ EDITS: 2
(snd-display ";scale-channel ~A[~A] cur-samp: ~A ~A" (short-file-name cursnd) curchn (sample cur-loc cursnd curchn) (* scaler cur-samp)))
(for-each
(lambda (s c amp ed fr)
- (if (not (and (equal? s cursnd)
- (= c curchn)))
- (begin
- (if (not (= (edit-position s c) ed))
- (snd-display ";scale-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (framples s c) fr))
- (snd-display ";scale-channel ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
- (if (fneq (maxamp s c) amp)
- (snd-display ";scale-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
+ (unless (and (equal? s cursnd)
+ (= c curchn))
+ (if (not (= (edit-position s c) ed))
+ (snd-display ";scale-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display ";scale-channel ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
+ (if (fneq (maxamp s c) amp)
+ (snd-display ";scale-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp))))
(car chan-list)
(cadr chan-list)
cur-maxamps
@@ -28382,39 +28131,37 @@ EDITS: 2
(val00 (reader0))
(val0 (* e0 val00))
(val1 (reader1)))
- (if (> (abs (- val0 val1)) .005)
- (begin
- (if (file-exists? "baddy.scm") (delete-file "baddy.scm"))
- (save-state "baddy.scm")
- (snd-display ";read env off by ~A: ~% (~A) at ~A: ~% ~A ~A (~A ~A) [~A ~A]:~% ~A"
- (abs (- val0 val1))
- e i val0 val1
- reader0 reader1 e0 val00
- (safe-display-edits cursnd curchn))
- (error 'mus-error))))))))
+ (when (> (abs (- val0 val1)) .005)
+ (if (file-exists? "baddy.scm") (delete-file "baddy.scm"))
+ (save-state "baddy.scm")
+ (snd-display ";read env off by ~A: ~% (~A) at ~A: ~% ~A ~A (~A ~A) [~A ~A]:~% ~A"
+ (abs (- val0 val1))
+ e i val0 val1
+ reader0 reader1 e0 val00
+ (safe-display-edits cursnd curchn))
+ (error 'mus-error)))))))
;; env-channel
((2)
(let ((pts (+ 1 (random 6))))
- (if (undo-env cursnd curchn)
- (begin
- (set! cur-maxamps (apply map maxamp chan-list))
- (set! cur-edits (apply map edit-position chan-list))
- (set! cur-framples (apply map framples chan-list))
- (set! cur-amp (maxamp cursnd curchn))
- (set! cur-edit (edit-position cursnd curchn))
- (set! cur-frame (framples cursnd curchn))))
- (let ((e (let ((e1 ())
- (x 0.0)
- (y 0.0))
- (do ((i 0 (+ i 1)))
- ((= i pts))
- (set! e1 (cons x e1))
- (if (> (random 3) 0)
- (set! y (mus-random 1.0)))
- (set! e1 (cons y e1))
- (set! x (+ x .01 (random 1.0))))
- (reverse e1))))
+ (when (undo-env cursnd curchn)
+ (set! cur-maxamps (apply map maxamp chan-list))
+ (set! cur-edits (apply map edit-position chan-list))
+ (set! cur-framples (apply map framples chan-list))
+ (set! cur-amp (maxamp cursnd curchn))
+ (set! cur-edit (edit-position cursnd curchn))
+ (set! cur-frame (framples cursnd curchn)))
+ (let ((e (do ((e1 ())
+ (x 0.0)
+ (y 0.0)
+ (i 0 (+ i 1)))
+ ((= i pts)
+ (reverse e1))
+ (set! e1 (cons x e1))
+ (if (> (random 3) 0)
+ (set! y (mus-random 1.0)))
+ (set! e1 (cons y e1))
+ (set! x (+ x .01 (random 1.0))))))
(env-channel e 0 (framples cursnd curchn) cursnd curchn))) ; can be a no-op
(if (not (or (= (edit-position cursnd curchn) (+ 1 cur-edit))
(= (edit-position cursnd curchn) cur-edit)))
@@ -28423,15 +28170,14 @@ EDITS: 2
(snd-display ";env-channel ~A[~A] framples: ~A ~A" (short-file-name cursnd) curchn (framples cursnd curchn) cur-frame))
(for-each
(lambda (s c amp ed fr)
- (if (not (and (equal? s cursnd)
- (= c curchn)))
- (begin
- (if (not (= (edit-position s c) ed))
- (snd-display ";env-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (framples s c) fr))
- (snd-display ";env-channel ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
- (if (fneq (maxamp s c) amp)
- (snd-display ";env-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
+ (unless (and (equal? s cursnd)
+ (= c curchn))
+ (if (not (= (edit-position s c) ed))
+ (snd-display ";env-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display ";env-channel ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
+ (if (fneq (maxamp s c) amp)
+ (snd-display ";env-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp))))
(car chan-list)
(cadr chan-list)
cur-maxamps
@@ -28441,17 +28187,17 @@ EDITS: 2
;; env-sound
((3) (let* ((pts (+ 1 (random 6)))
(recalc #f)
- (e (let ((e1 ())
- (x 0.0)
- (y 0.0))
- (do ((i 0 (+ i 1)))
- ((= i pts))
- (set! e1 (cons x e1))
- (if (> (random 3) 0)
- (set! y (mus-random 1.0)))
- (set! e1 (cons y e1))
- (set! x (+ x .01 (random 1.0))))
- (reverse e1)))
+ (e (do ((e1 ())
+ (x 0.0)
+ (y 0.0)
+ (i 0 (+ i 1)))
+ ((= i pts)
+ (reverse e1))
+ (set! e1 (cons x e1))
+ (if (> (random 3) 0)
+ (set! y (mus-random 1.0)))
+ (set! e1 (cons y e1))
+ (set! x (+ x .01 (random 1.0)))))
(end (apply min cur-framples)) ; env-sound can lengthen a shorter sound if syncd+multichannel
(beg (random (floor (/ end 2)))))
(for-each
@@ -28463,14 +28209,13 @@ EDITS: 2
(if (not recalc) (set! recalc val)))))
(car chan-list)
(cadr chan-list))
- (if recalc
- (begin
- (set! cur-maxamps (apply map maxamp chan-list))
- (set! cur-edits (apply map edit-position chan-list))
- (set! cur-framples (apply map framples chan-list))
- (set! cur-amp (maxamp cursnd curchn))
- (set! cur-edit (edit-position cursnd curchn))
- (set! cur-frame (framples cursnd curchn))))
+ (when recalc
+ (set! cur-maxamps (apply map maxamp chan-list))
+ (set! cur-edits (apply map edit-position chan-list))
+ (set! cur-framples (apply map framples chan-list))
+ (set! cur-amp (maxamp cursnd curchn))
+ (set! cur-edit (edit-position cursnd curchn))
+ (set! cur-frame (framples cursnd curchn)))
(env-sound e beg (max pts (- end beg)) 1.0 cursnd curchn) ; dur here, not end point
(for-each
(lambda (s c amp ed fr)
@@ -28516,27 +28261,26 @@ EDITS: 2
(begin
(snd-display ";lens: ~A ~A" len0 len1)
#f)
- (do ((i 0 (+ i 1)))
+ (do ((i 0 (+ i 1))
+ (max0 -1.0 -1.0)
+ (max1 -1.0 -1.0))
((or (not happy) (= i minlen1))
happy)
- (let ((max0 -1.0)
- (max1 -1.0))
- (if (= inc0 1)
- (set! max0 (e0 i))
- (do ((j 0 (+ j 1))
- (j1 (* inc0 i) (+ j1 1)))
- ((= j inc0))
- (set! max0 (max max0 (e0 j1)))))
- (if (= inc1 1)
- (set! max1 (e1 i))
- (do ((j 0 (+ j 1))
- (j1 (* inc1 i) (+ j1 1)))
- ((= j inc1))
- (set! max1 (max max1 (e1 j1)))))
- (if (> (abs (- max0 max1)) df)
- (begin
- (snd-display ";amp-env ~A: ~A ~A" i max0 max1)
- (set! happy #f))))))))))))
+ (if (= inc0 1)
+ (set! max0 (e0 i))
+ (do ((j 0 (+ j 1))
+ (j1 (* inc0 i) (+ j1 1)))
+ ((= j inc0))
+ (set! max0 (max max0 (e0 j1)))))
+ (if (= inc1 1)
+ (set! max1 (e1 i))
+ (do ((j 0 (+ j 1))
+ (j1 (* inc1 i) (+ j1 1)))
+ ((= j inc1))
+ (set! max1 (max max1 (e1 j1)))))
+ (when (> (abs (- max0 max1)) df)
+ (snd-display ";amp-env ~A: ~A ~A" i max0 max1)
+ (set! happy #f))))))))))
(define* (edit-difference s1 c1 e1 e2 (offset 0))
(let ((N (framples s1 c1 e1)))
@@ -28565,11 +28309,11 @@ EDITS: 2
(define (mus-arrays-equal?-at v0 v1)
(call-with-exit
(lambda (return)
- (let ((len (length v0)))
- (do ((i 0 (+ i 1)))
- ((= i len) #f)
- (if (> (abs (- (v0 i) (v1 i))) .001)
- (return (list i (v0 i) (v1 i)))))))))
+ (do ((len (length v0))
+ (i 0 (+ i 1)))
+ ((= i len) #f)
+ (if (> (abs (- (v0 i) (v1 i))) .001)
+ (return (list i (v0 i) (v1 i))))))))
(define (edits-not-equal? tl0 tl1 pos)
(if (null? tl0)
(and (not (null? tl1))
@@ -28642,14 +28386,12 @@ EDITS: 2
data))
(let ((happy #t))
- (if (not (mus-arrays-equal? v (channel->float-vector 0 (framples) ind 0)))
- (begin
- (set! happy #f)
- (snd-display ";~A forth:~% current: ~A~% expected: ~A" name (channel->float-vector 0 (framples) ind 0) v)))
- (if (not (mus-arrays-equal? v (reversed-read ind 0)))
- (begin
- (set! happy #f)
- (snd-display ";~A back: ~A ~A" name (reversed-read ind 0) v)))
+ (unless (mus-arrays-equal? v (channel->float-vector 0 (framples) ind 0))
+ (set! happy #f)
+ (snd-display ";~A forth:~% current: ~A~% expected: ~A" name (channel->float-vector 0 (framples) ind 0) v))
+ (unless (mus-arrays-equal? v (reversed-read ind 0))
+ (set! happy #f)
+ (snd-display ";~A back: ~A ~A" name (reversed-read ind 0) v))
happy))
@@ -28663,17 +28405,17 @@ EDITS: 2
(define (convolve-coeffs v1 v2)
(let* ((v1-len (length v1))
(v2-len (length v2))
- (res-len (+ v1-len v2-len -1))
- (vres (make-float-vector res-len)))
- (do ((i 0 (+ i 1)))
- ((= i res-len))
- (let ((sum 0.0))
- (do ((j (max 0 (- (+ i 1) v2-len)) (+ j 1)))
- ((> j (min i (- v1-len 1))))
- (set! sum (+ sum (* (v1 j)
- (v2 (- i j))))))
- (set! (vres i) sum)))
- vres))
+ (res-len (+ v1-len v2-len -1)))
+ (do ((vres (make-float-vector res-len))
+ (i 0 (+ i 1)))
+ ((= i res-len)
+ vres)
+ (do ((sum 0.0)
+ (j (max 0 (- (+ i 1) v2-len)) (+ j 1)))
+ ((> j (min i (- v1-len 1)))
+ (set! (vres i) sum))
+ (set! sum (+ sum (* (v1 j)
+ (v2 (- i j)))))))))
(do ((test-16 0 (+ 1 test-16)))
((= test-16 tests))
@@ -29006,8 +28748,8 @@ EDITS: 2
smooth-channel)
(funcs-equal? "env-sound"
(lambda args (env-sound '(0 0 1 1)
- (if (> (length args) 0) (car args) 0)
- (and (> (length args) 1)
+ (if (pair? args) (car args) 0)
+ (and (> (length args) 1)
(number? (cadr args))
(- (cadr args) 1))
1.0
@@ -29178,10 +28920,9 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((or (not happy) (= i 1000)))
(let ((val (reader)))
- (if (fneq val 0.0)
- (begin
- (snd-display ";clm-channel overlap delayed: ~A: ~A" i val)
- (set! happy #f)))))
+ (when (fneq val 0.0)
+ (snd-display ";clm-channel overlap delayed: ~A: ~A" i val)
+ (set! happy #f))))
(let ((v0 (make-float-vector len))
(v1 (make-float-vector len)))
(do ((i 0 (+ i 1)))
@@ -29194,10 +28935,9 @@ EDITS: 2
(snd-display ";clm-channel overlap main: ~A ~A" v0 v1)))
(do ((i 0 (+ i 1)))
((or (not happy) (= i 1000)))
- (if (fneq (reader) 0.0)
- (begin
- (snd-display ";clm-channel overlap trailing garbage")
- (set! happy #f))))))
+ (when (fneq (reader) 0.0)
+ (snd-display ";clm-channel overlap trailing garbage")
+ (set! happy #f)))))
(close-sound ind))
(let ((ind (open-sound "oboe.snd"))
@@ -29205,10 +28945,9 @@ EDITS: 2
(oldloc 0)
(ctr 0))
(scan-channel (lambda (y)
- (if (>= (abs y) oldamp)
- (begin
- (set! oldloc ctr)
- (set! oldamp (abs y))))
+ (when (>= (abs y) oldamp)
+ (set! oldloc ctr)
+ (set! oldamp (abs y)))
(set! ctr (+ ctr 1))
#f))
(scale-by 10.0)
@@ -29218,10 +28957,9 @@ EDITS: 2
(loc 0)
(ctr (- (framples) 1)))
(scan-channel (lambda (y)
- (if (> (abs y) amp)
- (begin
- (set! amp (abs y))
- (set! loc ctr)))
+ (when (> (abs y) amp)
+ (set! amp (abs y))
+ (set! loc ctr))
(set! ctr (- ctr 1))
#f))
;; can't use maxamp here because it may be set by scaling process
@@ -29234,10 +28972,9 @@ EDITS: 2
(loc 0)
(ctr (- (framples) 1)))
(scan-channel (lambda (y)
- (if (> (abs y) amp)
- (begin
- (set! amp (abs y))
- (set! loc ctr)))
+ (when (> (abs y) amp)
+ (set! amp (abs y))
+ (set! loc ctr))
(set! ctr (- ctr 1))
#f))
;; can't use maxamp here because it may be set by scaling process
@@ -29264,10 +29001,10 @@ EDITS: 2
(check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "scale-channel 0.5 10 20")
(env-channel (make-env '(0 0 1 1) :length 11) 15 10)
- (let ((e (make-env '(0 0 1 1) :length 11)))
- (do ((i 15 (+ i 1)))
- ((= i 25))
- (set! (vals i) (* (vals i) (env e)))))
+ (do ((e (make-env '(0 0 1 1) :length 11))
+ (i 15 (+ i 1)))
+ ((= i 25))
+ (set! (vals i) (* (vals i) (env e))))
(check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
(25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "env-channel 15 10")
@@ -29358,10 +29095,10 @@ EDITS: 2
(40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.100000001490116 0.0 0.0 0) (60 1 60 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "scale-selection-by .1")
(env-channel (make-env '(0 0 1 1 2 0 3 0) :length 31 :base 0) 50 30)
- (let ((e (make-env '(0 0 1 1 2 0 3 0) :length 31 :base 0)))
- (do ((i 50 (+ i 1)))
- ((= i 80))
- (set! (vals i) (* (vals i) (env e)))))
+ (do ((e (make-env '(0 0 1 1 2 0 3 0) :length 31 :base 0))
+ (i 50 (+ i 1)))
+ ((= i 80))
+ (set! (vals i) (* (vals i) (env e))))
(check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
(15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
(21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
@@ -29501,29 +29238,29 @@ EDITS: 2
; (delete-file "hiho.scm")
(env-channel (make-env '(0 1 1 0 2 1) :length 20) 50 20)
- (let ((e (make-env '(0 1 1 0 2 1) :length 20)))
- (do ((i 50 (+ i 1)))
- ((= i 70))
- (set! (vals i) (* (env e) (vals i)))))
+ (do ((e (make-env '(0 1 1 0 2 1) :length 20))
+ (i 50 (+ i 1)))
+ ((= i 70))
+ (set! (vals i) (* (env e) (vals i))))
(check-edit-tree '((0 15 0 24 1.0 0.0 0.0 0) (25 13 25 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 1.0 -0.100000001490116 4)
(51 13 51 59 1.0 0.899999976158142 -0.100000001490116 4) (60 13 60 69 1.0 0.0 0.111111111938953 4)
(70 13 70 74 1.0 0.0 0.0 0) (75 16 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "env on env")
(env-channel (make-env '(0 1 1 0 2 1) :length 80) 10 80)
- (let ((e (make-env '(0 1 1 0 2 1) :length 80)))
- (do ((i 10 (+ i 1)))
- ((= i 90))
- (set! (vals i) (* (env e) (vals i)))))
+ (do ((e (make-env '(0 1 1 0 2 1) :length 80))
+ (i 10 (+ i 1)))
+ ((= i 90))
+ (set! (vals i) (* (env e) (vals i))))
(check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 15 10 24 1.0 1.0 -0.025000000372529 4) (25 13 25 49 1.0 0.625 -0.025000000372529 4)
(50 14 0 0 1.0 1.0 -0.100000001490116 6) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 6)
(60 13 60 69 1.0 0.0 0.111111111938953 6) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
(75 16 0 14 1.0 0.64102566242218 0.0256410259753466 4) (90 16 15 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "env on env 2")
(env-channel (make-env '(0 1 1 0 2 1) :length 20) 50 20)
- (let ((e (make-env '(0 1 1 0 2 1) :length 20)))
- (do ((i 50 (+ i 1)))
- ((= i 70))
- (set! (vals i) (* (env e) (vals i)))))
+ (do ((e (make-env '(0 1 1 0 2 1) :length 20))
+ (i 50 (+ i 1)))
+ ((= i 70))
+ (set! (vals i) (* (env e) (vals i))))
(check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 15 10 24 1.0 1.0 -0.025000000372529 4) (25 13 25 49 1.0 0.625 -0.025000000372529 4)
(50 14 0 0 1.0 1.0 -0.100000001490116 10) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 10)
(60 13 60 69 1.0 0.0 0.111111111938953 10) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
@@ -29775,36 +29512,36 @@ EDITS: 2
(fill! vals 1.0)
(float-vector->channel vals 0 100000)
(env-channel (make-env '(0 0 1 1 2 0) :length 10000) 30000 10000)
- (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
- (do ((i 30000 (+ i 1)))
- ((= i 40000))
- (float-vector-set! vals i (env e))))
+ (do ((e (make-env '(0 0 1 1 2 0) :length 10000))
+ (i 30000 (+ i 1)))
+ ((= i 40000))
+ (float-vector-set! vals i (env e)))
(check-edit-tree '((0 1 0 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 4)
(35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 4) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
vals "partial env")
(scale-channel .5 10000 10000)
(env-channel (make-env '(0 0 1 1 2 0) :length 10000) 30000 10000) ; env over env
- (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
- (do ((i 30000 (+ i 1)))
- ((= i 40000))
- (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (do ((e (make-env '(0 0 1 1 2 0) :length 10000))
+ (i 30000 (+ i 1)))
+ ((= i 40000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e))))
(do ((i 10000 (+ i 1)))
((= i 20000))
(float-vector-set! vals i (* (float-vector-ref vals i) 0.5)))
(check-edit-tree '((0 1 0 9999 1.0 0.0 0.0 0) (10000 1 10000 19999 0.5 0.0 0.0 0) (20000 1 20000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
vals "env over env")
(env-channel (make-env '(0 0 1 1 2 0) :length 10000) 5000 10000) ; env over scl
- (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
- (do ((i 5000 (+ i 1)))
- ((= i 15000))
- (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (do ((e (make-env '(0 0 1 1 2 0) :length 10000))
+ (i 5000 (+ i 1)))
+ ((= i 15000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e))))
(check-edit-tree '((0 1 0 4999 1.0 0.0 0.0 0) (5000 1 5000 9999 1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 0.5 0.0 0.0 0) (20000 1 20000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
vals "env over scl")
(ramp-channel .5 -.5 25000 1000)
- (let ((e (make-env '(0 .5 1 -.5) :length 1000)))
- (do ((i 25000 (+ i 1)))
- ((= i 26000))
- (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (do ((e (make-env '(0 .5 1 -.5) :length 1000))
+ (i 25000 (+ i 1)))
+ ((= i 26000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e))))
(check-edit-tree '((0 1 0 4999 1.0 0.0 0.0 0) (5000 1 5000 9999 1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 0.5 0.0 0.0 0) (20000 1 20000 24999 1.0 0.0 0.0 0) (25000 1 25000 25999 1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
vals "ramp")
(scale-by -1.0)
@@ -29820,10 +29557,10 @@ EDITS: 2
(undo 1)
(ramp-channel -1.0 1.0 50000 30000)
- (let ((e (make-env '(0 -1.0 1 1.0) :length 30000)))
- (do ((i 50000 (+ i 1)))
- ((= i 80000))
- (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (do ((e (make-env '(0 -1.0 1 1.0) :length 30000))
+ (i 50000 (+ i 1)))
+ ((= i 80000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e))))
(check-edit-tree '((0 1 0 4999 -1.0 0.0 0.0 0) (5000 1 5000 9999 -1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 -0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 -0.5 0.0 0.0 0) (20000 1 20000 24999 -1.0 0.0 0.0 0) (25000 1 25000 25999 -1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 -1.0 0.0 0.0 0) (30000 1 30000 34999 -1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 -1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 49999 -1.0 0.0 0.0 0) (50000 1 50000 79999 -1.0 -1.0 6.66688865749165e-5 4) (80000 1 80000 99999 -1.0 0.0 0.0 0) (100000 -2 0 0 -0.0 0.0 0.0 0))
vals "ramp")
(env-sound '(0 0 1 1))
@@ -29989,11 +29726,10 @@ EDITS: 2
))
'(10 10000))
- (if (null? (hook-functions initial-graph-hook))
- (begin
- (set! (hook-functions update-hook) ())
- (set! (hook-functions close-hook) ())
- (set! (hook-functions exit-hook) ())))
+ (when (null? (hook-functions initial-graph-hook))
+ (set! (hook-functions update-hook) ())
+ (set! (hook-functions close-hook) ())
+ (set! (hook-functions exit-hook) ()))
(let ((data (map
(lambda (sound)
@@ -30265,8 +30001,7 @@ EDITS: 2
-0.003 -0.002 -0.000 0.001 0.001 0.000 0.000 -0.000 -0.000 -0.000)))
(snd-display ";src-channel 0.25 -> ~A" (channel->float-vector 360 80 ind 0)))
(undo 2 ind 0)
- ;(map-channel (let ((i 0)) (lambda (y) (let ((val (sin (* i (/ pi 100))))) (set! i (+ i 1)) (* .5 val)))))
- (let ((e (make-env (list 0.0 0.0 1.0 1.0) :scaler (* .01 pi (- (framples) 1.0)) :length (framples))))
+ (let ((e (make-env '(0.0 0.0 1.0 1.0) :scaler (* .01 pi (- (framples) 1.0)) :length (framples))))
(map-channel (lambda (y) (* .5 (sin (env e))))))
(for-each
(lambda (sr df)
@@ -30426,22 +30161,22 @@ EDITS: 2
(revert-sound ind)
- (let ((len (floor (* 1.25 (framples)))))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (case (if (zero? test-16) 3 (random 10))
- ((0) (pad-channel (random len) (random 1000)))
- ((1) (env-channel '(0 0 1 1 2 0) (random len) (random 1000)))
- ((2) (env-sound '(0 0 1 1 2 0) (random len) (random 1000)))
- ((3) (scale-channel (random 1.0) (random len) (random 1000)))
- ((4) (scale-sound-by (random 1.0) (random len) (random 1000)))
- ((5) (src-channel (+ .9 (random .2)) (random len) (random 1000)))
- ((6) (ramp-channel (random 1.0) (random 1.0) (random len) (random 1000)))
- ((7) (reverse-channel (random len) (random 1000)))
- ((8) (let ((dur (max 2 (random 100)))) (float-vector->channel (make-float-vector dur) (random len) dur)))
- ((9) (map-channel (lambda (y) (* y 2.0)) (random (floor (/ (framples) 2))) (random 1000))))))
+ (do ((len (floor (* 1.25 (framples))))
+ (i 0 (+ i 1)))
+ ((= i 100))
+ (case (if (zero? test-16) 3 (random 10))
+ ((0) (pad-channel (random len) (random 1000)))
+ ((1) (env-channel '(0 0 1 1 2 0) (random len) (random 1000)))
+ ((2) (env-sound '(0 0 1 1 2 0) (random len) (random 1000)))
+ ((3) (scale-channel (random 1.0) (random len) (random 1000)))
+ ((4) (scale-sound-by (random 1.0) (random len) (random 1000)))
+ ((5) (src-channel (+ .9 (random .2)) (random len) (random 1000)))
+ ((6) (ramp-channel (random 1.0) (random 1.0) (random len) (random 1000)))
+ ((7) (reverse-channel (random len) (random 1000)))
+ ((8) (let ((dur (max 2 (random 100)))) (float-vector->channel (make-float-vector dur) (random len) dur)))
+ ((9) (map-channel (lambda (y) (* y 2.0)) (random (floor (/ (framples) 2))) (random 1000)))))
(close-sound ind))
-
+
(let ((ind (open-sound "oboe.snd")))
(if (fneq (maxamp) 0.14724731445312)
(snd-display ";oboe max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
@@ -30940,102 +30675,97 @@ EDITS: 1
(ramp-channel 0.0 1.0 0 5)
(let ((edpos (edit-position ind 0)))
(check-back-and-forth ind "ramp+scl setup" (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
+ (do ((happy #t)
+ (start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
+ (= (+ start len) 11)))
+ (let ((v (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)))))
(set! (edit-position ind 0) start-pos)
(ramp-channel 1.0 0.0 5 5)
(let ((edpos (edit-position ind 0)))
(check-back-and-forth ind "ramp+scl 2 setup" (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
+ (do ((happy #t)
+ (start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
+ (= (+ start len) 11)))
+ (let ((v (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)))))
(set! (edit-position ind 0) start-pos)
(ramp-channel 0.0 1.0 0 5)
(ramp-channel 1.0 0.0 5 5)
(let ((edpos (edit-position ind 0)))
(check-back-and-forth ind "ramp+scl 3 setup" (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
+ (do ((happy #t)
+ (start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
+ (= (+ start len) 11)))
+ (let ((v (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)))))
(set! (edit-position ind 0) start-pos)
(ramp-channel 1.0 0.0 3 5)
(let ((edpos (edit-position ind 0)))
(check-back-and-forth ind "ramp+scl 4 setup" (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000 1.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
+ (do ((happy #t)
+ (start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000 1.000 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl mid 1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
+ (= (+ start len) 11)))
+ (let ((v (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000 1.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl mid 1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)))))
(set! (edit-position ind 0) start-pos)
(env-channel '(0 1 1 0 2 0 3 1))
(let ((edpos (edit-position ind 0)))
(check-back-and-forth ind "ramp+scl setup" (float-vector 1.000 0.667 0.333 0.000 0.000 0.000 0.000 0.000 0.333 0.667 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
- ((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (float-vector 1.000 0.667 0.333 0.000 0.000 0.000 0.000 0.000 0.333 0.667 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-0-1 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
+ (do ((happy #t)
+ (start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
+ ((or (not happy)
+ (= (+ start len) 11)))
+ (let ((v (float-vector 1.000 0.667 0.333 0.000 0.000 0.000 0.000 0.000 0.333 0.667 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-0-1 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)))))
(set! (edit-position ind 0) start-pos))
(list
@@ -31365,7 +31095,8 @@ EDITS: 1
(undo)
(env-channel '(0 0 1 1) 0 #f ind 0 edpos)
(if (not (= (framples ind 0) 20)) (snd-display ";env edpos len: ~A" (framples ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 20) (float-vector 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474 0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 20)
+ (float-vector 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474 0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
(snd-display ";env edpos: ~A" (channel->float-vector 0 20)))
(undo)
(close-sound ind)))
@@ -31498,7 +31229,8 @@ EDITS: 1
(map-channel (lambda (y) (float-vector-set! data 0 y) data)))
(if (not (= (framples ind 0) 20))
(snd-display ";map-channel -> float-vector: ~A" (framples ind 0))
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector)
+ (float-vector 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000)))
(snd-display ";map-channel float-vector result: ~A" (channel->float-vector))))
(undo)
@@ -31925,13 +31657,11 @@ EDITS: 1
(-> 100 50 10 ind 0 cr)
(fill-rectangle 20 20 100 100 ind 0 time-graph #f cr)
(free-cairo cr))
- (make-bezier 0 0 20 20 40 30 60 10 10)
(update-time-graph ind 0)
;(fill-rectangle 20 20 100 100 ind 0 time-graph #t)
(set! (hook-functions after-graph-hook) ())
(set! (hook-functions lisp-graph-hook) ())
- (set! (hook-functions lisp-graph-hook) ())
(let ((ind (open-sound "oboe.snd")))
(set! (time-graph? ind 0) #f)
(graph (list (float-vector 0 1 2) (float-vector 3 2 1) (float-vector 1 2 3) (float-vector 1 1 1) (float-vector 0 1 0) (float-vector 3 1 2)))
@@ -32773,7 +32503,7 @@ EDITS: 1
(snd-display ";edit-list->function 9a: ~A" func))
(func ind 0))
(if (not (= (framples) (+ frs 200))) (snd-display ";edit-list->function insert-samples (200): ~A ~A" frs (framples)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 5) (float-vector 0.1 0.1 0.1 0.1 0.1)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 5) (make-float-vector 5 0.1)))
(snd-display ";edit-list->function func 9a: ~A" (channel->float-vector 0 5)))
(revert-sound ind)
@@ -32785,7 +32515,7 @@ EDITS: 1
(snd-display ";edit-list->function 9b: ~A" func))
(func ind 0))
(if (not (= (framples) frs)) (snd-display ";edit-list->function set-samples (2): ~A ~A" frs (framples)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 5) (float-vector 0.1 0.1 0.1 0.1 0.1)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 5) (make-float-vector 5 0.1)))
(snd-display ";edit-list->function func 9b: ~A" (channel->float-vector 0 5)))
(revert-sound ind)
@@ -33658,12 +33388,11 @@ EDITS: 1
(set! bjm (- (* j tox bj) bjp))
(set! bjp bj)
(set! bj bjm)
- (if (> (abs bj) bigno)
- (begin
- (set! bj (* bj bigni))
- (set! bjp (* bjp bigni))
- (set! ans (* ans bigni))
- (set! sum (* sum bigni))))
+ (when (> (abs bj) bigno)
+ (set! bj (* bj bigni))
+ (set! bjp (* bjp bigni))
+ (set! ans (* ans bigni))
+ (set! sum (* sum bigni)))
(if (not (= 0 jsum))
(set! sum (+ sum bj)))
(set! jsum (- 1 jsum))
@@ -33770,7 +33499,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
- (if (fneq (/ (bes-yn k x) (bes-yn-1 k x)) 1.0)
+ (if (ffneq (/ (bes-yn k x) (bes-yn-1 k x)) 1.0)
(snd-display ";(bes-yn ~A ~A) -> ~A ~A" k x (bes-yn k x) (bes-yn-1 k x)))))))
@@ -33844,11 +33573,10 @@ EDITS: 1
(set! bim (+ bip (* j tox bi)))
(set! bip bi)
(set! bi bim)
- (if (> (abs bi) bigno)
- (begin
- (set! ans (* ans bigni))
- (set! bi (* bi bigni))
- (set! bip (* bip bigni))))
+ (when (> (abs bi) bigno)
+ (set! ans (* ans bigni))
+ (set! bi (* bi bigni))
+ (set! bip (* bip bigni)))
(if (= j n) (set! ans bip)))
(if (and (< x 0.0) (odd? n))
(set! ans (- ans)))
@@ -34028,46 +33756,45 @@ EDITS: 1
(do ((ii 0 (+ 1 ii))
(i 1 (+ i 2)))
((> i n))
- (let ((ni (+ i nmod joff))
- (nj (+ i nmod joff))
- (ii+nh (+ ii nh)))
- (do ((k 1 (+ k 1)))
- ((> k ncof))
- (let ((jf (logand n1 (+ ni k))) ;gad wotta kludge...
- (jr (logand n1 (+ nj k))))
- (set! (data1 ii) (+ (data1 ii)
- (* (cc (- k 1))
- (data jf))))
- (set! (data1 ii+nh) (+ (data1 ii+nh)
- (* (cr (- k 1))
- (data jr))))))))
+ (do ((ni (+ i nmod joff))
+ (nj (+ i nmod joff))
+ (ii+nh (+ ii nh))
+ (k 1 (+ k 1)))
+ ((> k ncof))
+ (let ((jf (logand n1 (+ ni k))) ;gad wotta kludge...
+ (jr (logand n1 (+ nj k))))
+ (set! (data1 ii) (+ (data1 ii)
+ (* (cc (- k 1))
+ (data jf))))
+ (set! (data1 ii+nh) (+ (data1 ii+nh)
+ (* (cr (- k 1))
+ (data jr)))))))
(do ((ii 0 (+ 1 ii))
(i 1 (+ i 2)))
((> i n))
- (let ((ai (data ii))
- (ai1 (data (+ ii nh)))
- (ni (+ i nmod joff))
- (nj (+ i nmod joff)))
- (do ((k 1 (+ k 1)))
- ((> k ncof))
- (let ((jf (logand n1 (+ ni k)))
- (jr (logand n1 (+ nj k))))
- (set! (data1 jf) (+ (data1 jf)
- (* ai (cc (- k 1)))))
- (set! (data1 jr) (+ (data1 jr)
- (* ai1 (cr (- k 1))))))))))
+ (do ((ai (data ii))
+ (ai1 (data (+ ii nh)))
+ (ni (+ i nmod joff))
+ (nj (+ i nmod joff))
+ (k 1 (+ k 1)))
+ ((> k ncof))
+ (let ((jf (logand n1 (+ ni k)))
+ (jr (logand n1 (+ nj k))))
+ (set! (data1 jf) (+ (data1 jf)
+ (* ai (cc (- k 1)))))
+ (set! (data1 jr) (+ (data1 jr)
+ (* ai1 (cr (- k 1)))))))))
(copy data1 data))))
(define (corr x y N M)
;; correlation from Orfanidis
- (let ((R (make-float-vector (+ 1 M))))
- (do ((k 0 (+ k 1)))
- ((> k M))
- (set! (R k) 0.0)
- (do ((n 0 (+ 1 n)))
- ((= n (- N k)))
- (set! (R k) (+ (R k) (* (x (+ n k)) (y n))))))
- R))
+ (do ((R (make-float-vector (+ 1 M)))
+ (k 0 (+ k 1)))
+ ((> k M) R)
+ (set! (R k) 0.0)
+ (do ((n 0 (+ 1 n)))
+ ((= n (- N k)))
+ (set! (R k) (+ (R k) (* (x (+ n k)) (y n)))))))
;; this returns the same results as the fft-based version below, modulo float-vector lengths
(define (cross-correlate-1 snd0 chn0 snd1 chn1)
@@ -34153,22 +33880,21 @@ EDITS: 1
(fft rl im -1)
(float-vector->channel rl 0 len snd chn #f (format #f "automorph ~A ~A ~A ~A" a b c d)))))
- (if (defined? 'bes-j0) ; dependent on mus-config.h HAVE_SPECIAL_FUNCTIONS
- (begin
- (test-j0)
- (test-j1)
- (test-jn)
- (test-y0)
- (test-y1)
- (test-yn)
- (test-k0)
- (test-k1)
- (test-kn)
- (test-i0)
- (test-i1)
- (test-in)
- (test-erf)
- (test-lgamma)))
+ (when (defined? 'bes-j0) ; dependent on mus-config.h HAVE_SPECIAL_FUNCTIONS
+ (test-j0)
+ (test-j1)
+ (test-jn)
+ (test-y0)
+ (test-y1)
+ (test-yn)
+ (test-k0)
+ (test-k1)
+ (test-kn)
+ (test-i0)
+ (test-i1)
+ (test-in)
+ (test-erf)
+ (test-lgamma))
(do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
(log-mem clmtest)
@@ -34203,25 +33929,23 @@ EDITS: 1
(let ((d0 (make-float-vector 19)))
(set! (d0 0) 1.0)
(snd-transform fourier-transform d0 0)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i 16)))
- (if (fneq (d0 i) 1.0)
- (begin
- (snd-display ";fourier (1.0) [~D]: ~A?" i (d0 i))
- (set! happy #f)))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i 16)))
+ (when (fneq (d0 i) 1.0)
+ (snd-display ";fourier (1.0) [~D]: ~A?" i (d0 i))
+ (set! happy #f)))
(snd-transform fourier-transform d0 0)
(if (and (fneq (d0 0) 256.0)
(fneq (d0 0) 361.0)) ; fftw funny length
(snd-display ";fourier (256.0): ~A?" (d0 0)))
- (let ((happy #t))
- (do ((i 1 (+ i 1)))
- ((or (not happy) (= i 16)))
- (if (fneq (d0 i) 0.0)
- (begin
- (snd-display ";fourier (0.0) [~D]: ~A?" i (d0 i))
- (set! happy #f))))))
+ (do ((happy #t)
+ (i 1 (+ i 1)))
+ ((or (not happy) (= i 16)))
+ (when (fneq (d0 i) 0.0)
+ (snd-display ";fourier (0.0) [~D]: ~A?" i (d0 i))
+ (set! happy #f))))
(let ((r0 (make-float-vector 8))
(i0 (make-float-vector 8))
@@ -34255,7 +33979,7 @@ EDITS: 1
(snd-display ";mus-fft 1: ~A ~A?" d0 d1))
(mus-fft d0 d1 8 -1)
(if (not (and (mus-arrays-equal? d0 (float-vector 0.000 0.000 8.000 0.000 0.000 0.000 0.000 0.000))
- (mus-arrays-equal? d1 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (mus-arrays-equal? d1 (make-float-vector 8))))
(snd-display ";mus-fft -1: ~A ~A?" d0 d1))
(fill! d0 1.0)
@@ -34318,46 +34042,42 @@ EDITS: 1
(let ((dcopy (copy d0))
(d1 (snd-spectrum d0 rectangular-window size)))
(if (not (mus-arrays-equal? d0 dcopy)) (snd-display ";snd-spectrum not in-place? ~A ~A" d0 dcopy))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i (/ size 2))))
- (if (fneq (d1 i) 1.0)
- (begin
- (snd-display ";snd-spectrum (1.0) [~D: ~D]: ~A?" i size (d1 i))
- (set! happy #f)))))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i (/ size 2))))
+ (when (fneq (d1 i) 1.0)
+ (snd-display ";snd-spectrum (1.0) [~D: ~D]: ~A?" i size (d1 i))
+ (set! happy #f)))))
(let ((d1 (snd-spectrum (make-float-vector size 1.0) rectangular-window)))
(if (fneq (d1 0) 1.0)
(snd-display ";snd-spectrum back (1.0 ~D): ~A?" size (d1 0)))
- (let ((happy #t))
- (do ((i 1 (+ i 1)))
- ((or (not happy) (= i (/ size 2))))
- (if (fneq (d1 i) 0.0)
- (begin
- (snd-display ";snd-spectrum (0.0) [~D: ~D]: ~A?" i size (d1 i))
- (set! happy #f))))))
+ (do ((happy #t)
+ (i 1 (+ i 1)))
+ ((or (not happy) (= i (/ size 2))))
+ (when (fneq (d1 i) 0.0)
+ (snd-display ";snd-spectrum (0.0) [~D: ~D]: ~A?" i size (d1 i))
+ (set! happy #f))))
(let* ((d0 (make-float-vector size))
(d1 (snd-spectrum d0 rectangular-window size #f))) ; dB (0.0 = max)
(set! (d0 0) 1.0)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i (/ size 2))))
- (if (fneq (d1 i) 0.0)
- (begin
- (snd-display ";snd-spectrum dB (0.0) [~D: ~D]: ~A?" i size (d1 i))
- (set! happy #f))))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i (/ size 2))))
+ (when (fneq (d1 i) 0.0)
+ (snd-display ";snd-spectrum dB (0.0) [~D: ~D]: ~A?" i size (d1 i))
+ (set! happy #f))))
(let ((d1 (snd-spectrum (make-float-vector size 1.0) rectangular-window size #f)))
(if (fneq (d1 0) 0.0)
(snd-display ";snd-spectrum dB back (0.0 ~D): ~A?" size (d1 0)))
- (let ((happy #t))
- (do ((i 1 (+ i 1)))
- ((or (not happy) (= i (/ size 2))))
- (if (fneq (d1 i) -90.0) ; currently ignores min-dB (snd-sig.c 5023)
- (begin
- (snd-display ";snd-spectrum dB (1.0) [~D: ~D]: ~A?" i size (d1 i))
- (set! happy #f))))))
+ (do ((happy #t)
+ (i 1 (+ i 1)))
+ ((or (not happy) (= i (/ size 2))))
+ (when (fneq (d1 i) -90.0) ; currently ignores min-dB (snd-sig.c 5023)
+ (snd-display ";snd-spectrum dB (1.0) [~D: ~D]: ~A?" i size (d1 i))
+ (set! happy #f))))
(let ((d0 (make-float-vector size)))
(set! (d0 0) 1.0)
@@ -34365,13 +34085,12 @@ EDITS: 1
(d1 (snd-spectrum d0 rectangular-window size #t 1.0 #t))) ; in-place
(if (mus-arrays-equal? d0 dcopy) (snd-display ";snd-spectrum in-place? ~A ~A" d0 dcopy))
(if (not (mus-arrays-equal? d0 d1)) (snd-display ";snd-spectrum returns in-place? ~A ~A" d0 d1))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i (/ size 2))))
- (if (fneq (d1 i) 1.0)
- (begin
- (snd-display ";snd-spectrum (1.0 #t) [~D: ~D]: ~A?" i size (d1 i))
- (set! happy #f)))))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i (/ size 2))))
+ (when (fneq (d1 i) 1.0)
+ (snd-display ";snd-spectrum (1.0 #t) [~D: ~D]: ~A?" i size (d1 i))
+ (set! happy #f)))))
(let ((d0 (make-float-vector size)))
(set! (d0 0) 1.0)
@@ -34379,23 +34098,21 @@ EDITS: 1
(d1 (snd-spectrum d0 rectangular-window size #f 1.0 #t))) ; in-place dB
(if (mus-arrays-equal? d0 dcopy) (snd-display ";snd-spectrum dB in-place? ~A ~A" d0 dcopy))
(if (not (mus-arrays-equal? d0 d1)) (snd-display ";snd-spectrum dB returns in-place? ~A ~A" d0 d1))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i (/ size 2))))
- (if (fneq (d1 i) 0.0)
- (begin
- (snd-display ";snd-spectrum dB (1.0 #t) [~D: ~D]: ~A?" i size (d1 i))
- (set! happy #f)))))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i (/ size 2))))
+ (when (fneq (d1 i) 0.0)
+ (snd-display ";snd-spectrum dB (1.0 #t) [~D: ~D]: ~A?" i size (d1 i))
+ (set! happy #f)))))
(let ((d1 (snd-spectrum (make-float-vector size 1.0) rectangular-window size #t 0.0 #f #f))) ; linear (in-place) not normalized
(if (fneq (d1 0) size) (snd-display ";snd-spectrum no norm 0: ~A" d1))
- (let ((happy #t))
- (do ((i 1 (+ i 1)))
- ((or (not happy) (= i (/ size 2))))
- (if (fneq (d1 i) 0.0)
- (begin
- (snd-display ";snd-spectrum no norm (0.0) [~D: ~D]: ~A?" i size (d1 i))
- (set! happy #f))))))
+ (do ((happy #t)
+ (i 1 (+ i 1)))
+ ((or (not happy) (= i (/ size 2))))
+ (when (fneq (d1 i) 0.0)
+ (snd-display ";snd-spectrum no norm (0.0) [~D: ~D]: ~A?" i size (d1 i))
+ (set! happy #f))))
(let ((d1 (snd-spectrum (make-float-vector size 1.0) blackman2-window size)))
(if (not (or (mus-arrays-equal? d1 (float-vector 1.000 0.721 0.293 0.091))
@@ -34423,13 +34140,12 @@ EDITS: 1
(fill! xrl 1.0)
(snd-transform fourier-transform rl)
(snd-transform fourier-transform xrl #t)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i len2)))
- (if (fneq (rl i) (xrl i))
- (begin
- (snd-display ";flat fft: ~A at ~A: ~A ~A" len i (rl i) (xrl i))
- (set! happy #f)))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i len2)))
+ (when (fneq (rl i) (xrl i))
+ (snd-display ";flat fft: ~A at ~A: ~A ~A" len i (rl i) (xrl i))
+ (set! happy #f)))
(if (fneq (rl 0) (* len len)) (snd-display ";snd-transform ~A at 0: ~A" len (rl 0)))
(set! (rl 0) 0.0)
(if (> (float-vector-peak rl) .001) (snd-display ";snd-transform ~A impulse: ~A" len (float-vector-peak rl)))))
@@ -34444,13 +34160,12 @@ EDITS: 1
(set! (xrl len2) 1.0)
(snd-transform fourier-transform rl)
(snd-transform fourier-transform xrl #t)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i len2)))
- (if (fneq (rl i) (xrl i))
- (begin
- (snd-display ";impulse fft: ~A at ~A: ~A ~A" len i (rl i) (xrl i))
- (set! happy #f)))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i len2)))
+ (when (fneq (rl i) (xrl i))
+ (snd-display ";impulse fft: ~A at ~A: ~A ~A" len i (rl i) (xrl i))
+ (set! happy #f)))
(if (fneq (rl 0) 1.0) (snd-display ";flat ~A at 0: ~A" len (rl 0)))))
'(16 128 512 1024))
@@ -34474,10 +34189,10 @@ EDITS: 1
(lambda (len)
(let ((rl (make-float-vector len))
(xrl (make-float-vector len)))
- (let ((g (make-oscil (/ 220500.0 len))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (float-vector-set! rl i (oscil g))))
+ (do ((g (make-oscil (/ 220500.0 len)))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! rl i (oscil g)))
(copy rl xrl)
(snd-transform fourier-transform rl)
(float-vector-scale! rl (/ 1.0 len))
@@ -34627,13 +34342,12 @@ EDITS: 1
(mus-fft xrl xim len -1)
(float-vector-scale! xrl (/ 1.0 len))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i len2)))
- (if (fneq (rl i) (xrl i))
- (begin
- (snd-display ";mus-fft? ~A at ~A: ~A ~A" len i (rl i) (xrl i))
- (set! happy #f)))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i len2)))
+ (when (fneq (rl i) (xrl i))
+ (snd-display ";mus-fft? ~A at ~A: ~A ~A" len i (rl i) (xrl i))
+ (set! happy #f)))
(set! (rl 0) 0.0)
(set! (rl 4) 0.0)
(fill! rl 0.0 len2 len)
@@ -34665,13 +34379,12 @@ EDITS: 1
(float-vector-scale! xim 0.0)
(mus-fft xrl xim len -1)
(float-vector-scale! xrl (/ 1.0 len))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy) (= i len2)))
- (if (fneq (rl i) (xrl i))
- (begin
- (snd-display ";random ~A at ~A: ~A ~A" len i (rl i) (xrl i))
- (set! happy #f)))))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy) (= i len2)))
+ (when (fneq (rl i) (xrl i))
+ (snd-display ";random ~A at ~A: ~A ~A" len i (rl i) (xrl i))
+ (set! happy #f)))))
'(16 64 256 512))
;; -------- cepstrum
@@ -34707,7 +34420,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i len))
(let ((val (+ (* (xrl i) (xrl i)) (* (xim i) (xim i)))))
- (set! val (if (> val .0000001) (log (sqrt val)) -10.0))
+ (set! val (if (> val .0000001) (* 1/2 (log val)) -10.0))
(set! (xrl i) val)))
(float-vector-scale! xim 0.0)
(mus-fft xrl xim len -1)
@@ -34962,10 +34675,9 @@ EDITS: 1
(happy #t))
(do ((i 0 (+ i 1)))
((or (not happy) (= i 256)))
- (if (fneq (samps i) (orig i))
- (begin
- (snd-display ";add-transform same (~A): ~D ~A ~A" ftype i (samps i) (orig i))
- (set! happy #f)))))
+ (when (fneq (samps i) (orig i))
+ (snd-display ";add-transform same (~A): ~D ~A ~A" ftype i (samps i) (orig i))
+ (set! happy #f))))
(set! (dot-size ind 0) 60)
(set! (graph-style ind 0) graph-lollipops)
(set! (x-bounds) (list 2.579 2.580))
@@ -34983,15 +34695,15 @@ EDITS: 1
(define* (vectors-equal? v1 v2 (error 1e-30))
(let ((len (length v1)))
(and (= (length v2) len)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (= i len) (not happy)) happy)
- (set! happy (< (magnitude (- (vector-ref v1 i) (vector-ref v2 i))) error)))))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (= i len) (not happy)) happy)
+ (set! happy (< (magnitude (- (vector-ref v1 i) (vector-ref v2 i))) error))))))
(define* (bignum-vector :rest args)
- (let* ((len (length args))
- (v (make-vector len)))
- (do ((i 0 (+ i 1))
+ (let ((len (length args)))
+ (do ((v (make-vector len))
+ (i 0 (+ i 1))
(arg args (cdr arg)))
((= i len) v)
(vector-set! v i (if (bignum? (car arg)) (car arg) (bignum (number->string (car arg))))))))
@@ -35065,22 +34777,22 @@ EDITS: 1
(set! (rl 1) (bignum "1.0"))
(bignum-fft rl im 64 -1)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (= i 64) (not happy)))
- (let ((cerr (magnitude (- (vector-ref rl i) (cos (/ (* 2 pi i) 64)))))
- (serr (magnitude (- (vector-ref im i) (sin (/ (* -2 pi i) 64))))))
- (set! happy (and (< cerr 1e-30)
- (< serr 1e-30)))
- (if (not happy)
- (snd-display ";big fft 1 at 0 (sin/cos) differs by ~A in ~A at ~A (~A ~A)~%"
- (max cerr serr)
- (if (> cerr serr) "cos" "sin")
- i
- (if (> cerr serr)
- (cos (/ (* 2 pi i) 64))
- (sin (/ (* -2 pi i) 64)))
- (vector-ref (if (> cerr serr) rl im) i))))))
+ (do ((happy #t)
+ (i 0 (+ i 1)))
+ ((or (= i 64) (not happy)))
+ (let ((cerr (magnitude (- (vector-ref rl i) (cos (/ (* 2 pi i) 64)))))
+ (serr (magnitude (- (vector-ref im i) (sin (/ (* -2 pi i) 64))))))
+ (set! happy (and (< cerr 1e-30)
+ (< serr 1e-30)))
+ (if (not happy)
+ (snd-display ";big fft 1 at 0 (sin/cos) differs by ~A in ~A at ~A (~A ~A)~%"
+ (max cerr serr)
+ (if (> cerr serr) "cos" "sin")
+ i
+ (if (> cerr serr)
+ (cos (/ (* 2 pi i) 64))
+ (sin (/ (* -2 pi i) 64)))
+ (vector-ref (if (> cerr serr) rl im) i)))))
(bignum-fft rl im 64)
(let ((crl (make-vector 64 (bignum "0.0")))
@@ -35487,19 +35199,19 @@ EDITS: 1
(pow (/ n 2) (/ pow 2))
(theta t0 (* theta 0.5)))
((= lg ipow))
- (let ((wpc (exp theta))
- (wc 1.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! wc (* wc wpc)))
- (set! prev mmax)))
+ (do ((wpc (exp theta))
+ (wc 1.0)
+ (ii 0 (+ ii 1)))
+ ((= ii prev)
+ (set! prev mmax))
+ (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! wc (* wc wpc))))
data))
(define* (fft! rl im n (dir 1))
@@ -35529,26 +35241,26 @@ EDITS: 1
(pow (/ n 2) (/ pow 2))
(theta (* pi dir) (* theta 0.5)))
((= lg ipow))
- (let ((wpr (cos theta))
- (wpi (sin theta))
- (wr 1.0)
- (wi 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 ((tempr (- (* wr (rl j)) (* wi (im j))))
- (tempi (+ (* wr (im j)) (* wi (rl j)))))
- (set! (rl j) (- (rl i) tempr))
- (set! (im j) (- (im i) tempi))
- (set! (rl i) (+ (rl i) tempr))
- (set! (im i) (+ (im i) tempi))))
- (let ((wtemp wr))
- (set! wr (- (* wr wpr) (* wi wpi)))
- (set! wi (+ (* wi wpr) (* wtemp wpi)))))
- (set! prev mmax)))
+ (do ((wpr (cos theta))
+ (wpi (sin theta))
+ (wr 1.0)
+ (wi 0.0)
+ (ii 0 (+ ii 1)))
+ ((= ii prev)
+ (set! prev mmax))
+ (do ((jj 0 (+ jj 1))
+ (i ii (+ i mmax))
+ (j (+ ii prev) (+ j mmax)))
+ ((>= jj pow))
+ (let ((tempr (- (* wr (rl j)) (* wi (im j))))
+ (tempi (+ (* wr (im j)) (* wi (rl j)))))
+ (set! (rl j) (- (rl i) tempr))
+ (set! (im j) (- (im i) tempi))
+ (set! (rl i) (+ (rl i) tempr))
+ (set! (im i) (+ (im i) tempi))))
+ (let ((wtemp wr))
+ (set! wr (- (* wr wpr) (* wi wpi)))
+ (set! wi (+ (* wi wpr) (* wtemp wpi))))))
rl)
(do ((i 0 (+ i 1)))
@@ -35564,17 +35276,17 @@ EDITS: 1
(vector-set! v2 k (complex (v0 k) (v1 k))))
(mus-fft v0 v1 len 1)
(cfft! v2 len 1)
- (let ((sum 0.0)
- (mx 0.0))
- (do ((m 0 (+ m 1)))
- ((= m len))
- (let ((diffr (abs (- (v0 m) (real-part (v2 m)))))
- (diffi (abs (- (v1 m) (imag-part (v2 m))))))
- (set! sum (+ sum diffr diffi))
- (set! mx (max mx diffr diffi))))
- (if (or (> mx 1e-6)
- (> sum 1e-6))
- (snd-display ";cfft! ~A: ~A ~A~%" len mx sum))))))
+ (do ((sum 0.0)
+ (mx 0.0)
+ (m 0 (+ m 1)))
+ ((= m len)
+ (if (or (> mx 1e-6)
+ (> sum 1e-6))
+ (snd-display ";cfft! ~A: ~A ~A~%" len mx sum)))
+ (let ((diffr (abs (- (v0 m) (real-part (v2 m)))))
+ (diffi (abs (- (v1 m) (imag-part (v2 m))))))
+ (set! sum (+ sum diffr diffi))
+ (set! mx (max mx diffr diffi)))))))
(let ((val (cfft! (cfft! (cfft! (cfft! (vector 0.0 1+i 0.0 0.0)))))))
(if (or (> (magnitude (val 0)) 1e-12)
@@ -35599,17 +35311,17 @@ EDITS: 1
(set! (v3 k) (v1 k)))
(mus-fft v0 v1 len 1)
(fft! v2 v3 len 1)
- (let ((sum 0.0)
- (mx 0.0))
- (do ((m 0 (+ m 1)))
- ((= m len))
- (let ((diffr (abs (- (v0 m) (v2 m))))
- (diffi (abs (- (v1 m) (v3 m)))))
- (set! sum (+ sum diffr diffi))
- (set! mx (max mx diffr diffi))))
- (if (or (> mx 1e-6)
- (> sum 1e-6))
- (snd-display ";fft! ~A: ~A ~A~%" len mx sum)))))))
+ (do ((sum 0.0)
+ (mx 0.0)
+ (m 0 (+ m 1)))
+ ((= m len)
+ (if (or (> mx 1e-6)
+ (> sum 1e-6))
+ (snd-display ";fft! ~A: ~A ~A~%" len mx sum)))
+ (let ((diffr (abs (- (v0 m) (v2 m))))
+ (diffi (abs (- (v1 m) (v3 m)))))
+ (set! sum (+ sum diffr diffi))
+ (set! mx (max mx diffr diffi))))))))
@@ -35639,17 +35351,17 @@ EDITS: 1
(text-width (* 6 (length text)))
(ls (left-sample snd chn))
(rs (right-sample snd chn)))
- (if (< ls samp rs)
- (let ((xpos (x->position (/ samp (srate))))
- (ypos (y->position (sample samp))))
- (catch #t
- (lambda ()
- (let ((cr (make-cairo (car (channel-widgets snd chn)))))
- (draw-line xpos 20 xpos (- ypos 4) snd chn time-graph cr)
- (draw-string text (- xpos (/ text-width 2)) 18 snd chn time-graph cr)
- (free-cairo cr)))
- (lambda args
- (snd-display ";draw error: ~A" args))))))))
+ (when (< ls samp rs)
+ (let ((xpos (x->position (/ samp (srate))))
+ (ypos (y->position (sample samp))))
+ (catch #t
+ (lambda ()
+ (let ((cr (make-cairo (car (channel-widgets snd chn)))))
+ (draw-line xpos 20 xpos (- ypos 4) snd chn time-graph cr)
+ (draw-string text (- xpos (/ text-width 2)) 18 snd chn time-graph cr)
+ (free-cairo cr)))
+ (lambda args
+ (snd-display ";draw error: ~A" args))))))))
comments)))
(define display-samps-in-red
@@ -35698,14 +35410,12 @@ EDITS: 1
(rs (right-sample snd chn)))
(if (< ls 1000 rs)
(let ((pos (x->position (/ 1000.0 (srate))))
- (old-color (foreground-color))
(cr (make-cairo (car (channel-widgets snd chn)))))
- (set! (foreground-color) (make-color .75 .75 .75))
- (fill-rectangle pos 10 50 20 snd chn time-graph #f cr)
- (set! (foreground-color) (make-color 1 0 0))
- (draw-string "hi!" (+ pos 5) 12 snd chn time-graph cr)
- (set! (foreground-color) old-color)
- (free-cairo cr)))))
+ (let-temporarily (((foreground-color) (make-color 0.75 0.75 0.75)))
+ (fill-rectangle pos 10 50 20 snd chn time-graph #f cr)
+ (set! (foreground-color) (make-color 1 0 0))
+ (draw-string "hi!" (+ pos 5) 12 snd chn time-graph cr)
+ (free-cairo cr))))))
(do ((test-ctr 0 (+ 1 test-ctr))) ((= test-ctr tests))
(log-mem test-ctr)
@@ -35889,10 +35599,9 @@ EDITS: 1
(happy #t))
(do ((i 0 (+ i 1)))
((or (not happy) (= i 100)))
- (if (fneq (data i) (coeffs i))
- (begin
- (snd-display ";coeffs '(0 1 1 1): ~A ~A ~A" i (coeffs i) (data i))
- (set! happy #f)))))
+ (when (fneq (data i) (coeffs i))
+ (snd-display ";coeffs '(0 1 1 1): ~A ~A ~A" i (coeffs i) (data i))
+ (set! happy #f))))
(undo)
(filter-sound '(0 1 1 1) 1000)
(if (not (mus-arrays-equal? (channel->float-vector 5 10) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
@@ -36581,9 +36290,11 @@ EDITS: 1
(list 'fft (lambda ()
(let* ((len (framples))
(fsize (expt 2 (ceiling (log len 2))))
- (rl (channel->float-vector 0 fsize))
- (im (make-float-vector fsize)))
- (do ((i 0 (+ i 1))) ((= i 4)) (mus-fft rl im fsize))
+ (rl (channel->float-vector 0 fsize)))
+ (do ((im (make-float-vector fsize))
+ (i 0 (+ i 1)))
+ ((= i 4))
+ (mus-fft rl im fsize))
(float-vector->channel (float-vector-scale! rl (/ 2.0 (* fsize fsize))) 0 len))))
(list 'set-samples (lambda () ; too slow for some reason, so cut it short at 100
(set! (squelch-update) #t)
@@ -36604,9 +36315,7 @@ EDITS: 1
us))))
((make-scaler 0 100)
(make-scaler 1 100)))
- (set! (squelch-update) #f)
- ))
- ))
+ (set! (squelch-update) #f)))))
(close-sound ind))
(let ((data1 (file->floats "1a.snd"))
@@ -36831,27 +36540,27 @@ EDITS: 1
(format *stderr* "~S: ~S but expected ~S~%" ',tst val ,expected))))
(define (fv0)
- (let ((fv (make-float-vector 3))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 3) fv)
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 3))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 3) fv)
+ (float-vector-set! fv i (oscil g))))
(test (fv0) (float-vector 0.0 0.1419943179576268 0.2811111133316549))
(define (fv00)
- (let ((fv (make-float-vector 3))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 3) fv)
- (set! (fv i) (oscil g)))))
+ (do ((fv (make-float-vector 3))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 3) fv)
+ (set! (fv i) (oscil g))))
(test (fv00) (float-vector 0.0 0.1419943179576268 0.2811111133316549))
(define (fv01)
- (let ((fv (make-float-vector 3))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 5) fv)
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 3))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 5) fv)
+ (float-vector-set! fv i (oscil g))))
(test (catch #t
fv01
@@ -36860,11 +36569,11 @@ EDITS: 1
"float-vector-set! argument 2, 3, is out of range (it is too large)")
(define (fv02)
- (let ((fv (make-float-vector 3))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1/2)))
- ((= i 2) fv)
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 3))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1/2)))
+ ((= i 2) fv)
+ (float-vector-set! fv i (oscil g))))
(test (catch #t
(lambda ()
@@ -36876,10 +36585,10 @@ EDITS: 1
;; (+ (* s1 s2) (* (- 1.0 s1) s3))
(define (fv1 s1 s2 s3)
- (let ((fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (* s1 s2) (* (- 1.0 s1) s3))))))
+ (do ((fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (* s1 s2) (* (- 1.0 s1) s3)))))
(test (fv1 1 2 3) (make-float-vector 4 2.0))
(test (fv1 2 3 4) (make-float-vector 4 2.0))
@@ -36920,383 +36629,374 @@ EDITS: 1
(test (fv3) (float-vector 0.0 0.9916648104524686 -0.9589242746631385))
(define (fv4)
- (let ((fv-a (make-float-vector 4))
- (fv-b (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) (list fv-a fv-b))
- (float-vector-set! fv-a i (float-vector-set! fv-b i (oscil g))))))
+ (do ((fv-a (make-float-vector 4))
+ (fv-b (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) (list fv-a fv-b))
+ (float-vector-set! fv-a i (float-vector-set! fv-b i (oscil g)))))
(test (fv4) (list (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
(float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)))
(define (fv5)
- (let ((fv-a (make-float-vector 4))
- (g1 (make-oscil 1000))
- (g2 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv-a)
- (float-vector-set! fv-a i (oscil g1 (oscil g2))))))
+ (do ((fv-a (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv-a)
+ (float-vector-set! fv-a i (oscil g1 (oscil g2)))))
(test (fv5) (float-vector 0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
(define (fv6)
(let ((g1 (make-oscil 1000))
(g2 (make-oscil 1000)))
- (list (oscil g1 (oscil g2)) (oscil g1 (oscil g2)) (oscil g1 (oscil g2)) (oscil g1 (oscil g2)))))
+ (let ((call (lambda () (oscil g1 (oscil g2)))))
+ (list (call) (call) (call) (call)))))
(test (fv6) '(0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
(define (fv7)
(let ((g0 (make-oscil 1000))
(g1 (make-oscil 1000))
- (x 0.1))
- (let ((fv (make-float-vector 6)))
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (float-vector-set! fv i (oscil g0 0.1)))
- (do ((i 3 (+ i 1)))
- ((= i 6))
- (float-vector-set! fv i (oscil g1 x)))
- fv)))
+ (x 0.1)
+ (fv (make-float-vector 6)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (float-vector-set! fv i (oscil g0 0.1)))
+ (do ((i 3 (+ i 1)))
+ ((= i 6))
+ (float-vector-set! fv i (oscil g1 x)))
+ fv))
(test (fv7) (float-vector 0.0 0.2401067896488338 0.4661656420314379 0.0 0.2401067896488338 0.4661656420314379))
(define (fv8)
- (let ((g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (oscil g))
+ (do ((g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4)
+ (oscil g))
(oscil g)))
(test (morally-equal? (fv8) 0.5395507431861811) #t)
(define (fv9)
- (let ((g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (oscil g 0.1))
+ (do ((g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4)
+ (oscil g 0.1))
(oscil g 0.1)))
(test (morally-equal? (fv9) 0.8248311180769614) #t)
(define (fv10)
- (let ((fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (* i i)))))
+ (do ((fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* i i))))
(test (fv10) (float-vector 0.0 1.0 4.0 9.0))
(define (fv11)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (* (oscil g0) (oscil g1))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (oscil g0) (oscil g1)))))
(test (fv11) (float-vector 0.0 0.02016238633225161 0.07902345803856255 0.1718360964482408))
(define (fv12)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (* 2.0 (oscil g0))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* 2.0 (oscil g0)))))
(test (fv12) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
(define (fv13)
- (let ((fv (make-float-vector 4))
- (x 2.0)
- (g0 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (* (oscil g0) x)))))
+ (do ((fv (make-float-vector 4))
+ (x 2.0)
+ (g0 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (oscil g0) x))))
(test (fv13) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
(define (fv14)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000))
- (s0 2.0)
- (s1 3.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (* s0 (oscil g0 (* s1 (oscil g1))))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (s0 2.0)
+ (s1 3.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* s0 (oscil g0 (* s1 (oscil g1)))))))
(test (fv14) (float-vector 0.0 0.2839886359152535 1.305084606281564 1.984158175327229))
(define (fv15)
- (let ((fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ i i)))))
+ (do ((fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ i i))))
(test (fv15) (float-vector 0.0 2.0 4.0 6.0))
(define (fv16)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g0) (oscil g1))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1)))))
(test (fv16) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
(define (fv17)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ 2.0 (oscil g0))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ 2.0 (oscil g0)))))
(test (fv17) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
(define (fv18)
- (let ((fv (make-float-vector 4))
- (x 2.0)
- (g0 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g0) x)))))
+ (do ((fv (make-float-vector 4))
+ (x 2.0)
+ (g0 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) x))))
(test (fv18) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
(define (fv19)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000))
- (s0 2.0)
- (s1 3.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ s0 (oscil g0 (* s1 (oscil g1))))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (s0 2.0)
+ (s1 3.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s0 (oscil g0 (* s1 (oscil g1)))))))
(test (fv19) (float-vector 2.0 2.141994317957627 2.652542303140782 2.992079087663615))
(define (fv20)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000))
- (g2 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2)))))
(test (fv20) (float-vector 0.0 0.4259829538728803 0.8433333399949648 1.243593530070886))
(define (fv21)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000))
- (s1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g0) (oscil g1) s1)))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (s1 1.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1) s1))))
(test (fv21) (float-vector 1.0 1.283988635915253 1.56222222666331 1.829062353380591))
(define (fv22)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g0) 1.0 (oscil g1))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) 1.0 (oscil g1)))))
(test (fv22) (float-vector 1.0 1.283988635915253 1.56222222666331 1.829062353380591))
(define (fv23)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (s1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ s1 1.0 (oscil g0))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 1.0 (oscil g0)))))
(test (fv23) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
(define (fv24)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (s1 1.0)
- (s2 2.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ s1 (oscil g0) s2)))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0)
+ (s2 2.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 (oscil g0) s2))))
(test (fv24) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
(define (fv25)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (s1 1.0)
- (s2 2.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ s1 s2 (oscil g0))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0)
+ (s2 2.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 s2 (oscil g0)))))
(test (fv25) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
(define (fv26)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (s1 1.0)
- (s2 2.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g0) s1 s2)))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0)
+ (s2 2.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) s1 s2))))
(test (fv26) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
(define (fv27)
- (let ((fv (make-float-vector 4))
- (s3 4.0)
- (s1 1.0)
- (s2 2.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ s3 s1 s2)))))
+ (do ((fv (make-float-vector 4))
+ (s3 4.0)
+ (s1 1.0)
+ (s2 2.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s3 s1 s2))))
(test (fv27) (make-float-vector 4 7.0))
(define (fv28)
- (let ((fv (make-float-vector 4))
- (s1 1.0)
- (s2 2.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ 4.0 s1 s2)))))
+ (do ((fv (make-float-vector 4))
+ (s1 1.0)
+ (s2 2.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ 4.0 s1 s2))))
(test (fv28) (make-float-vector 4 7.0))
(define (fv29)
- (let ((fv (make-float-vector 4))
- (s1 1.0)
- (s2 2.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ s1 s2 4.0)))))
+ (do ((fv (make-float-vector 4))
+ (s1 1.0)
+ (s2 2.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 s2 4.0))))
(test (fv29) (make-float-vector 4 7.0))
(define (fv30)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000))
- (g2 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (* (oscil g0) (oscil g1) (oscil g2))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (oscil g0) (oscil g1) (oscil g2)))))
(test (fv30) (float-vector 0.0 0.002862944295646243 0.02221437226853764 0.07123141925855635))
(define (fv31)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000 4.0)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (abs (oscil g0))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000 4.0))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (abs (oscil g0)))))
(test (fv31) (float-vector 0.7568024953079282 0.8419478535558946 0.9100310927158114 0.9596725022396432))
(define (fv32)
- (let ((fv (make-float-vector 4))
- (s0 -1.5))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (abs s0)))))
- (test (fv32) (float-vector 1.5 1.5 1.5 1.5))
+ (do ((fv (make-float-vector 4))
+ (s0 -1.5)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (abs s0))))
+ (test (fv32) (make-float-vector 4 1.5))
(define (fv31a)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (g1 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (let ((x (oscil g0)))
- (float-vector-set! fv i (oscil g1 x))))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (oscil g0)))
+ (float-vector-set! fv i (oscil g1 x)))))
(test (fv31a) (float-vector 0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
(define (fv33)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (g1 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (let ((x (oscil g0))
- (y (oscil g0)))
- (float-vector-set! fv i (* y (oscil g1 x)))))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (oscil g0))
+ (y (oscil g0)))
+ (float-vector-set! fv i (* y (oscil g1 x))))))
(test (fv33) (float-vector 0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
(define (fv34)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (g1 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (let* ((x (oscil g0))
- (y (oscil g0)))
- (float-vector-set! fv i (* y (oscil g1 x)))))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let* ((x (oscil g0))
+ (y (oscil g0)))
+ (float-vector-set! fv i (* y (oscil g1 x))))))
(test (fv34) (float-vector 0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
(define (fv35)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (g1 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (let ((y (oscil g0)))
- (float-vector-set! fv i (+ y (oscil g1)))))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((y (oscil g0)))
+ (float-vector-set! fv i (+ y (oscil g1))))))
(test (fv35) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
- (define (fv36)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (g1 (make-oscil 1000))
- (x 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) (and (positive? x) fv))
- (float-vector-set! fv i (+ 1.0 (oscil g1))))))
- (test (fv36) (float-vector 1.0 1.141994317957627 1.281111113331655 1.414531176690295))
-
(define (fv37)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (x0 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (odd-weight (+ x0 (oscil g0)))))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x0 1.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (odd-weight (+ x0 (oscil g0))))))
(test (fv37) (float-vector 1.0 0.8580056820423732 0.7188888866683452 0.5854688233097047))
(define (fv38)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (x0 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (even-weight (+ x0 (oscil g0)))))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x0 1.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (even-weight (+ x0 (oscil g0))))))
(test (fv38) (float-vector 0.0 0.1419943179576268 0.2811111133316548 0.4145311766902953))
(define (fv39)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (max (oscil g0) 0.25)))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (max (oscil g0) 0.25))))
(test (fv39) (float-vector 0.25 0.25 0.2811111133316549 0.4145311766902953))
(define (fv40)
- (let ((g0 (make-file->sample "oboe.snd"))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (ina i g0)))))
+ (do ((g0 (make-file->sample "oboe.snd"))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (ina i g0))))
(test (fv40) (float-vector 0.0 -0.00030517578125 -0.00030517578125 -0.000274658203125))
(define (fv41)
- (let ((g0 (make-float-vector 3 0.5))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (ina i g0)))))
+ (do ((g0 (make-float-vector 3 0.5))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (ina i g0))))
(test (fv41) (float-vector 0.5 0.5 0.5 0.0))
(define (fv42)
- (let ((g0 (make-float-vector 3 0.5))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (- (ina i g0))))))
+ (do ((g0 (make-float-vector 3 0.5))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (- (ina i g0)))))
(test (fv42) (float-vector -0.5 -0.5 -0.5 0.0))
(define (fv43)
- (let ((fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (- i)))))
+ (do ((fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (- i))))
(test (fv43) (float-vector 0 -1 -2 -3))
(define (permute op . args)
@@ -37334,199 +37034,192 @@ EDITS: 1
(list 'x '(+ .01 (oscil g0)) 2.0 '(+ .01 (oscil g1)) 'y))
(define (fv44)
- (let ((g0 (make-float-vector 3 1.0))
- (fv (make-float-vector 4))
- (x 2.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (polynomial g0 x)))))
+ (do ((g0 (make-float-vector 3 1.0))
+ (fv (make-float-vector 4))
+ (x 2.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (polynomial g0 x))))
(test (fv44) (make-float-vector 4 7.0))
(define (fv45)
- (let ((g0 (make-float-vector 3 1.0))
- (fv (make-float-vector 4))
- (x (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (polynomial g0 (* 2.0 (oscil x)))))))
+ (do ((g0 (make-float-vector 3 1.0))
+ (fv (make-float-vector 4))
+ (x (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (polynomial g0 (* 2.0 (oscil x))))))
(test (fv45) (float-vector 1.0 1.36463818124426 1.87831605881756 2.516406739173554))
(define (fv47)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (x 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (amplitude-modulate 1.0 x (oscil g0))))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x 1.0)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (amplitude-modulate 1.0 x (oscil g0)))))
(test (fv47) (float-vector 1.0 1.141994317957627 1.281111113331655 1.414531176690295))
(define (fv48)
- (let ((g0 (make-oscil 1000))
- (fv (make-float-vector 4))
- (x 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 4) (and (zero? (log x)) fv))
- (float-vector-set! fv i (remainder (* 10 (oscil g0)) 1.0)))))
+ (do ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x 1.0)
+ (i 0 (+ i 1)))
+ ((= i 4) (and (zero? (log x)) fv))
+ (float-vector-set! fv i (remainder (* 10 (oscil g0)) 1.0))))
(test (fv48) (float-vector 0.0 0.4199431795762676 0.8111111333165493 0.1453117669029531))
(define (fv49)
- (let ((g0 (float-vector 1 2 3 4 5 6))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (float-vector-ref g0 (+ i 2))))))
+ (do ((g0 (float-vector 1 2 3 4 5 6))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (float-vector-ref g0 (+ i 2)))))
(test (fv49) (float-vector 3 4 5 6))
(define (fv49a)
- (let ((fv (make-float-vector 4))
- (g0 (make-oscil 1000))
- (g1 (make-oscil 1000))
- (g2 (make-oscil 1000))
- (g3 (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2) (oscil g3))))))
+ (do ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (g3 (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2) (oscil g3)))))
(test (fv49a) (float-vector 0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
(define (fv50)
- (let ((iv (int-vector 0 1 2 3 4 5 6))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv (vector-ref iv i) 1.0))))
+ (do ((iv (int-vector 0 1 2 3 4 5 6))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv (vector-ref iv i) 1.0)))
(test (fv50) (make-float-vector 4 1.0))
(define (fv51)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((> i 4) fv)
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((> i 4) fv)
+ (float-vector-set! fv i (oscil g))))
(test (catch #t fv51 (lambda args (car args))) 'out-of-range)
(define (fv52)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1.1)))
- ((= i 4) fv)
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1.1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (oscil g))))
(test (catch #t fv52 (lambda args (car args))) 'wrong-type-arg)
(define (fv53)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 2)))
- ((= i 3) fv)
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 2)))
+ ((= i 3) fv)
+ (float-vector-set! fv i (oscil g))))
(test (catch #t fv53 (lambda args (car args))) 'out-of-range)
(define (fv54)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.1)))
- ((> i 4) (and (positive? x) fv))
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((> i 4) (and (positive? x) fv))
+ (float-vector-set! fv i (oscil g))))
(test (catch #t fv54 (lambda args (car args))) 'out-of-range)
(define (fv55)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1.1))
- (x 0.0 (+ x 0.1)))
- ((= i 4) (and (positive? x) fv))
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1.1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 4) (and (positive? x) fv))
+ (float-vector-set! fv i (oscil g))))
(test (catch #t fv55 (lambda args (car args))) 'wrong-type-arg)
(define (fv56)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 2))
- (x 0.0 (+ x 0.1)))
- ((= i 3) (and (positive? x) fv))
- (float-vector-set! fv i (oscil g)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 2))
+ (x 0.0 (+ x 0.1)))
+ ((= i 3) (and (positive? x) fv))
+ (float-vector-set! fv i (oscil g))))
(test (catch #t fv56 (lambda args (car args))) 'out-of-range)
(define (fv57)
- (let ((g (make-oscil 1000))
- (e (make-env '(0 0 1 1) :length 5))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (* (env e) (oscil g))))))
+ (do ((g (make-oscil 1000))
+ (e (make-env '(0 0 1 1) :length 5))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (env e) (oscil g)))))
(test (fv57) (float-vector 0.0 0.03549857948940669 0.1405555566658275 0.3108983825177215))
(define (fv59)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (let ((j (abs i))) ; j is not an integer! so is_fv_set_rf rejects it -- yow
- (float-vector-set! fv j (oscil g))))))
-
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((j (abs i))) ; j is not an integer! so is_fv_set_rf rejects it -- yow
+ (float-vector-set! fv j (oscil g)))))
(test (fv59) (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953))
(define (fv60)
- (let ((xv (float-vector 0 1 2 3 4))
- (fv (make-float-vector 4))
- (g (make-oscil 1000))
- (len 5))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (array-interp xv (* 4 (abs (oscil g))) len)))))
-
+ (do ((xv (float-vector 0 1 2 3 4))
+ (fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (len 5)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (array-interp xv (* 4 (abs (oscil g))) len))))
(test (fv60) (float-vector 0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
(define (fv61)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g) (oscil g))))))
-
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g) (oscil g)))))
(test (fv61) (float-vector 0.1419943179576268 0.6956422900219503 1.193187027684375 1.594501774071586))
(define (fv62)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000))
- (x .1))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g) (oscil g x))))))
-
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (x .1)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g) (oscil g x)))))
(test (fv62) (float-vector 0.1419943179576268 0.8788265473477139 1.4870276868047 1.877577239959861))
(define (fv63)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000))
- (x .1))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (+ (oscil g x) (oscil g))))))
-
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (x .1)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g x) (oscil g)))))
(test (fv63) (float-vector 0.2401067896488338 0.962578603769539 1.544160801705073 1.899729018207357))
(define (fv64)
(set! (mus-rand-seed) 1234)
- (let ((fv (make-float-vector 10))
- (e (make-env '(0 0 1 1) :length 10))
- (r (make-rand-interp 1000 .1)))
- (do ((i 0 (+ i 1)))
- ((= i 10) fv)
- (float-vector-set! fv i (+ (env e) (rand-interp r))))))
-
+ (do ((fv (make-float-vector 10))
+ (e (make-env '(0 0 1 1) :length 10))
+ (r (make-rand-interp 1000 .1))
+ (i 0 (+ i 1)))
+ ((= i 10) fv)
+ (float-vector-set! fv i (+ (env e) (rand-interp r)))))
(test (fv64) (float-vector -0.001775140394296145 0.1075608303225188 0.2168968010393338 0.3262327717561487 0.4355687424729637 0.5449047131897787 0.6542406839065937 0.7635766546234087 0.8729126253402237 0.9822485960570387))
(define (fv65)
(set! (mus-rand-seed) 1234)
- (let ((fv (make-float-vector 10))
- (e (make-triangle-wave 1000 .5))
- (r (make-rand-interp 1000 .1)))
- (do ((i 0 (+ i 1)))
- ((= i 10) fv)
- (float-vector-set! fv i (+ (triangle-wave e) (rand-interp r))))))
-
+ (do ((fv (make-float-vector 10))
+ (e (make-triangle-wave 1000 .5))
+ (r (make-rand-interp 1000 .1))
+ (i 0 (+ i 1)))
+ ((= i 10) fv)
+ (float-vector-set! fv i (+ (triangle-wave e) (rand-interp r)))))
(test (fv65) (float-vector -0.001775140394296145 0.0418011931343102 0.08537752666291655 0.1289538601915229 0.1725301937201293 0.2161065272487356 0.2596828607773419 0.3032591943059482 0.3468355278345545 0.3904118613631609))
(define (fv66)
@@ -37541,7 +37234,6 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (oscil (vector-ref gv i))))))
-
(test (fv66) (float-vector 0.0 0.0 0.1419943179576268 0.1419943179576268 0.2811111133316549 0.2811111133316549 0.4145311766902953 0.4145311766902953))
(define (fv67)
@@ -37552,7 +37244,6 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (oscil (vector-ref v i))))))
-
(test (fv67) (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953 0.5395507431861811 0.6536362844981936 0.7544758509208143 0.8400259231507713))
(define (fv68)
@@ -37568,31 +37259,28 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (oscil (vector-ref gv i) x)))))
-
(test (fv68) (float-vector 0.0 0.0 0.2401067896488338 0.2401067896488338 0.4661656420314379 0.4661656420314379 0.6649505230927522 0.6649505230927522))
(define (fv69)
- (let ((fv (make-float-vector 4))
- (g (make-formant 440 .9))
- (e (make-env '(0 440 1 880) :length 10)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (mus-set-formant-frequency g (env e))))))
-
+ (do ((fv (make-float-vector 4))
+ (g (make-formant 440 .9))
+ (e (make-env '(0 440 1 880) :length 10))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (mus-set-formant-frequency g (env e)))))
(test (fv69) (float-vector 440.0 488.8888888888889 537.7777777777778 586.6666666666667))
(define (fv70)
- (let ((fv1 (make-float-vector 4))
- (fv2 (make-float-vector 4))
- (g1 (make-oscil 1000))
- (g2 (make-oscil 1000))
- (e (make-env '(0 2.0 1 2.0) :length 10)))
- (do ((i 0 (+ i 1)))
- ((= i 4) (list fv1 fv2))
- (let ((x (env e)))
- (float-vector-set! fv1 i (oscil g1))
- (float-vector-set! fv2 i (* x (oscil g2)))))))
-
+ (do ((fv1 (make-float-vector 4))
+ (fv2 (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (e (make-env '(0 2.0 1 2.0) :length 10))
+ (i 0 (+ i 1)))
+ ((= i 4) (list fv1 fv2))
+ (let ((x (env e)))
+ (float-vector-set! fv1 i (oscil g1))
+ (float-vector-set! fv2 i (* x (oscil g2))))))
(test (fv70) (list (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
(float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906)))
@@ -37608,21 +37296,20 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (env (vector-ref gv i))))))
-
(test (fv71) (float-vector 0.0 0.0 0.25 0.25 0.5 0.5 0.75 0.75))
(define (fv72)
(let ((fv (make-float-vector 10))
(ls (make-list 10))
(x 0.0))
- (let ((g (make-square-wave 2205)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (float-vector-set! fv i (+ (square-wave g) (square-wave g x)))))
- (let ((g (make-square-wave 2205)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (list-set! ls i (+ (square-wave g) (square-wave g x)))))
+ (do ((g (make-square-wave 2205))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (float-vector-set! fv i (+ (square-wave g) (square-wave g x))))
+ (do ((g (make-square-wave 2205))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (list-set! ls i (+ (square-wave g) (square-wave g x))))
(list fv ls)))
(test (fv72) (list (float-vector 2.0 2.0 2.0 2.0 2.0 0.0 0.0 0.0 0.0 0.0)
@@ -37632,15 +37319,15 @@ EDITS: 1
(let ((fv (make-float-vector 10))
(ls (make-list 10))
(x 0.5))
- (let ((g (make-square-wave 2205)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (float-vector-set! fv i (+ (square-wave g) (square-wave g x)))))
+ (do ((g (make-square-wave 2205))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (float-vector-set! fv i (+ (square-wave g) (square-wave g x))))
(newline *stderr*)
- (let ((g (make-square-wave 2205)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (list-set! ls i (+ (square-wave g) (square-wave g x)))))
+ (do ((g (make-square-wave 2205))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (list-set! ls i (+ (square-wave g) (square-wave g x))))
(list fv ls)))
(test (fv73) (list (float-vector 2.0 2.0 2.0 0.0 0.0 0.0 2.0 2.0 2.0 0.0)
@@ -37655,51 +37342,49 @@ EDITS: 1
(test (fv74) (float-vector 0.008 0.01148666785741709 0.01717900881454179 0.02679348967895129))
(define (fv75)
- (let ((fv (make-float-vector 4))
- (g (make-r2k!cos 1000 :r 0.5 :k 3.0)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (r2k!cos g .1)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-r2k!cos 1000 :r 0.5 :k 3.0))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (r2k!cos g .1))))
(test (fv75) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
(define (fv76)
- (let ((fv (make-float-vector 4))
- (g (make-r2k!cos 1000 :r 0.5 :k 3.0))
- (x .1))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (r2k!cos g x)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-r2k!cos 1000 :r 0.5 :k 3.0))
+ (x .1)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (r2k!cos g x))))
(test (fv76) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
(define (fv77)
- (let ((fv (make-float-vector 4))
- (g (make-r2k!cos 1000 :r 0.5 :k 3.0))
- (x (make-env '(0 .1 1 .1) :length 10)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (r2k!cos g (env x))))))
+ (do ((fv (make-float-vector 4))
+ (g (make-r2k!cos 1000 :r 0.5 :k 3.0))
+ (x (make-env '(0 .1 1 .1) :length 10))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (r2k!cos g (env x)))))
(test (fv77) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
- (define (fv80) (let ((x 0.0)) (do ((i 0 (+ i 1))) ((= i 4) x) (set! x .1)))) (test (fv80) .1)
(define (fv81) (do ((x 0.0) (i 0 (+ i 1)) (y .1 .1)) ((= i 4) x) (set! x y))) (test (fv81) .1)
- (define (fv82) (let ((x 0.0) (y 0.1)) (do ((i 0 (+ i 1))) ((= i 4) x) (set! x y)))) (test (fv82) .1)
- (define (fv83) (let ((x 0.0) (y 0.1)) (do ((i 0 (+ i 1))) ((= i 4) x) (set! x (+ x y))))) (test (fv83) .4)
- (define (fv84) (let ((x 1.0)) (do ((i 0 (+ i 1))) ((= i 10) x) (set! x (+ x (* i 2.0)))))) (test (fv84) 91.0)
+ (define (fv82) (do ((x 0.0) (y 0.1) (i 0 (+ i 1))) ((= i 4) x) (set! x y))) (test (fv82) .1)
+ (define (fv84) (do ((x 1.0) (i 0 (+ i 1))) ((= i 10) x) (set! x (+ x (* i 2.0))))) (test (fv84) 91.0)
(define (fv85)
- (let ((fv1 (make-float-vector 4 1.5))
- (fv2 (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 10) fv2)
- (float-vector-add! fv2 fv1))))
+ (do ((fv1 (make-float-vector 4 1.5))
+ (fv2 (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 10) fv2)
+ (float-vector-add! fv2 fv1)))
(test (fv85) (make-float-vector 4 15.0))
(define (fv86)
- (let ((g0 (make-float-vector 4 1.0))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (set! (fv i) (g0 i)))))
+ (do ((g0 (make-float-vector 4 1.0))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (set! (fv i) (g0 i))))
(test (fv86) (make-float-vector 4 1.0))
(define (fv87)
@@ -37713,27 +37398,27 @@ EDITS: 1
(test (fv87) (float-vector 9 8 7 6))
(define (fv88)
- (let ((fv (make-float-vector 4))
- (ifv (make-float-vector 1))
- (g (make-file->frample "oboe.snd")))
- (do ((i 0 (+ i 1))
- (j 1000 (+ j 1)))
- ((= i 4) fv)
- (file->frample g j ifv)
- (float-vector-set! fv i (ifv 0)))))
+ (do ((fv (make-float-vector 4))
+ (ifv (make-float-vector 1))
+ (g (make-file->frample "oboe.snd"))
+ (i 0 (+ i 1))
+ (j 1000 (+ j 1)))
+ ((= i 4) fv)
+ (file->frample g j ifv)
+ (float-vector-set! fv i (ifv 0))))
(test (fv88) (float-vector 0.0328369140625 0.0347900390625 0.0340576171875 0.031036376953125))
(define (fv89)
- (let ((fv0 (make-float-vector 4))
- (fv1 (make-float-vector 4))
- (ifv (make-float-vector 2))
- (g (make-file->frample "2.snd")))
- (do ((i 0 (+ i 1))
- (j 1000 (+ j 1)))
- ((= i 4) (list fv0 fv1))
- (file->frample g j ifv)
- (float-vector-set! fv0 i (ifv 0))
- (float-vector-set! fv1 i (ifv 1)))))
+ (do ((fv0 (make-float-vector 4))
+ (fv1 (make-float-vector 4))
+ (ifv (make-float-vector 2))
+ (g (make-file->frample "2.snd"))
+ (i 0 (+ i 1))
+ (j 1000 (+ j 1)))
+ ((= i 4) (list fv0 fv1))
+ (file->frample g j ifv)
+ (float-vector-set! fv0 i (ifv 0))
+ (float-vector-set! fv1 i (ifv 1))))
(test (fv89) (list (float-vector 0.002227783203125 0.00634765625 0.00787353515625 0.007293701171875)
(float-vector 0.004425048828125 0.012664794921875 0.015777587890625 0.014556884765625)))
@@ -37830,7 +37515,7 @@ EDITS: 1
(float-vector-set! fv i ((if (even? i) + -) i 10.0))
(float-vector-set! fv1 i (+ (float-vector-ref fv1 i) 1.0))))
(test (fv96) (list (float-vector 10.0 -9.0 12.0 -7.0)
- (float-vector 4.0 4.0 4.0 4.0)))
+ (make-float-vector 4 4.0)))
(define (fv97)
(do ((fv (make-float-vector 4))
@@ -37879,22 +37564,12 @@ EDITS: 1
(set! ctr (+ ctr 1)))))
(test (fv101) 2)
- (define (fv103)
- (let ((fv (make-float-vector 100))
- (n 100))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (do ((j 0 (+ j 1))
- (k i (+ k 1)))
- ((= j n) k)
- (float-vector-set! fv i (+ (float-vector-ref fv i) 1.0))))))
- (fv103) ; just run without overflow
-
(define (fv104)
- (let ((fv (make-float-vector 10)))
- (do ((i 0 (+ i 1))) ((= i 10) fv)
- (do ((j 0 (+ j 1))) ((= j i))
- (float-vector-set! fv i (+ (float-vector-ref fv j) 1.0))))))
+ (do ((fv (make-float-vector 10))
+ (i 0 (+ i 1)))
+ ((= i 10) fv)
+ (do ((j 0 (+ j 1))) ((= j i))
+ (float-vector-set! fv i (+ (float-vector-ref fv j) 1.0)))))
(test (fv104) (float-vector 0 1 2 3 4 5 6 7 8 9))
(when all-args
@@ -37939,22 +37614,22 @@ EDITS: 1
(define (fv108)
(let ((fv (make-float-vector 10)))
- (let ((locs (make-locsig :output fv))
- (k 0))
- (do ((i 0 (- i 1)))
- ((= i -10) fv)
- (set! k (abs i))
- (locsig locs k (* .1 i))))))
+ (do ((locs (make-locsig :output fv))
+ (k 0)
+ (i 0 (- i 1)))
+ ((= i -10) fv)
+ (set! k (abs i))
+ (locsig locs k (* .1 i)))))
(test (fv108) (float-vector 0 -.1 -.2 -.3 -.4 -.5 -.6 -.7 -.8 -.9))
(define (fv109)
(let ((fv (make-float-vector 10)))
- (let ((locs (make-locsig :output fv))
- (k 0))
- (do ((i 0 (+ i 1)))
- ((= i 10) fv)
- (locsig locs k (* .1 i))
- (set! k (+ k 1))))))
+ (do ((locs (make-locsig :output fv))
+ (k 0)
+ (i 0 (+ i 1)))
+ ((= i 10) fv)
+ (locsig locs k (* .1 i))
+ (set! k (+ k 1)))))
(test (fv109) (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
(define (fv110)
@@ -38000,32 +37675,32 @@ EDITS: 1
(test (catch #t fv113 (lambda args 'error)) 'error)
(define (fv114)
- (let ((fv (make-float-vector 10000))
+ (let ((fv (make-float-vector base-length))
(k 0)
(x 1.2))
(set! *output* fv)
(do ((i 0 (+ i 1)))
- ((= i 10000) fv)
+ ((= i base-length) fv)
(outa k (* .001 i))
(set! k (+ k x)))))
(test (catch #t fv114 (lambda args 'error)) 'error)
(define (fv115)
- (let ((g0 (make-float-vector 4 1.0))
- (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (let ((x (g0 i)))
- (set! (fv i) x)))))
+ (do ((g0 (make-float-vector 4 1.0))
+ (fv (make-float-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (g0 i)))
+ (set! (fv i) x))))
(test (fv115) (make-float-vector 4 1.0))
(define (fv116)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 100)))
- (do ((i 0 (+ i 1))
- (x 0 (+ x 1)))
- ((= i 4) (and (positive? x) fv))
- (float-vector-set! fv i ((if (oscil? g) + -) i 10.0)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 100))
+ (i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) (and (positive? x) fv))
+ (float-vector-set! fv i ((if (oscil? g) + -) i 10.0))))
(test (fv116) (float-vector 10.0 11.0 12.0 13.0))
(define (fv117)
@@ -38099,17 +37774,11 @@ EDITS: 1
(float-vector-set! fv i ((if (> i j) + -) i 10.0))))
(test (fv124) (float-vector -10.0 -9.0 -8.0 13.0))
- (define (fv125)
- (let ((gen (make-delay 5)))
- (fill! (mus-data gen) 0.3)
- (copy (mus-data gen) (make-float-vector 5) 0 3)))
- (test (fv125) (float-vector 0.3 0.3 0.3 0.0 0.0))
-
(define (fv126)
(let ((d0 (float-vector 1 0 -1 0 1 0 -1 0))
(d1 (float-vector 0 1 0 -1 0 1 0 -1))
(e0 (float-vector 0 0 8 0 0 0 0 0))
- (e1 (float-vector 0 0 0 0 0 0 0 0))
+ (e1 (make-float-vector 8))
(rl (make-float-vector 8))
(im (make-float-vector 8)))
(set! (rl 2) 1.0)
@@ -38128,47 +37797,40 @@ EDITS: 1
(if (not (and (morally-equal? d0 rl)
(morally-equal? d1 im)))
(format *stderr* ";fv126 mus-fft 2: ~A ~A~%" rl im))
- (let ((loc 2)
- (val 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 1))
- (mus-fft rl im 8 -1)
- (float-vector-set! rl loc val)
- (mus-fft rl im 8))
- (if (not (and (morally-equal? d0 rl)
- (morally-equal? d1 im)))
- (format *stderr* ";fv126 mus-fft 2: ~A ~A~%" rl im)))))
+ (do ((loc 2)
+ (val 1.0)
+ (i 0 (+ i 1)))
+ ((= i 1)
+ (if (not (and (morally-equal? d0 rl)
+ (morally-equal? d1 im)))
+ (format *stderr* ";fv126 mus-fft 2: ~A ~A~%" rl im)))
+ (mus-fft rl im 8 -1)
+ (float-vector-set! rl loc val)
+ (mus-fft rl im 8))))
(fv126)
(define (fv127)
- (let ((fv (make-float-vector 4))
- (j 2))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i ((if (or (> i j) (= i 3)) + -) i 10.0)))))
+ (do ((fv (make-float-vector 4))
+ (j 2)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i ((if (or (> i j) (= i 3)) + -) i 10.0))))
(test (fv127) (float-vector -10.0 -9.0 -8.0 13.0))
- (define (fv128)
- (let ((fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i ((if (or (= i 1) (= i 3)) + -) i 10.0)))))
- (test (fv128) (float-vector -10.0 11.0 -8.0 13.0))
-
(define (fv129)
- (let ((fv (make-float-vector 4))
- (j 2))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i ((if (and (= i j) (< i 3)) + -) i 10.0)))))
+ (do ((fv (make-float-vector 4))
+ (j 2)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i ((if (and (= i j) (< i 3)) + -) i 10.0))))
(test (fv129) (float-vector -10.0 -9.0 12.0 -7.0))
(define (fv130)
- (let ((fv (make-float-vector 4))
- (j #\a))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i ((if (char=? j #\a) + -) i 10.0)))))
+ (do ((fv (make-float-vector 4))
+ (j #\a)
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i ((if (char=? j #\a) + -) i 10.0))))
(test (fv130) (float-vector 10.0 11.0 12.0 13.0))
(define (char-permute op . args)
@@ -38260,7 +37922,7 @@ EDITS: 1
(x 0.0 (+ x 0.1))
(lst ()))
((= i 10)
- (set! fv2 (list->vector (reverse lst))))
+ (set! fv2 (reverse (list->vector lst))))
(set! lst (cons (mus-chebyshev-t-sum x coeffs) lst)))
(if (not (morally-equal? fv1 fv2))
(format *stderr* ";t-sum: ~A ~A~%" fv1 fv2))))
@@ -38279,67 +37941,42 @@ EDITS: 1
(x 0.0 (+ x 0.1))
(lst ()))
((= i 10)
- (set! fv2 (list->vector (reverse lst))))
+ (set! fv2 (reverse (list->vector lst))))
(set! lst (cons (mus-chebyshev-tu-sum x t-coeffs u-coeffs) lst)))
(if (not (morally-equal? fv1 fv2))
(format *stderr* ";tu-sum: ~A ~A~%" fv1 fv2))))
(fv132))
(define (fv132a)
- (let ((fv (make-float-vector 10)))
- (let ((o1 (make-oscil 1000))
- (o2 (make-oscil 1000))
- (s1 (make-sawtooth-wave 1000))
- (s2 (make-sawtooth-wave 1000))
- (s3 (make-sawtooth-wave 1000))
- (s4 (make-sawtooth-wave 1000))
- (t1 (make-triangle-wave 1000))
- (t2 (make-triangle-wave 1000))
- (p1 (make-polywave 1000 '(1 .4 2 .6)))
- (p2 (make-polywave 1000 '(1 .4 2 .6)))
- (p3 (make-polywave 1000 '(1 .4 2 .6)))
- (p4 (make-polywave 1000 '(1 .4 2 .6))))
- (do ((i 0 (+ i 1)))
- ((= i 10) fv)
- (set! (fv i)
- (if (even? i)
- (+ (oscil o1)
- (* (triangle-wave t1)
- (polywave (if (zero? (modulo i 2)) p1 p2)))
- (sawtooth-wave (if (odd? i) s1 s2)))
- (+ (oscil o2)
- (* (triangle-wave t2)
- (polywave (if (zero? (modulo i 2)) p3 p4)))
- (sawtooth-wave (if (odd? i) s3 s4)))))))))
+ (do ((fv (make-float-vector 10))
+ (o1 (make-oscil 1000))
+ (o2 (make-oscil 1000))
+ (s1 (make-sawtooth-wave 1000))
+ (s2 (make-sawtooth-wave 1000))
+ (s3 (make-sawtooth-wave 1000))
+ (s4 (make-sawtooth-wave 1000))
+ (t1 (make-triangle-wave 1000))
+ (t2 (make-triangle-wave 1000))
+ (p1 (make-polywave 1000 '(1 .4 2 .6)))
+ (p2 (make-polywave 1000 '(1 .4 2 .6)))
+ (p3 (make-polywave 1000 '(1 .4 2 .6)))
+ (p4 (make-polywave 1000 '(1 .4 2 .6)))
+ (i 0 (+ i 1)))
+ ((= i 10) fv)
+ (set! (fv i)
+ (if (even? i)
+ (+ (oscil o1)
+ (* (triangle-wave t1)
+ (polywave (if (zero? (modulo i 2)) p1 p2)))
+ (sawtooth-wave (if (odd? i) s1 s2)))
+ (+ (oscil o2)
+ (* (triangle-wave t2)
+ (polywave (if (zero? (modulo i 2)) p3 p4)))
+ (sawtooth-wave (if (odd? i) s3 s4)))))))
(test (fv132a) (float-vector 0.0 0.0 0.2754865742400099 0.2754865742400099 0.5330915108442034 0.5330915108442034
0.7567925994733748 0.7567925994733748 0.9340879688376413 0.9340879688376413))
- (define (fv133)
- (let ((fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- ((lambda ()
- (set! (fv i) i))))))
- (test (fv133) (float-vector 0.0 1.0 2.0 3.0))
-
- (define (fv134)
- (do ((fv (make-float-vector 4))
- (i 0 (+ i 1)))
- ((= i 4) fv)
- ((lambda ()
- (set! (fv i) i)))))
- (test (fv134) (float-vector 0.0 1.0 2.0 3.0))
-
- (define (fv135)
- (do ((fv (make-float-vector 4))
- (i 0 (+ i 1))
- (x 0.0 (+ x 1.0)))
- ((= i 4) (and (positive? x) fv))
- ((lambda ()
- (set! (fv i) i)))))
- (test (fv135) (float-vector 0.0 1.0 2.0 3.0))
-
(define (fv136)
(do ((fv (make-vector 4))
(i 0 (+ i 1))
@@ -38424,28 +38061,28 @@ EDITS: 1
(test (fv143) (hash-table* 0 '(0.0) 1 '(10.0) 2 '(20.0) 3 '(30.0)))
(define (fv144)
- (let ((g0 (make-iterator (list 0 1 2 3 4)))
- (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (iterate g0)))))
+ (do ((g0 (make-iterator '(0 1 2 3 4)))
+ (v (make-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (iterate g0))))
(test (fv144) (vector 0 1 2 3))
(define (fv145)
- (let ((g0 (list (make-iterator (list 0 1 2 3 4))))
- (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (iterate (car g0))))))
+ (do ((g0 (list (make-iterator '(0 1 2 3 4))))
+ (v (make-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (iterate (car g0)))))
(test (fv145) (vector 0 1 2 3))
(define (fv146)
- (let ((x 0))
- (do ((i 0 (+ i 1)))
- ((= i 4) x)
- (do ((k 0 (+ k 1)))
- ((= k 4))
- (set! x (+ x k))))))
+ (do ((x 0)
+ (i 0 (+ i 1)))
+ ((= i 4) x)
+ (do ((k 0 (+ k 1)))
+ ((= k 4))
+ (set! x (+ x k)))))
(test (fv146) 24)
(define (fv147a)
@@ -38475,141 +38112,112 @@ EDITS: 1
(test (fv147c) '(2.0 4.0 6.0))
(define (fv148)
- (let ((g0 (list 0 1 2 3 4))
- (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (g0 i)))))
+ (do ((g0 (list 0 1 2 3 4))
+ (v (make-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i))))
(test (fv148) (vector 0 1 2 3))
(define (fv149)
- (let ((g0 "012345")
- (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (g0 i)))))
+ (do ((g0 "012345")
+ (v (make-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i))))
(test (fv149) (vector #\0 #\1 #\2 #\3))
(define (fv150)
- (let ((g0 (int-vector 0 1 2 3 4))
- (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (g0 i)))))
+ (do ((g0 (int-vector 0 1 2 3 4))
+ (v (make-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i))))
(test (fv150) (vector 0 1 2 3))
(define (fv151)
- (let ((g0 (float-vector 0 1 2 3 4))
- (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (g0 i)))))
+ (do ((g0 (float-vector 0 1 2 3 4))
+ (v (make-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i))))
(test (fv151) (vector 0 1 2 3))
(define (fv152)
- (let ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
- (syms (vector 'a 'b 'c 'd))
- (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (g0 (syms i))))))
+ (do ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
+ (syms (vector 'a 'b 'c 'd))
+ (v (make-vector 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 (syms i)))))
(test (fv152) (vector 0 1 2 3))
(define (fv153)
- (let ((g0 (list 0 1 2 3 4))
- (v (make-list 4 #f)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (set! (v i) (g0 i)))))
+ (do ((g0 (list 0 1 2 3 4))
+ (v (make-list 4 #f))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i))))
(test (fv153) (list 0 1 2 3))
(define (fv154)
- (let ((g0 "012345")
- (v (make-string 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (set! (v i) (g0 i)))))
+ (do ((g0 "012345")
+ (v (make-string 4))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i))))
(test (fv154) "0123")
(define (fv155)
- (let ((g0 (int-vector 0 1 2 3 4))
- (v (make-int-vector 4 -1)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (set! (v i) (g0 i)))))
+ (do ((g0 (int-vector 0 1 2 3 4))
+ (v (make-int-vector 4 -1))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i))))
(test (fv155) (int-vector 0 1 2 3))
(define (fv156)
- (let ((g0 (float-vector 0 1 2 3 4))
- (v (make-float-vector 4 pi)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (set! (v i) (g0 i)))))
+ (do ((g0 (float-vector 0 1 2 3 4))
+ (v (make-float-vector 4 pi))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i))))
(test (fv156) (float-vector 0 1 2 3))
(define (fv157)
- (let ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
- (syms (vector 'a 'b 'c 'd))
- (v (inlet 'a -1 'b -1 'c -1 'd -1)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (set! (v (syms i)) (g0 (syms i))))))
+ (do ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
+ (syms (vector 'a 'b 'c 'd))
+ (v (inlet 'a -1 'b -1 'c -1 'd -1))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v (syms i)) (g0 (syms i)))))
(test (fv157) (inlet 'a 0 'b 1 'c 2 'd 3))
(define (fv158)
- (let ((g0 (hash-table* 'a 0 'b 1 'c 2 'd 3))
- (syms (vector 'a 'b 'c 'd))
- (v (hash-table* 'a -1 'b -1 'c -1 'd -1)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (set! (v (syms i)) (g0 (syms i))))))
+ (do ((g0 (hash-table* 'a 0 'b 1 'c 2 'd 3))
+ (syms (vector 'a 'b 'c 'd))
+ (v (hash-table* 'a -1 'b -1 'c -1 'd -1))
+ (i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v (syms i)) (g0 (syms i)))))
(test (fv158) (hash-table* 'a 0 'b 1 'c 2 'd 3))
- (define (fv159)
- (let ((o (make-oscil 1000))
- (oscs (vector (make-oscil 400) (make-oscil 500) (make-oscil 600)))
- (v1 (make-float-vector 10))
- (v2 (make-float-vector 10))
- (v3 (float-vector 0.1419943179576268 1.008255926858552 -0.3982998307862416 -0.4953385977530639
- 1.122094083214508 0.6986797544826313 -0.5752063448650614 0.5489621715396582
- 1.499234145268148 0.1194943083560847))
- (k 1))
- (do ((i 0 (+ i 1))) ((= i 10))
- (let ((x (oscil o)))
- (set! (v1 i) (+ (oscil (vector-ref oscs k)) (oscil o 1.5)))))
- (set! o (make-oscil 1000))
- (set! oscs (vector (make-oscil 400) (make-oscil 500) (make-oscil 600)))
- (set! (v2 0) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 1) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 2) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 3) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 4) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 5) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 6) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 7) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 8) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (set! (v2 9) (begin (oscil o) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))
- (if (not (and (morally-equal? v1 v2)
- (morally-equal? v1 v3)))
- (format *stderr* "~A~%~A~%~A~%" v1 v2 v3))))
- (fv159)
-
(define (fv160)
- (let ((fv (make-float-vector 4))
- (g (make-oscil 1000)))
- (do ((i 0 (+ i 1))
- (x 0.1 0.0))
- ((= i 4) fv)
- (float-vector-set! fv i (oscil g x)))))
+ (do ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (i 0 (+ i 1))
+ (x 0.1 0.0))
+ ((= i 4) fv)
+ (float-vector-set! fv i (oscil g x))))
(test (fv160) (let ((g (make-oscil 1000))) (float-vector (oscil g 0.1) (oscil g) (oscil g) (oscil g))))
(define (fv162)
- (let ((fv (make-int-vector 4))
- (iter (make-iterator '(1 2 3 4))))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (int-vector-set! fv i (iterate iter)))))
+ (do ((fv (make-int-vector 4))
+ (iter (make-iterator '(1 2 3 4)))
+ (i 0 (+ i 1)))
+ ((= i 4) fv)
+ (int-vector-set! fv i (iterate iter))))
(test (fv162) (int-vector 1 2 3 4))
(define (fv163)
@@ -38618,303 +38226,204 @@ EDITS: 1
(x 0.0 (+ x 0.25)))
((= i 4) fv)
(set! (fv i) (sin x))))
- (test (fv163) (float-vector (sin 0.0) (sin 0.25) (sin 0.5) (sin 0.75)))
+ (test (fv163) (float-vector 0.0 (sin 0.25) (sin 0.5) (sin 0.75)))
- (define (fv164) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0)))))
- (test (fv164) (make-float-vector 4 6.0))
-
- (define (fv165) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 4.5 3/2)))))
+ (define (fv165) (do ((fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 4.5 3/2))))
(test (fv165) (make-float-vector 4 6.0))
- (define (fv166) (let ((x 1/2) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 x)))))
+ (define (fv166) (do ((x 1/2) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 x))))
(test (fv166) (make-float-vector 4 1.5))
- (define (fv167) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) 6.0))))
+ (define (fv167) (do ((fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) 6.0)))
(test (fv167) (make-float-vector 4 6.0))
- (define (fv168) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 5.0)))))
+ (define (fv168) (do ((x 1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 5.0))))
(test (fv168) (make-float-vector 4 6.0))
- (define (fv169) (let ((x 1.0) (y 5.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y)))))
+ (define (fv169) (do ((x 1.0) (y 5.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y))))
(test (fv169) (make-float-vector 4 6.0))
- (define (fv170) (let ((x 1.0) (y 6.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y -1.0)))))
+ (define (fv170) (do ((x 1.0) (y 6.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y -1.0))))
(test (fv170) (make-float-vector 4 6.0))
- (define (fv171) (let ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y z)))))
+ (define (fv171) (do ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y z))))
(test (fv171) (make-float-vector 4 6.0))
- (define (fv172) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x -1.0 6.0)))))
- (test (fv172) (make-float-vector 4 6.0))
-
- (define (fv173) (let ((x 3.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x (abs x))))))
+ (define (fv173) (do ((x 3.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x (abs x)))))
(test (fv173) (make-float-vector 4 6.0))
- (define (fv174) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 2 (abs x))))))
+ (define (fv174) (do ((x 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 2 (abs x)))))
(test (fv174) (make-float-vector 4 6.0))
- (define (fv175) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2.0 2 (abs x))))))
+ (define (fv175) (do ((x 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2.0 2 (abs x)))))
(test (fv175) (make-float-vector 4 6.0))
- (define (fv176) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2.0 (abs x) (abs x))))))
- (test (fv176) (make-float-vector 4 6.0))
-
- (define (fv177) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) (abs x) (abs x))))))
- (test (fv177) (make-float-vector 4 6.0))
-
- (define (fv178) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x (abs x))))))
+ (define (fv178) (do ((x 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x (abs x)))))
(test (fv178) (make-float-vector 4 6.0))
- (define (fv178c) (let ((x 2.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x y)))))
+ (define (fv178c) (do ((x 2.0) (y 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x y))))
(test (fv178c) (make-float-vector 4 6.0))
- (define (fv179) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 1.0 2.0 3.0)))))
+ (define (fv179) (do ((fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 1.0 2.0 3.0))))
(test (fv179) (make-float-vector 4 6.0))
- (define (fv180) (let ((x 1.0) (y 6.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y -1.0)))))
+ (define (fv180) (do ((x 1.0) (y 6.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y -1.0))))
(test (fv180) (make-float-vector 4 -6.0))
- (define (fv181) (let ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y z)))))
+ (define (fv181) (do ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y z))))
(test (fv181) (make-float-vector 4 -6.0))
- (define (fv182) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x -1.0 6.0)))))
+ (define (fv182) (do ((x 1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x -1.0 6.0))))
(test (fv182) (make-float-vector 4 -6.0))
- (define (fv183) (let ((x 3.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x (abs x))))))
+ (define (fv183) (do ((x 3.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x (abs x)))))
(test (fv183) (make-float-vector 4 9.0))
- (define (fv184) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 2 (abs x))))))
+ (define (fv184) (do ((x 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 2 (abs x)))))
(test (fv184) (make-float-vector 4 8.0))
- (define (fv185) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2.0 2 (abs x))))))
+ (define (fv185) (do ((x 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2.0 2 (abs x)))))
(test (fv185) (make-float-vector 4 8.0))
- (define (fv186) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2.0 (abs x) (abs x))))))
- (test (fv186) (make-float-vector 4 8.0))
-
- (define (fv187) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) (abs x) (abs x))))))
- (test (fv187) (make-float-vector 4 8.0))
-
- (define (fv188) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x (abs x))))))
+ (define (fv188) (do ((x 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x (abs x)))))
(test (fv188) (make-float-vector 4 8.0))
- (define (fv188c) (let ((x 2.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x y)))))
+ (define (fv188c) (do ((x 2.0) (y 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x y))))
(test (fv188c) (make-float-vector 4 8.0))
- (define (fv189) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 4.5 3/2)))))
+ (define (fv189) (do ((fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 4.5 3/2))))
(test (fv189) (make-float-vector 4 6.75))
- (define (fv190) (let ((x 1/2) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) x))))
+ (define (fv190) (do ((x 1/2) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) x)))
(test (fv190) (make-float-vector 4 0.5))
- (define (fv192) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 5.0)))))
+ (define (fv192) (do ((x 1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 5.0))))
(test (fv192) (make-float-vector 4 5.0))
- (define (fv193) (let ((x 1.0) (y 5.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y)))))
+ (define (fv193) (do ((x 1.0) (y 5.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y))))
(test (fv193) (make-float-vector 4 5.0))
- (define (fvi164) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 2 3)))))
- (test (fvi164) (make-int-vector 4 6))
-
- (define (fvi165) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 4.5 3/2)))))
+ (define (fvi165) (do ((fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 4.5 3/2))))
(test (catch #t fvi165 (lambda args 'error)) 'error)
- (define (fvi166) (let ((x 1/2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 x)))))
+ (define (fvi166) (do ((x 1/2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 x))))
(test (catch #t fvi166 (lambda args 'error))'error)
- (define (fvi167) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) 6))))
+ (define (fvi167) (do ((fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) 6)))
(test (fvi167) (make-int-vector 4 6))
- (define (fvi168) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 5)))))
+ (define (fvi168) (do ((x 1) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 5))))
(test (fvi168) (make-int-vector 4 6))
- (define (fvi169) (let ((x 1) (y 5) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y)))))
+ (define (fvi169) (do ((x 1) (y 5) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y))))
(test (fvi169) (make-int-vector 4 6))
- (define (fvi170) (let ((x 1) (y 6) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y -1)))))
+ (define (fvi170) (do ((x 1) (y 6) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y -1))))
(test (fvi170) (make-int-vector 4 6))
- (define (fvi171) (let ((x 1) (y 6) (z -1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y z)))))
+ (define (fvi171) (do ((x 1) (y 6) (z -1) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y z))))
(test (fvi171) (make-int-vector 4 6))
- (define (fvi172) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x -1 6)))))
- (test (fvi172) (make-int-vector 4 6))
-
- (define (fvi173) (let ((x 3) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x (abs x))))))
+ (define (fvi173) (do ((x 3) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x (abs x)))))
(test (fvi173) (make-int-vector 4 6))
- (define (fvi174) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 2 (abs x))))))
+ (define (fvi174) (do ((x 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 2 (abs x)))))
(test (fvi174) (make-int-vector 4 6))
- (define (fvi175) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2 2 (abs x))))))
- (test (fvi175) (make-int-vector 4 6))
-
- (define (fvi176) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2 (abs x) (abs x))))))
- (test (fvi176) (make-int-vector 4 6))
-
- (define (fvi177) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) (abs x) (abs x))))))
- (test (fvi177) (make-int-vector 4 6))
-
- (define (fvi178) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x (abs x))))))
+ (define (fvi178) (do ((x 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x (abs x)))))
(test (fvi178) (make-int-vector 4 6))
- (define (fvk178) (let ((x 2) (y 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x y)))))
+ (define (fvk178) (do ((x 2) (y 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x y))))
(test (fvk178) (make-int-vector 4 6))
-
- (define (fvi179) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 1 2 3)))))
- (test (fvi179) (make-int-vector 4 6))
-
- (define (fvi180) (let ((x 1) (y 6) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y -1)))))
- (test (fvi180) (make-int-vector 4 -6))
-
- (define (fvi181) (let ((x 1) (y 6) (z -1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y z)))))
+ (define (fvi181) (do ((x 1) (y 6) (z -1) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y z))))
(test (fvi181) (make-int-vector 4 -6))
- (define (fvi182) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x -1 6)))))
- (test (fvi182) (make-int-vector 4 -6))
+ (define (fvi183) (do ((x 3) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x (abs x)))))
+ (test (fvi183) (make-int-vector 4 9))
- (define (fvi183) (let ((x 3) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x (abs x))))))
- (test (fvi183) (int-vector 9 9 9 9))
-
- (define (fvi184) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 2 (abs x))))))
+ (define (fvi184) (do ((x 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 2 (abs x)))))
(test (fvi184) (make-int-vector 4 8))
- (define (fvi185) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2 2 (abs x))))))
- (test (fvi185) (make-int-vector 4 8))
-
- (define (fvi186) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2 (abs x) (abs x))))))
- (test (fvi186) (make-int-vector 4 8))
-
- (define (fvi187) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) (abs x) (abs x))))))
- (test (fvi187) (make-int-vector 4 8))
-
- (define (fvi188) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x (abs x))))))
+ (define (fvi188) (do ((x 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x (abs x)))))
(test (fvi188) (make-int-vector 4 8))
- (define (fvk188) (let ((x 2) (y 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x y)))))
+ (define (fvk188) (do ((x 2) (y 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x y))))
(test (fvk188) (make-int-vector 4 8))
- (define (fvi191) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 6)))))
- (test (fvi191) (make-int-vector 4 6))
-
- (define (fvi192) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 5)))))
+ (define (fvi192) (do ((x 1) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 5))))
(test (fvi192) (make-int-vector 4 5))
- (define (fvi193) (let ((x 1) (y 5) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y)))))
+ (define (fvi193) (do ((x 1) (y 5) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y))))
(test (fvi193) (make-int-vector 4 5))
-
- (define (fv194) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0 4.0)))))
- (test (fv194) (make-float-vector 4 10.0))
-
- (define (fv195) (let ((x 1.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y (+ x 2.0) 4.0)))))
- (test (fv195) (make-float-vector 4 10.0))
-
- (define (fv196) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0 4.0 5.0)))))
- (test (fv196) (make-float-vector 4 15.0))
-
- (define (fv197) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0 4.0 5.0 6.0)))))
- (test (fv197) (make-float-vector 4 21.0))
-
- (define (fv198) (let ((fv (make-float-vector 4))
- (a 1.0) (b 2.0) (c 4.0))
- (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ a b 3.0 c a c b c a b c a b c a b c a b c a b c)))))
+ (define (fv198) (do ((fv (make-float-vector 4))
+ (a 1.0) (b 2.0) (c 4.0)
+ (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ a b 3.0 c a c b c a b c a b c a b c a b c a b c))))
(test (fv198) (make-float-vector 4 56.0))
-
- (define (fv164b) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1.0 2.0 3.0)))))
+ (define (fv164b) (do ((fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1.0 2.0 3.0))))
(test (fv164b) (make-float-vector 4 -4.0))
- (define (fv165b) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 4.5 3/2)))))
+ (define (fv165b) (do ((fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 4.5 3/2))))
(test (fv165b) (make-float-vector 4 3.0))
- (define (fv166b) (let ((x 1/2) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 x)))))
+ (define (fv166b) (do ((x 1/2) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 x))))
(test (fv166b) (make-float-vector 4 .5))
- (define (fv167b) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 6.0)))))
- (test (fv167b) (make-float-vector 4 -6.0))
-
- (define (fv168b) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 5.0)))))
+ (define (fv168b) (do ((x 1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 5.0))))
(test (fv168b) (make-float-vector 4 -4.0))
- (define (fv169b) (let ((x 1.0) (y 5.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y)))))
+ (define (fv169b) (do ((x 1.0) (y 5.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y))))
(test (fv169b) (make-float-vector 4 -4.0))
- (define (fv170b) (let ((x 1.0) (y 6.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y -1.0)))))
+ (define (fv170b) (do ((x 1.0) (y 6.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y -1.0))))
(test (fv170b) (make-float-vector 4 -4.0))
- (define (fv171b) (let ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y z)))))
+ (define (fv171b) (do ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y z))))
(test (fv171b) (make-float-vector 4 -4.0))
- (define (fv172b) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x -1.0 6.0)))))
+ (define (fv172b) (do ((x 1.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x -1.0 6.0))))
(test (fv172b) (make-float-vector 4 -4.0))
- (define (fv173b) (let ((x 3.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x (abs x))))))
+ (define (fv173b) (do ((x 3.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x (abs x)))))
(test (fv173b) (make-float-vector 4))
- (define (fv174b) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 2 (abs x))))))
+ (define (fv174b) (do ((x 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 2 (abs x)))))
(test (fv174b) (make-float-vector 4 -2.0))
- (define (fv175b) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2.0 2 (abs x))))))
- (test (fv175b) (make-float-vector 4 -2.0))
-
- (define (fv176b) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2.0 (abs x) (abs x))))))
- (test (fv176b) (make-float-vector 4 -2.0))
-
- (define (fv177b) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) (abs x) (abs x))))))
- (test (fv177b) (make-float-vector 4 -2.0))
-
- (define (fv178b) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x (abs x))))))
- (test (fv178b) (make-float-vector 4 -2.0))
-
- (define (fv178bb) (let ((x 2.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x y)))))
+ (define (fv178bb) (do ((x 2.0) (y 2.0) (fv (make-float-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x y))))
(test (fv178bb) (make-float-vector 4 -2.0))
- (define (fvi164a) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 2 3)))))
- (test (fvi164a) (make-int-vector 4 -4))
-
- (define (fvi165a) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 4.5 3/2)))))
+ (define (fvi165a) (do ((fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 4.5 3/2))))
(test (catch #t fvi165a (lambda args 'error)) 'error)
- (define (fvi166a) (let ((x 1/2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 x)))))
+ (define (fvi166a) (do ((x 1/2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 x))))
(test (catch #t fvi166a (lambda args 'error))'error)
- (define (fvi167a) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) -6))))
+ (define (fvi167a) (do ((fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) -6)))
(test (fvi167a) (make-int-vector 4 -6))
- (define (fvi168a) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 5)))))
+ (define (fvi168a) (do ((x 1) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 5))))
(test (fvi168a) (make-int-vector 4 -4))
- (define (fvi169a) (let ((x 1) (y 5) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y)))))
+ (define (fvi169a) (do ((x 1) (y 5) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y))))
(test (fvi169a) (make-int-vector 4 -4))
- (define (fvi170a) (let ((x 1) (y 6) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y -1)))))
+ (define (fvi170a) (do ((x 1) (y 6) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y -1))))
(test (fvi170a) (make-int-vector 4 -4))
- (define (fvi171a) (let ((x 1) (y 6) (z -1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y z)))))
+ (define (fvi171a) (do ((x 1) (y 6) (z -1) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y z))))
(test (fvi171a) (make-int-vector 4 -4))
- (define (fvi173a) (let ((x 3) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x (abs x))))))
- (test (fvi173a) (int-vector 0 0 0 0))
+ (define (fvi173a) (do ((x 3) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x (abs x)))))
+ (test (fvi173a) (make-int-vector 4))
- (define (fvi174a) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 2 (abs x))))))
+ (define (fvi174a) (do ((x 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 2 (abs x)))))
(test (fvi174a) (make-int-vector 4 -2))
- (define (fvi175a) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2 2 (abs x))))))
- (test (fvi175a) (make-int-vector 4 -2))
-
- (define (fvi176a) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2 (abs x) (abs x))))))
- (test (fvi176a) (make-int-vector 4 -2))
-
- (define (fvi177a) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) (abs x) (abs x))))))
- (test (fvi177a) (make-int-vector 4 -2))
-
- (define (fvi178a) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x (abs x))))))
- (test (fvi178a) (make-int-vector 4 -2))
-
- (define (fvi178aa) (let ((x 2) (y 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x y)))))
+ (define (fvi178aa) (do ((x 2) (y 2) (fv (make-int-vector 4)) (i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x y))))
(test (fvi178aa) (make-int-vector 4 -2))
)
@@ -39393,10 +38902,10 @@ EDITS: 1
(outa i (* amp (oscil osc (+ (env e) (green-noise-interp grn 0.0))))))))
(define (ws-sine freq)
- (let ((o (make-oscil freq)))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (outa i (oscil o)))))
+ (do ((o (make-oscil freq))
+ (i 0 (+ i 1)))
+ ((= i 100))
+ (outa i (oscil o))))
(define (step-src)
(let ((tempfile (with-sound ((snd-tempnam) :srate (srate) :to-snd #f :comment "step-src")
@@ -39460,11 +38969,11 @@ EDITS: 1
(let ((dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (let ((osc (make-oscil :frequency freq))
- (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
- (do ((i beg (+ i 1)))
- ((= i end))
- (dlocsig dloc i (* (env aenv) (oscil osc))))))))
+ (do ((osc (make-oscil :frequency freq))
+ (aenv (make-env :envelope amp-env :scaler amp :duration duration))
+ (i beg (+ i 1)))
+ ((= i end))
+ (dlocsig dloc i (* (env aenv) (oscil osc)))))))
(definstrument (dlocsig-sinewave-1 start-time duration freq amp
(amp-env '(0 1 1 1))
@@ -39479,11 +38988,11 @@ EDITS: 1
(let ((dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (let ((osc (make-oscil :frequency freq))
- (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
- (do ((i beg (+ i 1)))
- ((= i end))
- (dlocsig dloc i (* (env aenv) (oscil osc))))))))
+ (do ((osc (make-oscil :frequency freq))
+ (aenv (make-env :envelope amp-env :scaler amp :duration duration))
+ (i beg (+ i 1)))
+ ((= i end))
+ (dlocsig dloc i (* (env aenv) (oscil osc)))))))
(define (mix-move-sound start-time file path)
(let* ((rd (make-sampler 0 file))
@@ -39501,10 +39010,10 @@ EDITS: 1
(mix tmp-sound start #t #f #f *with-mix-tags* #t)))
(definstrument (defopt-simp beg dur (frequency 440.0) (amplitude 0.1))
- (let ((os (make-oscil frequency))
- (end (+ beg dur)))
- (do ((i beg (+ i 1))) ((= i end))
- (outa i (* amplitude (oscil os))))))
+ (do ((os (make-oscil frequency))
+ (end (+ beg dur))
+ (i beg (+ i 1))) ((= i end))
+ (outa i (* amplitude (oscil os)))))
(definstrument (jcrev2)
(let ((allpass11 (make-all-pass -0.700 0.700 1051))
@@ -39740,12 +39249,11 @@ EDITS: 1
(for-each close-sound (sounds))
- (if (file-exists? "ii.scm")
- (begin
- (time (load "ii.scm"))
- (for-each close-sound (sounds))
- (delete-file "test.snd")
- (delete-file "test.rev")))
+ (when (file-exists? "ii.scm")
+ (time (load "ii.scm"))
+ (for-each close-sound (sounds))
+ (delete-file "test.snd")
+ (delete-file "test.rev"))
(let ((var (make-st1 :one 1 :two 2)))
(if (not (= (var 'one) 1)) (snd-display ";st1-one: ~A" (var 'one)))
@@ -40168,26 +39676,26 @@ EDITS: 1
(with-sound (:srate 44100 :play #f) (bigbird 0 2 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
(let ((ind (or (find-sound "test.snd") (open-sound "oboe.snd"))))
(let ((mx (maxamp)))
- (notch-sound (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)))
+ (notch-sound (do ((freqs ()) (i 60 (+ i 60))) ((= i 3000) (reverse freqs)) (set! freqs (cons i freqs))))
(if (or (fneq mx .5)
(ffneq (maxamp) .027))
(snd-display ";notch 60 Hz: ~A to ~A" mx (maxamp))))
(undo)
- (notch-sound (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
+ (notch-sound (do ((freqs ()) (i 60 (+ i 60))) ((= i 3000) (reverse freqs)) (set! freqs (cons i freqs))) #f ind 0 10)
(if (ffneq (maxamp) .011)
(snd-display ";notch-sound 60 hz 2: ~A" (maxamp)))
(undo)
- (notch-channel (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f #f #f ind 0 #f #f 10)
+ (notch-channel (do ((freqs ()) (i 60 (+ i 60))) ((= i 3000) (reverse freqs)) (set! freqs (cons i freqs))) #f #f #f ind 0 #f #f 10)
(if (ffneq (maxamp) .004)
(snd-display ";notch-channel 60 hz 2: ~A" (maxamp)))
(undo)
(make-selection 10000 11000)
- (notch-selection (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f 10)
+ (notch-selection (do ((freqs ()) (i 60 (+ i 60))) ((= i 3000) (reverse freqs)) (set! freqs (cons i freqs))) #f 10)
(close-sound ind))
(with-sound (:srate 44100 :play #f) (bigbird 0 30 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
(let ((ind (find-sound "test.snd")))
- (notch-sound (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
+ (notch-sound (do ((freqs ()) (i 60 (+ i 60))) ((= i 3000) (reverse freqs)) (set! freqs (cons i freqs))) #f ind 0 10)
(if (ffneq (maxamp) .011)
(snd-display ";notch-sound 60 hz 2 60: ~A" (maxamp)))
(close-sound ind))
@@ -40316,9 +39824,10 @@ EDITS: 1
(variable-display (variable-display (* (variable-display (sin (* (variable-display i wid1) .1)) wid3) .5) wid2) wid4)))
(let ((tag (catch #t (lambda () (set! (sample 0 (car wid3) 0) .5)) (lambda args (car args)))))
(if (> (edit-position (car wid3) 0) 0) (snd-display ";edited variable graph? ~A ~A" tag (edit-position (car wid3) 0))))
- (if (provided? 'snd-motif)
- ((*motif* 'XtUnmanageChild) variables-dialog)
- ((*gtk* 'gtk_widget_hide) variables-dialog))
+ ((if (provided? 'snd-motif)
+ (*motif* 'XtUnmanageChild)
+ (*gtk* 'gtk_widget_hide))
+ variables-dialog)
(close-sound (car wid3))
(close-sound (car wid4))))
@@ -40591,18 +40100,18 @@ EDITS: 1
(let ((rg (make-rmsgain))
(rg1 (make-rmsgain 40))
(rg2 (make-rmsgain 2))
- (e (make-env '(0 0 1 1 2 0) :length 10000))
- (e1 (make-env '(0 0 1 1) :length 10000))
- (e2 (make-env '(0 0 1 1 2 0 10 0) :length 10000))
+ (e (make-env '(0 0 1 1 2 0) :length base-length))
+ (e1 (make-env '(0 0 1 1) :length base-length))
+ (e2 (make-env '(0 0 1 1 2 0 10 0) :length base-length))
(o (make-oscil 440.0)))
(do ((i 0 (+ i 1)))
- ((= i 10000))
+ ((= i base-length))
(let ((sig (env e)))
(outa i (balance rg sig (env e2)))
(outb i (balance rg1 sig (env e1)))
(outc i (balance rg2 (* .1 (oscil o)) (env e2)))))
- (if (fneq (gain-avg rg) 0.98402) (snd-display ";rmsgain gain-avg: ~A" (gain-avg rg)))
- (if (not (= (rg2 'avgc) 10000)) (snd-display ";rmsgain count: ~A" (rg2 'avgc))))))))
+ (if (fneq (gain-avg rg) 1.4227) (snd-display ";rmsgain gain-avg: ~A" (gain-avg rg)))
+ (if (not (= (rg2 'avgc) base-length)) (snd-display ";rmsgain count: ~A" (rg2 'avgc))))))))
(if (sound? ind)
(close-sound ind)
(snd-display ";with-sound balance?")))
@@ -40682,9 +40191,9 @@ EDITS: 1
(frample->file *reverb* 0 (float-vector .2 .1 .05 .025 .0125)))
(define (frample n)
(let* ((ind (selected-sound))
- (c (channels ind))
- (v (make-float-vector c)))
- (do ((i 0 (+ i 1)))
+ (c (channels ind)))
+ (do ((v (make-float-vector c))
+ (i 0 (+ i 1)))
((= i c) v)
(set! (v i) (sample n ind i)))))
(if (not (vmus-arrays-equal? (frample 2438) (make-float-vector 5)))
@@ -40895,9 +40404,9 @@ EDITS: 1
(if (mus-arrays-equal? v1 v4) (snd-display ";reverb output not written to float-vector?")))
(if (< (float-vector-peak v1) .28)
(snd-display ";rev with-sound -> float-vector fm-violin maxamp (opt): ~A" (float-vector-peak v1)))
- (let ((v2 (with-sound ((make-float-vector 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (float-vector-peak v2) .28)
- (snd-display ";rev with-sound -> float-vector fm-violin maxamp: ~A" (float-vector-peak v2))))
+ (let ((v2 (float-vector-peak (with-sound ((make-float-vector 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9)))))
+ (if (< v2 .28)
+ (snd-display ";rev with-sound -> float-vector fm-violin maxamp: ~A" v2)))
(with-sound (v1 :channels 1 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))
@@ -40912,9 +40421,9 @@ EDITS: 1
(if (mus-arrays-equal? v1 v4) (snd-display ";reverb output not written to sd?")))
(if (< (maxamp v1) .23)
(snd-display ";rev with-sound -> vector2 fm-violin maxamp (opt): ~A" (maxamp v1)))
- (let ((v2 (with-sound ((make-float-vector '(1 44100)) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (maxamp v2) .23)
- (snd-display ";rev with-sound -> vector2 fm-violin maxamp: ~A" (maxamp v2))))
+ (let ((v2 (maxamp (with-sound ((make-float-vector '(1 44100)) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9)))))
+ (if (< v2 .23)
+ (snd-display ";rev with-sound -> vector2 fm-violin maxamp: ~A" v2)))
(with-sound (v1 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))
@@ -40930,11 +40439,11 @@ EDITS: 1
(snd-display ";rev with-sound -> vector2 fm-violin maxamp (1 opt): ~A" (maxamp v1))
(snd-display ";rev with-sound -> vector2 fm-violin maxamp (2 opt): ~A" (maxamp v1)))
- (let ((v2 (with-sound ((make-float-vector '(2 44100)) :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (when (< (maxamp v2) .23)
- (snd-display ";rev with-sound -> vector2 fm-violin maxamp (2): ~A" (maxamp v2))
- (snd-display ";rev with-sound -> vector2 fm-violin maxamp (2 2): ~A" (maxamp v2))))
+ (let ((v2 (maxamp (with-sound ((make-float-vector '(2 44100)) :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9)))))
+ (when (< v2 .23)
+ (snd-display ";rev with-sound -> vector2 fm-violin maxamp (2): ~A" v2)
+ (snd-display ";rev with-sound -> vector2 fm-violin maxamp (2 2): ~A" v2)))
(with-sound (v1 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
@@ -41017,22 +40526,22 @@ EDITS: 1
(for-each
(lambda (n)
- (let ((v2 (with-sound ((make-float-vector 400))
- (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0))))
- (if (fneq (float-vector-peak v2) 0.1) (snd-display ";outa tests 2 ~A: ~A" n (float-vector-peak v2))))
- (let ((v3 (with-sound ((make-float-vector 400))
- (simple-outn 0 .01 440 0.0 .5 0.0 0.0 0.0 0.0))))
- (if (fneq (float-vector-peak v3) 0.0) (snd-display ";outa tests 3 ~A: ~A" n (float-vector-peak v3))))
- (let ((v4 (with-sound ((make-float-vector 4410) :reverb jc-reverb)
- (simple-outn 0 .01 440 0.2 0.0 0.0 0.0 0.05 0.0))))
- (if (fneq (float-vector-peak v4) 0.2) (snd-display ";outa tests 4 ~A: ~A" n (float-vector-peak v4))))
- (let ((v5 (with-sound ((make-float-vector 4410) :reverb simple-in-rev :reverb-data '(0.0 1.0 1.0 0.0))
- (simple-outn 0 .01 440 0.0 0.0 0.0 0.0 0.5 0.0))))
- (if (fneq (float-vector-peak v5) 0.5) (snd-display ";outa tests 5 ~A: ~A" n (float-vector-peak v5))))
- (let ((v6 (with-sound ((make-float-vector 400))
- (simple-outn 0 .01 440 0.5 0.0 0.0 0.0 0.0 0.0)
- (simple-outn 0 .01 440 0.2 0.0 0.0 0.0 0.0 0.0))))
- (if (fneq (float-vector-peak v6) 0.7) (snd-display ";outa tests 11 ~A: ~A" n (float-vector-peak v6))))
+ (let ((v2 (float-vector-peak (with-sound ((make-float-vector 400))
+ (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0)))))
+ (if (fneq v2 0.1) (snd-display ";outa tests 2 ~A: ~A" n v2)))
+ (let ((v3 (float-vector-peak (with-sound ((make-float-vector 400))
+ (simple-outn 0 .01 440 0.0 .5 0.0 0.0 0.0 0.0)))))
+ (if (fneq v3 0.0) (snd-display ";outa tests 3 ~A: ~A" n v3)))
+ (let ((v4 (float-vector-peak (with-sound ((make-float-vector 4410) :reverb jc-reverb)
+ (simple-outn 0 .01 440 0.2 0.0 0.0 0.0 0.05 0.0)))))
+ (if (fneq v4 0.2) (snd-display ";outa tests 4 ~A: ~A" n v4)))
+ (let ((v5 (float-vector-peak (with-sound ((make-float-vector 4410) :reverb simple-in-rev :reverb-data '(0.0 1.0 1.0 0.0))
+ (simple-outn 0 .01 440 0.0 0.0 0.0 0.0 0.5 0.0)))))
+ (if (fneq v5 0.5) (snd-display ";outa tests 5 ~A: ~A" n v5)))
+ (let ((v6 (float-vector-peak (with-sound ((make-float-vector 400))
+ (simple-outn 0 .01 440 0.5 0.0 0.0 0.0 0.0 0.0)
+ (simple-outn 0 .01 440 0.2 0.0 0.0 0.0 0.0 0.0)))))
+ (if (fneq v6 0.7) (snd-display ";outa tests 11 ~A: ~A" n v6)))
(let ((mx1 (maxamp
(with-sound ((make-float-vector '(1 4410)))
(simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0)))))
@@ -41179,114 +40688,114 @@ EDITS: 1
;; generators.scm
-
+
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-ercos 100 :r 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (ercos gen))))))))
+ (do ((gen (make-ercos 100 :r 1.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (ercos gen)))))))
(if (not (sound? snd)) (snd-display ";ercos: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";ercos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
(let ((gen (make-ercos 100 :r 0.1)))
(with-let gen
- (let ((g (curlet))
- (t-env (make-env '(0 .1 1 2) :length 20000))
- (poly-coeffs (mus-data osc)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (set! r (env t-env))
- (set! cosh-t (cosh r))
- (float-vector-set! poly-coeffs 0 cosh-t)
- (let ((exp-t (exp (- r))))
- (set! offset (/ (- 1.0 exp-t) (* 2.0 exp-t)))
- (set! scaler (* (sinh r) offset)))
- (outa i (ercos g))))))))))
+ (do ((g (curlet))
+ (t-env (make-env '(0 .1 1 2) :length 20000))
+ (poly-coeffs (mus-data osc))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (set! r (env t-env))
+ (set! cosh-t (cosh r))
+ (float-vector-set! poly-coeffs 0 cosh-t)
+ (let ((exp-t (exp (- r))))
+ (set! offset (/ (- 1.0 exp-t) (* 2.0 exp-t)))
+ (set! scaler (* (sinh r) offset)))
+ (outa i (ercos g)))))))))
(if (not (sound? snd)) (snd-display ";ercos 1: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";ercos 1 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-erssb 1000.0 0.1 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (erssb gen))))))))
+ (do ((gen (make-erssb 1000.0 0.1 1.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (erssb gen)))))))
(if (not (sound? snd)) (snd-display ";erssb: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";erssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-noddsin 100 :n 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (noddsin gen))))))))
+ (do ((gen (make-noddsin 100 :n 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (noddsin gen)))))))
(if (not (sound? snd)) (snd-display ";noddsin: ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";noddsin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-noddcos 100 :n 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (noddcos gen))))))))
+ (do ((gen (make-noddcos 100 :n 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (noddcos gen)))))))
(if (not (sound? snd)) (snd-display ";noddcos: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";noddcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-noddssb 1000.0 0.1 5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (noddssb gen))))))))
+ (do ((gen (make-noddssb 1000.0 0.1 5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (noddssb gen)))))))
(if (not (sound? snd)) (snd-display ";noddssb: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";noddssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-asyfm 2000.0 :ratio .1)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (asyfm-J gen))))))))
+ (do ((gen (make-asyfm 2000.0 :ratio .1))
+ (i 0 (+ i 1)))
+ ((= i 1000))
+ (outa i (asyfm-J gen)))))))
(if (not (sound? snd)) (snd-display ";asyfm-J ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";asyfm-J max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-asyfm 2000.0 :ratio .1 :index 1))
- (r-env (make-env '(0 -4 1 -1) :length 20000)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (set! (gen 'r) (env r-env))
- (outa i (asyfm-J gen))))))))
+ (do ((gen (make-asyfm 2000.0 :ratio .1 :index 1))
+ (r-env (make-env '(0 -4 1 -1) :length 20000))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (set! (gen 'r) (env r-env))
+ (outa i (asyfm-J gen)))))))
(if (not (sound? snd)) (snd-display ";asyfm-J1 ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";asyfm-J1 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-asyfm 2000.0 :ratio .1)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (asyfm-I gen))))))))
+ (do ((gen (make-asyfm 2000.0 :ratio .1))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (asyfm-I gen)))))))
(if (not (sound? snd)) (snd-display ";asyfm-I ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";asyfm-I max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-nrcos 400.0 :n 5 :r 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nrcos gen))))))))
+ (do ((gen (make-nrcos 400.0 :n 5 :r 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nrcos gen)))))))
(if (not (sound? snd)) (snd-display ";nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nrcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((samps 44100)
- (gen (make-noid 100.0 3 'min-peak)))
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (noid gen))))))))
+ (do ((samps base-length)
+ (gen (make-noid 100.0 3 'min-peak))
+ (i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (noid gen)))))))
(if (not (sound? snd)) (snd-display ";noid ~A" snd))
(if (ffneq (maxamp snd) 0.6599) (snd-display ";noid min-peak max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((samps 44100)
- (gen (make-noid 100.0 3 'max-peak)))
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (noid gen))))))))
+ (do ((samps base-length)
+ (gen (make-noid 100.0 3 'max-peak))
+ (i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (noid gen)))))))
(if (not (sound? snd)) (snd-display ";noid ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";noid max-peak max: ~A" (maxamp snd))))
@@ -41295,97 +40804,96 @@ EDITS: 1
(indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
(let ((set-nrcos-scaler (procedure-setter (gen 'mus-scaler))))
(do ((i 0 (+ i 1)))
- ((= i 40000))
+ ((= i base-length))
(set-nrcos-scaler gen (env indr))
(outa i (nrcos gen)))))))))
(if (not (sound? snd)) (snd-display ";nrcos with scaler ~A" snd))
- ;(if (fneq (maxamp snd) 1.0) (snd-display ";nrcos with scaler max: ~A" (maxamp snd)))
;; this is not a new problem -- was the scaler supposed to fix maxamp?
)
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-ncos2 100.0 :n 10)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (ncos2 gen))))))))
+ (do ((gen (make-ncos2 100.0 :n 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (ncos2 gen)))))))
(if (not (sound? snd)) (snd-display ";ncos2 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";ncos2 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-ncos4 100.0 :n 10)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (ncos4 gen))))))))
+ (do ((gen (make-ncos4 100.0 :n 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (ncos4 gen)))))))
(if (not (sound? snd)) (snd-display ";ncos4 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";ncos4 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-npcos 100.0 :n 10)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (npcos gen))))))))
+ (do ((gen (make-npcos 100.0 :n 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (npcos gen)))))))
(if (not (sound? snd)) (snd-display ";npcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";npcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-n1cos 100.0 :n 10)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (n1cos gen))))))))
+ (do ((gen (make-n1cos 100.0 :n 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (n1cos gen)))))))
(if (not (sound? snd)) (snd-display ";n1cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";n1cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rcos 100.0 :r 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (rcos gen))))))))
+ (do ((gen (make-rcos 100.0 :r 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rcos gen)))))))
(if (not (sound? snd)) (snd-display ";rcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-bess 100.0 :n 0)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (bess gen))))))))
+ (do ((gen (make-bess 100.0 :n 0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (bess gen)))))))
(if (not (sound? snd)) (snd-display ";bess ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";bess max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen1 (make-bess 400.0 :n 1))
- (gen2 (make-bess 400.0 :n 1))
- (vol (make-env '(0 0 1 1 9 1 10 0) :scaler 2.0 :length 20000)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (bess gen1 (* (env vol) (bess gen2 0.0))))))))))
+ (do ((gen1 (make-bess 400.0 :n 1))
+ (gen2 (make-bess 400.0 :n 1))
+ (vol (make-env '(0 0 1 1 9 1 10 0) :scaler 2.0 :length 20000))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (bess gen1 (* (env vol) (bess gen2 0.0)))))))))
(if (not (sound? snd)) (snd-display ";bess 1 ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";bess 1 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen1 (make-bess 400.0 :n 1))
- (gen2 (make-oscil 400.0))
- (vol (make-env '(0 1 1 0) :scaler 1.0 :length 20000)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (bess gen1 (* (env vol) (oscil gen2 0.0))))))))))
+ (do ((gen1 (make-bess 400.0 :n 1))
+ (gen2 (make-oscil 400.0))
+ (vol (make-env '(0 1 1 0) :scaler 1.0 :length 20000))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (bess gen1 (* (env vol) (oscil gen2 0.0)))))))))
(if (not (sound? snd)) (snd-display ";bess 2 ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";bess 2 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-eoddcos 400.0 :r 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (eoddcos gen))))))))
+ (do ((gen (make-eoddcos 400.0 :r 1.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (eoddcos gen)))))))
(if (not (sound? snd)) (snd-display ";eoddcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";eoddcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-eoddcos 400.0 :r 0.0))
- (a-env (make-env '(0 0 1 1) :length 10000)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (set! (gen 'r) (env a-env))
- (outa i (eoddcos gen))))))))
+ (do ((gen (make-eoddcos 400.0 :r 0.0))
+ (a-env (make-env '(0 0 1 1) :length 10000))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (set! (gen 'r) (env a-env))
+ (outa i (eoddcos gen)))))))
(if (not (sound? snd)) (snd-display ";eoddcos 1 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";eoddcos 1 max: ~A" (maxamp snd))))
@@ -41394,17 +40902,17 @@ EDITS: 1
(gen2 (make-oscil 400.0))
(a-env (make-env '(0 0 1 1) :length 10000)))
(do ((i 0 (+ i 1)))
- ((= i 10000))
+ ((= i base-length))
(set! (gen1 'r) (env a-env))
(outa i (eoddcos gen1 (* .1 (oscil gen2))))))))))
(if (not (sound? snd)) (snd-display ";eoddcos 2 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";eoddcos 2 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nssb 2000.0 0.05 3)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (* .3 (nssb gen)))))))))
+ (do ((gen (make-nssb 2000.0 0.05 3))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (* .3 (nssb gen))))))))
(if (not (sound? snd)) (snd-display ";nssb ~A" snd))
(if (fneq (maxamp snd) 0.3) (snd-display ";nssb max: ~A" (maxamp snd))))
@@ -41442,82 +40950,82 @@ EDITS: 1
(test-nssb-1))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nrssb 2000.0 0.05 3 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nrssb gen))))))))
+ (do ((gen (make-nrssb 2000.0 0.05 3 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nrssb gen)))))))
(if (not (sound? snd)) (snd-display ";nrssb ~A" snd))
(if (fneq (maxamp snd) 0.777) (snd-display ";nrssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rkcos 440.0 :r 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rkcos gen))))))))
+ (do ((gen (make-rkcos 440.0 :r 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rkcos gen)))))))
(if (not (sound? snd)) (snd-display ";rkcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rkcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rk!cos 440.0 :r 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rk!cos gen))))))))
+ (do ((gen (make-rk!cos 440.0 :r 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rk!cos gen)))))))
(if (not (sound? snd)) (snd-display ";rk!cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rk!cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-r2k!cos 440.0 :r 0.5 :k 3.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (r2k!cos gen))))))))
+ (do ((gen (make-r2k!cos 440.0 :r 0.5 :k 3.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (r2k!cos gen)))))))
(if (not (sound? snd)) (snd-display ";r2k!cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";r2k!cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-k2sin 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (k2sin gen))))))))
+ (do ((gen (make-k2sin 440.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (k2sin gen)))))))
(if (not (sound? snd)) (snd-display ";k2sin ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";k2sin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-k2cos 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (k2cos gen))))))))
+ (do ((gen (make-k2cos 440.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (k2cos gen)))))))
(if (not (sound? snd)) (snd-display ";k2cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";k2cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-k2ssb 1000.0 0.1)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (k2ssb gen))))))))
+ (do ((gen (make-k2ssb 1000.0 0.1))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (k2ssb gen)))))))
(if (not (sound? snd)) (snd-display ";k2ssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";k2ssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rssb 1000 0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rssb gen))))))))
+ (do ((gen (make-rssb 1000 0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rssb gen)))))))
(if (not (sound? snd)) (snd-display ";rssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-dblsum 100 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (* .47 (dblsum gen))))))))) ; k starts at 0, so maxamp would be 2 except something else is wrong
+ (do ((gen (make-dblsum 100 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (* .47 (dblsum gen)))))))) ; k starts at 0, so maxamp would be 2 except something else is wrong
(if (not (sound? snd)) (snd-display ";dblsum ~A" snd))
(if (> (maxamp snd) 1.0) (snd-display ";dblsum max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nkssb 1000.0 0.1 5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nkssb gen))))))))
+ (do ((gen (make-nkssb 1000.0 0.1 5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nkssb gen)))))))
(if (not (sound? snd)) (snd-display ";nkssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nkssb max: ~A" (maxamp snd))))
@@ -41525,7 +41033,7 @@ EDITS: 1
(let ((gen (make-nkssb 1000.0 0.1 5))
(vib (make-polywave 5.0 (list 1 (hz->radians 50.0)) mus-chebyshev-second-kind)))
(do ((i 0 (+ i 1)))
- ((= i 30000))
+ ((= i base-length))
(outa i (nkssb gen (polywave vib)))))))))
(if (not (sound? snd)) (snd-display ";nkssb 1 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nkssb 1 max: ~A" (maxamp snd))))
@@ -41535,241 +41043,233 @@ EDITS: 1
(move (make-env '(0 1 1 -1) :length 30000))
(vib (make-polywave 5.0 (list 1 (hz->radians 50.0)) mus-chebyshev-second-kind)))
(do ((i 0 (+ i 1)))
- ((= i 30000))
+ ((= i base-length))
(outa i (nkssb-interp gen (polywave vib) (env move)))))))))
(if (not (sound? snd)) (snd-display ";nkssb 2 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nkssb 2 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rkoddssb 1000.0 0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rkoddssb gen))))))))
+ (do ((gen (make-rkoddssb 1000.0 0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rkoddssb gen)))))))
(if (not (sound? snd)) (snd-display ";rkoddssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rkoddssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-krksin 440.0 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (krksin gen))))))))
+ (do ((gen (make-krksin 440.0 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (krksin gen)))))))
(if (not (sound? snd)) (snd-display ";krksin ~A" snd)))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-abcos 100.0 0.5 0.25)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (abcos gen))))))))
+ (do ((gen (make-abcos 100.0 0.5 0.25))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (abcos gen)))))))
(if (not (sound? snd)) (snd-display ";abcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";abcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-absin 100.0 0.5 0.25)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (absin gen))))))))
+ (do ((gen (make-absin 100.0 0.5 0.25))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (absin gen)))))))
(if (not (sound? snd)) (snd-display ";absin ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";absin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-r2k2cos 100.0 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (r2k2cos gen))))))))
+ (do ((gen (make-r2k2cos 100.0 1.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (r2k2cos gen)))))))
(if (not (sound? snd)) (snd-display ";r2k2cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";r2k2cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (jjcos gen))))))))
+ (do ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (jjcos gen)))))))
(if (not (sound? snd)) (snd-display ";jjcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";jjcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-j0evencos 100.0 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (j0evencos gen))))))))
+ (do ((gen (make-j0evencos 100.0 1.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (j0evencos gen)))))))
(if (not (sound? snd)) (snd-display ";j0evencos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";j0evencos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rksin 100.0 :r 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rksin gen))))))))
+ (do ((gen (make-rksin 100.0 :r 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rksin gen)))))))
(if (not (sound? snd)) (snd-display ";rksin ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rksin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rkssb 1000.0 0.1 :r 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rkssb gen))))))))
+ (do ((gen (make-rkssb 1000.0 0.1 :r 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rkssb gen)))))))
(if (not (sound? snd)) (snd-display ";rkssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rkssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rk!ssb 1000.0 0.1 :r 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rk!ssb gen))))))))
+ (do ((gen (make-rk!ssb 1000.0 0.1 :r 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rk!ssb gen)))))))
(if (not (sound? snd)) (snd-display ";rk!ssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rk!ssb max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-jpcos 100.0 :a 1.0 :r 0.99 :k 1)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (jpcos gen))))))))
+ (do ((gen (make-jpcos 100.0 :a 1.0 :r 0.99 :k 1))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (jpcos gen)))))))
(if (not (sound? snd)) (snd-display ";jpcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";jpcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-j2cos 100.0 :r 1.0 :n 0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (j2cos gen))))))))
+ (do ((gen (make-j2cos 100.0 :r 1.0 :n 0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (j2cos gen)))))))
(if (not (sound? snd)) (snd-display ";j2cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";j2cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nxysin 300 1/3 3)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nxysin gen))))))))
+ (do ((gen (make-nxysin 300 1/3 3))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nxysin gen)))))))
(if (not (sound? snd)) (snd-display ";nxysin ~A" snd)))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nxycos 300 1/3 3)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nxycos gen))))))))
+ (do ((gen (make-nxycos 300 1/3 3))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nxycos gen)))))))
(if (not (sound? snd)) (snd-display ";nxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nxycos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nxy1cos 300 1/3 3)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nxy1cos gen))))))))
+ (do ((gen (make-nxy1cos 300 1/3 3))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nxy1cos gen)))))))
(if (not (sound? snd)) (snd-display ";nxy1cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nxy1cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nxy1sin 300 1/3 3)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nxy1sin gen))))))))
+ (do ((gen (make-nxy1sin 300 1/3 3))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nxy1sin gen)))))))
(if (not (sound? snd)) (snd-display ";nxy1sin ~A" snd))
(if (fneq (maxamp snd) 0.951) (snd-display ";nxy1sin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-nrxysin 1000 0.1 5 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 2000))
- (outa i (nrxysin gen))))))))
+ (do ((gen (make-nrxysin 1000 0.1 5 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nrxysin gen)))))))
(if (not (sound? snd)) (snd-display ";nrxysin ~A" snd))
(if (fneq (maxamp snd) 0.985) (snd-display ";nrxysin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nrxycos 1000 0.1 5 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 2000))
- (outa i (nrxycos gen))))))))
+ (do ((gen (make-nrxycos 1000 0.1 5 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nrxycos gen)))))))
(if (not (sound? snd)) (snd-display ";nrxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nrxycos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-nrxycos 1000 0.1 15 0.5))
- (indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
- (do ((i 0 (+ i 1)))
- ((= i 40000))
- (set! (mus-scaler gen) (env indr))
- (outa i (nrxycos gen))))))))
+ (do ((gen (make-nrxycos 1000 0.1 15 0.5))
+ (indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (set! (mus-scaler gen) (env indr))
+ (outa i (nrxycos gen)))))))
(if (not (sound? snd)) (snd-display ";nrxycos with scaler ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nrxycos with scaler max: ~A" (maxamp snd))))
+ (if (fneq (maxamp snd) 0.992) (snd-display ";nrxycos with scaler max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((black4 (make-blackman 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (blackman black4 0.0))))))))
+ (do ((black4 (make-blackman 440.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (blackman black4 0.0)))))))
(if (not (sound? snd)) (snd-display ";blackman ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";blackman max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((black4 (make-sinc-train 440.0 10)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (sinc-train black4 0.0))))))))
+ (do ((black4 (make-sinc-train 440.0 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (sinc-train black4 0.0)))))))
(if (not (sound? snd)) (snd-display ";sinc-train ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";sinc-train max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-k3sin 100.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (k3sin gen))))))))
+ (do ((gen (make-k3sin 100.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (k3sin gen)))))))
(if (not (sound? snd)) (snd-display ";k3sin ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";k3sin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-izcos 100.0 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (izcos gen))))))))
+ (do ((gen (make-izcos 100.0 1.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (izcos gen)))))))
(if (not (sound? snd)) (snd-display ";izcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";izcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rxysin 1000 0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (* .5 (rxysin gen)))))))))
+ (do ((gen (make-rxysin 1000 0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (* .5 (rxysin gen))))))))
(if (not (sound? snd)) (snd-display ";rxysin ~A" snd))
(if (> (maxamp snd) 1.0) (snd-display ";rxysin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rxycos 1000 0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rxycos gen))))))))
+ (do ((gen (make-rxycos 1000 0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rxycos gen)))))))
(if (not (sound? snd)) (snd-display ";rxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";rxycos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f :srate 44100)
- (let ((gen (make-safe-rxycos 1000 0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (safe-rxycos gen))))))))
+ (do ((gen (make-safe-rxycos 1000 0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (safe-rxycos gen)))))))
(if (not (sound? snd)) (snd-display ";safe-rxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";safe-rxycos max: ~A" (maxamp snd))))
- (let* ((base-r 0.0)
- (end-r 0.0)
- (snd (find-sound (with-sound (:clipped #f :channels 2 :srate 44100)
+ (let ((snd (find-sound (with-sound (:clipped #f :channels 2 :srate 44100)
(let ((gen1 (make-safe-rxycos 1000 1 0.99))
(gen2 (make-safe-rxycos 1000 1 0.99))
(frqf (make-env '(0 0 1 1) :length 10000 :scaler (hz->radians 1000))))
(let ((set-freq (procedure-setter (gen2 'mus-frequency))))
- (set! base-r (gen1 'r))
(do ((i 0 (+ i 1)))
- ((= i 10000))
+ ((= i base-length))
(let ((fm (env frqf)))
(set-freq gen2 (+ 1000 (radians->hz fm)))
(outa i (safe-rxycos gen1 fm)))
- (outb i (safe-rxycos gen2 0.0))
- (set! end-r (clamp-rxycos-r gen2 0.0)))))))))
- (if (not (sound? snd)) (snd-display ";safe-rxycos 1 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";safe-rxycos 1 max: ~A" (maxamp snd)))
- (if (fneq base-r .588) (snd-display ";safe-rxycos-r 1 base: ~A" base-r))
- (if (fneq end-r .316) (snd-display ";safe-rxycos-r 1 end: ~A" end-r)))
+ (outb i (safe-rxycos gen2 0.0)))))))))
+ (if (not (sound? snd)) (snd-display ";safe-rxycos 1 ~A" snd)))
(let* ((base-r 0.0)
- (end-r 0.0)
(snd (find-sound (with-sound (:clipped #f :channels 2 :srate 44100)
(let ((gen1 (make-safe-rxycos 1000 .1 0.99))
(gen2 (make-safe-rxycos 1000 .1 0.99))
@@ -41777,124 +41277,122 @@ EDITS: 1
(let ((set-freq (procedure-setter (gen2 'mus-frequency))))
(set! base-r (gen1 'r))
(do ((i 0 (+ i 1)))
- ((= i 10000))
+ ((= i base-length))
(let ((fm (env frqf)))
(set-freq gen2 (+ 1000 (radians->hz fm)))
(outa i (safe-rxycos gen1 fm)))
- (outb i (safe-rxycos gen2 0.0))
- (set! end-r (clamp-rxycos-r gen2 0.0)))))))))
+ (outb i (safe-rxycos gen2 0.0)))))))))
(if (not (sound? snd)) (snd-display ";safe-rxycos 2 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";safe-rxycos 2 max: ~A" (maxamp snd)))
- (if (fneq base-r .951) (snd-display ";safe-rxycos-r 2 base: ~A" base-r))
- (if (fneq end-r .896) (snd-display ";safe-rxycos-r 2 end: ~A" end-r)))
+ (if (fneq base-r .951) (snd-display ";safe-rxycos-r 2 base: ~A" base-r)))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rxyk!sin 1000 0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rxyk!sin gen))))))))
+ (do ((gen (make-rxyk!sin 1000 0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rxyk!sin gen)))))))
(if (not (sound? snd)) (snd-display ";rxyk!sin ~A" snd))
(if (fneq (maxamp snd) 0.992) (snd-display ";rxyk!sin max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-rxyk!cos 1000 0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rxyk!cos gen))))))))
+ (do ((gen (make-rxyk!cos 1000 0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (rxyk!cos gen)))))))
(if (not (sound? snd)) (snd-display ";rxyk!cos ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";rxyk!cos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f :statistics #t :play #f)
- (let ((gen (make-nsincos 100.0 3)))
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (nsincos gen))))))))
+ (do ((gen (make-nsincos 100.0 3))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nsincos gen)))))))
(if (not (sound? snd)) (snd-display ";nsincos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";nsincos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f :play #f)
- (let ((gen (make-nchoosekcos 2000.0 0.05 10)))
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (nchoosekcos gen))))))))
+ (do ((gen (make-nchoosekcos 2000.0 0.05 10))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (nchoosekcos gen)))))))
(if (not (sound? snd)) (snd-display ";nchoosekcos ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display ";nchoosekcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound ()
- (let ((gen (make-adjustable-square-wave 100 .2 .5)))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (outa i (adjustable-square-wave gen))))))))
+ (do ((gen (make-adjustable-square-wave 100 .2 .5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (adjustable-square-wave gen)))))))
(if (not (sound? snd)) (snd-display ";adj sq ~A" snd))
(if (fneq (maxamp snd) 0.5) (snd-display ";adj sq max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound ()
- (let ((gen (make-adjustable-triangle-wave 100 .2 .5)))
- (do ((i 0 (+ i 1)))
- ((= i 22050))
- (outa i (adjustable-triangle-wave gen))))))))
+ (do ((gen (make-adjustable-triangle-wave 100 .2 .5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (adjustable-triangle-wave gen)))))))
(if (not (sound? snd)) (snd-display ";adj tri ~A" snd))
(if (ffneq (maxamp snd) 0.5) (snd-display ";adj tri max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound ()
- (let ((gen (make-adjustable-sawtooth-wave 100 .2 .5)))
- (do ((i 0 (+ i 1)))
- ((= i 22050))
- (outa i (adjustable-sawtooth-wave gen))))))))
+ (do ((gen (make-adjustable-sawtooth-wave 100 .2 .5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (adjustable-sawtooth-wave gen)))))))
(if (not (sound? snd)) (snd-display ";adj saw ~A" snd))
(if (ffneq (maxamp snd) 0.5) (snd-display ";adj saw max: ~A" (maxamp snd))))
(with-sound (:clipped #f) ; at least run the thing -- not sure how to test this automatically
(let ((gen (make-pink-noise 12)))
(do ((i 0 (+ i 1)))
- ((= i 44100))
+ ((= i base-length))
(outa i (pink-noise gen)))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-brown-noise 100.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (brown-noise gen))))))))
+ (do ((gen (make-brown-noise 100.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (brown-noise gen)))))))
(if (not (sound? snd)) (snd-display ";brown-noise ~A" snd))
(if (< (maxamp snd) 0.01) (snd-display ";brown-noise max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-green-noise 100.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (green-noise gen))))))))
+ (do ((gen (make-green-noise 100.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (green-noise gen)))))))
(if (not (sound? snd)) (snd-display ";green-noise ~A" snd))
(if (not (<= 0.01 (maxamp snd) 1.0)) (snd-display ";green-noise max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-green-noise 100.0 0.1 -0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (green-noise gen))))))))
+ (do ((gen (make-green-noise 100.0 0.1 -0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (green-noise gen)))))))
(if (not (sound? snd)) (snd-display ";green-noise .5 ~A" snd))
(if (not (<= 0.01 (maxamp snd) 0.5)) (snd-display ";green-noise .5 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-green-noise-interp 100.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (green-noise-interp gen))))))))
+ (do ((gen (make-green-noise-interp 100.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (green-noise-interp gen)))))))
(if (not (sound? snd)) (snd-display ";green-noise-interp ~A" snd))
(if (not (<= 0.01 (maxamp snd) 1.0)) (snd-display ";green-noise-interp max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-green-noise-interp 100.0 0.1 -0.1 0.5)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (green-noise-interp gen))))))))
+ (do ((gen (make-green-noise-interp 100.0 0.1 -0.1 0.5))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (green-noise-interp gen)))))))
(if (not (sound? snd)) (snd-display ";green-noise-interp .5 ~A" snd))
(if (not (<= 0.01 (maxamp snd) 0.5)) (snd-display ";green-noise-interp .5 max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen (make-tanhsin 440.0 2.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (tanhsin gen))))))))
+ (do ((gen (make-tanhsin 440.0 2.0))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (tanhsin gen)))))))
(if (not (sound? snd)) (snd-display ";tanhsin ~A" snd))
(if (> (abs (- 1.0 (maxamp snd))) 0.1) (snd-display ";tanhsin max: ~A" (maxamp snd))))
@@ -41904,11 +41402,10 @@ EDITS: 1
(data (make-float-vector 256)))
(set! (lisp-graph?) #t)
(do ((i 0 (+ i 1)))
- ((= i 10000))
- (if (moving-fft ft)
- (begin
- (float-vector-subseq (mus-xcoeffs ft) 0 255 data)
- (graph data "fft" 0.0 11025.0 0.0 0.1 snd 0 #t))))
+ ((= i base-length))
+ (when (moving-fft ft)
+ (float-vector-subseq (mus-xcoeffs ft) 0 255 data)
+ (graph data "fft" 0.0 11025.0 0.0 0.1 snd 0 #t)))
(close-sound snd)))
(test-sv)
@@ -41949,7 +41446,7 @@ EDITS: 1
(set! (v 0) (make-nrcos 440 10 .5))
(set! (v 1) (make-nrcos 440 10 .5))
(do ((i 0 (+ i 1)))
- ((= i 1000))
+ ((= i base-length))
(outa i (nrcos (vector-ref v 0) 0.0))))))))
(if (not (sound? snd)) (snd-display ";vect nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";vect nrcos max: ~A" (maxamp snd))))
@@ -41959,19 +41456,19 @@ EDITS: 1
(set! (val 0) (make-nrcos 100 1 .1))
(set! (val 1) (make-nrcos 200 1 .1))
(do ((i 0 (+ i 1)))
- ((= i 2000))
+ ((= i base-length))
(outa i (* .5 (+ (nrcos (vector-ref val 0) 0.0)
(nrcos (vector-ref val 1) 0.0))))))))))
(if (not (sound? snd)) (snd-display ";vect 2 nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";vect 2 nrcos max: ~A" (maxamp snd))))
(let ((snd (find-sound (with-sound (:clipped #f)
- (let ((gen1 (make-nrcos 100 1 .1))
- (gen2 (make-nrcos 200 1 .1)))
- (do ((i 0 (+ i 1)))
- ((= i 2000))
- (outa i (* .5 (+ (nrcos gen1 0.0)
- (nrcos gen2 0.0))))))))))
+ (do ((gen1 (make-nrcos 100 1 .1))
+ (gen2 (make-nrcos 200 1 .1))
+ (i 0 (+ i 1)))
+ ((= i base-length))
+ (outa i (* .5 (+ (nrcos gen1 0.0)
+ (nrcos gen2 0.0)))))))))
(if (not (sound? snd)) (snd-display ";no vect 2 nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display ";no vect 2 nrcos max: ~A" (maxamp snd))))
@@ -41980,7 +41477,7 @@ EDITS: 1
(set! (v 0) (make-nrcos 440 10 .5))
(set! (v 1) (make-nrcos 440 10 .5))
(do ((i 0 (+ i 1)))
- ((= i 2000))
+ ((= i base-length))
(let ((gen (vector-ref v 0)))
(outa i (nrcos gen)))))))))
(if (not (sound? snd)) (snd-display ";vect let nrcos ~A" snd))
@@ -42089,34 +41586,33 @@ EDITS: 1
tanhsin moving-fft moving-scentroid moving-autocorrelation moving-pitch
)))
- (let ((gen1 (make-oscil 440.0))
- (gen2 (make-oscil 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (let* ((pm (mus-random 1.0))
- (val1 (oscil gen1 0.0 pm))
- (val2 (run-with-fm-and-pm gen2 0.0 pm))) ; generators.scm
- (if (fneq val1 val2)
- (snd-display ";run-with-fm-and-pm: ~A ~A" val1 val2)))))
-
- (let ((gen1 (make-oscil 440.0))
- (gen2 (make-oscil 440.0))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let* ((pm (mus-random 1.0))
- (val1 (oscil gen1 0.0 pm))
- (val2 (run-with-fm-and-pm gen2 0.0 pm)))
- (if (fneq val1 val2)
- (set! happy #f))))
- (if (not happy)
- (snd-display ";run-with-fm-and-pm unhappy")))
+ (do ((gen1 (make-oscil 440.0))
+ (gen2 (make-oscil 440.0))
+ (i 0 (+ i 1)))
+ ((= i 1000))
+ (let* ((pm (mus-random 1.0))
+ (val1 (oscil gen1 0.0 pm))
+ (val2 (run-with-fm-and-pm gen2 0.0 pm))) ; generators.scm
+ (if (fneq val1 val2)
+ (snd-display ";run-with-fm-and-pm: ~A ~A" val1 val2))))
+
+ (do ((gen1 (make-oscil 440.0))
+ (gen2 (make-oscil 440.0))
+ (happy #t)
+ (i 0 (+ i 1)))
+ ((or (not happy)
+ (= i 1000))
+ (if (not happy)
+ (snd-display ";run-with-fm-and-pm unhappy")))
+ (let* ((pm (mus-random 1.0))
+ (val1 (oscil gen1 0.0 pm))
+ (val2 (run-with-fm-and-pm gen2 0.0 pm)))
+ (if (fneq val1 val2)
+ (set! happy #f))))
(if (pair? (sounds)) (for-each close-sound (sounds)))
- (test-documentation-instruments) ; clm23.scm
- )
+ (test-documentation-instruments)) ; clm23.scm
;;; ---------------- test 23: X/Xt/Xm --------------------
@@ -42140,9 +41636,9 @@ EDITS: 1
(define (snd-test-clean-string str)
;; full file name should be unique, so I think we need only fix it up to look like a flat name
- (let* ((len (length str))
- (new-str (make-string len #\.)))
- (do ((i 0 (+ i 1)))
+ (let ((len (length str)))
+ (do ((new-str (make-string len #\.))
+ (i 0 (+ i 1)))
((= i len) new-str)
(let ((c (str i)))
(string-set! new-str i (if (memv c '(#\\ #\/)) #\_ c))))))
@@ -42612,7 +42108,7 @@ EDITS: 1
(XFreeFontSet dpy fs))))
(XBell dpy 10)
(let ((cmd (XGetCommand dpy win)))
- (if (or (<= (length cmd) 0)
+ (if (or (null? cmd)
(not (string=? (substring (car cmd) (- (length (car cmd)) 3)) "snd")))
(snd-display ";XGetCommand: ~A" cmd)))
(XSetCommand dpy win (list "hiho" "away") 2)
@@ -42850,7 +42346,7 @@ EDITS: 1
(XSetRegion dpy sgc (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule))
(let ((pix (make-pixmap (cadr (main-widgets)) arrow-strs)))
- (if (not (Pixmap? pix))
+ (if (not (Pixmap? pix))
(snd-display ";make-pixmap?")
(begin
(XSetTile dpy sgc pix)
@@ -42879,10 +42375,8 @@ EDITS: 1
(if (not (Cursor? vals)) (snd-display ";XCreatePixmapCursor: ~A" vals))
(XRecolorCursor dpy vals col1 col))
(XAllocColorPlanes dpy cmap #f 2 1 1 1)
- (XAllocColorCells dpy cmap #f 1 1))
-
-
- )))
+ (XAllocColorCells dpy cmap #f 1 1)))))
+
(let* ((fid (XLoadFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
(fnt (XLoadQueryFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
(chs (XQueryTextExtents dpy fid "hiho"))
@@ -43065,47 +42559,47 @@ EDITS: 1
(if (XEqualRegion reg reg1) (snd-display ";f XEqualRegion"))
(if (XEmptyRegion reg) (snd-display ";f XEmptyRegion"))
(XXorRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (not (and (= (.x (cadr box)) 2)
- (= (.y (cadr box)) 2)
- (= (.width (cadr box)) 8)
- (= (.height (cadr box)) 2)))
- (snd-display ";XXorRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (let ((box (cadr (XClipBox reg2))))
+ (if (not (and (= (.x box) 2)
+ (= (.y box) 2)
+ (= (.width box) 8)
+ (= (.height box) 2)))
+ (snd-display ";XXorRegion: ~A ~A ~A ~A" (.x box) (.y box) (.width box) (.height box))))
(XUnionRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (not (and (= (.x (cadr box)) 2)
- (= (.y (cadr box)) 2)
- (= (.width (cadr box)) 8)
- (= (.height (cadr box)) 8)))
- (snd-display ";XUnionRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (let ((box (cadr (XClipBox reg2))))
+ (if (not (and (= (.x box) 2)
+ (= (.y box) 2)
+ (= (.width box) 8)
+ (= (.height box) 8)))
+ (snd-display ";XUnionRegion: ~A ~A ~A ~A" (.x box) (.y box) (.width box) (.height box))))
(XSubtractRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (not (and (= (.x (cadr box)) 0)
- (= (.y (cadr box)) 0)
- (= (.width (cadr box)) 0)
- (= (.height (cadr box)) 0)))
- (snd-display ";XSubtractRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (let ((box (cadr (XClipBox reg2))))
+ (if (not (and (= (.x box) 0)
+ (= (.y box) 0)
+ (= (.width box) 0)
+ (= (.height box) 0)))
+ (snd-display ";XSubtractRegion: ~A ~A ~A ~A" (.x box) (.y box) (.width box) (.height box))))
(XIntersectRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (not (and (= (.x (cadr box)) 2)
- (= (.y (cadr box)) 4)
- (= (.width (cadr box)) 8)
- (= (.height (cadr box)) 6)))
- (snd-display ";XIntersectRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (let ((box (cadr (XClipBox reg2))))
+ (if (not (and (= (.x box) 2)
+ (= (.y box) 4)
+ (= (.width box) 8)
+ (= (.height box) 6)))
+ (snd-display ";XIntersectRegion: ~A ~A ~A ~A" (.x box) (.y box) (.width box) (.height box))))
(XUnionRectWithRegion (XRectangle 1 3 100 100) reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (not (and (= (.x (cadr box)) 1)
- (= (.y (cadr box)) 2)
- (= (.width (cadr box)) 100)
- (= (.height (cadr box)) 101)))
- (snd-display ";XUnionRectWithRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (let ((box (cadr (XClipBox reg2))))
+ (if (not (and (= (.x box) 1)
+ (= (.y box) 2)
+ (= (.width box) 100)
+ (= (.height box) 101)))
+ (snd-display ";XUnionRectWithRegion: ~A ~A ~A ~A" (.x box) (.y box) (.width box) (.height box))))
(XRectInRegion reg 0 0 100 100)
- (let ((box (XClipBox reg1)))
- (if (not (and (= (.x (cadr box)) 2)
- (= (.y (cadr box)) 2)
- (= (.width (cadr box)) 8)
- (= (.height (cadr box)) 8)))
- (snd-display ";XClipBox: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (let ((box (cadr (XClipBox reg1))))
+ (if (not (and (= (.x box) 2)
+ (= (.y box) 2)
+ (= (.width box) 8)
+ (= (.height box) 8)))
+ (snd-display ";XClipBox: ~A ~A ~A ~A" (.x box) (.y box) (.width box) (.height box))))
(XDestroyRegion reg1)
))
@@ -43569,18 +43063,17 @@ EDITS: 1
(set! row (XmStringConcatAndFree tmp entry)))
(set! row entry)))
(set! our-tags (cdr our-tags))
- (if (null? our-tags)
- (begin
- (set! our-tags tags)
- (set! table (cons row table))
- (set! row #f))))
+ (when (null? our-tags)
+ (set! our-tags tags)
+ (set! table (cons row table))
+ (set! row #f)))
'("this" "is" "a" "test" "of" "the" "renditions" "and" "rendertables"
"perhaps" "all" "will" "go" "well" "and" "then" "again" "perhaps" "not"))
- (let ((c (XmStringInitContext (car table)))
+ (let ((c (cadr (XmStringInitContext (car table))))
(happy #t))
(do ((i 0 (+ i 1)))
((not happy))
- (let ((type (XmStringGetNextTriple (cadr c))))
+ (let ((type (XmStringGetNextTriple c)))
(if (= (car type) XmSTRING_COMPONENT_TEXT)
(if (not (and (= (cadr type) ((list 0 0 2 0 0 0 4 0 0 0 3 0 0 0 4) i))
(string=? (caddr type)
@@ -43589,7 +43082,7 @@ EDITS: 1
(if (and (not (= (car type) XmSTRING_COMPONENT_TAB))
(= (car type) XmSTRING_COMPONENT_END))
(set! happy #f)))))
- (XmStringFreeContext (cadr c))))))
+ (XmStringFreeContext c)))))
(XtAppAddActions (car (main-widgets))
(list (list "try1" (lambda (w e strs)
@@ -45672,20 +45165,19 @@ EDITS: 1
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
(snd-display ";(~A ~A) -> ~A" name arg tag)))
- (if (dilambda? n)
- (begin
- (let ((tag
- (catch #t
- (lambda () (set! (n arg) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";(~A ~A) -> ~A" name arg tag)))
- (let ((tag
- (catch #t
- (lambda () (set! (n 0) arg))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";(set ~A ~A) -> ~A" name arg tag))))))
+ (when (dilambda? n)
+ (let ((tag
+ (catch #t
+ (lambda () (set! (n arg) 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display ";(~A ~A) -> ~A" name arg tag)))
+ (let ((tag
+ (catch #t
+ (lambda () (set! (n 0) arg))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display ";(set ~A ~A) -> ~A" name arg tag)))))
struct-accessors
struct-accessor-names))
(list dpy win '(Atom 0) '(Colormap 0) 1.5 "/hiho" 1234 #f #\c '(Time 0) '(Font 0) #() '(Cursor 1))))
@@ -46128,7 +45620,7 @@ EDITS: 1
(lambda ()
(n (integer->sound 123)))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-sound))
+ (if (not (memq tag '(wrong-type-arg no-such-sound)))
(snd-display ";snd no-such-sound ~A: ~A" n tag))))
(list amp-control apply-controls channels chans comment contrast-control
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
@@ -46583,16 +46075,6 @@ EDITS: 1
(let ((tag
(catch #t
(lambda ()
- (n (integer->mix 1234)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-mix))
- (snd-display ";[1]: mix procs ~A: ~A" n tag))))
- (list mix-amp mix-length mix-name mix-position mix-home mix-speed mix-tag-y))
-
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
(set! (n (integer->mix 1234)) float-vector-5))
(lambda args (car args)))))
(if (not (memq tag '(error wrong-type-arg syntax-error no-such-mix)))
@@ -46625,16 +46107,6 @@ EDITS: 1
(snd-display "; mark procs ~A: ~A" n tag))))
(list add-mark mark-name mark-sample mark-sync mark-home delete-mark delete-marks find-mark))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n (integer->mark 1234)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-mark))
- (snd-display "; no mark procs ~A: ~A" n tag))))
- (list mark-name mark-sample mark-sync mark-home delete-mark))
-
(let* ((index (open-sound "oboe.snd"))
(id (add-mark 0 index 0)))
(for-each (lambda (n)
@@ -46668,17 +46140,6 @@ EDITS: 1
(let ((tag
(catch #t
(lambda ()
- (n (integer->region 1234)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-region))
- (snd-display "; (no) region procs ~A: ~A" n tag))))
- (list region-chans region-home region-framples region-position
- region-maxamp region-maxamp-position region-srate forget-region))
-
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
(set! (n) float-vector-5))
(lambda args (car args)))))
(if (not (memq tag '(error wrong-type-arg syntax-error)))
@@ -46765,8 +46226,8 @@ EDITS: 1
(lambda () (set! (mus-xcoeff (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3) 4) 1.0))
(lambda () (set! (mus-ycoeff (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3) 4) 1.0))))
(check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (float-vector 1 1 -2 1))))
- (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (list 1 1 -2 1))))
- (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (list))))
+ (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials '(1 1 -2 1))))
+ (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials ())))
(check-error-tag 'no-such-channel (lambda () (make-sampler 0 "oboe.snd" -1)))
(check-error-tag 'no-such-channel (lambda () (make-sampler 0 "oboe.snd" 1)))
(check-error-tag 'no-such-envelope (lambda () (set! (enved-envelope) "not-an-env")))
@@ -46781,9 +46242,6 @@ EDITS: 1
(check-error-tag 'no-such-menu (lambda () (add-to-menu 1234 "hi" (lambda () #f))))
(check-error-tag 'no-such-menu (lambda () (main-menu -1)))
(check-error-tag 'no-such-menu (lambda () (main-menu 111)))
- (check-error-tag 'no-such-mix (lambda () (mix-properties (integer->mix (+ 1 (mix-sync-max))))))
- (check-error-tag 'no-such-mix (lambda () (set! (mix-properties (integer->mix (+ 1 (mix-sync-max)))) '(a 1))))
- (check-error-tag 'no-such-region (lambda () (make-region-sampler (integer->region 1234567) 0)))
(check-error-tag 'no-such-sound (lambda () (edit-header-dialog 1234)))
(check-error-tag 'no-such-sound (lambda () (set! (sound-loop-info 123) '(0 0 1 1))))
(for-each (lambda (arg)
@@ -46827,8 +46285,6 @@ EDITS: 1
(lambda () (set! *mus-array-print-length* -1))
(lambda () (set! *play-arrow-size* -1))
(lambda () (set! *print-length* -1))
- (lambda () (set! *transform-type* (integer->transform 123)))
- (lambda () (snd-transform (integer->transform 20) (make-float-vector 4)))
(lambda () (src (make-src :input (lambda (dir) 1.0)) 2000000.0))))
(for-each (lambda (arg)
(check-error-tag 'wrong-type-arg arg))
@@ -46844,7 +46300,6 @@ EDITS: 1
(lambda () (set! *ask-about-unsaved-edits* 123))
(lambda () (set! *save-as-dialog-auto-comment* 123))
(lambda () (set! *save-as-dialog-src* 123))
- (lambda () (set! *transform-type* (integer->transform -1)))
(lambda () (set! *with-menu-icons* 123))
(lambda () (set! *with-smpte-label* 123))
(lambda () (set! *with-toolbar* 123))
@@ -46973,11 +46428,9 @@ EDITS: 1
(check-error-tag 'no-active-selection (lambda () (filter-selection (float-vector 0 0 1 1) 4)))
(check-error-tag 'no-active-selection (lambda () (save-selection "/bad/baddy.snd")))
(check-error-tag 'no-active-selection (lambda () (env-selection '(0 0 1 1))))
- (check-error-tag 'no-such-region (lambda () (save-region (integer->region 1234) "/bad/baddy.snd")))
(make-region 0 100 ind 0)
(check-error-tag 'cannot-save (lambda () (save-selection "/bad/baddy.snd")))
(check-error-tag 'cannot-save (lambda () (save-region (car (regions)) "/bad/baddy.snd")))
- (check-error-tag 'no-such-mix (lambda () (make-mix-sampler (integer->mix 1234))))
(check-error-tag 'no-such-sound (lambda () (make-region 0 12 1234 #t)))
(set! (read-only ind) #t)
(check-error-tag 'bad-arity (lambda () (play (selected-sound) 0 :stop (lambda () #f))))
@@ -47334,14 +46787,14 @@ EDITS: 1
all-hooks))
(define (report-hook-calls)
- (let ((not-called ()))
- (do ((i 0 (+ i 1)))
- ((= i (length all-hooks)))
- (if (positive? (hook-calls i))
- (format *stderr* "~A: ~D~%" (hook-names i) (hook-calls i))
- (set! not-called (cons (hook-names i) not-called))))
- (if (pair? not-called)
- (format *stderr* "not called: ~{~A~^, ~}~%" not-called))))
+ (do ((not-called ())
+ (i 0 (+ i 1)))
+ ((= i (length all-hooks))
+ (if (pair? not-called)
+ (format *stderr* "not called: ~{~A~^, ~}~%" not-called)))
+ (if (positive? (hook-calls i))
+ (format *stderr* "~A: ~D~%" (hook-names i) (hook-calls i))
+ (set! not-called (cons (hook-names i) not-called)))))
(cond ((> test-at-random 0) ; run tests in any random order
@@ -47447,15 +46900,13 @@ EDITS: 1
(if (file-exists? original-temp-dir)
(system (format #f "rm -f ~A/snd_*" original-temp-dir)))
-(if (file-exists? "/tmp")
- (begin
- (system "rm -f /tmp/snd_*")
- (system "rm -f /tmp/file*.snd")))
+(when (file-exists? "/tmp")
+ (system "rm -f /tmp/snd_*")
+ (system "rm -f /tmp/file*.snd"))
-(if (file-exists? "/var/tmp")
- (begin
- (system "rm -f /var/tmp/snd_*")
- (system "rm -f /var/tmp/file*.snd")))
+(when (file-exists? "/var/tmp")
+ (system "rm -f /var/tmp/snd_*")
+ (system "rm -f /var/tmp/file*.snd"))
(if (defined? 'dlocsig-speaker-configs) (set! dlocsig-speaker-configs #f))
@@ -47737,5 +47188,3 @@ callgrind_annotate --auto=yes callgrind.out.<pid> > hi
330,406,288 clm.c:fb_many_with_amps_c1_c2 [/home/bil/motif-snd/snd]
|#
-
-
diff --git a/snd-xref.c b/snd-xref.c
index 11a8813..d01f6f6 100644
--- a/snd-xref.c
+++ b/snd-xref.c
@@ -1,104 +1,104 @@
/* Snd help index (generated by make-index.scm) */
-#define HELP_NAMES_SIZE 1607
+#define HELP_NAMES_SIZE 1609
#if HAVE_SCHEME || HAVE_FORTH
static const char *help_names[HELP_NAMES_SIZE] = {
- "*#readers*", "->byte-vector", "abcos", "abcos?", "abort", "absin",
- "absin?", "add-amp-controls", "add-colormap", "add-delete-option", "add-directory-to-view-files-list", "add-file-filter",
- "add-file-sorter", "add-file-to-view-files-list", "add-mark", "add-mark-pane", "add-player", "add-sound-file-extension",
- "add-source-file-extension", "add-to-main-menu", "add-to-menu", "add-tooltip", "add-transform", "additive synthesis",
- "adjustable-sawtooth-wave", "adjustable-sawtooth-wave?", "adjustable-square-wave", "adjustable-square-wave?", "adjustable-triangle-wave", "adjustable-triangle-wave?",
- "after-apply-controls-hook", "after-edit-hook", "after-graph-hook", "after-lisp-graph-hook", "after-open-hook", "after-save-as-hook",
- "after-save-state-hook", "after-transform-hook", "all-chans", "all-pass", "all-pass-bank", "all-pass-bank?",
- "all-pass?", "amp-control", "amp-control-bounds", "amplitude-modulate", "analyse-ladspa", "anoi",
- "any-env-channel", "any-random", "apply-controls", "apply-ladspa", "aritable?", "arity",
- "array->file", "array-interp", "as-one-edit", "ask-about-unsaved-edits", "ask-before-overwrite", "asyfm-I",
- "asyfm-J", "asyfm?", "asymmetric-fm", "asymmetric-fm?", "auto-resize", "auto-save",
- "auto-update", "auto-update-interval", "autocorrelate", "axis-color", "axis-info", "axis-label-font",
- "axis-numbers-font", "background-gradient", "bad-header-hook", "bagpipe", "basic-color", "beats-per-measure",
- "beats-per-minute", "before-close-hook", "before-exit-hook", "before-save-as-hook", "before-save-state-hook", "before-transform-hook",
- "bes-j0", "bess", "bess?", "bessel filters", "bigbird", "bignum",
- "bignum?", "binary files", "bind-key", "bird", "blackman", "blackman4-env-channel",
- "blackman?", "bold-peaks-font", "break", "brown-noise", "brown-noise?", "butterworth filters",
- "byte-vector", "byte-vector?", "c-define", "c-g?", "c-object?", "c-pointer",
- "c-pointer?", "call-with-exit", "canter", "cascade->canonical", "catch", "cellon",
- "chain-dsps", "channel->vct", "channel-amp-envs", "channel-data", "channel-envelope", "channel-polynomial",
- "channel-properties", "channel-property", "channel-rms", "channel-style", "channel-sync", "channel-widgets",
- "channels", "channels-equal?", "channels=?", "chans", "char-position", "cheby-hka",
- "chebyshev filters", "check-mix-tags", "chordalize", "chorus", "clean-channel", "clean-sound",
- "clear-listener", "clip-hook", "clipping", "clm-channel", "clm-expsrc", "close-hook",
- "close-sound", "color->list", "color-cutoff", "color-hook", "color-inverted", "color-mixes",
- "color-orientation-dialog", "color-scale", "color?", "colormap", "colormap->integer", "colormap-name",
- "colormap-ref", "colormap-size", "colormap?", "comb", "comb-bank", "comb-bank?",
- "comb?", "combined-data-color", "comment", "complexify", "concatenate-envelopes", "constant?",
- "continuation?", "continue-frample->file", "continue-sample->file", "contrast-channel", "contrast-control", "contrast-control-amp",
- "contrast-control-bounds", "contrast-control?", "contrast-enhancement", "contrast-sound", "controls->channel", "convolution",
- "convolution reverb", "convolve", "convolve-files", "convolve-selection-with", "convolve-with", "convolve?",
- "copy", "copy-context", "copy-sampler", "correlate", "coverlet", "cross-fade (amplitude)",
- "cross-fade (frequency domain)", "cross-synthesis", "curlet", "current-font", "cursor", "cursor-color",
- "cursor-context", "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style", "cursor-update-interval",
- "cutlet", "cyclic-sequences", "dac-combines-channels", "dac-size", "data-color", "data-location",
- "data-size", "db->linear", "default-output-chans", "default-output-header-type", "default-output-sample-type", "default-output-srate",
- "defgenerator", "define*", "define-constant", "define-envelope", "define-expansion", "define-macro",
- "define-macro*", "define-selection-via-marks", "defined?", "degrees->radians", "delay", "delay-channel-mixes",
- "delay-tick", "delay?", "delete-colormap", "delete-file-filter", "delete-file-sorter", "delete-mark",
- "delete-marks", "delete-sample", "delete-samples", "delete-samples-and-smooth", "delete-selection", "delete-selection-and-smooth",
- "delete-transform", "describe-hook", "describe-mark", "dht", "dialog-widgets", "dilambda",
- "disable-control-panel", "display-bark-fft", "display-correlation", "display-db", "display-edits", "display-energy",
- "dissolve-fade", "dither-channel", "dither-sound", "dolph", "dot-product", "dot-size",
- "down-oct", "draw-axes", "draw-dot", "draw-dots", "draw-line", "draw-lines",
- "draw-mark-hook", "draw-mix-hook", "draw-string", "drone", "drop sites", "drop-hook",
- "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook", "edit-list->function", "edit-position",
- "edit-properties", "edit-property", "edit-tree", "edits", "edot-product", "effects-hook",
- "elliptic filters", "env", "env-any", "env-channel", "env-channel-with-base", "env-expt-channel",
- "env-interp", "env-mixes", "env-selection", "env-sound", "env-sound-interp", "env-squared-channel",
- "env?", "enved-base", "enved-clip?", "enved-dialog", "enved-envelope", "enved-filter",
- "enved-filter-order", "enved-hook", "enved-in-dB", "enved-power", "enved-style", "enved-target",
- "enved-wave?", "enved-waveform-color", "envelope-interp", "enveloped-mix", "eoddcos", "eoddcos?",
- "eps-bottom-margin", "eps-file", "eps-left-margin", "eps-size", "ercos", "ercos?",
- "*error-hook*", "erssb", "erssb?", "even-multiple", "even-weight", "every-sample?",
- "exit", "exit-hook", "expand-control", "expand-control-bounds", "expand-control-hop", "expand-control-jitter",
- "expand-control-length", "expand-control-ramp", "expand-control?", "explode-sf2", "exponentially-weighted-moving-average", "expsnd",
- "expsrc", "*features*", "feedback fm", "fft", "fft-cancel", "fft-edit",
- "fft-env-edit", "fft-env-interp", "fft-log-frequency", "fft-log-magnitude", "fft-smoother", "fft-squelch",
- "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database", "file->array",
- "file->frample", "file->frample?", "file->sample", "file->sample?", "file-name", "fill!",
- "fill-polygon", "fill-rectangle", "filter", "filter-channel", "filter-control-coeffs", "filter-control-envelope",
- "filter-control-in-dB", "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color", "filter-control?", "filter-fft",
- "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb", "filtered-comb-bank",
- "filtered-comb-bank?", "filtered-comb?", "find-dialog", "find-mark", "find-mix", "find-sound",
- "finfo", "finish-progress-report", "fir-filter", "fir-filter?", "firmant", "firmant?",
- "fit-selection-between-marks", "flatten-partials", "float-vector", "float-vector*", "float-vector+", "float-vector->channel",
- "float-vector->list", "float-vector->string", "float-vector-abs!", "float-vector-add!", "float-vector-copy", "float-vector-equal?",
- "float-vector-fill!", "float-vector-length", "float-vector-max", "float-vector-min", "float-vector-move!", "float-vector-multiply!",
- "float-vector-offset!", "float-vector-peak", "float-vector-polynomial", "float-vector-ref", "float-vector-reverse!", "float-vector-scale!",
- "float-vector-set!", "float-vector-subseq", "float-vector-subtract!", "float-vector?", "flocsig", "flocsig?",
- "flute model", "fm-bell", "fm-drum", "fm-noise", "fm-parallel-component", "fm-talker",
- "fm-trumpet", "fm-violin", "fm-voice", "fmssb", "fmssb?", "focus-widget",
- "FOF synthesis", "fofins", "for-each-child", "for-each-sound-file", "Forbidden Planet", "foreground-color",
- "forget-region", "formant", "formant-bank", "formant-bank?", "formant?", "format",
- "fp", "fractional-fourier-transform", "frample->file", "frample->file?", "frample->frample", "framples",
- "free-player", "free-sampler", "freeverb", "fullmix", "funclet", "gaussian-distribution",
- "gc-off", "gc-on", "gensym", "gensym?", "gl-graph->ps", "glSpectrogram",
- "goertzel", "goto-listener-end", "grani", "granulate", "granulate?", "granulated-sound-interp",
- "graph", "graph->ps", "graph-color", "graph-cursor", "graph-data", "graph-hook",
- "graph-style", "graphic equalizer", "graphs-horizontal", "green-noise", "green-noise-interp", "green-noise-interp?",
- "green-noise?", "grid-density", "harmonicizer", "Hartley transform", "hash-table", "hash-table*",
- "hash-table-entries", "hash-table-ref", "hash-table-set!", "hash-table?", "header-type", "hello-dentist",
- "help-dialog", "help-hook", "hide-widget", "highlight-color", "hilbert-transform", "hook-functions",
- "hook-member", "html", "html-dir", "html-program", "hz->radians", "iir-filter",
- "iir-filter?", "in", "in-any", "ina", "inb", "info-dialog",
- "init-ladspa", "initial-beg", "initial-dur", "initial-graph-hook", "inlet", "insert-channel",
- "insert-file-dialog", "insert-region", "insert-sample", "insert-samples", "insert-selection", "insert-silence",
- "insert-sound", "int-vector", "int-vector-ref", "int-vector-set!", "int-vector?", "integer->colormap",
- "integer->mark", "integer->mix", "integer->region", "integer->sound", "integer->transform", "integrate-envelope",
- "invert-filter", "iterate", "iterator-at-end?", "iterator-sequence", "iterator?", "izcos",
- "izcos?", "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?", "j2cos",
- "j2cos?", "jc-reverb", "jjcos", "jjcos?", "jncos", "jncos?",
- "jpcos", "jpcos?", "just-sounds", "jycos", "jycos?", "k2cos",
- "k2cos?", "k2sin", "k2sin?", "k2ssb", "k2ssb?", "k3sin",
- "k3sin?", "kalman-filter-channel", "key", "key-binding", "key-press-hook", "krksin",
- "krksin?", "ladspa-descriptor", "ladspa-dir", "lambda*", "lbj-piano", "left-sample",
- "let->list", "let-ref", "let-set!", "let?", "linear->db", "linear-src-channel",
+ "*#readers*", "abcos", "abcos?", "abort", "absin", "absin?",
+ "add-amp-controls", "add-colormap", "add-delete-option", "add-directory-to-view-files-list", "add-file-filter", "add-file-sorter",
+ "add-file-to-view-files-list", "add-mark", "add-mark-pane", "add-player", "add-sound-file-extension", "add-source-file-extension",
+ "add-to-main-menu", "add-to-menu", "add-tooltip", "add-transform", "additive synthesis", "adjustable-sawtooth-wave",
+ "adjustable-sawtooth-wave?", "adjustable-square-wave", "adjustable-square-wave?", "adjustable-triangle-wave", "adjustable-triangle-wave?", "after-apply-controls-hook",
+ "after-edit-hook", "after-graph-hook", "after-lisp-graph-hook", "after-open-hook", "after-save-as-hook", "after-save-state-hook",
+ "after-transform-hook", "all-chans", "all-pass", "all-pass-bank", "all-pass-bank?", "all-pass?",
+ "amp-control", "amp-control-bounds", "amplitude-modulate", "analyse-ladspa", "anoi", "any-env-channel",
+ "any-random", "apply-controls", "apply-ladspa", "aritable?", "arity", "array->file",
+ "array-interp", "as-one-edit", "ask-about-unsaved-edits", "ask-before-overwrite", "asyfm-I", "asyfm-J",
+ "asyfm?", "asymmetric-fm", "asymmetric-fm?", "auto-resize", "auto-save", "auto-update",
+ "auto-update-interval", "autocorrelate", "axis-color", "axis-info", "axis-label-font", "axis-numbers-font",
+ "background-gradient", "bad-header-hook", "bagpipe", "basic-color", "beats-per-measure", "beats-per-minute",
+ "before-close-hook", "before-exit-hook", "before-save-as-hook", "before-save-state-hook", "before-transform-hook", "bes-j0",
+ "bess", "bess?", "bessel filters", "bigbird", "bignum", "bignum?",
+ "binary files", "bind-key", "bird", "blackman", "blackman4-env-channel", "blackman?",
+ "bold-peaks-font", "break", "brown-noise", "brown-noise?", "butterworth filters", "byte-vector",
+ "byte-vector?", "c-define", "c-g?", "c-object?", "c-pointer", "c-pointer?",
+ "call-with-exit", "canter", "cascade->canonical", "catch", "cellon", "chain-dsps",
+ "channel->vct", "channel-amp-envs", "channel-data", "channel-envelope", "channel-polynomial", "channel-properties",
+ "channel-property", "channel-rms", "channel-style", "channel-sync", "channel-widgets", "channels",
+ "channels-equal?", "channels=?", "chans", "char-position", "cheby-hka", "chebyshev filters",
+ "check-mix-tags", "chordalize", "chorus", "clean-channel", "clean-sound", "clear-listener",
+ "clip-hook", "clipping", "clm-channel", "clm-expsrc", "close-hook", "close-sound",
+ "color->list", "color-cutoff", "color-hook", "color-inverted", "color-mixes", "color-orientation-dialog",
+ "color-scale", "color?", "colormap", "colormap->integer", "colormap-name", "colormap-ref",
+ "colormap-size", "colormap?", "comb", "comb-bank", "comb-bank?", "comb?",
+ "combined-data-color", "comment", "complexify", "concatenate-envelopes", "constant?", "continuation?",
+ "continue-frample->file", "continue-sample->file", "contrast-channel", "contrast-control", "contrast-control-amp", "contrast-control-bounds",
+ "contrast-control?", "contrast-enhancement", "contrast-sound", "controls->channel", "convolution", "convolution reverb",
+ "convolve", "convolve-files", "convolve-selection-with", "convolve-with", "convolve?", "copy",
+ "copy-context", "copy-sampler", "correlate", "coverlet", "cross-fade (amplitude)", "cross-fade (frequency domain)",
+ "cross-synthesis", "curlet", "current-font", "cursor", "cursor-color", "cursor-context",
+ "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style", "cursor-update-interval", "cutlet",
+ "cyclic-sequences", "dac-combines-channels", "dac-size", "data-color", "data-location", "data-size",
+ "db->linear", "default-output-chans", "default-output-header-type", "default-output-sample-type", "default-output-srate", "defgenerator",
+ "define*", "define-constant", "define-envelope", "define-expansion", "define-macro", "define-macro*",
+ "define-selection-via-marks", "defined?", "degrees->radians", "delay", "delay-channel-mixes", "delay-tick",
+ "delay?", "delete-colormap", "delete-file-filter", "delete-file-sorter", "delete-mark", "delete-marks",
+ "delete-sample", "delete-samples", "delete-samples-and-smooth", "delete-selection", "delete-selection-and-smooth", "delete-transform",
+ "describe-hook", "describe-mark", "dht", "dialog-widgets", "dilambda", "disable-control-panel",
+ "display-bark-fft", "display-correlation", "display-db", "display-edits", "display-energy", "dissolve-fade",
+ "dither-channel", "dither-sound", "dolph", "dot-product", "dot-size", "down-oct",
+ "draw-axes", "draw-dot", "draw-dots", "draw-line", "draw-lines", "draw-mark-hook",
+ "draw-mix-hook", "draw-string", "drone", "drop sites", "drop-hook", "during-open-hook",
+ "edit-fragment", "edit-header-dialog", "edit-hook", "edit-list->function", "edit-position", "edit-properties",
+ "edit-property", "edit-tree", "edits", "edot-product", "effects-hook", "elliptic filters",
+ "env", "env-any", "env-channel", "env-channel-with-base", "env-expt-channel", "env-interp",
+ "env-mixes", "env-selection", "env-sound", "env-sound-interp", "env-squared-channel", "env?",
+ "enved-base", "enved-clip?", "enved-dialog", "enved-envelope", "enved-filter", "enved-filter-order",
+ "enved-hook", "enved-in-dB", "enved-power", "enved-style", "enved-target", "enved-wave?",
+ "enved-waveform-color", "envelope-interp", "enveloped-mix", "eoddcos", "eoddcos?", "eps-bottom-margin",
+ "eps-file", "eps-left-margin", "eps-size", "ercos", "ercos?", "*error-hook*",
+ "erssb", "erssb?", "even-multiple", "even-weight", "every-sample?", "exit",
+ "exit-hook", "expand-control", "expand-control-bounds", "expand-control-hop", "expand-control-jitter", "expand-control-length",
+ "expand-control-ramp", "expand-control?", "explode-sf2", "exponentially-weighted-moving-average", "expsnd", "expsrc",
+ "*features*", "feedback fm", "fft", "fft-cancel", "fft-edit", "fft-env-edit",
+ "fft-env-interp", "fft-log-frequency", "fft-log-magnitude", "fft-smoother", "fft-squelch", "fft-window",
+ "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database", "file->array", "file->frample",
+ "file->frample?", "file->sample", "file->sample?", "file-name", "fill!", "fill-polygon",
+ "fill-rectangle", "filter", "filter-channel", "filter-control-coeffs", "filter-control-envelope", "filter-control-in-dB",
+ "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color", "filter-control?", "filter-fft", "filter-selection",
+ "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb", "filtered-comb-bank", "filtered-comb-bank?",
+ "filtered-comb?", "find-dialog", "find-mark", "find-mix", "find-sound", "finfo",
+ "finish-progress-report", "fir-filter", "fir-filter?", "firmant", "firmant?", "fit-selection-between-marks",
+ "flatten-partials", "float-vector", "float-vector*", "float-vector+", "float-vector->channel", "float-vector->list",
+ "float-vector->string", "float-vector-abs!", "float-vector-add!", "float-vector-copy", "float-vector-equal?", "float-vector-fill!",
+ "float-vector-length", "float-vector-max", "float-vector-min", "float-vector-move!", "float-vector-multiply!", "float-vector-offset!",
+ "float-vector-peak", "float-vector-polynomial", "float-vector-ref", "float-vector-reverse!", "float-vector-scale!", "float-vector-set!",
+ "float-vector-subseq", "float-vector-subtract!", "float-vector?", "flocsig", "flocsig?", "flute model",
+ "fm-bell", "fm-drum", "fm-noise", "fm-parallel-component", "fm-talker", "fm-trumpet",
+ "fm-violin", "fm-voice", "fmssb", "fmssb?", "focus-widget", "FOF synthesis",
+ "fofins", "for-each-child", "for-each-sound-file", "Forbidden Planet", "foreground-color", "forget-region",
+ "formant", "formant-bank", "formant-bank?", "formant?", "format", "fp",
+ "fractional-fourier-transform", "frample->file", "frample->file?", "frample->frample", "framples", "free-player",
+ "free-sampler", "freeverb", "fullmix", "funclet", "gaussian-distribution", "gc-off",
+ "gc-on", "gensym", "gensym?", "gl-graph->ps", "glSpectrogram", "goertzel",
+ "goto-listener-end", "grani", "granulate", "granulate?", "granulated-sound-interp", "graph",
+ "graph->ps", "graph-color", "graph-cursor", "graph-data", "graph-hook", "graph-style",
+ "graphic equalizer", "graphs-horizontal", "green-noise", "green-noise-interp", "green-noise-interp?", "green-noise?",
+ "grid-density", "harmonicizer", "Hartley transform", "hash-table", "hash-table*", "hash-table-entries",
+ "hash-table-ref", "hash-table-set!", "hash-table?", "header-type", "hello-dentist", "help-dialog",
+ "help-hook", "hide-widget", "highlight-color", "hilbert-transform", "hook-functions", "hook-member",
+ "html", "html-dir", "html-program", "hz->radians", "iir-filter", "iir-filter?",
+ "in", "in-any", "ina", "inb", "info-dialog", "init-ladspa",
+ "initial-beg", "initial-dur", "initial-graph-hook", "inlet", "insert-channel", "insert-file-dialog",
+ "insert-region", "insert-sample", "insert-samples", "insert-selection", "insert-silence", "insert-sound",
+ "int-vector", "int-vector-ref", "int-vector-set!", "int-vector?", "integer->colormap", "integer->mark",
+ "integer->mix", "integer->region", "integer->sound", "integer->transform", "integrate-envelope", "invert-filter",
+ "iterate", "iterator-at-end?", "iterator-sequence", "iterator?", "izcos", "izcos?",
+ "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?", "j2cos", "j2cos?",
+ "jc-reverb", "jjcos", "jjcos?", "jncos", "jncos?", "jpcos",
+ "jpcos?", "just-sounds", "jycos", "jycos?", "k2cos", "k2cos?",
+ "k2sin", "k2sin?", "k2ssb", "k2ssb?", "k3sin", "k3sin?",
+ "kalman-filter-channel", "key", "key-binding", "key-press-hook", "krksin", "krksin?",
+ "ladspa-descriptor", "ladspa-dir", "lambda*", "lbj-piano", "left-sample", "let->list",
+ "let-ref", "let-set!", "let-temporarily", "let?", "linear->db", "linear-src-channel",
"lint for scheme", "lisp-graph-hook", "lisp-graph-style", "lisp-graph?", "list->float-vector", "list->vct",
"list-ladspa", "listener-click-hook", "listener-color", "listener-colorized", "listener-font", "listener-prompt",
"listener-selection", "listener-text-color", "little-endian?", "*load-hook*", "*load-path*", "locate-zero",
@@ -174,202 +174,203 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin", "nsin?",
"nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos", "nxy1cos?",
"nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin", "nxysin?",
- "object->string", "odd-multiple", "odd-weight", "offset-channel", "offset-sound", "one-pole",
- "one-pole-all-pass", "one-pole-all-pass?", "one-pole?", "one-zero", "one-zero?", "open-file-dialog",
- "open-file-dialog-directory", "open-hook", "open-next-file-in-directory", "open-raw-sound", "open-raw-sound-hook", "open-sound",
- "openlet", "openlet?", "orientation-hook", "oscil", "oscil-bank", "oscil-bank?",
- "oscil?", "out-any", "out-bank", "outa", "outlet", "*output*",
- "output-comment-hook", "overlay-rms-env", "owlet", "pad-channel", "pad-marks", "pad-sound",
- "pair-filename", "pair-line-number", "pan-mix", "pan-mix-float-vector", "partials->polynomial", "partials->wave",
- "pausing", "peak-env-dir", "peaks", "peaks-font", "phase-partials->wave", "phase-vocoder",
- "phase-vocoder?", "piano model", "pink-noise", "pink-noise?", "pins", "place-sound",
- "play", "play-arrow-size", "play-between-marks", "play-hook", "play-mixes", "play-often",
- "play-region-forever", "play-sine", "play-sines", "play-syncd-marks", "play-until-c-g", "play-with-envs",
- "player-home", "player?", "players", "playing", "pluck", "polar->rectangular",
- "polynomial", "polynomial operations", "polyoid", "polyoid-env", "polyoid?", "polyshape",
- "polyshape?", "polywave", "polywave?", "port-filename", "port-line-number", "position->x",
- "position->y", "position-color", "power-env", "pqw", "pqw-vox", "preferences-dialog",
- "previous-sample", "print-dialog", "print-length", "procedure-documentation", "procedure-setter", "procedure-signature",
- "procedure-source", "progress-report", "pulse-train", "pulse-train?", "pulsed-env", "pulsed-env?",
- "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians->degrees", "radians->hz",
- "ramp-channel", "rand", "rand-interp", "rand-interp?", "rand?", "random",
- "random-state", "random-state?", "rcos", "rcos?", "*read-error-hook*", "read-hook",
- "read-mix-sample", "read-only", "read-region-sample", "read-sample", "read-sample-with-direction", "reader-cond",
- "readin", "readin?", "rectangular->magnitudes", "rectangular->polar", "redo", "region->integer",
- "region->vct", "region-chans", "region-framples", "region-graph-style", "region-home", "region-maxamp",
- "region-maxamp-position", "region-play-list", "region-position", "region-rms", "region-sample", "region-sampler?",
- "region-srate", "region?", "regions", "remember-sound-state", "remove-clicks", "remove-from-menu",
- "replace-with-selection", "report-mark-names", "require", "reset-all-hooks", "reset-controls", "reset-listener-cursor",
- "reson", "restore-controls", "*reverb*", "reverb-control-decay", "reverb-control-feedback", "reverb-control-length",
- "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds", "reverb-control?", "reverse!",
- "reverse-by-blocks", "reverse-channel", "reverse-envelope", "reverse-selection", "reverse-sound", "revert-sound",
- "right-sample", "ring-modulate", "rk!cos", "rk!cos?", "rk!ssb", "rk!ssb?",
- "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin", "rksin?",
- "rkssb", "rkssb?", "rms", "rms, gain, balance gens", "rms-envelope", "rootlet",
- "round-interp", "round-interp?", "rssb", "rssb-interp", "rssb?", "rubber-sound",
- "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", "rxyk!sin", "rxyk!sin?",
- "rxysin", "rxysin?", "sample", "sample->file", "sample->file?", "sample-type",
- "sampler-at-end?", "sampler-home", "sampler-position", "sampler?", "samples", "samples->seconds",
- "sash-color", "save-as-dialog-auto-comment", "save-as-dialog-src", "save-controls", "save-dir", "save-edit-history",
- "save-envelopes", "save-hook", "save-listener", "save-mark-properties", "save-marks", "save-mix",
- "save-region", "save-region-dialog", "save-selection", "save-selection-dialog", "save-sound", "save-sound-as",
- "save-sound-dialog", "save-state", "save-state-file", "save-state-hook", "savitzky-golay-filter", "sawtooth-wave",
- "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope", "scale-mixes", "scale-selection-by",
- "scale-selection-to", "scale-sound", "scale-tempo", "scale-to", "scan-channel", "scanned synthesis",
- "scentroid", "scratch", "script-arg", "script-args", "search-for-click", "search-procedure",
- "seconds->samples", "select-all", "select-channel", "select-channel-hook", "select-sound", "select-sound-hook",
- "selected-channel", "selected-data-color", "selected-graph-color", "selected-sound", "selection", "selection->mix",
- "selection-chans", "selection-color", "selection-context", "selection-creates-region", "selection-framples", "selection-maxamp",
- "selection-maxamp-position", "selection-member?", "selection-members", "selection-position", "selection-rms", "selection-srate",
- "selection?", "set-samples", "short-file-name", "show-axes", "show-controls", "show-disk-space",
- "show-full-duration", "show-full-range", "show-grid", "show-indices", "show-listener", "show-marks",
- "show-mix-waveforms", "show-selection", "show-selection-transform", "show-sonogram-cursor", "show-transform-peaks", "show-widget",
- "show-y-zero", "silence-all-mixes", "silence-mixes", "sinc-train", "sinc-train?", "sinc-width",
- "sine-env-channel", "sine-ramp", "singer", "smooth-channel", "smooth-selection", "smooth-sound",
- "SMS synthesis", "snap-mark-to-beat", "snap-marks", "snap-mix-to-beat", "snd->sample", "snd->sample?",
- "snd-color", "snd-error", "snd-error-hook", "snd-font", "snd-gcs", "snd-help",
- "snd-hooks", "*snd-opened-sound*", "snd-print", "snd-spectrum", "snd-tempnam", "snd-url",
- "snd-urls", "snd-version", "snd-warning", "snd-warning-hook", "sndwarp", "sort!",
- "sound->amp-env", "sound->integer", "sound-file-extensions", "sound-file?", "sound-files-in-directory", "sound-interp",
- "sound-loop-info", "sound-properties", "sound-property", "sound-widgets", "sound?", "soundfont-info",
- "sounds", "sounds->segment-data", "spectra", "spectral interpolation", "spectral-polynomial", "spectro-hop",
- "spectro-x-angle", "spectro-x-scale", "spectro-y-angle", "spectro-y-scale", "spectro-z-angle", "spectro-z-scale",
- "spectrum", "spectrum->coeffs", "spectrum-end", "spectrum-start", "speed-control", "speed-control-bounds",
- "speed-control-style", "speed-control-tones", "spot-freq", "square-wave", "square-wave?", "squelch-update",
- "squelch-vowels", "srate", "src", "src-channel", "src-duration", "src-fit-envelope",
- "src-mixes", "src-selection", "src-sound", "src?", "ssb-am", "ssb-am?",
- "ssb-bank", "ssb-bank-env", "ssb-fm", "start-dac", "start-playing", "start-playing-hook",
- "start-playing-selection-hook", "start-progress-report", "status-report", "stdin-prompt", "stereo->mono", "stereo-flute",
- "stop-player", "stop-playing", "stop-playing-hook", "stop-playing-selection-hook", "stretch-envelope", "stretch-sound-via-dft",
- "string-position", "sublet", "superimpose-ffts", "swap-channels", "swap-selection-channels", "symbol->dynamic-value",
- "symbol->value", "symbol-access", "symbol-table", "sync", "sync-everything", "sync-max",
- "sync-style", "syncd-marks", "syncd-mixes", "syncup", "table-lookup", "table-lookup?",
- "tanhsin", "tanhsin?", "tap", "tap?", "telephone", "temp-dir",
- "text-focus-color", "time-graph-style", "time-graph-type", "time-graph?", "times->samples", "tiny-font",
- "touch-tone", "trace", "tracking-cursor-style", "transform->integer", "transform->vct", "transform-dialog",
- "transform-framples", "transform-graph-style", "transform-graph-type", "transform-graph?", "transform-normalization", "transform-sample",
- "transform-size", "transform-type", "transform?", "transpose-mixes", "triangle-wave", "triangle-wave?",
- "tubebell", "tubular bell", "two-pole", "two-pole?", "two-tab", "two-zero",
- "two-zero?", "unbind-key", "*unbound-variable-hook*", "unclip-channel", "undo", "undo-hook",
- "unlet", "unselect-all", "update-graphs", "update-hook", "update-lisp-graph", "update-sound",
- "update-time-graph", "update-transform-graph", "upon-save-yourself", "user interface extensions", "variable-display", "variable-graph?",
- "varlet", "vct", "vct*", "vct+", "vct->channel", "vct->list",
- "vct->string", "vct->vector", "vct-abs!", "vct-add!", "vct-copy", "vct-equal?",
- "vct-fill!", "vct-length", "vct-max", "vct-min", "vct-move!", "vct-multiply!",
- "vct-offset!", "vct-peak", "vct-ref", "vct-reverse!", "vct-scale!", "vct-set!",
- "vct-subseq", "vct-subtract!", "vct?", "vector->vct", "vibrating-uniform-circular-string", "view-files-amp",
- "view-files-amp-env", "view-files-dialog", "view-files-files", "view-files-select-hook", "view-files-selected-files", "view-files-sort",
- "view-files-speed", "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog", "view-sound", "voice physical model",
- "voiced->unvoiced", "volterra-filter", "vox", "wave-train", "wave-train?", "wavelet-type",
- "waveshaping voice", "wavo-hop", "wavo-trace", "weighted-moving-average", "widget-position", "widget-size",
- "widget-text", "window-height", "window-samples", "window-width", "window-x", "window-y",
- "with-background-processes", "with-baffle", "with-file-monitor", "with-gl", "with-inset-graph", "with-interrupts",
- "with-let", "with-local-hook", "with-menu-icons", "with-mix-tags", "with-pointer-focus", "with-relative-panes",
- "with-smpte-label", "with-sound", "with-temporary-selection", "with-toolbar", "with-tooltips", "with-tracking-cursor",
- "with-verbose-cursor", "x->position", "x-axis-label", "x-axis-style", "x-bounds", "x-position-slider",
- "x-zoom-slider", "xb-open", "xramp-channel", "y->position", "y-axis-label", "y-bounds",
- "y-position-slider", "y-zoom-slider", "z-transform", "zecho", "zero+", "zero-pad",
- "zero-phase", "zip-sound", "zipper", "zoom-color", "zoom-focus-style"};
+ "object->let", "object->string", "odd-multiple", "odd-weight", "offset-channel", "offset-sound",
+ "one-pole", "one-pole-all-pass", "one-pole-all-pass?", "one-pole?", "one-zero", "one-zero?",
+ "open-file-dialog", "open-file-dialog-directory", "open-hook", "open-next-file-in-directory", "open-raw-sound", "open-raw-sound-hook",
+ "open-sound", "openlet", "openlet?", "orientation-hook", "oscil", "oscil-bank",
+ "oscil-bank?", "oscil?", "out-any", "out-bank", "outa", "outlet",
+ "*output*", "output-comment-hook", "overlay-rms-env", "owlet", "pad-channel", "pad-marks",
+ "pad-sound", "pair-filename", "pair-line-number", "pan-mix", "pan-mix-float-vector", "partials->polynomial",
+ "partials->wave", "pausing", "peak-env-dir", "peaks", "peaks-font", "phase-partials->wave",
+ "phase-vocoder", "phase-vocoder?", "piano model", "pink-noise", "pink-noise?", "pins",
+ "place-sound", "play", "play-arrow-size", "play-between-marks", "play-hook", "play-mixes",
+ "play-often", "play-region-forever", "play-sine", "play-sines", "play-syncd-marks", "play-until-c-g",
+ "play-with-envs", "player-home", "player?", "players", "playing", "pluck",
+ "polar->rectangular", "polynomial", "polynomial operations", "polyoid", "polyoid-env", "polyoid?",
+ "polyshape", "polyshape?", "polywave", "polywave?", "port-filename", "port-line-number",
+ "position->x", "position->y", "position-color", "power-env", "pqw", "pqw-vox",
+ "preferences-dialog", "previous-sample", "print-dialog", "print-length", "procedure-documentation", "procedure-setter",
+ "procedure-signature", "procedure-source", "progress-report", "pulse-train", "pulse-train?", "pulsed-env",
+ "pulsed-env?", "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians->degrees",
+ "radians->hz", "ramp-channel", "rand", "rand-interp", "rand-interp?", "rand?",
+ "random", "random-state", "random-state?", "rcos", "rcos?", "*read-error-hook*",
+ "read-hook", "read-mix-sample", "read-only", "read-region-sample", "read-sample", "read-sample-with-direction",
+ "reader-cond", "readin", "readin?", "rectangular->magnitudes", "rectangular->polar", "redo",
+ "region->integer", "region->vct", "region-chans", "region-framples", "region-graph-style", "region-home",
+ "region-maxamp", "region-maxamp-position", "region-play-list", "region-position", "region-rms", "region-sample",
+ "region-sampler?", "region-srate", "region?", "regions", "remember-sound-state", "remove-clicks",
+ "remove-from-menu", "replace-with-selection", "report-mark-names", "require", "reset-all-hooks", "reset-controls",
+ "reset-listener-cursor", "reson", "restore-controls", "*reverb*", "reverb-control-decay", "reverb-control-feedback",
+ "reverb-control-length", "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds", "reverb-control?",
+ "reverse!", "reverse-by-blocks", "reverse-channel", "reverse-envelope", "reverse-selection", "reverse-sound",
+ "revert-sound", "right-sample", "ring-modulate", "rk!cos", "rk!cos?", "rk!ssb",
+ "rk!ssb?", "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin",
+ "rksin?", "rkssb", "rkssb?", "rms", "rms, gain, balance gens", "rms-envelope",
+ "rootlet", "round-interp", "round-interp?", "rssb", "rssb-interp", "rssb?",
+ "rubber-sound", "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", "rxyk!sin",
+ "rxyk!sin?", "rxysin", "rxysin?", "sample", "sample->file", "sample->file?",
+ "sample-type", "sampler-at-end?", "sampler-home", "sampler-position", "sampler?", "samples",
+ "samples->seconds", "sash-color", "save-as-dialog-auto-comment", "save-as-dialog-src", "save-controls", "save-dir",
+ "save-edit-history", "save-envelopes", "save-hook", "save-listener", "save-mark-properties", "save-marks",
+ "save-mix", "save-region", "save-region-dialog", "save-selection", "save-selection-dialog", "save-sound",
+ "save-sound-as", "save-sound-dialog", "save-state", "save-state-file", "save-state-hook", "savitzky-golay-filter",
+ "sawtooth-wave", "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope", "scale-mixes",
+ "scale-selection-by", "scale-selection-to", "scale-sound", "scale-tempo", "scale-to", "scan-channel",
+ "scanned synthesis", "scentroid", "scratch", "script-arg", "script-args", "search-for-click",
+ "search-procedure", "seconds->samples", "select-all", "select-channel", "select-channel-hook", "select-sound",
+ "select-sound-hook", "selected-channel", "selected-data-color", "selected-graph-color", "selected-sound", "selection",
+ "selection->mix", "selection-chans", "selection-color", "selection-context", "selection-creates-region", "selection-framples",
+ "selection-maxamp", "selection-maxamp-position", "selection-member?", "selection-members", "selection-position", "selection-rms",
+ "selection-srate", "selection?", "set-samples", "short-file-name", "show-axes", "show-controls",
+ "show-disk-space", "show-full-duration", "show-full-range", "show-grid", "show-indices", "show-listener",
+ "show-marks", "show-mix-waveforms", "show-selection", "show-selection-transform", "show-sonogram-cursor", "show-transform-peaks",
+ "show-widget", "show-y-zero", "silence-all-mixes", "silence-mixes", "sinc-train", "sinc-train?",
+ "sinc-width", "sine-env-channel", "sine-ramp", "singer", "smooth-channel", "smooth-selection",
+ "smooth-sound", "SMS synthesis", "snap-mark-to-beat", "snap-marks", "snap-mix-to-beat", "snd->sample",
+ "snd->sample?", "snd-color", "snd-error", "snd-error-hook", "snd-font", "snd-gcs",
+ "snd-help", "snd-hooks", "*snd-opened-sound*", "snd-print", "snd-spectrum", "snd-tempnam",
+ "snd-url", "snd-urls", "snd-version", "snd-warning", "snd-warning-hook", "sndwarp",
+ "sort!", "sound->amp-env", "sound->integer", "sound-file-extensions", "sound-file?", "sound-files-in-directory",
+ "sound-interp", "sound-loop-info", "sound-properties", "sound-property", "sound-widgets", "sound?",
+ "soundfont-info", "sounds", "sounds->segment-data", "spectra", "spectral interpolation", "spectral-polynomial",
+ "spectro-hop", "spectro-x-angle", "spectro-x-scale", "spectro-y-angle", "spectro-y-scale", "spectro-z-angle",
+ "spectro-z-scale", "spectrum", "spectrum->coeffs", "spectrum-end", "spectrum-start", "speed-control",
+ "speed-control-bounds", "speed-control-style", "speed-control-tones", "spot-freq", "square-wave", "square-wave?",
+ "squelch-update", "squelch-vowels", "srate", "src", "src-channel", "src-duration",
+ "src-fit-envelope", "src-mixes", "src-selection", "src-sound", "src?", "ssb-am",
+ "ssb-am?", "ssb-bank", "ssb-bank-env", "ssb-fm", "start-dac", "start-playing",
+ "start-playing-hook", "start-playing-selection-hook", "start-progress-report", "status-report", "stdin-prompt", "stereo->mono",
+ "stereo-flute", "stop-player", "stop-playing", "stop-playing-hook", "stop-playing-selection-hook", "stretch-envelope",
+ "stretch-sound-via-dft", "string->byte-vector", "string-position", "sublet", "superimpose-ffts", "swap-channels",
+ "swap-selection-channels", "symbol->dynamic-value", "symbol->value", "symbol-access", "symbol-table", "sync",
+ "sync-everything", "sync-max", "sync-style", "syncd-marks", "syncd-mixes", "syncup",
+ "table-lookup", "table-lookup?", "tanhsin", "tanhsin?", "tap", "tap?",
+ "telephone", "temp-dir", "text-focus-color", "time-graph-style", "time-graph-type", "time-graph?",
+ "times->samples", "tiny-font", "touch-tone", "trace", "tracking-cursor-style", "transform->integer",
+ "transform->vct", "transform-dialog", "transform-framples", "transform-graph-style", "transform-graph-type", "transform-graph?",
+ "transform-normalization", "transform-sample", "transform-size", "transform-type", "transform?", "transpose-mixes",
+ "triangle-wave", "triangle-wave?", "tubebell", "tubular bell", "two-pole", "two-pole?",
+ "two-tab", "two-zero", "two-zero?", "unbind-key", "*unbound-variable-hook*", "unclip-channel",
+ "undo", "undo-hook", "unlet", "unselect-all", "update-graphs", "update-hook",
+ "update-lisp-graph", "update-sound", "update-time-graph", "update-transform-graph", "upon-save-yourself", "user interface extensions",
+ "variable-display", "variable-graph?", "varlet", "vct", "vct*", "vct+",
+ "vct->channel", "vct->list", "vct->string", "vct->vector", "vct-abs!", "vct-add!",
+ "vct-copy", "vct-equal?", "vct-fill!", "vct-length", "vct-max", "vct-min",
+ "vct-move!", "vct-multiply!", "vct-offset!", "vct-peak", "vct-ref", "vct-reverse!",
+ "vct-scale!", "vct-set!", "vct-subseq", "vct-subtract!", "vct?", "vector->vct",
+ "vibrating-uniform-circular-string", "view-files-amp", "view-files-amp-env", "view-files-dialog", "view-files-files", "view-files-select-hook",
+ "view-files-selected-files", "view-files-sort", "view-files-speed", "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog",
+ "view-sound", "voice physical model", "voiced->unvoiced", "volterra-filter", "vox", "wave-train",
+ "wave-train?", "wavelet-type", "waveshaping voice", "wavo-hop", "wavo-trace", "weighted-moving-average",
+ "widget-position", "widget-size", "widget-text", "window-height", "window-samples", "window-width",
+ "window-x", "window-y", "with-background-processes", "with-baffle", "with-file-monitor", "with-gl",
+ "with-inset-graph", "with-interrupts", "with-let", "with-local-hook", "with-menu-icons", "with-mix-tags",
+ "with-pointer-focus", "with-relative-panes", "with-smpte-label", "with-sound", "with-temporary-selection", "with-toolbar",
+ "with-tooltips", "with-tracking-cursor", "with-verbose-cursor", "x->position", "x-axis-label", "x-axis-style",
+ "x-bounds", "x-position-slider", "x-zoom-slider", "xb-open", "xramp-channel", "y->position",
+ "y-axis-label", "y-bounds", "y-position-slider", "y-zoom-slider", "z-transform", "zecho",
+ "zero+", "zero-pad", "zero-phase", "zip-sound", "zipper", "zoom-color",
+ "zoom-focus-style"};
#endif
#if HAVE_RUBY
static const char *help_names[HELP_NAMES_SIZE] = {
- "*#readers*", "2byte_vector", "abcos", "abcos?", "abort", "absin",
- "absin?", "add_amp_controls", "add_colormap", "add_delete_option", "add_directory_to_view_files_list", "add_file_filter",
- "add_file_sorter", "add_file_to_view_files_list", "add_mark", "add_mark_pane", "add_player", "add_sound_file_extension",
- "add_source_file_extension", "add_to_main_menu", "add_to_menu", "add_tooltip", "add_transform", "additive_synthesis",
- "adjustable_sawtooth_wave", "adjustable_sawtooth_wave?", "adjustable_square_wave", "adjustable_square_wave?", "adjustable_triangle_wave", "adjustable_triangle_wave?",
- "after_apply_controls_hook", "after_edit_hook", "after_graph_hook", "after_lisp_graph_hook", "after_open_hook", "after_save_as_hook",
- "after_save_state_hook", "after_transform_hook", "all_chans", "all_pass", "all_pass_bank", "all_pass_bank?",
- "all_pass?", "amp_control", "amp_control_bounds", "amplitude_modulate", "analyse_ladspa", "anoi",
- "any_env_channel", "any_random", "apply_controls", "apply_ladspa", "aritable?", "arity",
- "array2file", "array_interp", "as_one_edit", "ask_about_unsaved_edits", "ask_before_overwrite", "asyfm_I",
- "asyfm_J", "asyfm?", "asymmetric_fm", "asymmetric_fm?", "auto_resize", "auto_save",
- "auto_update", "auto_update_interval", "autocorrelate", "axis_color", "axis_info", "axis_label_font",
- "axis_numbers_font", "background_gradient", "bad_header_hook", "bagpipe", "basic_color", "beats_per_measure",
- "beats_per_minute", "before_close_hook", "before_exit_hook", "before_save_as_hook", "before_save_state_hook", "before_transform_hook",
- "bes_j0", "bess", "bess?", "bessel_filters", "bigbird", "bignum",
- "bignum?", "binary_files", "bind_key", "bird", "blackman", "blackman4_env_channel",
- "blackman?", "bold_peaks_font", "break", "brown_noise", "brown_noise?", "butterworth_filters",
- "byte_vector", "byte_vector?", "c_define", "c_g?", "c_object?", "c_pointer",
- "c_pointer?", "call_with_exit", "canter", "cascade2canonical", "catch", "cellon",
- "chain_dsps", "channel2vct", "channel_amp_envs", "channel_data", "channel_envelope", "channel_polynomial",
- "channel_properties", "channel_property", "channel_rms", "channel_style", "channel_sync", "channel_widgets",
- "channels", "channels_equal?", "channels_?", "chans", "char_position", "cheby_hka",
- "chebyshev_filters", "check_mix_tags", "chordalize", "chorus", "clean_channel", "clean_sound",
- "clear_listener", "clip_hook", "clipping", "clm_channel", "clm_expsrc", "close_hook",
- "close_sound", "color2list", "color_cutoff", "color_hook", "color_inverted", "color_mixes",
- "color_orientation_dialog", "color_scale", "color?", "colormap", "colormap2integer", "colormap_name",
- "colormap_ref", "colormap_size", "colormap?", "comb", "comb_bank", "comb_bank?",
- "comb?", "combined_data_color", "comment", "complexify", "concatenate_envelopes", "constant?",
- "continuation?", "continue_frample2file", "continue_sample2file", "contrast_channel", "contrast_control", "contrast_control_amp",
- "contrast_control_bounds", "contrast_control?", "contrast_enhancement", "contrast_sound", "controls2channel", "convolution",
- "convolution_reverb", "convolve", "convolve_files", "convolve_selection_with", "convolve_with", "convolve?",
- "copy", "Copy_context", "copy_sampler", "correlate", "coverlet", "cross_fade__amplitude_",
- "cross_fade__frequency_domain_", "cross_synthesis", "curlet", "current_font", "cursor", "cursor_color",
- "Cursor_context", "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style", "cursor_update_interval",
- "cutlet", "cyclic_sequences", "dac_combines_channels", "dac_size", "data_color", "data_location",
- "data_size", "db2linear", "default_output_chans", "default_output_header_type", "default_output_sample_type", "default_output_srate",
- "defgenerator", "define_", "define_constant", "define_envelope", "define_expansion", "define_macro",
- "define_macro_", "define_selection_via_marks", "defined?", "degrees2radians", "delay", "delay_channel_mixes",
- "delay_tick", "delay?", "delete_colormap", "delete_file_filter", "delete_file_sorter", "delete_mark",
- "delete_marks", "delete_sample", "delete_samples", "delete_samples_and_smooth", "delete_selection", "delete_selection_and_smooth",
- "delete_transform", "describe_hook", "describe_mark", "dht", "dialog_widgets", "dilambda",
- "disable_control_panel", "display_bark_fft", "display_correlation", "display_db", "display_edits", "display_energy",
- "dissolve_fade", "dither_channel", "dither_sound", "dolph", "dot_product", "dot_size",
- "down_oct", "draw_axes", "draw_dot", "draw_dots", "draw_line", "draw_lines",
- "draw_mark_hook", "draw_mix_hook", "draw_string", "drone", "drop_sites", "drop_hook",
- "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook", "edit_list2function", "edit_position",
- "edit_properties", "edit_property", "edit_tree", "edits", "edot_product", "effects_hook",
- "elliptic_filters", "env", "env_any", "env_channel", "env_channel_with_base", "env_expt_channel",
- "env_interp", "env_mixes", "env_selection", "env_sound", "env_sound_interp", "env_squared_channel",
- "env?", "enved_base", "enved_clip?", "enved_dialog", "enved_envelope", "enved_filter",
- "enved_filter_order", "enved_hook", "enved_in_dB", "enved_power", "enved_style", "enved_target",
- "enved_wave?", "enved_waveform_color", "envelope_interp", "enveloped_mix", "eoddcos", "eoddcos?",
- "eps_bottom_margin", "eps_file", "eps_left_margin", "eps_size", "ercos", "ercos?",
- "_error_hook_", "erssb", "erssb?", "even_multiple", "even_weight", "every_sample?",
- "exit", "exit_hook", "expand_control", "expand_control_bounds", "expand_control_hop", "expand_control_jitter",
- "expand_control_length", "expand_control_ramp", "expand_control?", "explode_sf2", "exponentially_weighted_moving_average", "expsnd",
- "expsrc", "_features_", "feedback_fm", "fft", "fft_cancel", "fft_edit",
- "fft_env_edit", "fft_env_interp", "fft_log_frequency", "fft_log_magnitude", "fft_smoother", "fft_squelch",
- "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database", "file2array",
- "file2frample", "file2frample?", "file2sample", "file2sample?", "file_name", "fill!",
- "fill_polygon", "fill_rectangle", "filter", "filter_channel", "filter_control_coeffs", "filter_control_envelope",
- "filter_control_in_dB", "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color", "filter_control?", "filter_fft",
- "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb", "filtered_comb_bank",
- "filtered_comb_bank?", "filtered_comb?", "find_dialog", "find_mark", "find_mix", "find_sound",
- "finfo", "finish_progress_report", "fir_filter", "fir_filter?", "firmant", "firmant?",
- "fit_selection_between_marks", "flatten_partials", "float_vector", "float-vector_multiply", "float-vector_add", "float_vector2channel",
- "float_vector2list", "float_vector2string", "float_vector_abs!", "float_vector_add!", "float_vector_copy", "float_vector_equal?",
- "float_vector_fill!", "float_vector_length", "float_vector_max", "float_vector_min", "float_vector_move!", "float_vector_multiply!",
- "float_vector_offset!", "float_vector_peak", "float_vector_polynomial", "float_vector_ref", "float_vector_reverse!", "float_vector_scale!",
- "float_vector_set!", "float_vector_subseq", "float_vector_subtract!", "float_vector?", "flocsig", "flocsig?",
- "flute_model", "fm_bell", "fm_drum", "fm_noise", "fm_parallel_component", "fm_talker",
- "fm_trumpet", "fm_violin", "fm_voice", "fmssb", "fmssb?", "focus_widget",
- "FOF_synthesis", "fofins", "for_each_child", "for_each_sound_file", "Forbidden_Planet", "foreground_color",
- "forget_region", "formant", "formant_bank", "formant_bank?", "formant?", "format",
- "fp", "fractional_fourier_transform", "frample2file", "frample2file?", "frample2frample", "framples",
- "free_player", "free_sampler", "freeverb", "fullmix", "funclet", "gaussian_distribution",
- "gc_off", "gc_on", "gensym", "gensym?", "gl_graph2ps", "glSpectrogram",
- "goertzel", "goto_listener_end", "grani", "granulate", "granulate?", "granulated_sound_interp",
- "graph", "graph2ps", "graph_color", "graph_cursor", "graph_data", "graph_hook",
- "graph_style", "graphic_equalizer", "graphs_horizontal", "green_noise", "green_noise_interp", "green_noise_interp?",
- "green_noise?", "grid_density", "harmonicizer", "Hartley_transform", "hash_table", "hash_table_",
- "hash_table_entries", "hash_table_ref", "hash_table_set!", "hash_table?", "header_type", "hello_dentist",
- "help_dialog", "help_hook", "hide_widget", "highlight_color", "hilbert_transform", "hook_functions",
- "hook_member", "html", "html_dir", "html_program", "hz2radians", "iir_filter",
- "iir_filter?", "call_in", "in_any", "ina", "inb", "info_dialog",
- "init_ladspa", "initial_beg", "initial_dur", "initial_graph_hook", "inlet", "insert_channel",
- "insert_file_dialog", "insert_region", "insert_sample", "insert_samples", "insert_selection", "insert_silence",
- "insert_sound", "int_vector", "int_vector_ref", "int_vector_set!", "int_vector?", "integer2colormap",
- "integer2mark", "integer2mix", "integer2region", "integer2sound", "integer2transform", "integrate_envelope",
- "invert_filter", "iterate", "iterator_at_end?", "iterator_sequence", "iterator?", "izcos",
- "izcos?", "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?", "j2cos",
- "j2cos?", "jc_reverb", "jjcos", "jjcos?", "jncos", "jncos?",
- "jpcos", "jpcos?", "just_sounds", "jycos", "jycos?", "k2cos",
- "k2cos?", "k2sin", "k2sin?", "k2ssb", "k2ssb?", "k3sin",
- "k3sin?", "kalman_filter_channel", "key", "key_binding", "key_press_hook", "krksin",
- "krksin?", "ladspa_descriptor", "ladspa_dir", "lambda_", "lbj_piano", "left_sample",
- "let2list", "let_ref", "let_set!", "let?", "linear2db", "linear_src_channel",
+ "*#readers*", "abcos", "abcos?", "abort", "absin", "absin?",
+ "add_amp_controls", "add_colormap", "add_delete_option", "add_directory_to_view_files_list", "add_file_filter", "add_file_sorter",
+ "add_file_to_view_files_list", "add_mark", "add_mark_pane", "add_player", "add_sound_file_extension", "add_source_file_extension",
+ "add_to_main_menu", "add_to_menu", "add_tooltip", "add_transform", "additive_synthesis", "adjustable_sawtooth_wave",
+ "adjustable_sawtooth_wave?", "adjustable_square_wave", "adjustable_square_wave?", "adjustable_triangle_wave", "adjustable_triangle_wave?", "after_apply_controls_hook",
+ "after_edit_hook", "after_graph_hook", "after_lisp_graph_hook", "after_open_hook", "after_save_as_hook", "after_save_state_hook",
+ "after_transform_hook", "all_chans", "all_pass", "all_pass_bank", "all_pass_bank?", "all_pass?",
+ "amp_control", "amp_control_bounds", "amplitude_modulate", "analyse_ladspa", "anoi", "any_env_channel",
+ "any_random", "apply_controls", "apply_ladspa", "aritable?", "arity", "array2file",
+ "array_interp", "as_one_edit", "ask_about_unsaved_edits", "ask_before_overwrite", "asyfm_I", "asyfm_J",
+ "asyfm?", "asymmetric_fm", "asymmetric_fm?", "auto_resize", "auto_save", "auto_update",
+ "auto_update_interval", "autocorrelate", "axis_color", "axis_info", "axis_label_font", "axis_numbers_font",
+ "background_gradient", "bad_header_hook", "bagpipe", "basic_color", "beats_per_measure", "beats_per_minute",
+ "before_close_hook", "before_exit_hook", "before_save_as_hook", "before_save_state_hook", "before_transform_hook", "bes_j0",
+ "bess", "bess?", "bessel_filters", "bigbird", "bignum", "bignum?",
+ "binary_files", "bind_key", "bird", "blackman", "blackman4_env_channel", "blackman?",
+ "bold_peaks_font", "break", "brown_noise", "brown_noise?", "butterworth_filters", "byte_vector",
+ "byte_vector?", "c_define", "c_g?", "c_object?", "c_pointer", "c_pointer?",
+ "call_with_exit", "canter", "cascade2canonical", "catch", "cellon", "chain_dsps",
+ "channel2vct", "channel_amp_envs", "channel_data", "channel_envelope", "channel_polynomial", "channel_properties",
+ "channel_property", "channel_rms", "channel_style", "channel_sync", "channel_widgets", "channels",
+ "channels_equal?", "channels_?", "chans", "char_position", "cheby_hka", "chebyshev_filters",
+ "check_mix_tags", "chordalize", "chorus", "clean_channel", "clean_sound", "clear_listener",
+ "clip_hook", "clipping", "clm_channel", "clm_expsrc", "close_hook", "close_sound",
+ "color2list", "color_cutoff", "color_hook", "color_inverted", "color_mixes", "color_orientation_dialog",
+ "color_scale", "color?", "colormap", "colormap2integer", "colormap_name", "colormap_ref",
+ "colormap_size", "colormap?", "comb", "comb_bank", "comb_bank?", "comb?",
+ "combined_data_color", "comment", "complexify", "concatenate_envelopes", "constant?", "continuation?",
+ "continue_frample2file", "continue_sample2file", "contrast_channel", "contrast_control", "contrast_control_amp", "contrast_control_bounds",
+ "contrast_control?", "contrast_enhancement", "contrast_sound", "controls2channel", "convolution", "convolution_reverb",
+ "convolve", "convolve_files", "convolve_selection_with", "convolve_with", "convolve?", "copy",
+ "Copy_context", "copy_sampler", "correlate", "coverlet", "cross_fade__amplitude_", "cross_fade__frequency_domain_",
+ "cross_synthesis", "curlet", "current_font", "cursor", "cursor_color", "Cursor_context",
+ "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style", "cursor_update_interval", "cutlet",
+ "cyclic_sequences", "dac_combines_channels", "dac_size", "data_color", "data_location", "data_size",
+ "db2linear", "default_output_chans", "default_output_header_type", "default_output_sample_type", "default_output_srate", "defgenerator",
+ "define_", "define_constant", "define_envelope", "define_expansion", "define_macro", "define_macro_",
+ "define_selection_via_marks", "defined?", "degrees2radians", "delay", "delay_channel_mixes", "delay_tick",
+ "delay?", "delete_colormap", "delete_file_filter", "delete_file_sorter", "delete_mark", "delete_marks",
+ "delete_sample", "delete_samples", "delete_samples_and_smooth", "delete_selection", "delete_selection_and_smooth", "delete_transform",
+ "describe_hook", "describe_mark", "dht", "dialog_widgets", "dilambda", "disable_control_panel",
+ "display_bark_fft", "display_correlation", "display_db", "display_edits", "display_energy", "dissolve_fade",
+ "dither_channel", "dither_sound", "dolph", "dot_product", "dot_size", "down_oct",
+ "draw_axes", "draw_dot", "draw_dots", "draw_line", "draw_lines", "draw_mark_hook",
+ "draw_mix_hook", "draw_string", "drone", "drop_sites", "drop_hook", "during_open_hook",
+ "edit_fragment", "edit_header_dialog", "edit_hook", "edit_list2function", "edit_position", "edit_properties",
+ "edit_property", "edit_tree", "edits", "edot_product", "effects_hook", "elliptic_filters",
+ "env", "env_any", "env_channel", "env_channel_with_base", "env_expt_channel", "env_interp",
+ "env_mixes", "env_selection", "env_sound", "env_sound_interp", "env_squared_channel", "env?",
+ "enved_base", "enved_clip?", "enved_dialog", "enved_envelope", "enved_filter", "enved_filter_order",
+ "enved_hook", "enved_in_dB", "enved_power", "enved_style", "enved_target", "enved_wave?",
+ "enved_waveform_color", "envelope_interp", "enveloped_mix", "eoddcos", "eoddcos?", "eps_bottom_margin",
+ "eps_file", "eps_left_margin", "eps_size", "ercos", "ercos?", "_error_hook_",
+ "erssb", "erssb?", "even_multiple", "even_weight", "every_sample?", "exit",
+ "exit_hook", "expand_control", "expand_control_bounds", "expand_control_hop", "expand_control_jitter", "expand_control_length",
+ "expand_control_ramp", "expand_control?", "explode_sf2", "exponentially_weighted_moving_average", "expsnd", "expsrc",
+ "_features_", "feedback_fm", "fft", "fft_cancel", "fft_edit", "fft_env_edit",
+ "fft_env_interp", "fft_log_frequency", "fft_log_magnitude", "fft_smoother", "fft_squelch", "fft_window",
+ "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database", "file2array", "file2frample",
+ "file2frample?", "file2sample", "file2sample?", "file_name", "fill!", "fill_polygon",
+ "fill_rectangle", "filter", "filter_channel", "filter_control_coeffs", "filter_control_envelope", "filter_control_in_dB",
+ "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color", "filter_control?", "filter_fft", "filter_selection",
+ "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb", "filtered_comb_bank", "filtered_comb_bank?",
+ "filtered_comb?", "find_dialog", "find_mark", "find_mix", "find_sound", "finfo",
+ "finish_progress_report", "fir_filter", "fir_filter?", "firmant", "firmant?", "fit_selection_between_marks",
+ "flatten_partials", "float_vector", "float-vector_multiply", "float-vector_add", "float_vector2channel", "float_vector2list",
+ "float_vector2string", "float_vector_abs!", "float_vector_add!", "float_vector_copy", "float_vector_equal?", "float_vector_fill!",
+ "float_vector_length", "float_vector_max", "float_vector_min", "float_vector_move!", "float_vector_multiply!", "float_vector_offset!",
+ "float_vector_peak", "float_vector_polynomial", "float_vector_ref", "float_vector_reverse!", "float_vector_scale!", "float_vector_set!",
+ "float_vector_subseq", "float_vector_subtract!", "float_vector?", "flocsig", "flocsig?", "flute_model",
+ "fm_bell", "fm_drum", "fm_noise", "fm_parallel_component", "fm_talker", "fm_trumpet",
+ "fm_violin", "fm_voice", "fmssb", "fmssb?", "focus_widget", "FOF_synthesis",
+ "fofins", "for_each_child", "for_each_sound_file", "Forbidden_Planet", "foreground_color", "forget_region",
+ "formant", "formant_bank", "formant_bank?", "formant?", "format", "fp",
+ "fractional_fourier_transform", "frample2file", "frample2file?", "frample2frample", "framples", "free_player",
+ "free_sampler", "freeverb", "fullmix", "funclet", "gaussian_distribution", "gc_off",
+ "gc_on", "gensym", "gensym?", "gl_graph2ps", "glSpectrogram", "goertzel",
+ "goto_listener_end", "grani", "granulate", "granulate?", "granulated_sound_interp", "graph",
+ "graph2ps", "graph_color", "graph_cursor", "graph_data", "graph_hook", "graph_style",
+ "graphic_equalizer", "graphs_horizontal", "green_noise", "green_noise_interp", "green_noise_interp?", "green_noise?",
+ "grid_density", "harmonicizer", "Hartley_transform", "hash_table", "hash_table_", "hash_table_entries",
+ "hash_table_ref", "hash_table_set!", "hash_table?", "header_type", "hello_dentist", "help_dialog",
+ "help_hook", "hide_widget", "highlight_color", "hilbert_transform", "hook_functions", "hook_member",
+ "html", "html_dir", "html_program", "hz2radians", "iir_filter", "iir_filter?",
+ "call_in", "in_any", "ina", "inb", "info_dialog", "init_ladspa",
+ "initial_beg", "initial_dur", "initial_graph_hook", "inlet", "insert_channel", "insert_file_dialog",
+ "insert_region", "insert_sample", "insert_samples", "insert_selection", "insert_silence", "insert_sound",
+ "int_vector", "int_vector_ref", "int_vector_set!", "int_vector?", "integer2colormap", "integer2mark",
+ "integer2mix", "integer2region", "integer2sound", "integer2transform", "integrate_envelope", "invert_filter",
+ "iterate", "iterator_at_end?", "iterator_sequence", "iterator?", "izcos", "izcos?",
+ "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?", "j2cos", "j2cos?",
+ "jc_reverb", "jjcos", "jjcos?", "jncos", "jncos?", "jpcos",
+ "jpcos?", "just_sounds", "jycos", "jycos?", "k2cos", "k2cos?",
+ "k2sin", "k2sin?", "k2ssb", "k2ssb?", "k3sin", "k3sin?",
+ "kalman_filter_channel", "key", "key_binding", "key_press_hook", "krksin", "krksin?",
+ "ladspa_descriptor", "ladspa_dir", "lambda_", "lbj_piano", "left_sample", "let2list",
+ "let_ref", "let_set!", "let_temporarily", "let?", "linear2db", "linear_src_channel",
"lint_for_scheme", "lisp_graph_hook", "lisp_graph_style", "lisp_graph?", "list2float_vector", "list2vct",
"list_ladspa", "listener_click_hook", "listener_color", "listener_colorized", "listener_font", "listener_prompt",
"listener_selection", "listener_text_color", "little_endian?", "_load_hook_", "_load_path_", "locate_zero",
@@ -445,252 +446,253 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin", "nsin?",
"nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos", "nxy1cos?",
"nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin", "nxysin?",
- "object2string", "odd_multiple", "odd_weight", "offset_channel", "offset_sound", "one_pole",
- "one_pole_all_pass", "one_pole_all_pass?", "one_pole?", "one_zero", "one_zero?", "open_file_dialog",
- "open_file_dialog_directory", "open_hook", "open_next_file_in_directory", "open_raw_sound", "open_raw_sound_hook", "open_sound",
- "openlet", "openlet?", "orientation_hook", "oscil", "oscil_bank", "oscil_bank?",
- "oscil?", "out_any", "out_bank", "outa", "outlet", "_output_",
- "output_comment_hook", "overlay_rms_env", "owlet", "pad_channel", "pad_marks", "pad_sound",
- "pair_filename", "pair_line_number", "pan_mix", "pan_mix_float_vector", "partials2polynomial", "partials2wave",
- "pausing", "peak_env_dir", "peaks", "peaks_font", "phase_partials2wave", "phase_vocoder",
- "phase_vocoder?", "piano_model", "pink_noise", "pink_noise?", "pins", "place_sound",
- "play", "play_arrow_size", "play_between_marks", "play_hook", "play_mixes", "play_often",
- "play_region_forever", "play_sine", "play_sines", "play_syncd_marks", "play_until_c_g", "play_with_envs",
- "player_home", "player?", "players", "playing", "pluck", "polar2rectangular",
- "polynomial", "polynomial_operations", "polyoid", "polyoid_env", "polyoid?", "polyshape",
- "polyshape?", "polywave", "polywave?", "port_filename", "port_line_number", "position2x",
- "position2y", "position_color", "power_env", "pqw", "pqw_vox", "preferences_dialog",
- "previous_sample", "print_dialog", "print_length", "procedure_documentation", "procedure_setter", "procedure_signature",
- "procedure_source", "progress_report", "pulse_train", "pulse_train?", "pulsed_env", "pulsed_env?",
- "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians2degrees", "radians2hz",
- "ramp_channel", "rand", "rand_interp", "rand_interp?", "rand?", "random",
- "random_state", "random_state?", "rcos", "rcos?", "_read_error_hook_", "read_hook",
- "read_mix_sample", "read_only", "read_region_sample", "read_sample", "read_sample_with_direction", "reader_cond",
- "readin", "readin?", "rectangular2magnitudes", "rectangular2polar", "redo_edit", "region2integer",
- "region2vct", "region_chans", "region_framples", "region_graph_style", "region_home", "region_maxamp",
- "region_maxamp_position", "region_play_list", "region_position", "region_rms", "region_sample", "region_sampler?",
- "region_srate", "region?", "regions", "remember_sound_state", "remove_clicks", "remove_from_menu",
- "replace_with_selection", "report_mark_names", "require", "reset_all_hooks", "reset_controls", "reset_listener_cursor",
- "reson", "restore_controls", "_reverb_", "reverb_control_decay", "reverb_control_feedback", "reverb_control_length",
- "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds", "reverb_control?", "reverse!",
- "reverse_by_blocks", "reverse_channel", "reverse_envelope", "reverse_selection", "reverse_sound", "revert_sound",
- "right_sample", "ring_modulate", "rk!cos", "rk!cos?", "rk!ssb", "rk!ssb?",
- "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin", "rksin?",
- "rkssb", "rkssb?", "rms", "rms__gain__balance_gens", "rms_envelope", "rootlet",
- "round_interp", "round_interp?", "rssb", "rssb_interp", "rssb?", "rubber_sound",
- "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", "rxyk!sin", "rxyk!sin?",
- "rxysin", "rxysin?", "sample", "sample2file", "sample2file?", "sample_type",
- "sampler_at_end?", "sampler_home", "sampler_position", "sampler?", "samples", "samples2seconds",
- "sash_color", "save_as_dialog_auto_comment", "save_as_dialog_src", "save_controls", "save_dir", "save_edit_history",
- "save_envelopes", "save_hook", "save_listener", "save_mark_properties", "save_marks", "save_mix",
- "save_region", "save_region_dialog", "save_selection", "save_selection_dialog", "save_sound", "save_sound_as",
- "save_sound_dialog", "save_state", "save_state_file", "save_state_hook", "savitzky_golay_filter", "sawtooth_wave",
- "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope", "scale_mixes", "scale_selection_by",
- "scale_selection_to", "scale_sound", "scale_tempo", "scale_to", "scan_channel", "scanned_synthesis",
- "scentroid", "scratch", "script_arg", "script_args", "search_for_click", "search_procedure",
- "seconds2samples", "select_all", "select_channel", "select_channel_hook", "select_sound", "select_sound_hook",
- "selected_channel", "selected_data_color", "selected_graph_color", "selected_sound", "selection", "selection2mix",
- "selection_chans", "selection_color", "Selection_context", "selection_creates_region", "selection_framples", "selection_maxamp",
- "selection_maxamp_position", "selection_member?", "selection_members", "selection_position", "selection_rms", "selection_srate",
- "selection?", "set_samples", "short_file_name", "show_axes", "show_controls", "show_disk_space",
- "show_full_duration", "show_full_range", "show_grid", "show_indices", "show_listener", "show_marks",
- "show_mix_waveforms", "show_selection", "show_selection_transform", "show_sonogram_cursor", "show_transform_peaks", "show_widget",
- "show_y_zero", "silence_all_mixes", "silence_mixes", "sinc_train", "sinc_train?", "sinc_width",
- "sine_env_channel", "sine_ramp", "singer", "smooth_channel", "smooth_selection", "smooth_sound",
- "SMS_synthesis", "snap_mark_to_beat", "snap_marks", "snap_mix_to_beat", "snd2sample", "snd2sample?",
- "snd_color", "snd_error", "snd_error_hook", "snd_font", "snd_gcs", "snd_help",
- "snd_hooks", "_snd_opened_sound_", "snd_print", "snd_spectrum", "snd_tempnam", "snd_url",
- "snd_urls", "snd_version", "snd_warning", "snd_warning_hook", "sndwarp", "sort!",
- "sound2amp_env", "sound2integer", "sound_file_extensions", "sound_file?", "sound_files_in_directory", "sound_interp",
- "sound_loop_info", "sound_properties", "sound_property", "sound_widgets", "sound?", "soundfont_info",
- "sounds", "sounds2segment_data", "spectra", "spectral_interpolation", "spectral_polynomial", "spectro_hop",
- "spectro_x_angle", "spectro_x_scale", "spectro_y_angle", "spectro_y_scale", "spectro_z_angle", "spectro_z_scale",
- "spectrum", "spectrum2coeffs", "spectrum_end", "spectrum_start", "speed_control", "speed_control_bounds",
- "speed_control_style", "speed_control_tones", "spot_freq", "square_wave", "square_wave?", "squelch_update",
- "squelch_vowels", "srate", "src", "src_channel", "src_duration", "src_fit_envelope",
- "src_mixes", "src_selection", "src_sound", "src?", "ssb_am", "ssb_am?",
- "ssb_bank", "ssb_bank_env", "ssb_fm", "start_dac", "start_playing", "start_playing_hook",
- "start_playing_selection_hook", "start_progress_report", "status_report", "stdin_prompt", "stereo2mono", "stereo_flute",
- "stop_player", "stop_playing", "stop_playing_hook", "stop_playing_selection_hook", "stretch_envelope", "stretch_sound_via_dft",
- "string_position", "sublet", "superimpose_ffts", "swap_channels", "swap_selection_channels", "symbol2dynamic_value",
- "symbol2value", "symbol_access", "symbol_table", "sync", "sync_everything", "sync_max",
- "sync_style", "syncd_marks", "syncd_mixes", "syncup", "table_lookup", "table_lookup?",
- "tanhsin", "tanhsin?", "tap", "tap?", "telephone", "temp_dir",
- "text_focus_color", "time_graph_style", "time_graph_type", "time_graph?", "times2samples", "tiny_font",
- "touch_tone", "trace", "tracking_cursor_style", "transform2integer", "transform2vct", "transform_dialog",
- "transform_framples", "transform_graph_style", "transform_graph_type", "transform_graph?", "transform_normalization", "transform_sample",
- "transform_size", "transform_type", "transform?", "transpose_mixes", "triangle_wave", "triangle_wave?",
- "tubebell", "tubular_bell", "two_pole", "two_pole?", "two_tab", "two_zero",
- "two_zero?", "unbind_key", "_unbound_variable_hook_", "unclip_channel", "undo", "undo_hook",
- "unlet", "unselect_all", "update_graphs", "update_hook", "update_lisp_graph", "update_sound",
- "update_time_graph", "update_transform_graph", "upon_save_yourself", "user_interface_extensions", "variable_display", "variable_graph?",
- "varlet", "vct", "vct_", "vct_", "vct2channel", "vct2list",
- "vct2string", "vct2vector", "vct_abs!", "vct_add!", "vct_copy", "vct_equal?",
- "vct_fill!", "vct_length", "vct_max", "vct_min", "vct_move!", "vct_multiply!",
- "vct_offset!", "vct_peak", "vct_ref", "vct_reverse!", "vct_scale!", "vct_set!",
- "vct_subseq", "vct_subtract!", "vct?", "vector2vct", "vibrating_uniform_circular_string", "view_files_amp",
- "view_files_amp_env", "view_files_dialog", "view_files_files", "view_files_select_hook", "view_files_selected_files", "view_files_sort",
- "view_files_speed", "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog", "view_sound", "voice_physical_model",
- "voiced2unvoiced", "volterra_filter", "vox", "wave_train", "wave_train?", "wavelet_type",
- "waveshaping_voice", "wavo_hop", "wavo_trace", "weighted_moving_average", "widget_position", "widget_size",
- "widget_text", "window_height", "window_samples", "window_width", "window_x", "window_y",
- "with_background_processes", "with_baffle", "with_file_monitor", "with_gl", "with_inset_graph", "with_interrupts",
- "with_let", "with_local_hook", "with_menu_icons", "with_mix_tags", "with_pointer_focus", "with_relative_panes",
- "with_smpte_label", "with_sound", "with_temporary_selection", "with_toolbar", "with_tooltips", "with_tracking_cursor",
- "with_verbose_cursor", "x2position", "x_axis_label", "x_axis_style", "x_bounds", "x_position_slider",
- "x_zoom_slider", "xb_open", "xramp_channel", "y2position", "y_axis_label", "y_bounds",
- "y_position_slider", "y_zoom_slider", "z_transform", "zecho", "zero_", "zero_pad",
- "zero_phase", "zip_sound", "zipper", "zoom_color", "zoom_focus_style"};
+ "object2let", "object2string", "odd_multiple", "odd_weight", "offset_channel", "offset_sound",
+ "one_pole", "one_pole_all_pass", "one_pole_all_pass?", "one_pole?", "one_zero", "one_zero?",
+ "open_file_dialog", "open_file_dialog_directory", "open_hook", "open_next_file_in_directory", "open_raw_sound", "open_raw_sound_hook",
+ "open_sound", "openlet", "openlet?", "orientation_hook", "oscil", "oscil_bank",
+ "oscil_bank?", "oscil?", "out_any", "out_bank", "outa", "outlet",
+ "_output_", "output_comment_hook", "overlay_rms_env", "owlet", "pad_channel", "pad_marks",
+ "pad_sound", "pair_filename", "pair_line_number", "pan_mix", "pan_mix_float_vector", "partials2polynomial",
+ "partials2wave", "pausing", "peak_env_dir", "peaks", "peaks_font", "phase_partials2wave",
+ "phase_vocoder", "phase_vocoder?", "piano_model", "pink_noise", "pink_noise?", "pins",
+ "place_sound", "play", "play_arrow_size", "play_between_marks", "play_hook", "play_mixes",
+ "play_often", "play_region_forever", "play_sine", "play_sines", "play_syncd_marks", "play_until_c_g",
+ "play_with_envs", "player_home", "player?", "players", "playing", "pluck",
+ "polar2rectangular", "polynomial", "polynomial_operations", "polyoid", "polyoid_env", "polyoid?",
+ "polyshape", "polyshape?", "polywave", "polywave?", "port_filename", "port_line_number",
+ "position2x", "position2y", "position_color", "power_env", "pqw", "pqw_vox",
+ "preferences_dialog", "previous_sample", "print_dialog", "print_length", "procedure_documentation", "procedure_setter",
+ "procedure_signature", "procedure_source", "progress_report", "pulse_train", "pulse_train?", "pulsed_env",
+ "pulsed_env?", "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians2degrees",
+ "radians2hz", "ramp_channel", "rand", "rand_interp", "rand_interp?", "rand?",
+ "random", "random_state", "random_state?", "rcos", "rcos?", "_read_error_hook_",
+ "read_hook", "read_mix_sample", "read_only", "read_region_sample", "read_sample", "read_sample_with_direction",
+ "reader_cond", "readin", "readin?", "rectangular2magnitudes", "rectangular2polar", "redo_edit",
+ "region2integer", "region2vct", "region_chans", "region_framples", "region_graph_style", "region_home",
+ "region_maxamp", "region_maxamp_position", "region_play_list", "region_position", "region_rms", "region_sample",
+ "region_sampler?", "region_srate", "region?", "regions", "remember_sound_state", "remove_clicks",
+ "remove_from_menu", "replace_with_selection", "report_mark_names", "require", "reset_all_hooks", "reset_controls",
+ "reset_listener_cursor", "reson", "restore_controls", "_reverb_", "reverb_control_decay", "reverb_control_feedback",
+ "reverb_control_length", "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds", "reverb_control?",
+ "reverse!", "reverse_by_blocks", "reverse_channel", "reverse_envelope", "reverse_selection", "reverse_sound",
+ "revert_sound", "right_sample", "ring_modulate", "rk!cos", "rk!cos?", "rk!ssb",
+ "rk!ssb?", "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin",
+ "rksin?", "rkssb", "rkssb?", "rms", "rms__gain__balance_gens", "rms_envelope",
+ "rootlet", "round_interp", "round_interp?", "rssb", "rssb_interp", "rssb?",
+ "rubber_sound", "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", "rxyk!sin",
+ "rxyk!sin?", "rxysin", "rxysin?", "sample", "sample2file", "sample2file?",
+ "sample_type", "sampler_at_end?", "sampler_home", "sampler_position", "sampler?", "samples",
+ "samples2seconds", "sash_color", "save_as_dialog_auto_comment", "save_as_dialog_src", "save_controls", "save_dir",
+ "save_edit_history", "save_envelopes", "save_hook", "save_listener", "save_mark_properties", "save_marks",
+ "save_mix", "save_region", "save_region_dialog", "save_selection", "save_selection_dialog", "save_sound",
+ "save_sound_as", "save_sound_dialog", "save_state", "save_state_file", "save_state_hook", "savitzky_golay_filter",
+ "sawtooth_wave", "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope", "scale_mixes",
+ "scale_selection_by", "scale_selection_to", "scale_sound", "scale_tempo", "scale_to", "scan_channel",
+ "scanned_synthesis", "scentroid", "scratch", "script_arg", "script_args", "search_for_click",
+ "search_procedure", "seconds2samples", "select_all", "select_channel", "select_channel_hook", "select_sound",
+ "select_sound_hook", "selected_channel", "selected_data_color", "selected_graph_color", "selected_sound", "selection",
+ "selection2mix", "selection_chans", "selection_color", "Selection_context", "selection_creates_region", "selection_framples",
+ "selection_maxamp", "selection_maxamp_position", "selection_member?", "selection_members", "selection_position", "selection_rms",
+ "selection_srate", "selection?", "set_samples", "short_file_name", "show_axes", "show_controls",
+ "show_disk_space", "show_full_duration", "show_full_range", "show_grid", "show_indices", "show_listener",
+ "show_marks", "show_mix_waveforms", "show_selection", "show_selection_transform", "show_sonogram_cursor", "show_transform_peaks",
+ "show_widget", "show_y_zero", "silence_all_mixes", "silence_mixes", "sinc_train", "sinc_train?",
+ "sinc_width", "sine_env_channel", "sine_ramp", "singer", "smooth_channel", "smooth_selection",
+ "smooth_sound", "SMS_synthesis", "snap_mark_to_beat", "snap_marks", "snap_mix_to_beat", "snd2sample",
+ "snd2sample?", "snd_color", "snd_error", "snd_error_hook", "snd_font", "snd_gcs",
+ "snd_help", "snd_hooks", "_snd_opened_sound_", "snd_print", "snd_spectrum", "snd_tempnam",
+ "snd_url", "snd_urls", "snd_version", "snd_warning", "snd_warning_hook", "sndwarp",
+ "sort!", "sound2amp_env", "sound2integer", "sound_file_extensions", "sound_file?", "sound_files_in_directory",
+ "sound_interp", "sound_loop_info", "sound_properties", "sound_property", "sound_widgets", "sound?",
+ "soundfont_info", "sounds", "sounds2segment_data", "spectra", "spectral_interpolation", "spectral_polynomial",
+ "spectro_hop", "spectro_x_angle", "spectro_x_scale", "spectro_y_angle", "spectro_y_scale", "spectro_z_angle",
+ "spectro_z_scale", "spectrum", "spectrum2coeffs", "spectrum_end", "spectrum_start", "speed_control",
+ "speed_control_bounds", "speed_control_style", "speed_control_tones", "spot_freq", "square_wave", "square_wave?",
+ "squelch_update", "squelch_vowels", "srate", "src", "src_channel", "src_duration",
+ "src_fit_envelope", "src_mixes", "src_selection", "src_sound", "src?", "ssb_am",
+ "ssb_am?", "ssb_bank", "ssb_bank_env", "ssb_fm", "start_dac", "start_playing",
+ "start_playing_hook", "start_playing_selection_hook", "start_progress_report", "status_report", "stdin_prompt", "stereo2mono",
+ "stereo_flute", "stop_player", "stop_playing", "stop_playing_hook", "stop_playing_selection_hook", "stretch_envelope",
+ "stretch_sound_via_dft", "string2byte_vector", "string_position", "sublet", "superimpose_ffts", "swap_channels",
+ "swap_selection_channels", "symbol2dynamic_value", "symbol2value", "symbol_access", "symbol_table", "sync",
+ "sync_everything", "sync_max", "sync_style", "syncd_marks", "syncd_mixes", "syncup",
+ "table_lookup", "table_lookup?", "tanhsin", "tanhsin?", "tap", "tap?",
+ "telephone", "temp_dir", "text_focus_color", "time_graph_style", "time_graph_type", "time_graph?",
+ "times2samples", "tiny_font", "touch_tone", "trace", "tracking_cursor_style", "transform2integer",
+ "transform2vct", "transform_dialog", "transform_framples", "transform_graph_style", "transform_graph_type", "transform_graph?",
+ "transform_normalization", "transform_sample", "transform_size", "transform_type", "transform?", "transpose_mixes",
+ "triangle_wave", "triangle_wave?", "tubebell", "tubular_bell", "two_pole", "two_pole?",
+ "two_tab", "two_zero", "two_zero?", "unbind_key", "_unbound_variable_hook_", "unclip_channel",
+ "undo", "undo_hook", "unlet", "unselect_all", "update_graphs", "update_hook",
+ "update_lisp_graph", "update_sound", "update_time_graph", "update_transform_graph", "upon_save_yourself", "user_interface_extensions",
+ "variable_display", "variable_graph?", "varlet", "vct", "vct_", "vct_",
+ "vct2channel", "vct2list", "vct2string", "vct2vector", "vct_abs!", "vct_add!",
+ "vct_copy", "vct_equal?", "vct_fill!", "vct_length", "vct_max", "vct_min",
+ "vct_move!", "vct_multiply!", "vct_offset!", "vct_peak", "vct_ref", "vct_reverse!",
+ "vct_scale!", "vct_set!", "vct_subseq", "vct_subtract!", "vct?", "vector2vct",
+ "vibrating_uniform_circular_string", "view_files_amp", "view_files_amp_env", "view_files_dialog", "view_files_files", "view_files_select_hook",
+ "view_files_selected_files", "view_files_sort", "view_files_speed", "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog",
+ "view_sound", "voice_physical_model", "voiced2unvoiced", "volterra_filter", "vox", "wave_train",
+ "wave_train?", "wavelet_type", "waveshaping_voice", "wavo_hop", "wavo_trace", "weighted_moving_average",
+ "widget_position", "widget_size", "widget_text", "window_height", "window_samples", "window_width",
+ "window_x", "window_y", "with_background_processes", "with_baffle", "with_file_monitor", "with_gl",
+ "with_inset_graph", "with_interrupts", "with_let", "with_local_hook", "with_menu_icons", "with_mix_tags",
+ "with_pointer_focus", "with_relative_panes", "with_smpte_label", "with_sound", "with_temporary_selection", "with_toolbar",
+ "with_tooltips", "with_tracking_cursor", "with_verbose_cursor", "x2position", "x_axis_label", "x_axis_style",
+ "x_bounds", "x_position_slider", "x_zoom_slider", "xb_open", "xramp_channel", "y2position",
+ "y_axis_label", "y_bounds", "y_position_slider", "y_zoom_slider", "z_transform", "zecho",
+ "zero_", "zero_pad", "zero_phase", "zip_sound", "zipper", "zoom_color",
+ "zoom_focus_style"};
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
static const char **help_names = NULL;
#endif
static const char *help_urls[HELP_NAMES_SIZE] = {
- "*#readers*", "s7.html#tobytevector", "sndclm.html#abcos", "sndclm.html#abcos?",
- "extsnd.html#abort", "sndclm.html#absin", "sndclm.html#absin?", "sndscm.html#addampcontrols",
- "extsnd.html#addcolormap", "sndscm.html#adddeleteoption", "extsnd.html#adddirectorytoviewfileslist", "extsnd.html#addfilefilter",
- "extsnd.html#addfilesorter", "extsnd.html#addfiletoviewfileslist", "extsnd.html#addmark", "sndscm.html#addmarkpane",
- "extsnd.html#addplayer", "extsnd.html#addsoundfileextension", "extsnd.html#addsourcefileextension", "extsnd.html#addtomainmenu",
- "extsnd.html#addtomenu", "sndscm.html#addtooltip", "extsnd.html#addtransform", "sndscm.html#spectra",
- "sndclm.html#adjustable-sawtooth-wave", "sndclm.html#adjustable-sawtooth-wave?", "sndclm.html#adjustable-square-wave", "sndclm.html#adjustable-square-wave?",
- "sndclm.html#adjustable-triangle-wave", "sndclm.html#adjustable-triangle-wave?", "extsnd.html#afterapplycontrolshook", "extsnd.html#afteredithook",
- "extsnd.html#aftergraphhook", "extsnd.html#afterlispgraphhook", "extsnd.html#afteropenhook", "extsnd.html#aftersaveashook",
- "extsnd.html#aftersavestatehook", "extsnd.html#aftertransformhook", "sndscm.html#allchans", "sndclm.html#all-pass",
- "sndclm.html#allpassbank", "sndclm.html#allpassbankp", "sndclm.html#all-pass?", "extsnd.html#ampcontrol",
- "extsnd.html#ampcontrolbounds", "sndclm.html#amplitude-modulate", "grfsnd.html#analyseladspa", "sndscm.html#anoi",
- "sndscm.html#anyenvchannel", "sndscm.html#anyrandom", "extsnd.html#applycontrols", "grfsnd.html#applyladspa",
- "s7.html#aritablep", "s7.html#arity", "sndclm.html#arraytofile", "sndclm.html#array-interp",
- "extsnd.html#asoneedit", "extsnd.html#askaboutunsavededits", "extsnd.html#askbeforeoverwrite", "sndclm.html#asyfmI",
- "sndclm.html#asyfmJ", "sndclm.html#asyfm?", "sndclm.html#asymmetric-fm", "sndclm.html#asymmetric-fm?",
- "extsnd.html#autoresize", "sndscm.html#autosavedoc", "extsnd.html#autoupdate", "extsnd.html#autoupdateinterval",
- "sndclm.html#autocorrelate", "extsnd.html#axiscolor", "extsnd.html#axisinfo", "extsnd.html#axislabelfont",
- "extsnd.html#axisnumbersfont", "extsnd.html#backgroundgradient", "extsnd.html#badheaderhook", "sndscm.html#bagpipe",
- "extsnd.html#basiccolor", "extsnd.html#beatspermeasure", "extsnd.html#beatsperminute", "extsnd.html#beforeclosehook",
- "extsnd.html#beforeexithook", "extsnd.html#beforesaveashook", "extsnd.html#beforesavestatehook", "extsnd.html#beforetransformhook",
- "extsnd.html#besj0", "sndclm.html#bess", "sndclm.html#bess?", "sndscm.html#analogfilterdoc",
- "sndscm.html#bigbird", "s7.html#bignum", "s7.html#bignump", "sndscm.html#binaryiodoc",
- "extsnd.html#bindkey", "sndscm.html#bird", "sndclm.html#blackman", "sndscm.html#blackman4envchannel",
- "sndclm.html#blackman?", "extsnd.html#boldpeaksfont", "extsnd.html#break", "sndclm.html#brown-noise",
- "sndclm.html#brown-noise?", "sndscm.html#analogfilterdoc", "s7.html#bytevector", "s7.html#bytevectorp",
- "s7.html#definecfunction", "extsnd.html#cgp", "s7.html#cobject", "s7.html#cpoint",
- "s7.html#cpointer", "s7.html#callwithexit", "sndscm.html#bagpipe", "sndscm.html#cascadetocanonical",
- "s7.html#catch", "sndscm.html#cellon", "sndscm.html#chaindsps", "extsnd.html#channeltovct",
- "extsnd.html#channelampenvs", "extsnd.html#channeldata", "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial",
- "extsnd.html#channelproperties", "extsnd.html#channelproperty", "sndscm.html#channelrms", "extsnd.html#channelstyle",
- "sndscm.html#channelsync", "extsnd.html#channelwidgets", "extsnd.html#channels", "sndscm.html#channelsequal",
- "sndscm.html#channelseq", "extsnd.html#chans", "s7.html#charposition", "sndscm.html#chebyhka",
- "sndscm.html#analogfilterdoc", "sndscm.html#checkmixtags", "sndscm.html#chordalize", "sndscm.html#chorus",
- "sndscm.html#cleanchannel", "sndscm.html#cleansound", "extsnd.html#clearlistener", "extsnd.html#cliphook",
- "extsnd.html#clipping", "extsnd.html#clmchannel", "sndscm.html#clmexpsrc", "extsnd.html#closehook",
- "extsnd.html#closesound", "extsnd.html#colortolist", "extsnd.html#colorcutoff", "extsnd.html#colorhook",
- "extsnd.html#colorinverted", "sndscm.html#colormixes", "extsnd.html#colororientationdialog", "extsnd.html#colorscale",
- "extsnd.html#colorp", "extsnd.html#colormap", "extsnd.html#colormaptointeger", "extsnd.html#colormapname",
- "extsnd.html#colormapref", "extsnd.html#colormapsize", "extsnd.html#colormapp", "sndclm.html#comb",
- "sndclm.html#combbank", "sndclm.html#combbankp", "sndclm.html#comb?", "extsnd.html#combineddatacolor",
- "extsnd.html#comment", "sndscm.html#complexify", "sndscm.html#concatenateenvelopes", "s7.html#constantp",
- "s7.html#continuationp", "sndclm.html#continue-frampletofile", "sndclm.html#continue-sampletofile", "sndscm.html#contrastchannel",
- "extsnd.html#contrastcontrol", "extsnd.html#contrastcontrolamp", "extsnd.html#contrastcontrolbounds", "extsnd.html#contrastcontrolp",
- "sndclm.html#contrast-enhancement", "sndscm.html#contrastsound", "extsnd.html#controlstochannel", "sndclm.html#convolution",
- "extsnd.html#convolvewith", "sndclm.html#convolve", "sndclm.html#convolvefiles", "extsnd.html#convolveselectionwith",
- "extsnd.html#convolvewith", "sndclm.html#convolve?", "s7.html#s7copy", "extsnd.html#copycontext",
- "extsnd.html#copysampler", "sndclm.html#correlate", "s7.html#coverlet", "sndscm.html#mixdoc",
- "sndscm.html#fadedoc", "sndscm.html#crosssynthesis", "s7.html#curlet", "extsnd.html#currentfont",
- "extsnd.html#cursor", "extsnd.html#cursorcolor", "extsnd.html#cursorcontext", "extsnd.html#cursorlocationoffset",
- "extsnd.html#cursorposition", "extsnd.html#cursorsize", "extsnd.html#cursorstyle", "extsnd.html#cursorupdateinterval",
- "s7.html#cutlet", "s7.html#cyclicsequences", "extsnd.html#dacfolding", "extsnd.html#dacsize",
- "extsnd.html#datacolor", "extsnd.html#datalocation", "extsnd.html#datasize", "sndclm.html#dbtolinear",
- "extsnd.html#defaultoutputchans", "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsampletype", "extsnd.html#defaultoutputsrate",
- "sndclm.html#defgenerator", "s7.html#definestar", "s7.html#defineconstant", "extsnd.html#defineenvelope",
- "s7.html#expansion", "s7.html#definemacro", "s7.html#definemacrostar", "sndscm.html#defineselectionviamarks",
- "s7.html#definedp", "sndclm.html#degreestoradians", "sndclm.html#delay", "sndscm.html#delaychannelmixes",
- "sndclm.html#delaytick", "sndclm.html#delay?", "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter",
- "extsnd.html#deletefilesorter", "extsnd.html#deletemark", "extsnd.html#deletemarks", "extsnd.html#deletesample",
- "extsnd.html#deletesamples", "extsnd.html#deletesamplesandsmooth", "extsnd.html#deleteselection", "extsnd.html#deleteselectionandsmooth",
- "extsnd.html#deletetransform", "sndscm.html#describehook", "sndscm.html#describemark", "sndscm.html#dht",
- "extsnd.html#dialogwidgets", "s7.html#dilambda", "sndscm.html#disablecontrolpanel", "sndscm.html#displaybarkfft",
- "sndscm.html#displaycorrelation", "sndscm.html#displaydb", "extsnd.html#displayedits", "sndscm.html#displayenergy",
- "sndscm.html#dissolvefade", "sndscm.html#ditherchannel", "sndscm.html#dithersound", "sndscm.html#dolph",
- "sndclm.html#dot-product", "extsnd.html#dotsize", "sndscm.html#downoct", "extsnd.html#drawaxes",
- "extsnd.html#drawdot", "extsnd.html#drawdots", "extsnd.html#drawline", "extsnd.html#drawlines",
- "extsnd.html#drawmarkhook", "extsnd.html#drawmixhook", "extsnd.html#drawstring", "sndscm.html#drone",
- "sndscm.html#makedropsite", "extsnd.html#drophook", "extsnd.html#duringopenhook", "extsnd.html#editfragment",
- "extsnd.html#editheaderdialog", "extsnd.html#edithook", "extsnd.html#editlisttofunction", "extsnd.html#editposition",
- "extsnd.html#editproperties", "extsnd.html#editproperty", "extsnd.html#edittree", "extsnd.html#edits",
- "sndclm.html#edot-product", "extsnd.html#effectshook", "sndscm.html#analogfilterdoc", "sndclm.html#env",
- "sndclm.html#env-any", "extsnd.html#envchannel", "extsnd.html#envchannelwithbase", "sndscm.html#envexptchannel",
- "sndclm.html#env-interp", "sndscm.html#envmixes", "extsnd.html#envselection", "extsnd.html#envsound",
- "sndscm.html#envsoundinterp", "sndscm.html#envsquaredchannel", "sndclm.html#env?", "extsnd.html#envedbase",
- "extsnd.html#envedclipping", "extsnd.html#enveddialog", "extsnd.html#envedenvelope", "extsnd.html#filterenv",
- "extsnd.html#filterenvorder", "extsnd.html#envedhook", "extsnd.html#envedin-dB", "extsnd.html#envedpower",
- "extsnd.html#envedstyle", "extsnd.html#envedtarget", "extsnd.html#envedwaving", "extsnd.html#envedwaveformcolor",
- "sndclm.html#envelopeinterp", "sndscm.html#envelopedmix", "sndclm.html#eoddcos", "sndclm.html#eoddcos?",
- "extsnd.html#epsbottommargin", "extsnd.html#epsfile", "extsnd.html#epsleftmargin", "extsnd.html#epssize",
- "sndclm.html#ercos", "sndclm.html#ercos?", "s7.html#errorhook", "sndclm.html#erssb",
- "sndclm.html#erssb?", "sndclm.html#evenmultiple", "sndclm.html#evenweight", "sndscm.html#everysample",
- "extsnd.html#exit", "extsnd.html#exithook", "extsnd.html#expandcontrol", "extsnd.html#expandcontrolbounds",
- "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter", "extsnd.html#expandcontrollength", "extsnd.html#expandcontrolramp",
- "extsnd.html#expandcontrolp", "sndscm.html#explodesf2", "sndclm.html#exponentially-weighted-moving-average", "sndscm.html#expsnd",
- "sndscm.html#expsrc", "s7.html#featureslist", "sndscm.html#cellon", "extsnd.html#fft",
- "sndscm.html#fftcancel", "sndscm.html#fftedit", "sndscm.html#fftenvedit", "sndscm.html#fftenvinterp",
- "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother", "sndscm.html#fftsquelch",
- "extsnd.html#fftwindow", "extsnd.html#fftalpha", "extsnd.html#fftbeta", "extsnd.html#fftwithphases",
- "sndscm.html#nbdoc", "sndclm.html#filetoarray", "sndclm.html#filetoframple", "sndclm.html#filetoframple?",
- "sndclm.html#filetosample", "sndclm.html#filetosample?", "extsnd.html#filename", "s7.html#fillb",
- "extsnd.html#fillpolygon", "extsnd.html#fillrectangle", "sndclm.html#filter", "extsnd.html#filterchannel",
- "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB", "extsnd.html#filtercontrolinhz",
- "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp", "sndscm.html#filterfft",
- "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound", "sndclm.html#filter?",
- "sndclm.html#filtered-comb", "sndclm.html#filteredcombbank", "sndclm.html#filteredcombbankp", "sndclm.html#filtered-comb?",
- "extsnd.html#finddialog", "extsnd.html#findmark", "sndscm.html#findmix", "extsnd.html#findsound",
- "sndscm.html#finfo", "extsnd.html#finishprogressreport", "sndclm.html#fir-filter", "sndclm.html#fir-filter?",
- "sndclm.html#firmant", "sndclm.html#firmant?", "sndscm.html#fitselectionbetweenmarks", "sndscm.html#flattenpartials",
- "extsnd.html#fv", "extsnd.html#fvtimes", "extsnd.html#fvplus", "extsnd.html#fvtochannel",
- "extsnd.html#fvtolist", "extsnd.html#fvtostring", "extsnd.html#fvabs", "extsnd.html#fvadd",
- "extsnd.html#fvcopy", "extsnd.html#fvequal", "extsnd.html#fvfill", "extsnd.html#fvlength",
- "extsnd.html#fvmax", "extsnd.html#fvmin", "extsnd.html#fvmove", "extsnd.html#fvmultiply",
- "extsnd.html#fvoffset", "extsnd.html#fvpeak", "sndscm.html#vctpolynomial", "extsnd.html#fvref",
- "extsnd.html#fvreverse", "extsnd.html#fvscale", "extsnd.html#fvset", "extsnd.html#fvsubseq",
- "extsnd.html#fvsubtract", "extsnd.html#fvp", "sndclm.html#flocsig", "sndclm.html#flocsig?",
- "sndscm.html#stereoflute", "sndscm.html#fmbell", "sndscm.html#fmdrum", "sndscm.html#fmnoise",
- "sndscm.html#fmparallelcomponent", "sndscm.html#fmvox", "sndscm.html#fmtrumpet", "sndscm.html#vdoc",
- "sndscm.html#fmvoice", "sndclm.html#fmssb", "sndclm.html#fmssb?", "extsnd.html#focuswidget",
- "sndscm.html#fofins", "sndscm.html#fofins", "sndscm.html#foreachchild", "sndscm.html#foreachsoundfile",
- "sndscm.html#fp", "extsnd.html#foregroundcolor", "extsnd.html#forgetregion", "sndclm.html#formant",
- "sndclm.html#formantbank", "sndclm.html#formantbankp", "sndclm.html#formant?", "s7.html#format",
- "sndscm.html#fp", "sndscm.html#fractionalfouriertransform", "sndclm.html#frampletofile", "sndclm.html#frampletofile?",
- "sndclm.html#frampletoframple", "extsnd.html#framples", "extsnd.html#freeplayer", "extsnd.html#freesampler",
- "sndscm.html#freeverb", "sndscm.html#fullmix", "s7.html#funclet", "sndscm.html#gaussiandistribution",
- "extsnd.html#gcoff", "extsnd.html#gcon", "s7.html#gensym", "s7.html#gensym?",
- "extsnd.html#glgraphtops", "extsnd.html#glspectrogram", "sndscm.html#goertzel", "extsnd.html#gotolistenerend",
- "sndscm.html#grani", "sndclm.html#granulate", "sndclm.html#granulate?", "sndscm.html#granulatedsoundinterp",
- "extsnd.html#graph", "extsnd.html#graphtops", "extsnd.html#graphcolor", "extsnd.html#graphcursor",
- "extsnd.html#graphdata", "extsnd.html#graphhook", "extsnd.html#graphstyle", "sndscm.html#grapheq",
- "extsnd.html#graphshorizontal", "sndclm.html#green-noise", "sndclm.html#green-noise-interp", "sndclm.html#green-noise-interp?",
- "sndclm.html#green-noise?", "extsnd.html#griddensity", "sndscm.html#harmonicizer", "sndscm.html#dht",
- "s7.html#hashtable", "s7.html#hashtablestar", "s7.html#hashtableentries", "s7.html#hashtableref",
- "s7.html#hashtableset", "s7.html#hashtablep", "extsnd.html#headertype", "sndscm.html#hellodentist",
- "extsnd.html#helpdialog", "extsnd.html#helphook", "extsnd.html#hidewidget", "extsnd.html#highlightcolor",
- "sndscm.html#hilberttransform", "s7.html#hookfunctions", "sndscm.html#hookmember", "sndscm.html#html",
- "extsnd.html#htmldir", "extsnd.html#htmlprogram", "sndclm.html#hztoradians", "sndclm.html#iir-filter",
- "sndclm.html#iir-filter?", "extsnd.html#gin", "sndclm.html#in-any", "sndclm.html#ina",
- "sndclm.html#inb", "extsnd.html#infodialog", "grfsnd.html#initladspa", "extsnd.html#initialbeg",
- "extsnd.html#initialdur", "extsnd.html#initialgraphhook", "s7.html#inlet", "sndscm.html#insertchannel",
- "extsnd.html#insertfiledialog", "extsnd.html#insertregion", "extsnd.html#insertsample", "extsnd.html#insertsamples",
- "extsnd.html#insertselection", "extsnd.html#insertsilence", "extsnd.html#insertsound", "s7.html#intvector",
- "s7.html#intvectorref", "s7.html#intvectorset", "s7.html#intvectorp", "extsnd.html#integertocolormap",
- "extsnd.html#integertomark", "extsnd.html#integertomix", "extsnd.html#integertoregion", "extsnd.html#integertosound",
- "extsnd.html#integertotransform", "sndscm.html#integrateenvelope", "sndscm.html#invertfilter", "s7.html#iterate",
- "s7.html#iteratoratend", "s7.html#iteratorsequence", "s7.html#iteratorp", "sndclm.html#izcos",
- "sndclm.html#izcos?", "sndclm.html#j0evencos", "sndclm.html#j0evencos?", "sndclm.html#j0j1cos",
- "sndclm.html#j0j1cos?", "sndclm.html#j2cos", "sndclm.html#j2cos?", "sndscm.html#jcreverb",
- "sndclm.html#jjcos", "sndclm.html#jjcos?", "sndclm.html#jncos", "sndclm.html#jncos?",
- "sndclm.html#jpcos", "sndclm.html#jpcos?", "extsnd.html#justsounds", "sndclm.html#jycos",
- "sndclm.html#jycos?", "sndclm.html#k2cos", "sndclm.html#k2cos?", "sndclm.html#k2sin",
- "sndclm.html#k2sin?", "sndclm.html#k2ssb", "sndclm.html#k2ssb?", "sndclm.html#k3sin",
- "sndclm.html#k3sin?", "sndscm.html#kalmanfilterchannel", "extsnd.html#key", "extsnd.html#keybinding",
- "extsnd.html#keypresshook", "sndclm.html#krksin", "sndclm.html#krksin?", "grfsnd.html#ladspadescriptor",
- "extsnd.html#ladspadir", "s7.html#lambdastar", "sndscm.html#lbjpiano", "extsnd.html#leftsample",
- "s7.html#lettolist", "s7.html#letref", "s7.html#letset", "s7.html#letp",
+ "*#readers*", "sndclm.html#abcos", "sndclm.html#abcos?", "extsnd.html#abort",
+ "sndclm.html#absin", "sndclm.html#absin?", "sndscm.html#addampcontrols", "extsnd.html#addcolormap",
+ "sndscm.html#adddeleteoption", "extsnd.html#adddirectorytoviewfileslist", "extsnd.html#addfilefilter", "extsnd.html#addfilesorter",
+ "extsnd.html#addfiletoviewfileslist", "extsnd.html#addmark", "sndscm.html#addmarkpane", "extsnd.html#addplayer",
+ "extsnd.html#addsoundfileextension", "extsnd.html#addsourcefileextension", "extsnd.html#addtomainmenu", "extsnd.html#addtomenu",
+ "sndscm.html#addtooltip", "extsnd.html#addtransform", "sndscm.html#spectra", "sndclm.html#adjustable-sawtooth-wave",
+ "sndclm.html#adjustable-sawtooth-wave?", "sndclm.html#adjustable-square-wave", "sndclm.html#adjustable-square-wave?", "sndclm.html#adjustable-triangle-wave",
+ "sndclm.html#adjustable-triangle-wave?", "extsnd.html#afterapplycontrolshook", "extsnd.html#afteredithook", "extsnd.html#aftergraphhook",
+ "extsnd.html#afterlispgraphhook", "extsnd.html#afteropenhook", "extsnd.html#aftersaveashook", "extsnd.html#aftersavestatehook",
+ "extsnd.html#aftertransformhook", "sndscm.html#allchans", "sndclm.html#all-pass", "sndclm.html#allpassbank",
+ "sndclm.html#allpassbankp", "sndclm.html#all-pass?", "extsnd.html#ampcontrol", "extsnd.html#ampcontrolbounds",
+ "sndclm.html#amplitude-modulate", "grfsnd.html#analyseladspa", "sndscm.html#anoi", "sndscm.html#anyenvchannel",
+ "sndscm.html#anyrandom", "extsnd.html#applycontrols", "grfsnd.html#applyladspa", "s7.html#aritablep",
+ "s7.html#arity", "sndclm.html#arraytofile", "sndclm.html#array-interp", "extsnd.html#asoneedit",
+ "extsnd.html#askaboutunsavededits", "extsnd.html#askbeforeoverwrite", "sndclm.html#asyfmI", "sndclm.html#asyfmJ",
+ "sndclm.html#asyfm?", "sndclm.html#asymmetric-fm", "sndclm.html#asymmetric-fm?", "extsnd.html#autoresize",
+ "sndscm.html#autosavedoc", "extsnd.html#autoupdate", "extsnd.html#autoupdateinterval", "sndclm.html#autocorrelate",
+ "extsnd.html#axiscolor", "extsnd.html#axisinfo", "extsnd.html#axislabelfont", "extsnd.html#axisnumbersfont",
+ "extsnd.html#backgroundgradient", "extsnd.html#badheaderhook", "sndscm.html#bagpipe", "extsnd.html#basiccolor",
+ "extsnd.html#beatspermeasure", "extsnd.html#beatsperminute", "extsnd.html#beforeclosehook", "extsnd.html#beforeexithook",
+ "extsnd.html#beforesaveashook", "extsnd.html#beforesavestatehook", "extsnd.html#beforetransformhook", "extsnd.html#besj0",
+ "sndclm.html#bess", "sndclm.html#bess?", "sndscm.html#analogfilterdoc", "sndscm.html#bigbird",
+ "s7.html#bignum", "s7.html#bignump", "sndscm.html#binaryiodoc", "extsnd.html#bindkey",
+ "sndscm.html#bird", "sndclm.html#blackman", "sndscm.html#blackman4envchannel", "sndclm.html#blackman?",
+ "extsnd.html#boldpeaksfont", "extsnd.html#break", "sndclm.html#brown-noise", "sndclm.html#brown-noise?",
+ "sndscm.html#analogfilterdoc", "s7.html#bytevector", "s7.html#bytevectorp", "s7.html#definecfunction",
+ "extsnd.html#cgp", "s7.html#cobject", "s7.html#cpoint", "s7.html#cpointer",
+ "s7.html#callwithexit", "sndscm.html#bagpipe", "sndscm.html#cascadetocanonical", "s7.html#catch",
+ "sndscm.html#cellon", "sndscm.html#chaindsps", "extsnd.html#channeltovct", "extsnd.html#channelampenvs",
+ "extsnd.html#channeldata", "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial", "extsnd.html#channelproperties",
+ "extsnd.html#channelproperty", "sndscm.html#channelrms", "extsnd.html#channelstyle", "sndscm.html#channelsync",
+ "extsnd.html#channelwidgets", "extsnd.html#channels", "sndscm.html#channelsequal", "sndscm.html#channelseq",
+ "extsnd.html#chans", "s7.html#charposition", "sndscm.html#chebyhka", "sndscm.html#analogfilterdoc",
+ "sndscm.html#checkmixtags", "sndscm.html#chordalize", "sndscm.html#chorus", "sndscm.html#cleanchannel",
+ "sndscm.html#cleansound", "extsnd.html#clearlistener", "extsnd.html#cliphook", "extsnd.html#clipping",
+ "extsnd.html#clmchannel", "sndscm.html#clmexpsrc", "extsnd.html#closehook", "extsnd.html#closesound",
+ "extsnd.html#colortolist", "extsnd.html#colorcutoff", "extsnd.html#colorhook", "extsnd.html#colorinverted",
+ "sndscm.html#colormixes", "extsnd.html#colororientationdialog", "extsnd.html#colorscale", "extsnd.html#colorp",
+ "extsnd.html#colormap", "extsnd.html#colormaptointeger", "extsnd.html#colormapname", "extsnd.html#colormapref",
+ "extsnd.html#colormapsize", "extsnd.html#colormapp", "sndclm.html#comb", "sndclm.html#combbank",
+ "sndclm.html#combbankp", "sndclm.html#comb?", "extsnd.html#combineddatacolor", "extsnd.html#comment",
+ "sndscm.html#complexify", "sndscm.html#concatenateenvelopes", "s7.html#constantp", "s7.html#continuationp",
+ "sndclm.html#continue-frampletofile", "sndclm.html#continue-sampletofile", "sndscm.html#contrastchannel", "extsnd.html#contrastcontrol",
+ "extsnd.html#contrastcontrolamp", "extsnd.html#contrastcontrolbounds", "extsnd.html#contrastcontrolp", "sndclm.html#contrast-enhancement",
+ "sndscm.html#contrastsound", "extsnd.html#controlstochannel", "sndclm.html#convolution", "extsnd.html#convolvewith",
+ "sndclm.html#convolve", "sndclm.html#convolvefiles", "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith",
+ "sndclm.html#convolve?", "s7.html#s7copy", "extsnd.html#copycontext", "extsnd.html#copysampler",
+ "sndclm.html#correlate", "s7.html#coverlet", "sndscm.html#mixdoc", "sndscm.html#fadedoc",
+ "sndscm.html#crosssynthesis", "s7.html#curlet", "extsnd.html#currentfont", "extsnd.html#cursor",
+ "extsnd.html#cursorcolor", "extsnd.html#cursorcontext", "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition",
+ "extsnd.html#cursorsize", "extsnd.html#cursorstyle", "extsnd.html#cursorupdateinterval", "s7.html#cutlet",
+ "s7.html#cyclicsequences", "extsnd.html#dacfolding", "extsnd.html#dacsize", "extsnd.html#datacolor",
+ "extsnd.html#datalocation", "extsnd.html#datasize", "sndclm.html#dbtolinear", "extsnd.html#defaultoutputchans",
+ "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsampletype", "extsnd.html#defaultoutputsrate", "sndclm.html#defgenerator",
+ "s7.html#definestar", "s7.html#defineconstant", "extsnd.html#defineenvelope", "s7.html#expansion",
+ "s7.html#definemacro", "s7.html#definemacrostar", "sndscm.html#defineselectionviamarks", "s7.html#definedp",
+ "sndclm.html#degreestoradians", "sndclm.html#delay", "sndscm.html#delaychannelmixes", "sndclm.html#delaytick",
+ "sndclm.html#delay?", "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter", "extsnd.html#deletefilesorter",
+ "extsnd.html#deletemark", "extsnd.html#deletemarks", "extsnd.html#deletesample", "extsnd.html#deletesamples",
+ "extsnd.html#deletesamplesandsmooth", "extsnd.html#deleteselection", "extsnd.html#deleteselectionandsmooth", "extsnd.html#deletetransform",
+ "sndscm.html#describehook", "sndscm.html#describemark", "sndscm.html#dht", "extsnd.html#dialogwidgets",
+ "s7.html#dilambda", "sndscm.html#disablecontrolpanel", "sndscm.html#displaybarkfft", "sndscm.html#displaycorrelation",
+ "sndscm.html#displaydb", "extsnd.html#displayedits", "sndscm.html#displayenergy", "sndscm.html#dissolvefade",
+ "sndscm.html#ditherchannel", "sndscm.html#dithersound", "sndscm.html#dolph", "sndclm.html#dot-product",
+ "extsnd.html#dotsize", "sndscm.html#downoct", "extsnd.html#drawaxes", "extsnd.html#drawdot",
+ "extsnd.html#drawdots", "extsnd.html#drawline", "extsnd.html#drawlines", "extsnd.html#drawmarkhook",
+ "extsnd.html#drawmixhook", "extsnd.html#drawstring", "sndscm.html#drone", "sndscm.html#makedropsite",
+ "extsnd.html#drophook", "extsnd.html#duringopenhook", "extsnd.html#editfragment", "extsnd.html#editheaderdialog",
+ "extsnd.html#edithook", "extsnd.html#editlisttofunction", "extsnd.html#editposition", "extsnd.html#editproperties",
+ "extsnd.html#editproperty", "extsnd.html#edittree", "extsnd.html#edits", "sndclm.html#edot-product",
+ "extsnd.html#effectshook", "sndscm.html#analogfilterdoc", "sndclm.html#env", "sndclm.html#env-any",
+ "extsnd.html#envchannel", "extsnd.html#envchannelwithbase", "sndscm.html#envexptchannel", "sndclm.html#env-interp",
+ "sndscm.html#envmixes", "extsnd.html#envselection", "extsnd.html#envsound", "sndscm.html#envsoundinterp",
+ "sndscm.html#envsquaredchannel", "sndclm.html#env?", "extsnd.html#envedbase", "extsnd.html#envedclipping",
+ "extsnd.html#enveddialog", "extsnd.html#envedenvelope", "extsnd.html#filterenv", "extsnd.html#filterenvorder",
+ "extsnd.html#envedhook", "extsnd.html#envedin-dB", "extsnd.html#envedpower", "extsnd.html#envedstyle",
+ "extsnd.html#envedtarget", "extsnd.html#envedwaving", "extsnd.html#envedwaveformcolor", "sndclm.html#envelopeinterp",
+ "sndscm.html#envelopedmix", "sndclm.html#eoddcos", "sndclm.html#eoddcos?", "extsnd.html#epsbottommargin",
+ "extsnd.html#epsfile", "extsnd.html#epsleftmargin", "extsnd.html#epssize", "sndclm.html#ercos",
+ "sndclm.html#ercos?", "s7.html#errorhook", "sndclm.html#erssb", "sndclm.html#erssb?",
+ "sndclm.html#evenmultiple", "sndclm.html#evenweight", "sndscm.html#everysample", "extsnd.html#exit",
+ "extsnd.html#exithook", "extsnd.html#expandcontrol", "extsnd.html#expandcontrolbounds", "extsnd.html#expandcontrolhop",
+ "extsnd.html#expandcontroljitter", "extsnd.html#expandcontrollength", "extsnd.html#expandcontrolramp", "extsnd.html#expandcontrolp",
+ "sndscm.html#explodesf2", "sndclm.html#exponentially-weighted-moving-average", "sndscm.html#expsnd", "sndscm.html#expsrc",
+ "s7.html#featureslist", "sndscm.html#cellon", "extsnd.html#fft", "sndscm.html#fftcancel",
+ "sndscm.html#fftedit", "sndscm.html#fftenvedit", "sndscm.html#fftenvinterp", "extsnd.html#fftlogfrequency",
+ "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother", "sndscm.html#fftsquelch", "extsnd.html#fftwindow",
+ "extsnd.html#fftalpha", "extsnd.html#fftbeta", "extsnd.html#fftwithphases", "sndscm.html#nbdoc",
+ "sndclm.html#filetoarray", "sndclm.html#filetoframple", "sndclm.html#filetoframple?", "sndclm.html#filetosample",
+ "sndclm.html#filetosample?", "extsnd.html#filename", "s7.html#fillb", "extsnd.html#fillpolygon",
+ "extsnd.html#fillrectangle", "sndclm.html#filter", "extsnd.html#filterchannel", "extsnd.html#filtercontrolcoeffs",
+ "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB", "extsnd.html#filtercontrolinhz", "extsnd.html#filtercontrolorder",
+ "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp", "sndscm.html#filterfft", "extsnd.html#filterselection",
+ "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound", "sndclm.html#filter?", "sndclm.html#filtered-comb",
+ "sndclm.html#filteredcombbank", "sndclm.html#filteredcombbankp", "sndclm.html#filtered-comb?", "extsnd.html#finddialog",
+ "extsnd.html#findmark", "sndscm.html#findmix", "extsnd.html#findsound", "sndscm.html#finfo",
+ "extsnd.html#finishprogressreport", "sndclm.html#fir-filter", "sndclm.html#fir-filter?", "sndclm.html#firmant",
+ "sndclm.html#firmant?", "sndscm.html#fitselectionbetweenmarks", "sndscm.html#flattenpartials", "extsnd.html#fv",
+ "extsnd.html#fvtimes", "extsnd.html#fvplus", "extsnd.html#fvtochannel", "extsnd.html#fvtolist",
+ "extsnd.html#fvtostring", "extsnd.html#fvabs", "extsnd.html#fvadd", "extsnd.html#fvcopy",
+ "extsnd.html#fvequal", "extsnd.html#fvfill", "extsnd.html#fvlength", "extsnd.html#fvmax",
+ "extsnd.html#fvmin", "extsnd.html#fvmove", "extsnd.html#fvmultiply", "extsnd.html#fvoffset",
+ "extsnd.html#fvpeak", "sndscm.html#vctpolynomial", "extsnd.html#fvref", "extsnd.html#fvreverse",
+ "extsnd.html#fvscale", "extsnd.html#fvset", "extsnd.html#fvsubseq", "extsnd.html#fvsubtract",
+ "extsnd.html#fvp", "sndclm.html#flocsig", "sndclm.html#flocsig?", "sndscm.html#stereoflute",
+ "sndscm.html#fmbell", "sndscm.html#fmdrum", "sndscm.html#fmnoise", "sndscm.html#fmparallelcomponent",
+ "sndscm.html#fmvox", "sndscm.html#fmtrumpet", "sndscm.html#vdoc", "sndscm.html#fmvoice",
+ "sndclm.html#fmssb", "sndclm.html#fmssb?", "extsnd.html#focuswidget", "sndscm.html#fofins",
+ "sndscm.html#fofins", "sndscm.html#foreachchild", "sndscm.html#foreachsoundfile", "sndscm.html#fp",
+ "extsnd.html#foregroundcolor", "extsnd.html#forgetregion", "sndclm.html#formant", "sndclm.html#formantbank",
+ "sndclm.html#formantbankp", "sndclm.html#formant?", "s7.html#format", "sndscm.html#fp",
+ "sndscm.html#fractionalfouriertransform", "sndclm.html#frampletofile", "sndclm.html#frampletofile?", "sndclm.html#frampletoframple",
+ "extsnd.html#framples", "extsnd.html#freeplayer", "extsnd.html#freesampler", "sndscm.html#freeverb",
+ "sndscm.html#fullmix", "s7.html#funclet", "sndscm.html#gaussiandistribution", "extsnd.html#gcoff",
+ "extsnd.html#gcon", "s7.html#gensym", "s7.html#gensym?", "extsnd.html#glgraphtops",
+ "extsnd.html#glspectrogram", "sndscm.html#goertzel", "extsnd.html#gotolistenerend", "sndscm.html#grani",
+ "sndclm.html#granulate", "sndclm.html#granulate?", "sndscm.html#granulatedsoundinterp", "extsnd.html#graph",
+ "extsnd.html#graphtops", "extsnd.html#graphcolor", "extsnd.html#graphcursor", "extsnd.html#graphdata",
+ "extsnd.html#graphhook", "extsnd.html#graphstyle", "sndscm.html#grapheq", "extsnd.html#graphshorizontal",
+ "sndclm.html#green-noise", "sndclm.html#green-noise-interp", "sndclm.html#green-noise-interp?", "sndclm.html#green-noise?",
+ "extsnd.html#griddensity", "sndscm.html#harmonicizer", "sndscm.html#dht", "s7.html#hashtable",
+ "s7.html#hashtablestar", "s7.html#hashtableentries", "s7.html#hashtableref", "s7.html#hashtableset",
+ "s7.html#hashtablep", "extsnd.html#headertype", "sndscm.html#hellodentist", "extsnd.html#helpdialog",
+ "extsnd.html#helphook", "extsnd.html#hidewidget", "extsnd.html#highlightcolor", "sndscm.html#hilberttransform",
+ "s7.html#hookfunctions", "sndscm.html#hookmember", "sndscm.html#html", "extsnd.html#htmldir",
+ "extsnd.html#htmlprogram", "sndclm.html#hztoradians", "sndclm.html#iir-filter", "sndclm.html#iir-filter?",
+ "extsnd.html#gin", "sndclm.html#in-any", "sndclm.html#ina", "sndclm.html#inb",
+ "extsnd.html#infodialog", "grfsnd.html#initladspa", "extsnd.html#initialbeg", "extsnd.html#initialdur",
+ "extsnd.html#initialgraphhook", "s7.html#inlet", "sndscm.html#insertchannel", "extsnd.html#insertfiledialog",
+ "extsnd.html#insertregion", "extsnd.html#insertsample", "extsnd.html#insertsamples", "extsnd.html#insertselection",
+ "extsnd.html#insertsilence", "extsnd.html#insertsound", "s7.html#intvector", "s7.html#intvectorref",
+ "s7.html#intvectorset", "s7.html#intvectorp", "extsnd.html#integertocolormap", "extsnd.html#integertomark",
+ "extsnd.html#integertomix", "extsnd.html#integertoregion", "extsnd.html#integertosound", "extsnd.html#integertotransform",
+ "sndscm.html#integrateenvelope", "sndscm.html#invertfilter", "s7.html#iterate", "s7.html#iteratoratend",
+ "s7.html#iteratorsequence", "s7.html#iteratorp", "sndclm.html#izcos", "sndclm.html#izcos?",
+ "sndclm.html#j0evencos", "sndclm.html#j0evencos?", "sndclm.html#j0j1cos", "sndclm.html#j0j1cos?",
+ "sndclm.html#j2cos", "sndclm.html#j2cos?", "sndscm.html#jcreverb", "sndclm.html#jjcos",
+ "sndclm.html#jjcos?", "sndclm.html#jncos", "sndclm.html#jncos?", "sndclm.html#jpcos",
+ "sndclm.html#jpcos?", "extsnd.html#justsounds", "sndclm.html#jycos", "sndclm.html#jycos?",
+ "sndclm.html#k2cos", "sndclm.html#k2cos?", "sndclm.html#k2sin", "sndclm.html#k2sin?",
+ "sndclm.html#k2ssb", "sndclm.html#k2ssb?", "sndclm.html#k3sin", "sndclm.html#k3sin?",
+ "sndscm.html#kalmanfilterchannel", "extsnd.html#key", "extsnd.html#keybinding", "extsnd.html#keypresshook",
+ "sndclm.html#krksin", "sndclm.html#krksin?", "grfsnd.html#ladspadescriptor", "extsnd.html#ladspadir",
+ "s7.html#lambdastar", "sndscm.html#lbjpiano", "extsnd.html#leftsample", "s7.html#lettolist",
+ "s7.html#letref", "s7.html#letset", "s7.html#lettemporarily", "s7.html#letp",
"sndclm.html#lineartodb", "sndscm.html#linearsrcchannel", "sndscm.html#lintdoc", "extsnd.html#lispgraphhook",
"extsnd.html#lispgraphstyle", "extsnd.html#lispgraphp", "extsnd.html#listtofv", "extsnd.html#listtovct",
"grfsnd.html#listladspa", "extsnd.html#listenerclickhook", "extsnd.html#listenercolor", "extsnd.html#listenercolorized",
@@ -804,150 +806,151 @@ static const char *help_urls[HELP_NAMES_SIZE] = {
"sndclm.html#nsincos", "sndclm.html#nsincos?", "sndclm.html#nssb", "sndclm.html#nssb?",
"sndclm.html#nxy1cos", "sndclm.html#nxy1cos?", "sndclm.html#nxy1sin", "sndclm.html#nxy1sin?",
"sndclm.html#nxycos", "sndclm.html#nxycos?", "sndclm.html#nxysin", "sndclm.html#nxysin?",
- "s7.html#objecttostring", "sndclm.html#oddmultiple", "sndclm.html#oddweight", "sndscm.html#offsetchannel",
- "sndscm.html#offsetsound", "sndclm.html#one-pole", "sndclm.html#one-pole-all-pass", "sndclm.html#one-pole-all-pass?",
- "sndclm.html#one-pole?", "sndclm.html#one-zero", "sndclm.html#one-zero?", "extsnd.html#openfiledialog",
- "extsnd.html#openfiledialogdirectory", "extsnd.html#openhook", "sndscm.html#opennextfileindirectory", "extsnd.html#openrawsound",
- "extsnd.html#openrawsoundhook", "extsnd.html#opensound", "s7.html#openlet", "s7.html#openletp",
- "extsnd.html#orientationhook", "sndclm.html#oscil", "sndclm.html#oscil-bank", "sndclm.html#oscil-bank?",
- "sndclm.html#oscil?", "sndclm.html#out-any", "sndclm.html#outbank", "sndclm.html#outa",
- "s7.html#outlet", "sndclm.html#*output*", "extsnd.html#outputcommenthook", "sndscm.html#overlayrmsenv",
- "s7.html#owlet", "extsnd.html#padchannel", "sndscm.html#padmarks", "sndscm.html#padsound",
- "s7.html#pairfilename", "s7.html#pairlinenumber", "sndscm.html#panmix", "sndscm.html#panmixvct",
- "sndclm.html#partialstopolynomial", "sndclm.html#partialstowave", "extsnd.html#pausing", "extsnd.html#peakenvdir",
- "extsnd.html#peaks", "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave", "sndclm.html#phase-vocoder",
- "sndclm.html#phase-vocoder?", "sndscm.html#pianodoc", "sndclm.html#pink-noise", "sndclm.html#pink-noise?",
- "sndscm.html#pins", "sndscm.html#placesound", "extsnd.html#play", "extsnd.html#playarrowsize",
- "sndscm.html#playbetweenmarks", "extsnd.html#playhook", "sndscm.html#playmixes", "sndscm.html#playoften",
- "sndscm.html#playregionforever", "sndscm.html#playsine", "sndscm.html#playsines", "sndscm.html#playsyncdmarks",
- "sndscm.html#playuntilcg", "sndscm.html#playwithenvs", "extsnd.html#playerhome", "extsnd.html#playerQ",
- "extsnd.html#players", "extsnd.html#playing", "sndscm.html#pluck", "sndclm.html#polartorectangular",
- "sndclm.html#polynomial", "sndscm.html#polydoc", "sndclm.html#polyoid", "sndclm.html#polyoidenv",
- "sndclm.html#polyoid?", "sndclm.html#polyshape", "sndclm.html#polyshape?", "sndclm.html#polywave",
- "sndclm.html#polywave?", "s7.html#portfilename", "s7.html#portlinenumber", "extsnd.html#positiontox",
- "extsnd.html#positiontoy", "extsnd.html#positioncolor", "sndscm.html#powerenv", "sndscm.html#pqw",
- "sndscm.html#pqwvox", "extsnd.html#preferencesdialog", "extsnd.html#previoussample", "extsnd.html#printdialog",
- "extsnd.html#printlength", "s7.html#proceduredocumentation", "s7.html#proceduresetter", "s7.html#proceduresignature",
- "s7.html#proceduresource", "extsnd.html#progressreport", "sndclm.html#pulse-train", "sndclm.html#pulse-train?",
- "sndclm.html#pulsedenv", "sndclm.html#pulsedenv?", "sndclm.html#r2k!cos", "sndclm.html#r2k!cos?",
- "sndclm.html#r2k2cos", "sndclm.html#r2k2cos?", "sndclm.html#radianstodegrees", "sndclm.html#radianstohz",
- "extsnd.html#rampchannel", "sndclm.html#rand", "sndclm.html#rand-interp", "sndclm.html#rand-interp?",
- "sndclm.html#rand?", "s7.html#random", "s7.html#randomstate", "s7.html#randomstatep",
- "sndclm.html#rcos", "sndclm.html#rcos?", "s7.html#readerrorhook", "extsnd.html#readhook",
- "extsnd.html#readmixsample", "extsnd.html#readonly", "extsnd.html#readregionsample", "extsnd.html#readsample",
- "extsnd.html#readsamplewithdirection", "s7.html#readercond", "sndclm.html#readin", "sndclm.html#readin?",
- "sndclm.html#rectangulartomagnitudes", "sndclm.html#rectangulartopolar", "extsnd.html#redo", "extsnd.html#regiontointeger",
- "extsnd.html#regiontovct", "extsnd.html#regionchans", "extsnd.html#regionframples", "extsnd.html#regiongraphstyle",
- "extsnd.html#regionhome", "extsnd.html#regionmaxamp", "extsnd.html#regionmaxampposition", "sndscm.html#regionplaylist",
- "extsnd.html#regionposition", "sndscm.html#regionrms", "extsnd.html#regionsample", "extsnd.html#regionsamplerQ",
- "extsnd.html#regionsrate", "extsnd.html#regionok", "extsnd.html#eregions", "extsnd.html#remembersoundstate",
- "sndscm.html#removeclicks", "extsnd.html#removefrommenu", "sndscm.html#replacewithselection", "sndscm.html#reportmarknames",
- "s7.html#requires7", "sndscm.html#resetallhooks", "extsnd.html#resetcontrols", "extsnd.html#resetlistenercursor",
- "sndscm.html#reson", "extsnd.html#restorecontrols", "sndclm.html#*reverb*", "extsnd.html#reverbdecay",
- "extsnd.html#reverbcontrolfeedback", "extsnd.html#reverbcontrollength", "extsnd.html#reverbcontrollengthbounds", "extsnd.html#reverbcontrollowpass",
- "extsnd.html#reverbcontrolscale", "extsnd.html#reverbcontrolscalebounds", "extsnd.html#reverbcontrolp", "s7.html#reverseb",
- "sndscm.html#reversebyblocks", "extsnd.html#reversechannel", "sndscm.html#reverseenvelope", "extsnd.html#reverseselection",
- "extsnd.html#reversesound", "extsnd.html#revertsound", "extsnd.html#rightsample", "sndclm.html#ring-modulate",
- "sndclm.html#rk!cos", "sndclm.html#rk!cos?", "sndclm.html#rk!ssb", "sndclm.html#rk!ssb?",
- "sndclm.html#rkcos", "sndclm.html#rkcos?", "sndclm.html#rkoddssb", "sndclm.html#rkoddssb?",
- "sndclm.html#rksin", "sndclm.html#rksin?", "sndclm.html#rkssb", "sndclm.html#rkssb?",
- "sndscm.html#rmsgain", "sndscm.html#rmsgain", "sndscm.html#rmsenvelope", "s7.html#rootlet",
- "sndclm.html#round-interp", "sndclm.html#round-interp?", "sndclm.html#rssb", "sndclm.html#rssbinterp",
- "sndclm.html#rssb?", "sndscm.html#rubbersound", "sndclm.html#rxycos", "sndclm.html#rxycos?",
- "sndclm.html#rxyk!cos", "sndclm.html#rxyk!cos?", "sndclm.html#rxyk!sin", "sndclm.html#rxyk!sin?",
- "sndclm.html#rxysin", "sndclm.html#rxysin?", "extsnd.html#sample", "sndclm.html#sampletofile",
- "sndclm.html#sampletofile?", "extsnd.html#sampletype", "extsnd.html#sampleratendQ", "extsnd.html#samplerhome",
- "extsnd.html#samplerposition", "extsnd.html#samplerQ", "extsnd.html#samples", "sndclm.html#samplestoseconds",
- "extsnd.html#sashcolor", "extsnd.html#saveasdialogautocomment", "extsnd.html#saveasdialogsrc", "extsnd.html#savecontrols",
- "extsnd.html#savedir", "extsnd.html#saveedithistory", "extsnd.html#saveenvelopes", "extsnd.html#savehook",
- "extsnd.html#savelistener", "sndscm.html#savemarkproperties", "extsnd.html#savemarks", "extsnd.html#savemix",
- "extsnd.html#saveregion", "extsnd.html#saveregiondialog", "extsnd.html#saveselection", "extsnd.html#saveselectiondialog",
- "extsnd.html#savesound", "extsnd.html#savesoundas", "extsnd.html#savesounddialog", "extsnd.html#savestate",
- "extsnd.html#savestatefile", "extsnd.html#savestatehook", "sndscm.html#sgfilter", "sndclm.html#sawtooth-wave",
- "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby", "extsnd.html#scalechannel", "sndscm.html#scaleenvelope",
- "sndscm.html#scalemixes", "extsnd.html#scaleselectionby", "extsnd.html#scaleselectionto", "sndscm.html#scalesound",
- "sndscm.html#scaletempo", "extsnd.html#scaleto", "extsnd.html#scanchannel", "sndscm.html#dspdocscanned",
- "sndscm.html#scentroid", "sndscm.html#scratch", "extsnd.html#scriptarg", "extsnd.html#scriptargs",
- "sndscm.html#searchforclick", "extsnd.html#searchprocedure", "sndclm.html#secondstosamples", "extsnd.html#selectall",
- "extsnd.html#selectchannel", "extsnd.html#selectchannelhook", "extsnd.html#selectsound", "extsnd.html#selectsoundhook",
- "extsnd.html#selectedchannel", "extsnd.html#selecteddatacolor", "extsnd.html#selectedgraphcolor", "extsnd.html#selectedsound",
- "extsnd.html#selection", "extsnd.html#selectiontomix", "extsnd.html#selectionchans", "extsnd.html#selectioncolor",
- "extsnd.html#selectioncontext", "extsnd.html#selectioncreatesregion", "extsnd.html#selectionframples", "extsnd.html#selectionmaxamp",
- "extsnd.html#selectionmaxampposition", "extsnd.html#selectionmember", "sndscm.html#selectionmembers", "extsnd.html#selectionposition",
- "sndscm.html#selectionrms", "extsnd.html#selectionsrate", "extsnd.html#selectionok", "extsnd.html#setsamples",
- "extsnd.html#shortfilename", "extsnd.html#showaxes", "extsnd.html#showcontrols", "sndscm.html#showdiskspace",
- "extsnd.html#showfullduration", "extsnd.html#showfullrange", "extsnd.html#showgrid", "extsnd.html#showindices",
- "extsnd.html#showlistener", "extsnd.html#showmarks", "extsnd.html#showmixwaveforms", "extsnd.html#showselection",
- "extsnd.html#showselectiontransform", "extsnd.html#showsonogramcursor", "extsnd.html#showtransformpeaks", "extsnd.html#showwidget",
- "extsnd.html#showyzero", "sndscm.html#silenceallmixes", "sndscm.html#silencemixes", "sndclm.html#sinc-train",
- "sndclm.html#sinc-train?", "extsnd.html#sincwidth", "sndscm.html#sineenvchannel", "sndscm.html#sineramp",
- "sndscm.html#singerdoc", "extsnd.html#smoothchannel", "extsnd.html#smoothselection", "extsnd.html#smoothsound",
- "sndscm.html#pins", "sndscm.html#snapmarktobeat", "sndscm.html#snapmarks", "sndscm.html#snapmixtobeat",
- "extsnd.html#sndtosample", "extsnd.html#sndtosamplep", "extsnd.html#sndcolor", "extsnd.html#snderror",
- "extsnd.html#snderrorhook", "extsnd.html#sndfont", "extsnd.html#sndgcs", "extsnd.html#sndhelp",
- "sndscm.html#sndscmhooks", "extsnd.html#sndopenedsound", "extsnd.html#sndprint", "extsnd.html#sndspectrum",
- "extsnd.html#sndtempnam", "extsnd.html#sndurl", "extsnd.html#sndurls", "extsnd.html#sndversion",
- "extsnd.html#sndwarning", "extsnd.html#sndwarninghook", "sndscm.html#sndwarp", "s7.html#sortb",
- "sndscm.html#soundtoamp_env", "extsnd.html#soundtointeger", "extsnd.html#soundfileextensions", "extsnd.html#soundfilep",
- "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp", "extsnd.html#soundloopinfo", "extsnd.html#soundproperties",
- "extsnd.html#soundproperty", "extsnd.html#soundwidgets", "extsnd.html#soundp", "extsnd.html#soundfontinfo",
- "extsnd.html#sounds", "sndscm.html#soundstosegmentdata", "sndscm.html#spectra", "sndscm.html#twotab",
- "sndscm.html#spectralpolynomial", "extsnd.html#spectrohop", "extsnd.html#spectroxangle", "extsnd.html#spectroxscale",
- "extsnd.html#spectroyangle", "extsnd.html#spectroyscale", "extsnd.html#spectrozangle", "extsnd.html#spectrozscale",
- "sndclm.html#spectrum", "sndscm.html#spectrumtocoeffs", "extsnd.html#spectrumend", "extsnd.html#spectrumstart",
- "extsnd.html#speedcontrol", "extsnd.html#speedcontrolbounds", "extsnd.html#speedstyle", "extsnd.html#speedtones",
- "sndscm.html#spotfreq", "sndclm.html#square-wave", "sndclm.html#square-wave?", "extsnd.html#squelchupdate",
- "sndscm.html#squelchvowels", "extsnd.html#srate", "sndclm.html#src", "extsnd.html#srcchannel",
- "sndscm.html#srcduration", "sndscm.html#srcfitenvelope", "sndscm.html#srcmixes", "extsnd.html#srcsoundselection",
- "extsnd.html#srcsound", "sndclm.html#src?", "sndclm.html#ssb-am", "sndclm.html#ssb-am?",
- "sndscm.html#ssbbank", "sndscm.html#ssbbankenv", "sndscm.html#ssbfm", "sndscm.html#startdac",
- "extsnd.html#startplaying", "extsnd.html#startplayinghook", "extsnd.html#startplayingselectionhook", "extsnd.html#startprogressreport",
- "extsnd.html#statusreport", "extsnd.html#stdinprompt", "sndscm.html#stereotomono", "sndscm.html#stereoflute",
- "extsnd.html#stopplayer", "extsnd.html#stopplaying", "extsnd.html#stopplayinghook", "extsnd.html#stopplayingselectionhook",
- "sndscm.html#stretchenvelope", "sndscm.html#stretchsoundviadft", "s7.html#stringposition", "s7.html#sublet",
- "sndscm.html#superimposeffts", "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels", "s7.html#symboltodynamicvalue",
- "s7.html#symboltovalue", "s7.html#symbolaccess", "s7.html#symboltable", "extsnd.html#sync",
- "sndscm.html#sync-everything", "extsnd.html#syncmax", "extsnd.html#syncstyle", "extsnd.html#syncdmarks",
- "sndscm.html#syncdmixes", "sndscm.html#syncup", "sndclm.html#table-lookup", "sndclm.html#table-lookup?",
- "sndclm.html#tanhsin", "sndclm.html#tanhsin?", "sndclm.html#tap", "sndclm.html#tap?",
- "sndscm.html#telephone", "extsnd.html#tempdir", "extsnd.html#textfocuscolor", "extsnd.html#timegraphstyle",
- "extsnd.html#timegraphtype", "extsnd.html#timegraphp", "sndclm.html#timestosamples", "extsnd.html#tinyfont",
- "sndscm.html#telephone", "s7.html#trace", "extsnd.html#trackingcursorstyle", "extsnd.html#transformtointeger",
- "extsnd.html#transformtovct", "extsnd.html#transformdialog", "extsnd.html#transformframples", "extsnd.html#transformgraphstyle",
- "extsnd.html#transformgraphtype", "extsnd.html#transformgraphp", "extsnd.html#normalizefft", "extsnd.html#transformsample",
- "extsnd.html#transformsize", "extsnd.html#transformtype", "extsnd.html#transformp", "sndscm.html#transposemixes",
- "sndclm.html#triangle-wave", "sndclm.html#triangle-wave?", "sndscm.html#tubebell", "sndscm.html#tubebell",
- "sndclm.html#two-pole", "sndclm.html#two-pole?", "sndscm.html#twotab", "sndclm.html#two-zero",
- "sndclm.html#two-zero?", "extsnd.html#unbindkey", "s7.html#unboundvariablehook", "sndscm.html#unclipchannel",
- "extsnd.html#undo", "extsnd.html#undohook", "s7.html#unlet", "extsnd.html#unselectall",
- "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph", "extsnd.html#updatesound",
- "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#uponsaveyourself", "sndscm.html#sndmotifdoc",
- "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "s7.html#varlet", "extsnd.html#vct",
- "extsnd.html#vcttimes", "extsnd.html#vctplus", "extsnd.html#vcttochannel", "extsnd.html#vcttolist",
- "extsnd.html#vcttostring", "extsnd.html#vcttovector", "extsnd.html#vctabs", "extsnd.html#vctadd",
- "extsnd.html#vctcopy", "extsnd.html#vctequal", "extsnd.html#vctfill", "extsnd.html#vctlength",
- "extsnd.html#vctmax", "extsnd.html#vctmin", "extsnd.html#vctmove", "extsnd.html#vctmultiply",
- "extsnd.html#vctoffset", "extsnd.html#vctpeak", "extsnd.html#vctref", "extsnd.html#vctreverse",
- "extsnd.html#vctscale", "extsnd.html#vctset", "extsnd.html#vctsubseq", "extsnd.html#vctsubtract",
- "extsnd.html#vctp", "extsnd.html#vectortovct", "sndscm.html#vibratinguniformcircularstring", "extsnd.html#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", "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"};
+ "s7.html#objecttolet", "s7.html#objecttostring", "sndclm.html#oddmultiple", "sndclm.html#oddweight",
+ "sndscm.html#offsetchannel", "sndscm.html#offsetsound", "sndclm.html#one-pole", "sndclm.html#one-pole-all-pass",
+ "sndclm.html#one-pole-all-pass?", "sndclm.html#one-pole?", "sndclm.html#one-zero", "sndclm.html#one-zero?",
+ "extsnd.html#openfiledialog", "extsnd.html#openfiledialogdirectory", "extsnd.html#openhook", "sndscm.html#opennextfileindirectory",
+ "extsnd.html#openrawsound", "extsnd.html#openrawsoundhook", "extsnd.html#opensound", "s7.html#openlet",
+ "s7.html#openletp", "extsnd.html#orientationhook", "sndclm.html#oscil", "sndclm.html#oscil-bank",
+ "sndclm.html#oscil-bank?", "sndclm.html#oscil?", "sndclm.html#out-any", "sndclm.html#outbank",
+ "sndclm.html#outa", "s7.html#outlet", "sndclm.html#*output*", "extsnd.html#outputcommenthook",
+ "sndscm.html#overlayrmsenv", "s7.html#owlet", "extsnd.html#padchannel", "sndscm.html#padmarks",
+ "sndscm.html#padsound", "s7.html#pairfilename", "s7.html#pairlinenumber", "sndscm.html#panmix",
+ "sndscm.html#panmixvct", "sndclm.html#partialstopolynomial", "sndclm.html#partialstowave", "extsnd.html#pausing",
+ "extsnd.html#peakenvdir", "extsnd.html#peaks", "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave",
+ "sndclm.html#phase-vocoder", "sndclm.html#phase-vocoder?", "sndscm.html#pianodoc", "sndclm.html#pink-noise",
+ "sndclm.html#pink-noise?", "sndscm.html#pins", "sndscm.html#placesound", "extsnd.html#play",
+ "extsnd.html#playarrowsize", "sndscm.html#playbetweenmarks", "extsnd.html#playhook", "sndscm.html#playmixes",
+ "sndscm.html#playoften", "sndscm.html#playregionforever", "sndscm.html#playsine", "sndscm.html#playsines",
+ "sndscm.html#playsyncdmarks", "sndscm.html#playuntilcg", "sndscm.html#playwithenvs", "extsnd.html#playerhome",
+ "extsnd.html#playerQ", "extsnd.html#players", "extsnd.html#playing", "sndscm.html#pluck",
+ "sndclm.html#polartorectangular", "sndclm.html#polynomial", "sndscm.html#polydoc", "sndclm.html#polyoid",
+ "sndclm.html#polyoidenv", "sndclm.html#polyoid?", "sndclm.html#polyshape", "sndclm.html#polyshape?",
+ "sndclm.html#polywave", "sndclm.html#polywave?", "s7.html#portfilename", "s7.html#portlinenumber",
+ "extsnd.html#positiontox", "extsnd.html#positiontoy", "extsnd.html#positioncolor", "sndscm.html#powerenv",
+ "sndscm.html#pqw", "sndscm.html#pqwvox", "extsnd.html#preferencesdialog", "extsnd.html#previoussample",
+ "extsnd.html#printdialog", "extsnd.html#printlength", "s7.html#proceduredocumentation", "s7.html#proceduresetter",
+ "s7.html#proceduresignature", "s7.html#proceduresource", "extsnd.html#progressreport", "sndclm.html#pulse-train",
+ "sndclm.html#pulse-train?", "sndclm.html#pulsedenv", "sndclm.html#pulsedenv?", "sndclm.html#r2k!cos",
+ "sndclm.html#r2k!cos?", "sndclm.html#r2k2cos", "sndclm.html#r2k2cos?", "sndclm.html#radianstodegrees",
+ "sndclm.html#radianstohz", "extsnd.html#rampchannel", "sndclm.html#rand", "sndclm.html#rand-interp",
+ "sndclm.html#rand-interp?", "sndclm.html#rand?", "s7.html#random", "s7.html#randomstate",
+ "s7.html#randomstatep", "sndclm.html#rcos", "sndclm.html#rcos?", "s7.html#readerrorhook",
+ "extsnd.html#readhook", "extsnd.html#readmixsample", "extsnd.html#readonly", "extsnd.html#readregionsample",
+ "extsnd.html#readsample", "extsnd.html#readsamplewithdirection", "s7.html#readercond", "sndclm.html#readin",
+ "sndclm.html#readin?", "sndclm.html#rectangulartomagnitudes", "sndclm.html#rectangulartopolar", "extsnd.html#redo",
+ "extsnd.html#regiontointeger", "extsnd.html#regiontovct", "extsnd.html#regionchans", "extsnd.html#regionframples",
+ "extsnd.html#regiongraphstyle", "extsnd.html#regionhome", "extsnd.html#regionmaxamp", "extsnd.html#regionmaxampposition",
+ "sndscm.html#regionplaylist", "extsnd.html#regionposition", "sndscm.html#regionrms", "extsnd.html#regionsample",
+ "extsnd.html#regionsamplerQ", "extsnd.html#regionsrate", "extsnd.html#regionok", "extsnd.html#eregions",
+ "extsnd.html#remembersoundstate", "sndscm.html#removeclicks", "extsnd.html#removefrommenu", "sndscm.html#replacewithselection",
+ "sndscm.html#reportmarknames", "s7.html#requires7", "sndscm.html#resetallhooks", "extsnd.html#resetcontrols",
+ "extsnd.html#resetlistenercursor", "sndscm.html#reson", "extsnd.html#restorecontrols", "sndclm.html#*reverb*",
+ "extsnd.html#reverbdecay", "extsnd.html#reverbcontrolfeedback", "extsnd.html#reverbcontrollength", "extsnd.html#reverbcontrollengthbounds",
+ "extsnd.html#reverbcontrollowpass", "extsnd.html#reverbcontrolscale", "extsnd.html#reverbcontrolscalebounds", "extsnd.html#reverbcontrolp",
+ "s7.html#reverseb", "sndscm.html#reversebyblocks", "extsnd.html#reversechannel", "sndscm.html#reverseenvelope",
+ "extsnd.html#reverseselection", "extsnd.html#reversesound", "extsnd.html#revertsound", "extsnd.html#rightsample",
+ "sndclm.html#ring-modulate", "sndclm.html#rk!cos", "sndclm.html#rk!cos?", "sndclm.html#rk!ssb",
+ "sndclm.html#rk!ssb?", "sndclm.html#rkcos", "sndclm.html#rkcos?", "sndclm.html#rkoddssb",
+ "sndclm.html#rkoddssb?", "sndclm.html#rksin", "sndclm.html#rksin?", "sndclm.html#rkssb",
+ "sndclm.html#rkssb?", "sndscm.html#rmsgain", "sndscm.html#rmsgain", "sndscm.html#rmsenvelope",
+ "s7.html#rootlet", "sndclm.html#round-interp", "sndclm.html#round-interp?", "sndclm.html#rssb",
+ "sndclm.html#rssbinterp", "sndclm.html#rssb?", "sndscm.html#rubbersound", "sndclm.html#rxycos",
+ "sndclm.html#rxycos?", "sndclm.html#rxyk!cos", "sndclm.html#rxyk!cos?", "sndclm.html#rxyk!sin",
+ "sndclm.html#rxyk!sin?", "sndclm.html#rxysin", "sndclm.html#rxysin?", "extsnd.html#sample",
+ "sndclm.html#sampletofile", "sndclm.html#sampletofile?", "extsnd.html#sampletype", "extsnd.html#sampleratendQ",
+ "extsnd.html#samplerhome", "extsnd.html#samplerposition", "extsnd.html#samplerQ", "extsnd.html#samples",
+ "sndclm.html#samplestoseconds", "extsnd.html#sashcolor", "extsnd.html#saveasdialogautocomment", "extsnd.html#saveasdialogsrc",
+ "extsnd.html#savecontrols", "extsnd.html#savedir", "extsnd.html#saveedithistory", "extsnd.html#saveenvelopes",
+ "extsnd.html#savehook", "extsnd.html#savelistener", "sndscm.html#savemarkproperties", "extsnd.html#savemarks",
+ "extsnd.html#savemix", "extsnd.html#saveregion", "extsnd.html#saveregiondialog", "extsnd.html#saveselection",
+ "extsnd.html#saveselectiondialog", "extsnd.html#savesound", "extsnd.html#savesoundas", "extsnd.html#savesounddialog",
+ "extsnd.html#savestate", "extsnd.html#savestatefile", "extsnd.html#savestatehook", "sndscm.html#sgfilter",
+ "sndclm.html#sawtooth-wave", "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby", "extsnd.html#scalechannel",
+ "sndscm.html#scaleenvelope", "sndscm.html#scalemixes", "extsnd.html#scaleselectionby", "extsnd.html#scaleselectionto",
+ "sndscm.html#scalesound", "sndscm.html#scaletempo", "extsnd.html#scaleto", "extsnd.html#scanchannel",
+ "sndscm.html#dspdocscanned", "sndscm.html#scentroid", "sndscm.html#scratch", "extsnd.html#scriptarg",
+ "extsnd.html#scriptargs", "sndscm.html#searchforclick", "extsnd.html#searchprocedure", "sndclm.html#secondstosamples",
+ "extsnd.html#selectall", "extsnd.html#selectchannel", "extsnd.html#selectchannelhook", "extsnd.html#selectsound",
+ "extsnd.html#selectsoundhook", "extsnd.html#selectedchannel", "extsnd.html#selecteddatacolor", "extsnd.html#selectedgraphcolor",
+ "extsnd.html#selectedsound", "extsnd.html#selection", "extsnd.html#selectiontomix", "extsnd.html#selectionchans",
+ "extsnd.html#selectioncolor", "extsnd.html#selectioncontext", "extsnd.html#selectioncreatesregion", "extsnd.html#selectionframples",
+ "extsnd.html#selectionmaxamp", "extsnd.html#selectionmaxampposition", "extsnd.html#selectionmember", "sndscm.html#selectionmembers",
+ "extsnd.html#selectionposition", "sndscm.html#selectionrms", "extsnd.html#selectionsrate", "extsnd.html#selectionok",
+ "extsnd.html#setsamples", "extsnd.html#shortfilename", "extsnd.html#showaxes", "extsnd.html#showcontrols",
+ "sndscm.html#showdiskspace", "extsnd.html#showfullduration", "extsnd.html#showfullrange", "extsnd.html#showgrid",
+ "extsnd.html#showindices", "extsnd.html#showlistener", "extsnd.html#showmarks", "extsnd.html#showmixwaveforms",
+ "extsnd.html#showselection", "extsnd.html#showselectiontransform", "extsnd.html#showsonogramcursor", "extsnd.html#showtransformpeaks",
+ "extsnd.html#showwidget", "extsnd.html#showyzero", "sndscm.html#silenceallmixes", "sndscm.html#silencemixes",
+ "sndclm.html#sinc-train", "sndclm.html#sinc-train?", "extsnd.html#sincwidth", "sndscm.html#sineenvchannel",
+ "sndscm.html#sineramp", "sndscm.html#singerdoc", "extsnd.html#smoothchannel", "extsnd.html#smoothselection",
+ "extsnd.html#smoothsound", "sndscm.html#pins", "sndscm.html#snapmarktobeat", "sndscm.html#snapmarks",
+ "sndscm.html#snapmixtobeat", "extsnd.html#sndtosample", "extsnd.html#sndtosamplep", "extsnd.html#sndcolor",
+ "extsnd.html#snderror", "extsnd.html#snderrorhook", "extsnd.html#sndfont", "extsnd.html#sndgcs",
+ "extsnd.html#sndhelp", "sndscm.html#sndscmhooks", "extsnd.html#sndopenedsound", "extsnd.html#sndprint",
+ "extsnd.html#sndspectrum", "extsnd.html#sndtempnam", "extsnd.html#sndurl", "extsnd.html#sndurls",
+ "extsnd.html#sndversion", "extsnd.html#sndwarning", "extsnd.html#sndwarninghook", "sndscm.html#sndwarp",
+ "s7.html#sortb", "sndscm.html#soundtoamp_env", "extsnd.html#soundtointeger", "extsnd.html#soundfileextensions",
+ "extsnd.html#soundfilep", "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp", "extsnd.html#soundloopinfo",
+ "extsnd.html#soundproperties", "extsnd.html#soundproperty", "extsnd.html#soundwidgets", "extsnd.html#soundp",
+ "extsnd.html#soundfontinfo", "extsnd.html#sounds", "sndscm.html#soundstosegmentdata", "sndscm.html#spectra",
+ "sndscm.html#twotab", "sndscm.html#spectralpolynomial", "extsnd.html#spectrohop", "extsnd.html#spectroxangle",
+ "extsnd.html#spectroxscale", "extsnd.html#spectroyangle", "extsnd.html#spectroyscale", "extsnd.html#spectrozangle",
+ "extsnd.html#spectrozscale", "sndclm.html#spectrum", "sndscm.html#spectrumtocoeffs", "extsnd.html#spectrumend",
+ "extsnd.html#spectrumstart", "extsnd.html#speedcontrol", "extsnd.html#speedcontrolbounds", "extsnd.html#speedstyle",
+ "extsnd.html#speedtones", "sndscm.html#spotfreq", "sndclm.html#square-wave", "sndclm.html#square-wave?",
+ "extsnd.html#squelchupdate", "sndscm.html#squelchvowels", "extsnd.html#srate", "sndclm.html#src",
+ "extsnd.html#srcchannel", "sndscm.html#srcduration", "sndscm.html#srcfitenvelope", "sndscm.html#srcmixes",
+ "extsnd.html#srcsoundselection", "extsnd.html#srcsound", "sndclm.html#src?", "sndclm.html#ssb-am",
+ "sndclm.html#ssb-am?", "sndscm.html#ssbbank", "sndscm.html#ssbbankenv", "sndscm.html#ssbfm",
+ "sndscm.html#startdac", "extsnd.html#startplaying", "extsnd.html#startplayinghook", "extsnd.html#startplayingselectionhook",
+ "extsnd.html#startprogressreport", "extsnd.html#statusreport", "extsnd.html#stdinprompt", "sndscm.html#stereotomono",
+ "sndscm.html#stereoflute", "extsnd.html#stopplayer", "extsnd.html#stopplaying", "extsnd.html#stopplayinghook",
+ "extsnd.html#stopplayingselectionhook", "sndscm.html#stretchenvelope", "sndscm.html#stretchsoundviadft", "s7.html#stringtobytevector",
+ "s7.html#stringposition", "s7.html#sublet", "sndscm.html#superimposeffts", "extsnd.html#swapchannels",
+ "sndscm.html#swapselectionchannels", "s7.html#symboltodynamicvalue", "s7.html#symboltovalue", "s7.html#symbolaccess",
+ "s7.html#symboltable", "extsnd.html#sync", "sndscm.html#sync-everything", "extsnd.html#syncmax",
+ "extsnd.html#syncstyle", "extsnd.html#syncdmarks", "sndscm.html#syncdmixes", "sndscm.html#syncup",
+ "sndclm.html#table-lookup", "sndclm.html#table-lookup?", "sndclm.html#tanhsin", "sndclm.html#tanhsin?",
+ "sndclm.html#tap", "sndclm.html#tap?", "sndscm.html#telephone", "extsnd.html#tempdir",
+ "extsnd.html#textfocuscolor", "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype", "extsnd.html#timegraphp",
+ "sndclm.html#timestosamples", "extsnd.html#tinyfont", "sndscm.html#telephone", "s7.html#trace",
+ "extsnd.html#trackingcursorstyle", "extsnd.html#transformtointeger", "extsnd.html#transformtovct", "extsnd.html#transformdialog",
+ "extsnd.html#transformframples", "extsnd.html#transformgraphstyle", "extsnd.html#transformgraphtype", "extsnd.html#transformgraphp",
+ "extsnd.html#normalizefft", "extsnd.html#transformsample", "extsnd.html#transformsize", "extsnd.html#transformtype",
+ "extsnd.html#transformp", "sndscm.html#transposemixes", "sndclm.html#triangle-wave", "sndclm.html#triangle-wave?",
+ "sndscm.html#tubebell", "sndscm.html#tubebell", "sndclm.html#two-pole", "sndclm.html#two-pole?",
+ "sndscm.html#twotab", "sndclm.html#two-zero", "sndclm.html#two-zero?", "extsnd.html#unbindkey",
+ "s7.html#unboundvariablehook", "sndscm.html#unclipchannel", "extsnd.html#undo", "extsnd.html#undohook",
+ "s7.html#unlet", "extsnd.html#unselectall", "sndscm.html#updategraphs", "extsnd.html#updatehook",
+ "extsnd.html#updatelispgraph", "extsnd.html#updatesound", "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph",
+ "sndscm.html#uponsaveyourself", "sndscm.html#sndmotifdoc", "sndscm.html#variabledisplay", "extsnd.html#variablegraphp",
+ "s7.html#varlet", "extsnd.html#vct", "extsnd.html#vcttimes", "extsnd.html#vctplus",
+ "extsnd.html#vcttochannel", "extsnd.html#vcttolist", "extsnd.html#vcttostring", "extsnd.html#vcttovector",
+ "extsnd.html#vctabs", "extsnd.html#vctadd", "extsnd.html#vctcopy", "extsnd.html#vctequal",
+ "extsnd.html#vctfill", "extsnd.html#vctlength", "extsnd.html#vctmax", "extsnd.html#vctmin",
+ "extsnd.html#vctmove", "extsnd.html#vctmultiply", "extsnd.html#vctoffset", "extsnd.html#vctpeak",
+ "extsnd.html#vctref", "extsnd.html#vctreverse", "extsnd.html#vctscale", "extsnd.html#vctset",
+ "extsnd.html#vctsubseq", "extsnd.html#vctsubtract", "extsnd.html#vctp", "extsnd.html#vectortovct",
+ "sndscm.html#vibratinguniformcircularstring", "extsnd.html#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", "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}",
@@ -1762,7 +1765,7 @@ static const char *Reverb_urls[] = {
#if HAVE_SCHEME
-static const char *snd_names[11630] = {
+static const char *snd_names[11634] = {
"*clm-array-print-length*", "ws.scm",
"*clm-channels*", "ws.scm",
"*clm-clipped*", "ws.scm",
@@ -2767,6 +2770,7 @@ static const char *snd_names[11630] = {
"IXANY", "libc.scm",
"IXOFF", "libc.scm",
"IXON", "libc.scm",
+ "In-t60", "piano.scm",
"LC_ADDRESS", "libc.scm",
"LC_ALL", "libc.scm",
"LC_COLLATE", "libc.scm",
@@ -6367,7 +6371,7 @@ static const char *snd_names[11630] = {
"legendre", "numerics.scm",
"legendre-polynomial", "numerics.scm",
"lesser-nighthawk", "animals.scm",
- "let-temporarily", "stuff.scm",
+ "let*-temporarily", "stuff.scm",
"libc.scm", "libc.scm",
"libdl.scm", "libdl.scm",
"libgdbm.scm", "libgdbm.scm",
@@ -6751,6 +6755,7 @@ static const char *snd_names[11630] = {
"nssb?", "generators.scm",
"ntohl", "libc.scm",
"ntohs", "libc.scm",
+ "null-environment", "stuff.scm",
"nxy1cos", "generators.scm",
"nxy1cos?", "generators.scm",
"nxy1sin", "generators.scm",
@@ -7582,7 +7587,7 @@ static const char *snd_names[11630] = {
static void autoload_info(s7_scheme *sc)
{
- s7_autoload_set_names(sc, snd_names, 5815);
+ s7_autoload_set_names(sc, snd_names, 5817);
}
#endif
diff --git a/snd.h b/snd.h
index e9b0db0..17590db 100644
--- a/snd.h
+++ b/snd.h
@@ -53,11 +53,11 @@
#include "snd-strings.h"
-#define SND_DATE "29-July-16"
+#define SND_DATE "6-Sep-16"
#ifndef SND_VERSION
-#define SND_VERSION "16.7"
+#define SND_VERSION "16.8"
#endif
#define SND_MAJOR_VERSION "16"
-#define SND_MINOR_VERSION "7"
+#define SND_MINOR_VERSION "8"
#endif
diff --git a/sndclm.html b/sndclm.html
index 0c00479..3bb7ff7 100644
--- a/sndclm.html
+++ b/sndclm.html
@@ -579,15 +579,15 @@ is the word "definstrument":
<pre class="indented">
(define (telephone start telephone-number)
- (let ((touch-tab-1 '(0 697 697 697 770 770 770 852 852 852 941 941 941))
- (touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477)))
- (do ((i 0 (+ i 1)))
- ((= i (length telephone-number)))
- (let* ((num (telephone-number i))
- (frq1 (touch-tab-1 num))
- (frq2 (touch-tab-2 num)))
- (<em class=red>simp</em> (+ start (* i .4)) .3 frq1 .1)
- (<em class=red>simp</em> (+ start (* i .4)) .3 frq2 .1)))))
+ (do ((touch-tab-1 '(0 697 697 697 770 770 770 852 852 852 941 941 941))
+ (touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477))
+ (i 0 (+ i 1)))
+ ((= i (length telephone-number)))
+ (let* ((num (telephone-number i))
+ (frq1 (touch-tab-1 num))
+ (frq2 (touch-tab-2 num)))
+ (<em class=red>simp</em> (+ start (* i .4)) .3 frq1 .1)
+ (<em class=red>simp</em> (+ start (* i .4)) .3 frq2 .1))))
(with-sound () (telephone 0.0 '(7 2 3 4 9 7 1)))
</pre>
@@ -3423,14 +3423,14 @@ large component for the carrier, and all the others are very small.
;; "wc" as carrier, "modfreq" as ncos freq,
;; "baseindex" as FM-index of first harmonic,
;; "n" as number of harmonics
- (let ((harms ())
- (amps ()))
- (do ((i 1 (+ i 1)))
- ((> i n))
- (set! harms (cons (* i modfreq) harms))
- (set! amps (cons (/ baseindex i n) amps)))
- (<a class=quiet href="sndscm.html#fmparallelcomponent">fm-parallel-component</a> freq-we-want wc
- (reverse harms) (reverse amps) () () #f)))
+ (do ((harms ())
+ (amps ())
+ (i 1 (+ i 1)))
+ ((> i n)
+ (<a class=quiet href="sndscm.html#fmparallelcomponent">fm-parallel-component</a> freq-we-want wc
+ (reverse harms) (reverse amps) () () #f))
+ (set! harms (cons (* i modfreq) harms))
+ (set! amps (cons (/ baseindex i n) amps))))
</pre>
<table class="method">
@@ -4869,10 +4869,10 @@ do perfectly well:
<pre class="indented">
(define (gaussian-noise)
- (let ((val 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 12) (/ val 12.0) )
- (set! val (+ val (random 1.0))))))
+ (do ((val 0.0)
+ (i 0 (+ i 1)))
+ ((= i 12) (/ val 12.0))
+ (set! val (+ val (random 1.0)))))
</pre>
<p>You can watch this (or any other distribution) in action via:
@@ -4888,12 +4888,12 @@ do perfectly well:
(rand (rands i)))
(do ((i 0 (+ i 1)))
((= i 100000))
- (let ((sum 0.0))
- (do ((k 0 (+ k 1)))
- ((= k n))
- (set! sum (+ sum (<em class=red>rand</em> (rands k)))))
- (let ((bin (floor (+ 100 (round sum)))))
- (set! (bins bin) (+ (bins bin) 1)))))
+ (do ((sum 0.0)
+ (k 0 (+ k 1)))
+ ((= k n)
+ (let ((bin (floor (+ 100 (round sum)))))
+ (set! (bins bin) (+ (bins bin) 1))))
+ (set! sum (+ sum (<em class=red>rand</em> (rands k))))))
bins))
(let ((ind (<a class=quiet href="extsnd.html#newsound">new-sound</a> "test.snd")))
@@ -4947,10 +4947,10 @@ but 0.5 should happen three times as often as either of the others:
</p>
<pre class="indented">
-(let ((vals (float-vector 0.0 0.5 0.5 0.5 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (<a class=quiet>format</a> () ";~A " (vals (random 5)))))
+(do ((vals (float-vector 0.0 0.5 0.5 0.5 1.0))
+ (i 0 (+ i 1)))
+ ((= i 10))
+ (<a class=quiet>format</a> () ";~A " (vals (random 5))))
</pre>
<p>These "distributions" refer to the values returned by the random number
@@ -4968,10 +4968,10 @@ than the preceding:
<pre class="indented">
(define (make-1f-noise n)
;; returns an array of rand's ready for the 1f-noise generator
- (let ((rans (make-vector n)))
- (do ((i 0 (+ i 1)))
- ((= i n) rans)
- (set! (rans i) (<em class=red>make-rand</em> :frequency (/ *clm-srate* (expt 2 i)))))))
+ (do ((rans (make-vector n))
+ (i 0 (+ i 1)))
+ ((= i n) rans)
+ (set! (rans i) (<em class=red>make-rand</em> :frequency (/ *clm-srate* (expt 2 i))))))
(define (1f-noise rans)
(let ((val 0.0)
@@ -5099,11 +5099,11 @@ We can also get all the period doublings and so on from sin:
<pre class="indented">
(<a class=quiet href="sndscm.html#withsound">with-sound</a> (:clipped #f :scaled-to 0.5)
- (let ((x 0.5))
- (do ((i 0 (+ i 1)))
- ((= i 44100))
- (outa i x)
- (set! x (* 4 (sin (* pi x)))))))
+ (do ((x 0.5)
+ (i 0 (+ i 1)))
+ ((= i 44100))
+ (outa i x)
+ (set! x (* 4 (sin (* pi x))))))
</pre>
<p>For an extended discussion of this case, complete with pictures of the
@@ -5557,10 +5557,10 @@ explicit do loop:
</p>
<pre class="indented">
-(let ((sum 0.0)) ; say we have n formant generators in the formants vector, and we're passing each a signal x
- (do ((i 0 (+ i 1)))
- ((= i n) sum)
- (set! sum (+ sum (formant (formants i) x)))))
+(do ((sum 0.0) ; say we have n formant generators in the formants vector, and we're passing each a signal x
+ (i 0 (+ i 1)))
+ ((= i n) sum)
+ (set! sum (+ sum (formant (formants i) x))))
</pre>
<p>can be replaced with:
@@ -6089,10 +6089,10 @@ be called via comb-bank.
</p>
<pre class="indented">
-(let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i n) sum)
- (set! sum (+ sum (comb (combs i) x)))))
+(do ((sum 0.0)
+ (i 0 (+ i 1)))
+ ((= i n) sum)
+ (set! sum (+ sum (comb (combs i) x))))
</pre>
<p>can be replaced with:
diff --git a/snddiff.scm b/snddiff.scm
index c9de21a..c86fad0 100644
--- a/snddiff.scm
+++ b/snddiff.scm
@@ -22,18 +22,17 @@
(let ((diff (float-vector-subtract! (copy v0) v1)))
(if (<= (float-vector-peak diff) maxdiff)
'no-difference
- (let ((diffs 0)
- (diff-data ())
- (len (min (length v0) (length v1))))
- (do ((i 0 (+ i 1)))
- ((or (> diffs 10)
- (= i len)))
- (if (> (abs (diff i)) .00001)
- (begin
- (set! diffs (+ diffs 1))
- (set! diff-data (cons (list i (v0 i) (v1 i)) diff-data)))))
- (and (< diffs 10)
- (list 'differences diff-data))))))
+ (do ((diffs 0)
+ (diff-data ())
+ (len (min (length v0) (length v1)))
+ (i 0 (+ i 1)))
+ ((or (> diffs 10)
+ (= i len))
+ (and (< diffs 10)
+ (list 'differences diff-data)))
+ (when (> (abs (diff i)) .00001)
+ (set! diffs (+ diffs 1))
+ (set! diff-data (cons (list i (v0 i) (v1 i)) diff-data)))))))
(define (float-vector-size v)
diff --git a/sndscm.html b/sndscm.html
index 75c1059..63314e9 100644
--- a/sndscm.html
+++ b/sndscm.html
@@ -3055,10 +3055,11 @@ filter 'order'. A common application cancels 60 Hz hum:
</p>
<pre class="indented">
-(notch-channel (let ((freqs ()))
- (do ((i 60 (+ i 60)))
- ((= i 3000))
- (set! freqs (cons i freqs))) (reverse freqs)))
+(notch-channel (do ((freqs ())
+ (i 60 (+ i 60)))
+ ((= i 3000)
+ (reverse freqs))
+ (set! freqs (cons i freqs))))
</pre>
<p>Here we've built a list of multiples of 60 and passed it to notch-channel. Its default notch
@@ -3070,10 +3071,12 @@ But, if the hum is not absolutely stable, you'll probably want wider notches:
</p>
<pre class="indented">
-(notch-channel (let ((freqs ()))
- (do ((i 60 (+ i 60)))
- ((= i 3000))
- (set! freqs (cons i freqs))) (reverse freqs)) 1024)
+(notch-channel (do ((freqs ())
+ (i 60 (+ i 60)))
+ ((= i 3000)
+ (reverse freqs))
+ (set! freqs (cons i freqs)))
+ 1024)
</pre>
<p>The order of 1024 means we get 20 Hz width minima (44100 Hz srate), so this
@@ -8690,23 +8693,23 @@ of harmonics, then the minimum peak amplitude, then (log peak n).
16 3.874 0.4884 | 14 3.598 0.4852 | 117 11.317 0.5095 | 93 11.942 0.5472
24 4.728 0.4888 | 13 3.475 0.4856 | 124 11.657 0.5095 | 23 5.562 0.5473
19 4.218 0.4889 | 18 4.070 0.4856 | 99 10.395 0.5095 | 22 5.434 0.5476
-22 4.540 0.4894 | 16 3.857 0.4869 | 120 11.467 0.5096 | 17 4.719 0.5476
-21 4.443 0.4898 | 15 3.738 0.4869 | 121 11.520 0.5096 | 95 12.115 0.5478
-15 3.768 0.4899 | 12 3.362 0.4879 | 128 11.857 0.5097 | 40 7.543 0.5478
-25 4.853 0.4907 | 21 4.422 0.4883 | 256 16.896 0.5098 | 77 10.803 0.5479
-13 3.524 0.4911 | 28 5.089 0.4883 | 96 10.249 0.5099 | 30 6.452 0.5481
-12 3.389 0.4911 | 23 4.655 0.4905 | 125 11.726 0.5099 | 39 7.452 0.5482
-18 4.140 0.4915 | 20 4.356 0.4912 | 102 10.574 0.5099 | 102 12.631 0.5484
-10 3.102 0.4917 | 31 5.419 0.4921 | 104 10.682 0.5100 | 86 11.518 0.5487
-29 5.241 0.4920 | 22 4.578 0.4922 | 123 11.636 0.5100 | 47 8.268 0.5487
-27 5.064 0.4922 | 24 4.786 0.4927 | 111 11.044 0.5100 | 63 9.713 0.5487
-28 5.157 0.4923 | 25 4.886 0.4928 | 100 10.472 0.5100 | 51 8.653 0.5488
+22 4.540 0.4894 | 21 4.399 0.4866 | 120 11.467 0.5096 | 17 4.719 0.5476
+21 4.443 0.4898 | 16 3.857 0.4869 | 121 11.520 0.5096 | 95 12.115 0.5478
+15 3.768 0.4899 | 20 4.300 0.4869 | 128 11.857 0.5097 | 40 7.543 0.5478
+25 4.853 0.4907 | 15 3.738 0.4869 | 256 16.896 0.5098 | 77 10.803 0.5479
+13 3.524 0.4911 | 12 3.362 0.4879 | 96 10.249 0.5099 | 30 6.452 0.5481
+12 3.389 0.4911 | 22 4.519 0.4880 | 125 11.726 0.5099 | 39 7.452 0.5482
+18 4.140 0.4915 | 28 5.089 0.4883 | 102 10.574 0.5099 | 102 12.631 0.5484
+10 3.102 0.4917 | 23 4.634 0.4891 | 104 10.682 0.5100 | 86 11.518 0.5487
+29 5.241 0.4920 | 25 4.834 0.4895 | 123 11.636 0.5100 | 47 8.268 0.5487
+27 5.064 0.4922 | 31 5.419 0.4921 | 111 11.044 0.5100 | 63 9.713 0.5487
+28 5.157 0.4923 | 24 4.783 0.4925 | 100 10.472 0.5100 | 51 8.653 0.5488
37 5.918 0.4924 | 33 5.603 0.4929 | 88 9.812 0.5100 | 94 12.115 0.5490
-35 5.762 0.4926 | 29 5.262 0.4931 | 116 11.309 0.5103 | 87 11.613 0.5491
+35 5.762 0.4926 | 29 5.257 0.4929 | 116 11.309 0.5103 | 87 11.613 0.5491
26 4.982 0.4929 | 30 5.353 0.4933 | 122 11.609 0.5104 | 109 13.144 0.5491
-33 5.608 0.4931 | 8 2.791 0.4935 | 109 10.962 0.5104 | 20 5.183 0.5492
-59 7.469 0.4931 | 27 5.087 0.4936 | 94 10.168 0.5105 | 21 5.324 0.5492
-32 5.526 0.4932 | 26 5.003 0.4942 | 103 10.655 0.5105 | 74 10.650 0.5496
+33 5.608 0.4931 | 27 5.085 0.4935 | 109 10.962 0.5104 | 20 5.183 0.5492
+59 7.469 0.4931 | 8 2.791 0.4935 | 94 10.168 0.5105 | 21 5.324 0.5492
+32 5.526 0.4932 | 26 4.997 0.4938 | 103 10.655 0.5105 | 74 10.650 0.5496
30 5.361 0.4937 | 7 2.618 0.4946 | 105 10.762 0.5105 | 89 11.788 0.5496
51 6.972 0.4939 | 32 5.563 0.4952 | 83 9.549 0.5106 | 29 6.365 0.5496
31 5.453 0.4939 | 52 7.080 0.4954 | 93 10.121 0.5107 | 96 12.293 0.5497
@@ -9386,12 +9389,11 @@ pvoc.scm also contains a few examples of using the CLM phase-vocoder generator:
512 4 128 1.0
#f ;no change to analysis
(lambda (v)
- (let ((N (length v)))
- (do ((i 0 (+ i 1)))
- ((= i N))
- (if (< ((phase-vocoder-amp-increments v) i) gate)
- (set! ((phase-vocoder-amp-increments v) i) 0.0)))
- #t))
+ (do ((N (length v))
+ (i 0 (+ i 1)))
+ ((= i N) #t)
+ (if (< ((phase-vocoder-amp-increments v) i) gate)
+ (set! ((phase-vocoder-amp-increments v) i) 0.0))))
#f))) ;no change to synthesis
(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (val)
(<a class=quiet href="sndclm.html#phase-vocoder">phase-vocoder</a> pv))))))
diff --git a/stochastic.scm b/stochastic.scm
index 19c2963..b2d3a43 100644
--- a/stochastic.scm
+++ b/stochastic.scm
@@ -30,11 +30,11 @@
;;init-array - initial x and y breakpoints for wave. x values must be
;; integers and 1 or greater, y values between -1.0 and 1.0
(let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (d-click (make-env (list 0 1 (- end 100) 1 end 0) :duration dur))
- ;;make float-vector to hold x,y breakpoints
- (xy-array (make-float-vector (* (length init-array) 2))))
- (let ((y 0.0)
+ (end (+ beg (seconds->samples dur))))
+ (let ((d-click (make-env (list 0 1 (- end 100) 1 end 0) :duration dur))
+ ;;make float-vector to hold x,y breakpoints
+ (xy-array (make-float-vector (* (length init-array) 2)))
+ (y 0.0)
(dx 0)
(prev-dx 0)
(dy 0.0)
@@ -46,7 +46,7 @@
(xdev 0)
(ydev 0)
(b (expt 2 (- bits 1)))
- (xy-array-l (floor (length xy-array))))
+ (xy-array-l (* (length init-array) 2)))
;;fill xy-array with values from init-array
(do ((iy 0 (+ iy 2));;index for reading values from init-array (a 2-dimensional list)
diff --git a/stuff.scm b/stuff.scm
index 772c29e..e444fa5 100644
--- a/stuff.scm
+++ b/stuff.scm
@@ -327,27 +327,7 @@
`(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1)))))))
vars)))))
-(define-macro (let-temporarily vars . body)
- `(with-let (#_inlet :orig (#_curlet)
- :saved (#_list ,@(map car vars))
- :new (#_list ,@(map cadr vars)))
- (dynamic-wind
- (lambda () #f)
- (lambda () ; this could be (with-let orig (let ,vars , at body)) but I want to handle stuff like individual vector locations
- ,@(map (let ((ctr -1))
- (lambda (v)
- (if (symbol? (car v))
- `(set! (orig ',(car v)) (list-ref new ,(set! ctr (+ ctr 1))))
- `(set! (with-let orig ,(car v)) (list-ref new ,(set! ctr (+ ctr 1)))))))
- vars)
- (with-let orig , at body))
- (lambda ()
- ,@(map (let ((ctr -1))
- (lambda (v)
- (if (symbol? (car v))
- `(set! (orig ',(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))
- `(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 (while test . body) ; while loop with predefined break and continue
`(call-with-exit
@@ -833,9 +813,9 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
(lognot (apply logior ints)))
(define (logeqv . ints)
- (if (odd? (length ints))
- (lognot (apply logxor -1 ints)) ; Clisp does it this way
- (lognot (apply logxor ints))))
+ (lognot (if (odd? (length ints))
+ (apply logxor -1 ints) ; Clisp does it this way
+ (apply logxor ints))))
(define (log-none-of . ints) ; bits on in none of ints
(lognot (apply logior ints)))
@@ -1113,9 +1093,9 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
0
(if (= mn 0)
1
- (let* ((mx (max k (- n k)))
- (cnk (+ 1 mx)))
- (do ((i 2 (+ i 1)))
+ (let ((mx (max k (- n k))))
+ (do ((cnk (+ 1 mx))
+ (i 2 (+ i 1)))
((> i mn) cnk)
(set! cnk (/ (* cnk (+ mx i)) i))))))))))))
@@ -1657,23 +1637,22 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
(cdr* obj start))
(else
- (let ((lst (make-list new-len #f)))
- (do ((i 0 (+ i 1)))
- ((= i new-len) lst)
- (set! (lst i) (obj (+ i start)))))))))
+ (do ((lst (make-list new-len #f))
+ (i 0 (+ i 1)))
+ ((= i new-len) lst)
+ (set! (lst i) (obj (+ i start))))))))
(define (sequence->string val)
- (format #f
- (cond ((or (not (sequence? val))
- (empty? val)) "~S")
- ((vector? val) "#(~{~A~| ~})")
- ((let? val) "(inlet ~{'~A~| ~})")
- ((hash-table? val) "(hash-table ~{'~A~| ~})")
- ((not (string? val)) "(~{~A~| ~})")
- ((byte-vector? val) "#u8(~{~D~| ~})")
- (else "\"~{~A~|~}\""))
- val))
+ (let ((ctrl-str (cond ((or (not (sequence? val))
+ (empty? val)) "~S")
+ ((vector? val) "#(~{~A~| ~})")
+ ((let? val) "(inlet ~{'~A~| ~})")
+ ((hash-table? val) "(hash-table ~{'~A~| ~})")
+ ((not (string? val)) "(~{~A~| ~})")
+ ((byte-vector? val) "#u8(~{~D~| ~})")
+ (else "\"~{~A~|~}\""))))
+ (format #f ctrl-str val)))
;;; ----------------
@@ -2130,3 +2109,22 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
(reader))
(string-append dir-name "/" file)))))))))))))))))
+
+;;; --------------------------------------------------------------------------------
+
+(define null-environment
+ (let ((e (let ((lt (inlet)))
+ (for-each (lambda (c)
+ (if (and (or (procedure? (cdr c))
+ (macro? (cdr c)))
+ (not (constant? (car c))))
+ (varlet lt (car c) (symbol "[" (symbol->string (car c)) "]"))))
+ (rootlet))
+ (sublet lt))))
+ (lambda () e))) ; always return the same env
+
+;;; since this is in the rootlet after we load stuff.scm, a subsequent reload
+;;; of stuff.scm will see it during the for-each above. If null-environment is the
+;;; environment (not a procedure), and is open (via openlet), (procedure? (cdr c))
+;;; becomes ((null-environment 'procedure?) null-environment) which is an error
+;;; because in that env, procedure? is the symbol '[procedure?]
diff --git a/tools/compsnd b/tools/compsnd
index 487d81e..00e6d68 100755
--- a/tools/compsnd
+++ b/tools/compsnd
@@ -25,6 +25,9 @@ fgrep -e "double* " *.h
fgrep -e "int* " *.h
fgrep -e "off_t* " *.[ch]
fgrep -e " long* " *.[ch]
+fgrep -e "propogat" *.[ch]
+fgrep -e "propogat" *.html
+fgrep -e "propogat" *.scm
grep ' \-\-$' *.html
/home/bil/cl/snd tools/va.scm
diff --git a/tools/gtk-header-diffs b/tools/gtk-header-diffs
index 7a91d8b..9628a7e 100755
--- a/tools/gtk-header-diffs
+++ b/tools/gtk-header-diffs
@@ -1,7 +1,7 @@
#!/bin/csh -f
-set gtkolddir = /home/bil/test/gtk+-3.21.3
-set gtknewdir = /home/bil/test/gtk+-3.21.4
+set gtkolddir = /home/bil/test/gtk+-3.21.4
+set gtknewdir = /home/bil/test/gtk+-3.21.5
set pangoolddir = /home/bil/test/pango-1.36.8
set pangonewdir = /home/bil/test/pango-1.36.8
set glibolddir = /home/bil/test/glib-2.39.3
diff --git a/tools/make-index.scm b/tools/make-index.scm
index 356aa62..34ce246 100644
--- a/tools/make-index.scm
+++ b/tools/make-index.scm
@@ -191,8 +191,8 @@
(string-position (car cap) line))
(pair? cap)))))
;; find the first character of the >name< business and downcase it
- (let ((bpos (char-position #\> line)))
- (set! (line (+ bpos 1)) (char-downcase (line (+ bpos 1))))))
+ (let ((bpos (+ 1 (char-position #\> line))))
+ (set! (line bpos) (char-downcase (line bpos)))))
(let ((bpos (char-position #\> line))
(epos (or (string-position "</a>" line)
@@ -373,7 +373,6 @@
url-str))))
-
;;; --------------------------------------------------------------------------------
;;; get indexer.data
@@ -771,7 +770,7 @@
(typecase "stuff.scm")
(enum "stuff.scm")
(while "stuff.scm")
- (let-temporarily "stuff.scm")
+ (let*-temporarily "stuff.scm")
(define-class "stuff.scm")
(elambda "stuff.scm")
(value->symbol "stuff.scm")
@@ -783,6 +782,7 @@
(reactive-lambda* "stuff.scm")
(pretty-print "write.scm")
(fully-macroexpand "stuff.scm")
+ (null-environment "stuff.scm")
(*mock-vector* "mockery.scm")
(*mock-port* "mockery.scm")
(*mock-symbol* "mockery.scm")
@@ -1112,49 +1112,43 @@
(format ofil "<table>~% <tr>")
(set! got-tr #t)
- (let ((row 0)
- (ctr 0)
- (offset (ceiling (/ n cols))))
- (do ((i 0 (+ i 1)))
- ((>= row offset))
- (let ((x (+ row (* ctr offset))))
- (if (>= x n)
- (format ofil "~%")
- (let ((name (tnames x)))
- (format ofil
- "<td~A>~A~A~A</td>"
- (if (or (not (ind-name name))
- (ind-sortby name))
- ""
- " class=\"green\"")
- (if (ind-char name)
- "<div class=\"centered\">"
- "<em class=tab>")
- (or (ind-char name)
- (ind-name name)
- " ")
-; (if (and (not (ind-char name))
-; (string? (ind-file name))
-; (string=? (ind-file name) "s7.html"))
-; " (s7)"
-; "")
-;; this looks kinda dumb
- (if (ind-char name)
- "</div>"
- "</em>")
- )
- (if (ind-indexed name)
- (format () "~A indexed twice~%" (ind-name name)))
- (set! (ind-indexed name) #t))))
- (set! ctr (+ ctr 1))
- (when (< ctr cols)
- (format ofil "<td></td>"))
-
- (when (= ctr cols)
- (if got-tr (begin (format ofil "</tr>~%") (set! got-tr #f)))
- (set! row (+ row 1))
- (if (< i n) (begin (format ofil " <tr>") (set! got-tr #t)))
- (set! ctr 0))))
+ (do ((row 0)
+ (ctr 0)
+ (offset (ceiling (/ n cols)))
+ (i 0 (+ i 1)))
+ ((>= row offset))
+ (let ((x (+ row (* ctr offset))))
+ (if (>= x n)
+ (format ofil "~%")
+ (let ((name (tnames x)))
+ (format ofil
+ "<td~A>~A~A~A</td>"
+ (if (or (not (ind-name name))
+ (ind-sortby name))
+ ""
+ " class=\"green\"")
+ (if (ind-char name)
+ "<div class=\"centered\">"
+ "<em class=tab>")
+ (or (ind-char name)
+ (ind-name name)
+ " ")
+ (if (ind-char name)
+ "</div>"
+ "</em>")
+ )
+ (if (ind-indexed name)
+ (format () "~A indexed twice~%" (ind-name name)))
+ (set! (ind-indexed name) #t))))
+ (set! ctr (+ ctr 1))
+ (when (< ctr cols)
+ (format ofil "<td></td>"))
+
+ (when (= ctr cols)
+ (if got-tr (begin (format ofil "</tr>~%") (set! got-tr #f)))
+ (set! row (+ row 1))
+ (if (< i n) (begin (format ofil " <tr>") (set! got-tr #t)))
+ (set! ctr 0)))
(format ofil "~%</table>~%</body></html>~%")))
;; end output
@@ -1272,342 +1266,342 @@
(lambda (file)
(call-with-input-file file
(lambda (f)
- (let ((linectr -1)
- (commands ())
- (comments 0)
- (openctr 0)
- (warned #f)
- (p-parens 0)
- (p-quotes 0)
- (p-curlys 0)
- (in-comment #f)
- (scripting #f))
- (do ((line (read-line f) (read-line f)))
- ((eof-object? line))
- (set! linectr (+ linectr 1))
- (let* ((len (length line))
- (opos (and (positive? len)
- (char-position "<>\"(){}&" line)))
- (cpos (and (not opos)
- in-comment
- (string-position " -- " line))))
- (when cpos
- (format () "~A[~D]: possible -- in comment: ~A~%" file linectr line))
- (when opos
- ;; open/close html entities
- (do ((i opos (or (char-position "<>\"(){}&" line (+ i 1)) len)))
- ((>= i len))
- (case (string-ref line i)
- ((#\<)
- (unless scripting
- (if (not (or (zero? openctr)
- (positive? p-quotes)
- in-comment))
- (format () "~A[~D]: ~A has unclosed <?~%" file linectr line))
- (set! openctr (+ openctr 1))
- (if (and (< i (- len 3))
- (char=? (line (+ i 1)) #\!)
- (char=? (line (+ i 2)) #\-)
- (char=? (line (+ i 3)) #\-))
- (begin
- (set! comments (+ comments 1))
- (if (> comments 1)
- (begin
- (format () "~A[~D]: nested <!--?~%" file linectr)
- (set! comments (- comments 1))))
- (set! in-comment #t)))
- (if (and (not in-comment)
- (< i (- len 1))
- (char=? (line (+ i 1)) #\space))
- (format () "~A[~D]: '< ' in ~A?~%" file linectr line))))
- ;; else c != <
-
- ((#\>)
- (unless scripting
- (set! openctr (- openctr 1))
- (if (and (>= i 2)
- (char=? (line (- i 1)) #\-)
- (char=? (line (- i 2)) #\-))
- (begin
- (set! in-comment #f)
- (set! comments (- comments 1))
- (if (< comments 0)
- (begin
- (format () "~A[~D]: extra -->?~%" file linectr)
- (set! comments 0))))
- (if (not (or (zero? openctr)
- (positive? p-quotes)
- in-comment))
- (format () "~A[~D]: ~A has unmatched >?~%" file linectr line)))
- (set! openctr 0)
- (if (and (not in-comment)
- (>= i 2)
- (char=? (line (- i 1)) #\-)
- (not (char=? (line (- i 2)) #\-))
- (< i (- len 1))
- (alphanumeric? (line (+ i 1))))
- (format () "~A[~D]: untranslated '>': ~A~%" file linectr line))))
- ;; else c != < or >
-
- ((#\()
- (set! p-parens (+ p-parens 1)))
-
- ((#\))
- (set! p-parens (- p-parens 1)))
-
- ((#\")
- (if (or (= i 0)
- (not (char=? (line (- i 1)) #\\)))
- (set! p-quotes (+ p-quotes 1))))
-
- ((#\&)
+ (do ((linectr -1)
+ (commands ())
+ (comments 0)
+ (openctr 0)
+ (warned #f)
+ (p-parens 0)
+ (p-quotes 0)
+ (p-curlys 0)
+ (in-comment #f)
+ (scripting #f)
+ (line (read-line f) (read-line f)))
+ ((eof-object? line)
+ (if (pair? commands)
+ (format () "open directives at end of ~A: ~A~%" file commands)))
+ (set! linectr (+ linectr 1))
+ (let* ((len (length line))
+ (opos (and (positive? len)
+ (char-position "<>\"(){}&" line)))
+ (cpos (and (not opos)
+ in-comment
+ (string-position " -- " line))))
+ (when cpos
+ (format () "~A[~D]: possible -- in comment: ~A~%" file linectr line))
+ (when opos
+ ;; open/close html entities
+ (do ((i opos (or (char-position "<>\"(){}&" line (+ i 1)) len)))
+ ((>= i len))
+ (case (string-ref line i)
+ ((#\<)
+ (unless scripting
+ (if (not (or (zero? openctr)
+ (positive? p-quotes)
+ in-comment))
+ (format () "~A[~D]: ~A has unclosed <?~%" file linectr line))
+ (set! openctr (+ openctr 1))
+ (if (and (< i (- len 3))
+ (char=? (line (+ i 1)) #\!)
+ (char=? (line (+ i 2)) #\-)
+ (char=? (line (+ i 3)) #\-))
+ (begin
+ (set! comments (+ comments 1))
+ (if (> comments 1)
+ (begin
+ (format () "~A[~D]: nested <!--?~%" file linectr)
+ (set! comments (- comments 1))))
+ (set! in-comment #t)))
+ (if (and (not in-comment)
+ (< i (- len 1))
+ (char=? (line (+ i 1)) #\space))
+ (format () "~A[~D]: '< ' in ~A?~%" file linectr line))))
+ ;; else c != <
+
+ ((#\>)
+ (unless scripting
+ (set! openctr (- openctr 1))
+ (if (and (>= i 2)
+ (char=? (line (- i 1)) #\-)
+ (char=? (line (- i 2)) #\-))
+ (begin
+ (set! in-comment #f)
+ (set! comments (- comments 1))
+ (if (< comments 0)
+ (begin
+ (format () "~A[~D]: extra -->?~%" file linectr)
+ (set! comments 0))))
+ (if (not (or (zero? openctr)
+ (positive? p-quotes)
+ in-comment))
+ (format () "~A[~D]: ~A has unmatched >?~%" file linectr line)))
+ (set! openctr 0)
(if (and (not in-comment)
- (case (string-ref line (+ i 1))
- ((#\g) (not (string=? ">" (substring line i (min len (+ i 4))))))
- ((#\l) (not (or (string=? "<" (substring line i (min len (+ i 4))))
- (string=? "λ" (substring line i (min len (+ i 8)))))))
- ((#\a) (not (string=? "&" (substring line i (min len (+ i 5))))))
- ((#\q) (not (string=? """ (substring line i (min len (+ i 6))))))
- ((#\o) (not (string=? "ö" (substring line i (min len (+ i 6))))))
- ((#\m) (not (member (substring line i (min len (+ i 7))) '("—" "µ") string=?)))
- ((#\n) (not (string=? " " (substring line i (min len (+ i 6))))))
- ((#\&) (not (string=? "&&" (substring line i (min len (+ i 2))))))
- ((#\space) (not (string=? "& " (substring line i (min len (+ i 2)))))) ; following char -- should skip this
- (else #t)))
- (format () "~A[~D]: unknown escape sequence: ~A~%" file linectr line)))
-
- ((#\{)
- (set! p-curlys (+ p-curlys 1)))
-
- ((#\})
- (set! p-curlys (- p-curlys 1)))))
-
- ;; end line scan
- (unless in-comment
- (let ((start #f)
- (closing #f)
- (pos (char-position #\< line)))
- (when pos
- (do ((i pos (or (char-position "</! >" line (+ i 1)) len)))
- ((>= i len))
- (case (string-ref line i)
- ((#\space #\>)
- (when start
- (if closing
- (let ((closer (string->symbol (substring line (+ start 2) i))))
- (if (eq? closer 'TABLE) (set! closer 'table))
- (cond ((memq closer '(center big font))
- (format () "~A[~D]: ~A is obsolete, ~A~%" file linectr closer line))
-
- ((eq? closer 'script)
- (set! scripting #f))
-
- (scripting)
-
- ((not (memq closer commands))
- (format () "~A[~D]: ~A without start? ~A from [~D:~D] (commands: ~A)~%"
- file linectr closer line (+ start 2) i commands))
-
- ((not (hash-table-ref closables closer))
- (set! commands (remove-all closer commands)))
-
- (else
- (if (not (eq? (car commands) closer))
- (format () "~A[~D]: ~A -> ~A?~%" file linectr closer commands))
-
- (if (memq closer '(p td pre))
+ (>= i 2)
+ (char=? (line (- i 1)) #\-)
+ (not (char=? (line (- i 2)) #\-))
+ (< i (- len 1))
+ (alphanumeric? (line (+ i 1))))
+ (format () "~A[~D]: untranslated '>': ~A~%" file linectr line))))
+ ;; else c != < or >
+
+ ((#\()
+ (set! p-parens (+ p-parens 1)))
+
+ ((#\))
+ (set! p-parens (- p-parens 1)))
+
+ ((#\")
+ (if (or (= i 0)
+ (not (char=? (line (- i 1)) #\\)))
+ (set! p-quotes (+ p-quotes 1))))
+
+ ((#\&)
+ (if (and (not in-comment)
+ (case (string-ref line (+ i 1))
+ ((#\g) (not (string=? ">" (substring line i (min len (+ i 4))))))
+ ((#\l) (not (or (string=? "<" (substring line i (min len (+ i 4))))
+ (string=? "λ" (substring line i (min len (+ i 8)))))))
+ ((#\a) (not (string=? "&" (substring line i (min len (+ i 5))))))
+ ((#\q) (not (string=? """ (substring line i (min len (+ i 6))))))
+ ((#\o) (not (string=? "ö" (substring line i (min len (+ i 6))))))
+ ((#\m) (not (member (substring line i (min len (+ i 7))) '("—" "µ") string=?)))
+ ((#\n) (not (string=? " " (substring line i (min len (+ i 6))))))
+ ((#\&) (not (string=? "&&" (substring line i (min len (+ i 2))))))
+ ((#\space) (not (string=? "& " (substring line i (min len (+ i 2)))))) ; following char -- should skip this
+ (else #t)))
+ (format () "~A[~D]: unknown escape sequence: ~A~%" file linectr line)))
+
+ ((#\{)
+ (set! p-curlys (+ p-curlys 1)))
+
+ ((#\})
+ (set! p-curlys (- p-curlys 1)))))
+
+ ;; end line scan
+ (unless in-comment
+ (let ((start #f)
+ (closing #f)
+ (pos (char-position #\< line)))
+ (when pos
+ (do ((i pos (or (char-position "</! >" line (+ i 1)) len)))
+ ((>= i len))
+ (case (string-ref line i)
+ ((#\space #\>)
+ (when start
+ (if closing
+ (let ((closer (string->symbol (substring line (+ start 2) i))))
+ (if (eq? closer 'TABLE) (set! closer 'table))
+ (cond ((memq closer '(center big font))
+ (format () "~A[~D]: ~A is obsolete, ~A~%" file linectr closer line))
+
+ ((eq? closer 'script)
+ (set! scripting #f))
+
+ (scripting)
+
+ ((not (memq closer commands))
+ (format () "~A[~D]: ~A without start? ~A from [~D:~D] (commands: ~A)~%"
+ file linectr closer line (+ start 2) i commands))
+
+ ((not (hash-table-ref closables closer))
+ (set! commands (remove-all closer commands)))
+
+ (else
+ (if (not (eq? (car commands) closer))
+ (format () "~A[~D]: ~A -> ~A?~%" file linectr closer commands))
+
+ (if (memq closer '(p td pre))
+ (begin
+ (if (odd? p-quotes)
+ (format () "~A[~D]: unmatched quote~%" file linectr))
+ (set! p-quotes 0)
+ (cond ((= p-curlys 1)
+ (format () "~A[~D]: extra '{'~%" file linectr))
+ ((= p-curlys -1)
+ (format () "~A[~D]: extra '}'~%" file linectr))
+ ((not (= p-curlys 0))
+ (format () "~A[~D]: curlys: ~D~%" file linectr p-curlys)))
+ (set! p-curlys 0)
+ (cond ((= p-parens 1)
+ (format () "~A[~D]: extra '('~%" file linectr))
+ ((= p-parens -1)
+ (format () "~A[~D]: extra ')'~%" file linectr))
+ ((not (= p-parens 0))
+ (format () "~A[~D]: parens: ~D~%" file linectr p-parens)))
+ (set! p-parens 0)))
+
+ (set! commands (remove-one closer commands))
+ (when (and (not warned)
+ (eq? closer 'table)
+ (not (memq 'table commands)))
+ (if (memq 'tr commands)
(begin
- (if (odd? p-quotes)
- (format () "~A[~D]: unmatched quote~%" file linectr))
- (set! p-quotes 0)
- (cond ((= p-curlys 1)
- (format () "~A[~D]: extra '{'~%" file linectr))
- ((= p-curlys -1)
- (format () "~A[~D]: extra '}'~%" file linectr))
- ((not (= p-curlys 0))
- (format () "~A[~D]: curlys: ~D~%" file linectr p-curlys)))
- (set! p-curlys 0)
- (cond ((= p-parens 1)
- (format () "~A[~D]: extra '('~%" file linectr))
- ((= p-parens -1)
- (format () "~A[~D]: extra ')'~%" file linectr))
- ((not (= p-parens 0))
- (format () "~A[~D]: parens: ~D~%" file linectr p-parens)))
- (set! p-parens 0)))
-
- (set! commands (remove-one closer commands))
- (when (and (not warned)
- (eq? closer 'table)
- (not (memq 'table commands)))
- (if (memq 'tr commands)
- (begin
- (set! warned #t)
- (set! commands (remove-all 'tr commands))
- (format () "~A[~D]: unclosed tr at table (~A)~%" file linectr commands)))
- (if (memq 'td commands)
- (begin
- (set! warned #t)
- (set! commands (remove-all 'td commands))
- (format () "~A[~D]: unclosed td at table (~A)~%" file linectr commands))))))
- (set! closing #f))
-
- ;; not closing
- (unless scripting
- (let ((opener (string->symbol (substring line (+ start 1) i))))
- (if (eq? opener 'TABLE) (set! opener 'table))
- (cond ((memq opener '(center big font))
- (format () "~A[~D]: ~A is obsolete, ~A~%" file linectr opener line))
-
- ((eq? opener 'script)
- (set! scripting #t))
-
- ((eq? opener 'img)
- (let ((rest-line (substring line (+ start 4))))
- (let ((alt-pos (string-position "alt=" rest-line))
- (src-pos (string-position "src=" rest-line)))
- (if (not alt-pos)
- (format () "~A[~D]: img but no alt: ~A~%" file linectr line))
- (if src-pos
- (let ((png-pos (string-position ".png" rest-line)))
- (if png-pos
- (let ((file (substring rest-line (+ src-pos 5) (+ png-pos 4))))
- (if (not (file-exists? file))
- (format () "~A[~D]: src not found: ~S~%" file linectr file)))))))))
-
- ((and (not (memq opener '(br spacer li hr area ul tr td table small sub blockquote)))
- (memq opener commands)
- (= p-quotes 0))
- (format () "~A[~D]: nested ~A? ~A from: ~A~%" file linectr opener line commands))
- (else
- (case opener
- ((td)
- (if (not (eq? 'tr (car commands)))
- (format () "~A[~D]: td without tr?~%" file linectr))
- (if (and (not warned)
- (memq 'td commands)
- (< (count-table commands) 2))
- (begin
- (set! warned #t)
- (set! commands (remove-one 'td commands))
- (format () "~A[~D]: unclosed td at table~%" file linectr))))
- ((tr)
- (if (not (or (eq? (car commands) 'table)
- (eq? (cadr commands) 'table)))
- (format () "~A[~D]: tr without table?~%" file linectr))
- (if (and (not warned)
- (memq 'tr commands)
- (< (count-table commands) 2))
- (begin
- (set! warned #t)
- (set! commands (remove-one 'tr commands))
- (format () "~A[~D]: unclosed tr at table~%" file linectr))))
- ((p)
- (if (eq? (car commands) 'table)
- (format () "~A[~D]: unclosed table?~%" file linectr)))
-
- ((pre br table hr img ul)
- (if (memq 'p commands)
- (format () "~A[~D]: ~A within <p>?~%" file linectr opener)))
- ((li)
- (if (not (memq 'ul commands))
- (format () "~A[~D]: li without ul~%" file linectr)))
- ((small)
- (if (memq (car commands) '(pre code))
- (format () "~A[~D]: small shouldn't follow ~A~%" file linectr (car commands))))
- ((--)
- (format () "~A[~D]: <-- missing !?~%" file linectr)))
- (if (not (memq opener '(br meta spacer li hr area)))
- (set! commands (cons opener commands))))))))
- ;; end if closing
- (set! start #f)))
+ (set! warned #t)
+ (set! commands (remove-all 'tr commands))
+ (format () "~A[~D]: unclosed tr at table (~A)~%" file linectr commands)))
+ (if (memq 'td commands)
+ (begin
+ (set! warned #t)
+ (set! commands (remove-all 'td commands))
+ (format () "~A[~D]: unclosed td at table (~A)~%" file linectr commands))))))
+ (set! closing #f))
+
+ ;; not closing
+ (unless scripting
+ (let ((opener (string->symbol (substring line (+ start 1) i))))
+ (if (eq? opener 'TABLE) (set! opener 'table))
+ (cond ((memq opener '(center big font))
+ (format () "~A[~D]: ~A is obsolete, ~A~%" file linectr opener line))
+
+ ((eq? opener 'script)
+ (set! scripting #t))
+
+ ((eq? opener 'img)
+ (let ((rest-line (substring line (+ start 4))))
+ (let ((alt-pos (string-position "alt=" rest-line))
+ (src-pos (string-position "src=" rest-line)))
+ (if (not alt-pos)
+ (format () "~A[~D]: img but no alt: ~A~%" file linectr line))
+ (if src-pos
+ (let ((png-pos (string-position ".png" rest-line)))
+ (if png-pos
+ (let ((file (substring rest-line (+ src-pos 5) (+ png-pos 4))))
+ (if (not (file-exists? file))
+ (format () "~A[~D]: src not found: ~S~%" file linectr file)))))))))
+
+ ((and (not (memq opener '(br spacer li hr area ul tr td table small sub blockquote)))
+ (memq opener commands)
+ (= p-quotes 0))
+ (format () "~A[~D]: nested ~A? ~A from: ~A~%" file linectr opener line commands))
+ (else
+ (case opener
+ ((td)
+ (if (not (eq? 'tr (car commands)))
+ (format () "~A[~D]: td without tr?~%" file linectr))
+ (if (and (not warned)
+ (memq 'td commands)
+ (< (count-table commands) 2))
+ (begin
+ (set! warned #t)
+ (set! commands (remove-one 'td commands))
+ (format () "~A[~D]: unclosed td at table~%" file linectr))))
+ ((tr)
+ (if (not (or (eq? (car commands) 'table)
+ (eq? (cadr commands) 'table)))
+ (format () "~A[~D]: tr without table?~%" file linectr))
+ (if (and (not warned)
+ (memq 'tr commands)
+ (< (count-table commands) 2))
+ (begin
+ (set! warned #t)
+ (set! commands (remove-one 'tr commands))
+ (format () "~A[~D]: unclosed tr at table~%" file linectr))))
+ ((p)
+ (if (eq? (car commands) 'table)
+ (format () "~A[~D]: unclosed table?~%" file linectr)))
+
+ ((pre br table hr img ul)
+ (if (memq 'p commands)
+ (format () "~A[~D]: ~A within <p>?~%" file linectr opener)))
+ ((li)
+ (if (not (memq 'ul commands))
+ (format () "~A[~D]: li without ul~%" file linectr)))
+ ((small)
+ (if (memq (car commands) '(pre code))
+ (format () "~A[~D]: small shouldn't follow ~A~%" file linectr (car commands))))
+ ((--)
+ (format () "~A[~D]: <-- missing !?~%" file linectr)))
+ (if (not (memq opener '(br meta spacer li hr area)))
+ (set! commands (cons opener commands))))))))
+ ;; end if closing
+ (set! start #f)))
+
+ ((#\<)
+ (if start
+ (if (not (or scripting
+ (positive? p-quotes)))
+ (format () "~A[~D]: nested < ~A~%" file linectr line))
+ (set! start i)))
+ ((#\/)
+ (if (and (integer? start) (= start (- i 1)))
+ (set! closing #t)))
+
+ ((#\!)
+ (if (and (integer? start) (= start (- i 1)))
+ (set! start #f)))))))
+ ) ; if not in-comment...
+
+ ;; search for name
+ (let ((dline line))
+ (do ((pos (string-position "<em class=def id=" dline))
+ (pos-len 18))
+ ((not pos))
+ (set! dline (substring dline (+ pos pos-len)))
+ (let ((epos (or (string-position "</a>" dline)
+ (string-position "</em>" dline)
+ (string-position "</A>" dline))))
+ ;;actually should look for close double quote
+ (if (not epos)
+ (format () "~A[~D]: <em...> but no </em> for ~A~%" file linectr dline)
+ (begin
+ (let ((min-epos (char-position #\space dline)))
+ (set! epos (char-position #\> dline))
+ (if (and (real? min-epos)
+ (< min-epos epos))
+ (set! epos min-epos)))
- ((#\<)
- (if start
- (if (not (or scripting
- (positive? p-quotes)))
- (format () "~A[~D]: nested < ~A~%" file linectr line))
- (set! start i)))
- ((#\/)
- (if (and (integer? start) (= start (- i 1)))
- (set! closing #t)))
+ (let ((new-name (string-append file "#" (substring dline 0 (- epos 1)))))
+ (if (hash-table-ref names new-name)
+ (format () "~A[~D]: ambiguous name: ~A~%" file linectr new-name))
+ (hash-table-set! names new-name file))
- ((#\!)
- (if (and (integer? start) (= start (- i 1)))
- (set! start #f)))))))
- ) ; if not in-comment...
-
- ;; search for name
- (let ((dline line))
- (do ((pos (string-position "<em class=def id=" dline))
- (pos-len 18))
- ((not pos))
- (set! dline (substring dline (+ pos pos-len)))
- (let ((epos (or (string-position "</a>" dline)
- (string-position "</em>" dline)
- (string-position "</A>" dline))))
- ;;actually should look for close double quote
- (if (not epos)
- (format () "~A[~D]: <em...> but no </em> for ~A~%" file linectr dline)
- (begin
- (let ((min-epos (char-position #\space dline)))
- (set! epos (char-position #\> dline))
- (if (and (real? min-epos)
- (< min-epos epos))
- (set! epos min-epos)))
-
- (let ((new-name (string-append file "#" (substring dline 0 (- epos 1)))))
- (if (hash-table-ref names new-name)
- (format () "~A[~D]: ambiguous name: ~A~%" file linectr new-name))
- (hash-table-set! names new-name file))
+ (set! name (+ name 1))
+ (set! dline (substring dline epos))
+ (set! pos (string-position "<em class=def id=" dline))
+ (set! pos-len 18))))))
+
+ ;; search for href
+ (let ((dline line))
+ (do ((pos (string-position " href=" dline)) ; ignore A HREF
+ (pos-len 7))
+ ((not pos))
+ ;; (format () "~A dline: ~A~%" pos dline)
+ (if (zero? (length dline)) (exit))
+ (set! dline (substring dline (+ pos pos-len)))
+ (let ((epos (char-position #\> dline)))
+ (if (not epos)
+ (format () "~A[~D]: <a href but no </a> for ~A~%" file linectr dline)
+ (begin
+ (set! epos (char-position #\" dline 1))
+ (let ((cur-href #f))
+ (if (char=? (dline 0) #\#)
+ (set! cur-href (string-append file (substring dline 0 epos)))
+ (begin
+ (set! cur-href (substring dline 0 epos))
+ (let ((pos (char-position #\# cur-href)))
+ (if (not (or pos
+ (<= epos 5)
+ (file-exists? cur-href)
+ (string=? (substring cur-href 0 4) "ftp:")
+ (string=? (substring cur-href 0 5) "http:")))
+ (format () "~A[~D]: reference to missing file ~S~%" file linectr cur-href)))))
- (set! name (+ name 1))
- (set! dline (substring dline epos))
- (set! pos (string-position "<em class=def id=" dline))
- (set! pos-len 18))))))
-
- ;; search for href
- (let ((dline line))
- (do ((pos (string-position " href=" dline)) ; ignore A HREF
- (pos-len 7))
- ((not pos))
- ;; (format () "~A dline: ~A~%" pos dline)
- (if (zero? (length dline)) (exit))
- (set! dline (substring dline (+ pos pos-len)))
- (let ((epos (char-position #\> dline)))
- (if (not epos)
- (format () "~A[~D]: <a href but no </a> for ~A~%" file linectr dline)
- (begin
- (set! epos (char-position #\" dline 1))
- (let ((cur-href #f))
- (if (char=? (dline 0) #\#)
- (set! cur-href (string-append file (substring dline 0 epos)))
- (begin
- (set! cur-href (substring dline 0 epos))
- (let ((pos (char-position #\# cur-href)))
- (if (not (or pos
- (<= epos 5)
- (file-exists? cur-href)
- (string=? (substring cur-href 0 4) "ftp:")
- (string=? (substring cur-href 0 5) "http:")))
- (format () "~A[~D]: reference to missing file ~S~%" file linectr cur-href)))))
-
- ;; cur-href here is the full link: sndclm.html#make-filetosample for example
- ;; it can also be a bare file name
- (let* ((name (let ((start (char-position #\# cur-href)))
- (and (number? start)
- (string->symbol (substring cur-href (+ start 1))))))
- (data (and (symbol? name)
- (hash-table-ref ids name))))
- (if name
- (if (not data)
- (format () ";can't find id ~A~%" name)
- (hash-table-set! ids name (+ data 1))))))
- (set! href (+ href 1))
- (set! dline (substring dline epos))
- (set! pos (string-position " href=" dline))
- (set! pos-len 7)))))))))
- (if (pair? commands)
- (format () "open directives at end of ~A: ~A~%" file commands))))))
+ ;; cur-href here is the full link: sndclm.html#make-filetosample for example
+ ;; it can also be a bare file name
+ (let* ((name (let ((start (char-position #\# cur-href)))
+ (and (number? start)
+ (string->symbol (substring cur-href (+ start 1))))))
+ (data (and (symbol? name)
+ (hash-table-ref ids name))))
+ (if name
+ (if (not data)
+ (format () ";can't find id ~A~%" name)
+ (hash-table-set! ids name (+ data 1))))))
+ (set! href (+ href 1))
+ (set! dline (substring dline epos))
+ (set! pos (string-position " href=" dline))
+ (set! pos-len 7))))))))))))
files)
;; end file scan
diff --git a/tools/makegl.scm b/tools/makegl.scm
index e96e19c..740db6e 100755
--- a/tools/makegl.scm
+++ b/tools/makegl.scm
@@ -117,37 +117,38 @@
(set! (val i) #\_)))))))
(define* (parse-args args x)
- (let ((data ())
- (sp -1)
- (type #f)
- (len (length args)))
- (if (string=? args "void")
- ()
- (do ((i 0 (+ i 1)))
- ((= i len) (reverse data))
- (let ((ch (args i)))
- (when (or (char=? ch #\space)
- (= i (- len 1)))
- (if type
- (begin
- (let ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ i 1) i))))
- (case (given-name 0)
- ((#\@) (set! data (cons (list type (substring given-name 1) 'null) data)))
- ((#\#) (set! data (cons (list type (substring given-name 1) 'opt) data)))
- ((#\[)
- (set! data (cons (list type (substring given-name 1 (- (length given-name) 1)) given-name) data))
- (set! type (deref-type (list type))))
- (else (set! data (cons (list type given-name) data)))))
- (if (eq? x 'x)
- (if (not (member type x-types))
- (set! x-types (cons type x-types)))
- (if (not (or (eq? x 'g)
- (member type types)))
- (set! types (cons type types))))
- (set! type #f))
- (if (> i (+ 1 sp))
- (set! type (substring args (+ 1 sp) i))))
- (set! sp i)))))))
+ (if (string=? args "void")
+ ()
+ (do ((data ())
+ (sp -1)
+ (type #f)
+ (len (length args))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (reverse data))
+ (let ((ch (args i)))
+ (when (or (char=? ch #\space)
+ (= i (- len 1)))
+ (if type
+ (begin
+ (let ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ i 1) i))))
+ (case (given-name 0)
+ ((#\@) (set! data (cons (list type (substring given-name 1) 'null) data)))
+ ((#\#) (set! data (cons (list type (substring given-name 1) 'opt) data)))
+ ((#\[)
+ (set! data (cons (list type (substring given-name 1 (- (length given-name) 1)) given-name) data))
+ (set! type (deref-type (list type))))
+ (else (set! data (cons (list type given-name) data)))))
+ (if (eq? x 'x)
+ (if (not (member type x-types))
+ (set! x-types (cons type x-types)))
+ (if (not (or (eq? x 'g)
+ (member type types)))
+ (set! types (cons type types))))
+ (set! type #f))
+ (if (> i (+ 1 sp))
+ (set! type (substring args (+ 1 sp) i))))
+ (set! sp i))))))
(define (helpify name type args)
(let ((initial (format #f " #define H_~A \"~A ~A(" name type name)))
@@ -824,57 +825,36 @@
(hey " s_real = s7_make_symbol(s7, \"real?\");~%")
(hey " s_any = s7_t(s7);~%~%")
-(for-each
- (lambda (sigc)
- (if (eq? (cdr sigc) :gtk)
- (let ((sig (car sigc)))
- (hey " ")
- (hey (sig-name sig))
- (hey " = s7_make_circular_signature(s7, ")
- (let ((len (length sig)))
- (hey (number->string (- len 1)))
- (hey ", ")
- (hey (number->string len))
- (hey ", ")
- (do ((i 0 (+ i 1))
- (s sig (cdr s)))
- ((= i len))
- (let ((typ (car s)))
- (hey (case typ
- ((integer?) "s_integer")
- ((boolean?) "s_boolean")
- ((real?) "s_real")
- (else "s_any"))))
- (if (< i (- len 1)) (hey ", "))))
- (hey ");~%"))))
- signatures)
-(hey "~%")
-(hey "#if USE_MOTIF~%")
-(for-each
- (lambda (sigc)
- (if (eq? (cdr sigc) :motif)
- (let ((sig (car sigc)))
- (hey " ")
- (hey (sig-name sig))
- (hey " = s7_make_circular_signature(s7, ")
- (let ((len (length sig)))
- (hey (number->string (- len 1)))
- (hey ", ")
- (hey (number->string len))
- (hey ", ")
- (do ((i 0 (+ i 1))
- (s sig (cdr s)))
- ((= i len))
- (let ((typ (car s)))
- (hey (case typ
- ((integer?) "s_integer")
- ((boolean?) "s_boolean")
- ((real?) "s_real")
- (else "s_any"))))
- (if (< i (- len 1)) (hey ", "))))
- (hey ");~%"))))
- signatures)
-(hey "#endif~%")
+(let ((sigout (lambda (gui)
+ (for-each
+ (lambda (sigc)
+ (if (eq? (cdr sigc) gui)
+ (let ((sig (car sigc)))
+ (hey " ")
+ (hey (sig-name sig))
+ (hey " = s7_make_circular_signature(s7, ")
+ (let ((len (length sig)))
+ (hey (number->string (- len 1)))
+ (hey ", ")
+ (hey (number->string len))
+ (hey ", ")
+ (do ((i 0 (+ i 1))
+ (s sig (cdr s)))
+ ((= i len))
+ (let ((typ (car s)))
+ (hey (case typ
+ ((integer?) "s_integer")
+ ((boolean?) "s_boolean")
+ ((real?) "s_real")
+ (else "s_any"))))
+ (if (< i (- len 1)) (hey ", "))))
+ (hey ");~%"))))
+ signatures))))
+ (sigout :gtk)
+ (hey "~%")
+ (hey "#if USE_MOTIF~%")
+ (sigout :motif)
+ (hey "#endif~%"))
(hey "#endif~%~%")
(hey "#if HAVE_SCHEME~%")
diff --git a/tools/makexg.scm b/tools/makexg.scm
index 7fdef99..d48748e 100755
--- a/tools/makexg.scm
+++ b/tools/makexg.scm
@@ -270,58 +270,58 @@
(define cairo-strings-912 ())
(define (parse-args args extra)
- (let ((data ())
- (sp -1)
- (type #f)
- (len (length args)))
- (if (string=? args "void")
- ()
- (do ((i 0 (+ i 1)))
- ((= i len) (reverse data))
- (let ((ch (args i)))
- (when (or (char=? ch #\space)
- (= i (- len 1)))
- (if (not type)
- (if (> i (+ 1 sp))
- (set! type (substring args (+ 1 sp) i)))
- (let ((reftype #f))
- (let ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ i 1) i))))
- (case (given-name 0)
- ((#\@) (set! data (cons (list type (substring given-name 1) 'null) data)))
- ((#\#) (set! data (cons (list type (substring given-name 1) 'opt) data)))
- ((#\&) (set! data (cons (list type (substring given-name 1) 'set) data)))
- ((#\[ #\{ #\|)
- (set! reftype (deref-type (list type)))
- (set! data (cons (list type (substring given-name 1 (- (length given-name) 1)) given-name) data)))
- (else (set! data (cons (list type given-name) data)))))
- (if reftype (set! type reftype))
-
- (unless (member type all-types)
- (set! all-types (cons type all-types))
- (case extra
- ((g-2.14) (set! types-2.14 (cons type types-2.14)))
- ((g-2.16) (set! types-2.16 (cons type types-2.16)))
- ((g-2.18) (set! types-2.18 (cons type types-2.18)))
- ((g-2.20) (set! types-2.20 (cons type types-2.20)))
- ((g-3.0) (set! types-3.0 (cons type types-3.0)))
- ((g-3.2) (set! types-3.2 (cons type types-3.2)))
- ((g-3.4) (set! types-3.4 (cons type types-3.4)))
- ((g-3.6) (set! types-3.6 (cons type types-3.6)))
- ((g-3.8) (set! types-3.8 (cons type types-3.8)))
- ((g-3.10) (set! types-3.10 (cons type types-3.10)))
- ((g-3.12) (set! types-3.12 (cons type types-3.12)))
- ((g-3.14) (set! types-3.14 (cons type types-3.14)))
- ((g-3.16) (set! types-3.16 (cons type types-3.16)))
- ((g-3.18) (set! types-3.18 (cons type types-3.18)))
- ((g-3.20) (set! types-3.20 (cons type types-3.20)))
- ((g-3.22) (set! types-3.22 (cons type types-3.22)))
- ((cairo) (set! cairo-types (cons type cairo-types)))
- ((cairo-810) (set! cairo-types-810 (cons type cairo-types-810)))
- ((cairo-912) (set! cairo-types-912 (cons type cairo-types-912)))
- (else (if (not (member type types))
+ (if (string=? args "void")
+ ()
+ (do ((data ())
+ (sp -1)
+ (type #f)
+ (len (length args))
+ (i 0 (+ i 1)))
+ ((= i len) (reverse data))
+ (let ((ch (args i)))
+ (when (or (char=? ch #\space)
+ (= i (- len 1)))
+ (if (not type)
+ (if (> i (+ 1 sp))
+ (set! type (substring args (+ 1 sp) i)))
+ (begin
+ (let ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ i 1) i))))
+ (case (given-name 0)
+ ((#\@) (set! data (cons (list type (substring given-name 1) 'null) data)))
+ ((#\#) (set! data (cons (list type (substring given-name 1) 'opt) data)))
+ ((#\&) (set! data (cons (list type (substring given-name 1) 'set) data)))
+ ((#\[ #\{ #\|)
+ (let ((reftype (deref-type (list type))))
+ (set! data (cons (list type (substring given-name 1 (- (length given-name) 1)) given-name) data))
+ (if reftype (set! type reftype))))
+ (else (set! data (cons (list type given-name) data)))))
+
+ (unless (member type all-types)
+ (set! all-types (cons type all-types))
+ (case extra
+ ((g-2.14) (set! types-2.14 (cons type types-2.14)))
+ ((g-2.16) (set! types-2.16 (cons type types-2.16)))
+ ((g-2.18) (set! types-2.18 (cons type types-2.18)))
+ ((g-2.20) (set! types-2.20 (cons type types-2.20)))
+ ((g-3.0) (set! types-3.0 (cons type types-3.0)))
+ ((g-3.2) (set! types-3.2 (cons type types-3.2)))
+ ((g-3.4) (set! types-3.4 (cons type types-3.4)))
+ ((g-3.6) (set! types-3.6 (cons type types-3.6)))
+ ((g-3.8) (set! types-3.8 (cons type types-3.8)))
+ ((g-3.10) (set! types-3.10 (cons type types-3.10)))
+ ((g-3.12) (set! types-3.12 (cons type types-3.12)))
+ ((g-3.14) (set! types-3.14 (cons type types-3.14)))
+ ((g-3.16) (set! types-3.16 (cons type types-3.16)))
+ ((g-3.18) (set! types-3.18 (cons type types-3.18)))
+ ((g-3.20) (set! types-3.20 (cons type types-3.20)))
+ ((g-3.22) (set! types-3.22 (cons type types-3.22)))
+ ((cairo) (set! cairo-types (cons type cairo-types)))
+ ((cairo-810) (set! cairo-types-810 (cons type cairo-types-810)))
+ ((cairo-912) (set! cairo-types-912 (cons type cairo-types-912)))
+ (else (if (not (member type types))
(set! types (cons type types))))))
- (set! type #f)))
- (set! sp i)))))))
+ (set! type #f)))
+ (set! sp i))))))
(define direct-types
(list (cons "void" #f)
@@ -584,6 +584,9 @@
(cons "GdkAxisFlags" "INT")
(cons "GdkDeviceToolType" "INT")
(cons "GdkSubpixelLayout" "INT")
+ (cons "GdkDevicePadFeature" "INT")
+ (cons "GdkAnchorHints" "INT")
+ (cons "GtkPadActionType" "INT")
))
(define (c-to-xen-macro-name type str)
@@ -1252,13 +1255,13 @@
(define listable-types ())
(for-each
(lambda (type)
- (let ((dereftype (let ((len (length type)))
- (and (char=? (type (- len 1)) #\*)
+ (let ((dereftype (let ((len (- (length type) 1)))
+ (and (char=? (type len) #\*)
(not (string=? type "char*")) ; these are surely strings (and set would need Xen_to_C_gchar etc)
(not (string=? type "GError*"))
(not (string=? type "GError**"))
(not (string=? type "gchar*"))
- (substring type 0 (- len 1))))))
+ (substring type 0 len)))))
(if (and dereftype
(assoc dereftype direct-types))
(set! listable-types (cons type listable-types)))))
@@ -1725,7 +1728,7 @@
(let* ((name (callback-func func))
(type (callback-type func))
(args (callback-args func))
- (gctype (callback-gc func))
+ (gcc-permanent? (eq? (callback-gc func) 'permanent-gcc))
(fname (callback-name func))
(void? (string=? type "void")))
(unless (member name funcs-done)
@@ -1764,7 +1767,7 @@
(if void?
""
(format #f "((~A)0)" (no-stars type))))
- (if (eq? gctype 'permanent-gcc)
+ (if gcc-permanent?
(hey "#if (!(defined(__cplusplus)))~% ")) ; const arg conversion causes trouble if g++
(let ((castlen (+ 12 (if void?
1
@@ -1797,7 +1800,7 @@
(if void?
(hey ";~%")
(hey "));~%")))
- (if (eq? gctype 'permanent-gcc)
+ (if gcc-permanent?
(begin
(if (not void?)
(begin
@@ -1835,247 +1838,240 @@
(define max-args 8)
-(define handle-func
- (lambda (data)
- (let* ((name (car data))
- (return-type (cadr data))
- (return-type-void (string=? return-type "void"))
- (args (caddr data))
- (cargs (length args))
- (refargs (ref-args args))
- (xgargs (- cargs refargs))
- (argstr (cadddr data))
- (lambda-type (hash-table-ref names name))
- (callback-data (and (not (eq? lambda-type 'fnc))
- (find-callback
- (lambda (func)
- (and (eq? (callback-name func) lambda-type)
- func)))))
- (spec (and (> (length data) 4) (data 4)))
- (spec-data (and (> (length data) 5) (data 5))) ; also callback-version
- (arg-start 0)
- (line-len 0))
-
- (define (hey-start)
- ;; start of checked line
- (set! line-len 0))
-
- (define (hey-mark)
- ;; start of checked line
- (set! arg-start line-len))
-
- (define (hey-on . args)
- ;; no cr -- just append
- (let ((line (apply format #f args)))
- (set! line-len (+ line-len (length line)))
- (heyc line)))
-
- (define (hey-ok arg)
- ;; cr ok after arg
- (set! line-len (+ line-len (length arg)))
- (heyc arg)
- (if (> line-len 120) ; line-max originally
+(define (handle-func data)
+ (let ((name (car data))
+ (args (caddr data))
+ (return-type (cadr data)))
+ (let ((cargs (length args))
+ (refargs (ref-args args))
+ (lambda-type (hash-table-ref names name)))
+ (let ((callback-data (and (not (eq? lambda-type 'fnc))
+ (find-callback
+ (lambda (func)
+ (and (eq? (callback-name func) lambda-type)
+ func)))))
+ (spec (and (> (length data) 4) (data 4)))
+ (spec-data (and (> (length data) 5) (data 5))) ; also callback-version
+ (return-type-void (string=? return-type "void"))
+ (xgargs (- cargs refargs))
+ (argstr (cadddr data))
+ (arg-start 0)
+ (line-len 0))
+
+ (define (hey-start)
+ ;; start of checked line
+ (set! line-len 0))
+
+ (define (hey-mark)
+ ;; start of checked line
+ (set! arg-start line-len))
+
+ (define (hey-on . args)
+ ;; no cr -- just append
+ (let ((line (apply format #f args)))
+ (set! line-len (+ line-len (length line)))
+ (heyc line)))
+
+ (define (hey-ok arg)
+ ;; cr ok after arg
+ (set! line-len (+ line-len (length arg)))
+ (heyc arg)
+ (when (> line-len 120) ; line-max originally
+ (format xg-file "~%~NC" arg-start #\space)
+ (set! line-len arg-start)))
+
+ (hey "static Xen gxg_~A(" name)
+ (if (null? args)
+ (heyc "void")
+ (if (>= (length args) max-args)
+ (heyc "Xen arglist")
+ (let ((previous-arg #f))
+ (for-each
+ (lambda (arg)
+ (let ((argname (cadr arg))
+ ;(argtype (car arg))
+ )
+ (if previous-arg (heyc ", "))
+ (set! previous-arg #t)
+ (if (and (ref-arg? arg)
+ (not (member name '("gdk_init" "gdk_init_check" "gtk_init" "gtk_init_check" "gtk_parse_args"))))
+ (hey "Xen ignore_~A" argname)
+ (hey "Xen ~A" argname))))
+ args))))
+ (hey ")~%{~%")
+ (helpify name return-type argstr)
+ (if (> refargs 0)
+ (for-each
+ (lambda (arg)
+ (if (ref-arg? arg)
+ (if (has-stars (deref-type arg))
+ (hey " ~A ~A = NULL;~%" (deref-type arg) (deref-name arg))
+ (hey " ~A ~A;~%" (deref-type arg) (deref-name arg)))))
+ args))
+ (if (and (>= (length args) max-args)
+ (> xgargs 0))
(begin
- (format xg-file "~%~NC" arg-start #\space)
- (set! line-len arg-start))))
-
- (hey "static Xen gxg_~A(" name)
- (if (null? args)
- (heyc "void")
- (if (>= (length args) max-args)
- (heyc "Xen arglist")
- (let ((previous-arg #f))
- (for-each
+ (heyc " Xen ")
+ (for-each
+ (let ((previous-arg #f))
(lambda (arg)
- (let ((argname (cadr arg))
- ;(argtype (car arg))
- )
+ (unless (ref-arg? arg) ;(< (length arg) 3)
(if previous-arg (heyc ", "))
(set! previous-arg #t)
- (if (and (ref-arg? arg)
- (not (member name '("gdk_init" "gdk_init_check" "gtk_init" "gtk_init_check" "gtk_parse_args"))))
- (hey "Xen ignore_~A" argname)
- (hey "Xen ~A" argname))))
+ (hey "~A" (cadr arg)))))
+ args)
+ (hey ";~%")
+ (let ((ctr 0)) ; list-ref counts from 0
+ (for-each
+ (lambda (arg)
+ (if (not (ref-arg? arg))
+ (hey " ~A = Xen_list_ref(arglist, ~D);~%" (cadr arg) ctr))
+ (set! ctr (+ ctr 1)))
args))))
- (hey ")~%{~%")
- (helpify name return-type argstr)
- (if (> refargs 0)
- (for-each
- (lambda (arg)
- (if (ref-arg? arg)
- (if (has-stars (deref-type arg))
- (hey " ~A ~A = NULL;~%" (deref-type arg) (deref-name arg))
- (hey " ~A ~A;~%" (deref-type arg) (deref-name arg)))))
- args))
- (if (and (>= (length args) max-args)
- (> xgargs 0))
- (let ((previous-arg #f))
- (heyc " Xen ")
+ (when (pair? args)
+ (let ((ctr 1)
+ (argc #f))
(for-each
(lambda (arg)
- (if (not (ref-arg? arg)) ;(< (length arg) 3)
- (begin
- (if previous-arg (heyc ", "))
- (set! previous-arg #t)
- (hey "~A" (cadr arg)))))
- args)
- (hey ";~%")
- (let ((ctr 0)) ; list-ref counts from 0
- (for-each
- (lambda (arg)
+ (let ((argname (cadr arg))
+ (argtype (car arg)))
(if (not (ref-arg? arg))
- (hey " ~A = Xen_list_ref(arglist, ~D);~%" (cadr arg) ctr))
- (set! ctr (+ ctr 1)))
- args))))
- (when (pair? args)
- (let ((ctr 1)
- (argc #f))
- (for-each
- (lambda (arg)
- (let ((argname (cadr arg))
- (argtype (car arg)))
- (if (not (ref-arg? arg))
- (if (null-arg? arg)
- (hey " Xen_check_type(Xen_is_~A(~A) || Xen_is_false(~A), ~A, ~D, ~S, ~S);~%"
- (no-stars argtype) argname argname argname ctr name argtype)
- (if (opt-arg? arg)
- (begin
- (hey " if (!Xen_is_bound(~A)) ~A = Xen_false; ~%" argname argname)
- (hey " else Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
- (no-stars argtype) argname argname ctr name argtype))
- (hey " Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
- (no-stars argtype) argname argname ctr name argtype)))
- (if (>= (length arg) 3)
- (if (char=? ((arg 2) 0) #\{)
- (begin
- (set! argc (deref-name arg))
- (hey " ~A = Xen_to_C_~A(~A);~%" (deref-name arg) (deref-type arg) argname))
- (if (char=? ((arg 2) 0) #\|)
- (begin
- (hey " ~A = (~A)calloc(~A, sizeof(~A));~%"
- (deref-name arg)
- (deref-type arg)
- argc
- (deref-element-type arg))
- (hey " {~% int i;~% Xen lst;~% lst = Xen_copy_arg(~A);~%" argname)
- (hey " for (i = 0; i < ~A; i++, lst = Xen_cdr(lst)) ~A[i] = Xen_to_C_~A(Xen_car(lst));~%"
- argc
- (deref-name arg)
- (no-stars (deref-element-type arg)))
- (hey " }~%"))))))
- (set! ctr (+ ctr 1))))
+ (if (null-arg? arg)
+ (hey " Xen_check_type(Xen_is_~A(~A) || Xen_is_false(~A), ~A, ~D, ~S, ~S);~%"
+ (no-stars argtype) argname argname argname ctr name argtype)
+ (if (opt-arg? arg)
+ (begin
+ (hey " if (!Xen_is_bound(~A)) ~A = Xen_false; ~%" argname argname)
+ (hey " else Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
+ (no-stars argtype) argname argname ctr name argtype))
+ (hey " Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
+ (no-stars argtype) argname argname ctr name argtype)))
+ (if (>= (length arg) 3)
+ (if (char=? ((arg 2) 0) #\{)
+ (begin
+ (set! argc (deref-name arg))
+ (hey " ~A = Xen_to_C_~A(~A);~%" (deref-name arg) (deref-type arg) argname))
+ (when (char=? ((arg 2) 0) #\|)
+ (hey " ~A = (~A)calloc(~A, sizeof(~A));~%"
+ (deref-name arg)
+ (deref-type arg)
+ argc
+ (deref-element-type arg))
+ (hey " {~% int i;~% Xen lst;~% lst = Xen_copy_arg(~A);~%" argname)
+ (hey " for (i = 0; i < ~A; i++, lst = Xen_cdr(lst)) ~A[i] = Xen_to_C_~A(Xen_car(lst));~%"
+ argc
+ (deref-name arg)
+ (no-stars (deref-element-type arg)))
+ (hey " }~%")))))
+ (set! ctr (+ ctr 1))))
args)))
- (let ((using-result #f))
- (if (eq? lambda-type 'fnc)
- (begin
- (set! using-result (and (> refargs 0)
- (not return-type-void)))
- (if using-result
- (begin
- (hey " {~%")
- (hey " Xen result;~%")))
- (hey-start)
-
- (if (not (eq? spec 'etc))
-
- (cond (return-type-void
- (hey-on " "))
-
- ((not (= refargs 0))
- (hey-on " result = C_to_Xen_~A(" (no-stars return-type)))
-
- (else
- (case spec
- ((free) (hey-on " {~% ~A result;~% Xen rtn;~% result = " return-type))
- ((const-return) (hey " return(C_to_Xen_~A((~A)" (no-stars return-type) return-type))
- (else
- (if (member name idlers)
- (begin
- (hey " xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(~A)));~%" (cadar args))
- (set! idlers (remove-if (lambda (x) (string=? x name)) idlers))))
- (hey-on " return(C_to_Xen_~A(" (no-stars return-type))))))))
-
- (let ((using-loc (or (eq? lambda-type 'GCallback)
- (and callback-data
- (memq (callback-gc callback-data) '(temporary semi-permanent))))))
- ;; lambda-type != 'fnc
- (set! using-result (not (or return-type-void
- (eq? lambda-type 'lambda))))
- (hey " {~%")
- (if using-result (hey " Xen result;~%"))
- (if using-loc (hey " int loc;~%"))
- (hey " Xen gxg_ptr = Xen_list_5(~A, func_info, Xen_false, Xen_false, Xen_false);~%"
- (call-with-exit
- (lambda (name-it)
- (for-each
- (lambda (arg)
- (let ((argname (cadr arg))
- ;(argtype (car arg))
- )
- (if (string=? argname "func")
- (name-it "func"))))
- args)
- "Xen_false")))
- (if using-loc
- (begin
- (hey " loc = xm_protect(gxg_ptr);~%")
- (hey " Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));~%"))
- (begin
- (hey " xm_protect(gxg_ptr);~%")
- (if (eq? lambda-type 'GtkClipboardGetFunc)
- (hey " Xen_list_set(gxg_ptr, 2, clear_func);~%"))))
- (for-each
- (lambda (arg)
- (let ((argname (cadr arg))
- (argtype (car arg)))
- (if (string=? argtype "GtkDestroyNotify")
- (hey " Xen_list_set(gxg_ptr, 3, ~A);~%" argname))))
- args)
- (hey-start)
- (if using-result
- (hey-on " result = C_to_Xen_~A(" (no-stars return-type))
- (heyc " "))))
-
- ;; pass args
- (if (eq? spec 'etc)
- (begin
- ;; goes to end
- ;; need to check ... list, set up locals, send out switch, return result
- (let* ((list-name (cadr (args (- cargs 1))))
- (min-len (car spec-data))
- (max-len (cadr spec-data))
- (types (caddr spec-data))
- (with-minus-one (member name '("gtk_list_store_set" "gtk_tree_store_set") string=?))
- (with-null (not (or with-minus-one
- (and (pair? types)
- (null? (cdr types))
- (string=? (car types) "GType")))))
- (modlen (length types)))
+ (let ((using-result #f))
+ (if (eq? lambda-type 'fnc)
+ (begin
+ (set! using-result (and (> refargs 0)
+ (not return-type-void)))
+ (when using-result
+ (hey " {~%")
+ (hey " Xen result;~%"))
+ (hey-start)
+
+ (cond ((eq? spec 'etc))
+
+ (return-type-void
+ (hey-on " "))
+
+ ((not (= refargs 0))
+ (hey-on " result = C_to_Xen_~A(" (no-stars return-type)))
+
+ (else
+ (case spec
+ ((free) (hey-on " {~% ~A result;~% Xen rtn;~% result = " return-type))
+ ((const-return) (hey " return(C_to_Xen_~A((~A)" (no-stars return-type) return-type))
+ (else
+ (when (member name idlers)
+ (hey " xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(~A)));~%" (cadar args))
+ (set! idlers (remove-if (lambda (x) (string=? x name)) idlers)))
+ (hey-on " return(C_to_Xen_~A(" (no-stars return-type)))))))
+
+ (let ((using-loc (or (eq? lambda-type 'GCallback)
+ (and callback-data
+ (memq (callback-gc callback-data) '(temporary semi-permanent))))))
+ ;; lambda-type != 'fnc
+ (set! using-result (not (or return-type-void
+ (eq? lambda-type 'lambda))))
(hey " {~%")
- (hey " int etc_len = 0;~%")
- (if (not return-type-void)
- (hey " ~A result = ~A;~%" return-type (if (has-stars return-type) "NULL" "0")))
- (do ((i 0 (+ i 1)))
- ((= i (- cargs 1)))
- (let ((arg (args i)))
- (hey " ~A p_arg~D;~%" (car arg) i)))
- (hey " if (Xen_is_list(~A)) etc_len = Xen_list_length(~A);~%" list-name list-name)
- (if (> min-len 0)
- (hey " if (etc_len < ~D) Xen_out_of_range_error(~S, ~A, ~A, \"... list must have at least ~D entr~A\");~%"
- min-len name (- cargs 1) list-name min-len (if (= min-len 1) "y" "ies")))
- (hey " if (etc_len > ~D) Xen_out_of_range_error(~S, ~A, ~A, \"... list too long (max len: ~D)\");~%"
- max-len name (- cargs 1) list-name max-len)
- (if (not (= modlen 1))
- (hey " if ((etc_len % ~D) != 0) Xen_out_of_range_error(~S, ~A, ~A, \"... list len must be multiple of ~D\");~%"
- modlen name (- cargs 1) list-name modlen))
- (do ((i 0 (+ i 1)))
- ((= i (- cargs 1)))
- (let ((arg (args i)))
- (hey " p_arg~D = Xen_to_C_~A(~A);~%" i (no-stars (car arg)) (cadr arg))))
- (hey " switch (etc_len)~%")
- (hey " {~%")
- (let ((name-is-file-chooser (string=? name "gtk_file_chooser_dialog_new")))
- (do ((i min-len (+ i modlen)))
+ (if using-result (hey " Xen result;~%"))
+ (if using-loc (hey " int loc;~%"))
+ (hey " Xen gxg_ptr = Xen_list_5(~A, func_info, Xen_false, Xen_false, Xen_false);~%"
+ (call-with-exit
+ (lambda (name-it)
+ (for-each
+ (lambda (arg)
+ (let ((argname (cadr arg))
+ ;(argtype (car arg))
+ )
+ (if (string=? argname "func")
+ (name-it "func"))))
+ args)
+ "Xen_false")))
+ (if using-loc
+ (begin
+ (hey " loc = xm_protect(gxg_ptr);~%")
+ (hey " Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));~%"))
+ (begin
+ (hey " xm_protect(gxg_ptr);~%")
+ (if (eq? lambda-type 'GtkClipboardGetFunc)
+ (hey " Xen_list_set(gxg_ptr, 2, clear_func);~%"))))
+ (for-each
+ (lambda (arg)
+ (let ((argname (cadr arg))
+ (argtype (car arg)))
+ (if (string=? argtype "GtkDestroyNotify")
+ (hey " Xen_list_set(gxg_ptr, 3, ~A);~%" argname))))
+ args)
+ (hey-start)
+ (if using-result
+ (hey-on " result = C_to_Xen_~A(" (no-stars return-type))
+ (heyc " "))))
+
+ ;; pass args
+ (if (eq? spec 'etc)
+ ;; need to check ... list, set up locals, send out switch, return result
+ (let ((list-name (cadr (args (- cargs 1))))
+ (types (caddr spec-data))
+ (with-minus-one (member name '("gtk_list_store_set" "gtk_tree_store_set") string=?)))
+ (let ((min-len (car spec-data))
+ (max-len (cadr spec-data))
+ (with-null (not (or with-minus-one
+ (and (pair? types)
+ (null? (cdr types))
+ (string=? (car types) "GType")))))
+ (modlen (length types)))
+ (hey " {~%")
+ (hey " int etc_len = 0;~%")
+ (if (not return-type-void)
+ (hey " ~A result = ~A;~%" return-type (if (has-stars return-type) "NULL" "0")))
+ (do ((i 0 (+ i 1)))
+ ((= i (- cargs 1)))
+ (let ((arg (args i)))
+ (hey " ~A p_arg~D;~%" (car arg) i)))
+ (hey " if (Xen_is_list(~A)) etc_len = Xen_list_length(~A);~%" list-name list-name)
+ (if (> min-len 0)
+ (hey " if (etc_len < ~D) Xen_out_of_range_error(~S, ~A, ~A, \"... list must have at least ~D entr~A\");~%"
+ min-len name (- cargs 1) list-name min-len (if (= min-len 1) "y" "ies")))
+ (hey " if (etc_len > ~D) Xen_out_of_range_error(~S, ~A, ~A, \"... list too long (max len: ~D)\");~%"
+ max-len name (- cargs 1) list-name max-len)
+ (if (not (= modlen 1))
+ (hey " if ((etc_len % ~D) != 0) Xen_out_of_range_error(~S, ~A, ~A, \"... list len must be multiple of ~D\");~%"
+ modlen name (- cargs 1) list-name modlen))
+ (do ((i 0 (+ i 1)))
+ ((= i (- cargs 1)))
+ (let ((arg (args i)))
+ (hey " p_arg~D = Xen_to_C_~A(~A);~%" i (no-stars (car arg)) (cadr arg))))
+ (hey " switch (etc_len)~%")
+ (hey " {~%")
+ (do ((name-is-file-chooser (string=? name "gtk_file_chooser_dialog_new"))
+ (i min-len (+ i modlen)))
((> i max-len))
(if (not return-type-void)
(hey " case ~D: result = ~A(" i name)
@@ -2084,21 +2080,21 @@
((= j (- cargs 1)))
(hey "p_arg~D, " j))
;; assume ending null for now
- (let ((modctr 0))
- (do ((j 0 (+ 1 j)))
- ((= j i))
- (let ((type (types modctr)))
- (set! modctr (+ 1 modctr))
- (if (>= modctr modlen) (set! modctr 0))
- (hey (cond ((assoc type '(("int" . "XLI(")
- ("gchar*" . "XLS(")
- ("GtkTextTag*" . "XLT(")
- ("GType" . "XLG("))
- string=?) => cdr)
- (else "XLA("))))
- (hey "~A, ~D)" list-name j)
- (if (or with-null with-minus-one (< j (- i 1)))
- (hey ", "))))
+ (do ((modctr 0)
+ (j 0 (+ 1 j)))
+ ((= j i))
+ (let ((type (types modctr)))
+ (set! modctr (+ 1 modctr))
+ (if (>= modctr modlen) (set! modctr 0))
+ (hey (cond ((assoc type '(("int" . "XLI(")
+ ("gchar*" . "XLS(")
+ ("GtkTextTag*" . "XLT(")
+ ("GType" . "XLG("))
+ string=?) => cdr)
+ (else "XLA("))))
+ (hey "~A, ~D)" list-name j)
+ (if (or with-null with-minus-one (< j (- i 1)))
+ (hey ", ")))
(if with-null
(if (and (= i 0)
name-is-file-chooser)
@@ -2106,17 +2102,15 @@
(hey "NULL); break;~%"))
(if with-minus-one
(hey "-1); break;~%")
- (hey "); break;~%")))))
- (hey " }~%")
-
- (if return-type-void
- (hey " return(Xen_false);~%")
- (hey " return(C_to_Xen_~A(result));~%" (no-stars return-type)))
- (hey " }~%")
- ))
-
- (begin
-
+ (hey "); break;~%"))))
+ (hey " }~%")
+
+ (if return-type-void
+ (hey " return(Xen_false);~%")
+ (hey " return(C_to_Xen_~A(result));~%" (no-stars return-type)))
+ (hey " }~%")))
+
+ ;; not eq? spec 'etc
(if (eq? lambda-type 'lambda)
(begin ; 'lambda (see line 1846)
(hey "if (Xen_is_aritable(func, 2))~%")
@@ -2158,7 +2152,7 @@
(hey " return(Xen_false);~%"))
(hey ")));~%"))
(hey " }~%")) ;'lambda
-
+
(begin
(hey-on "~A(" name)
(hey-mark)
@@ -2197,46 +2191,40 @@
(hey " return(result);~%")
(hey " return(Xen_false);~%"))
(hey " }~%"))
- (begin ;'fnc
- (if (> refargs 0)
- (let ((previous-arg using-result))
- (if using-result (heyc " "))
- (if (string=? name "gdk_property_get")
- (begin
- ;; special case -- type returned is dependent to some extent on atom
- (hey " {~% Xen data_val = Xen_false;~%\
+
+ (if (> refargs 0)
+ (let ((previous-arg using-result))
+ (if using-result (heyc " "))
+ (if (string=? name "gdk_property_get") ; special case -- type returned is dependent to some extent on atom
+ (hey " {~% Xen data_val = Xen_false;~%\
if (ref_actual_property_type == GDK_TARGET_STRING)~%\
data_val = C_string_to_Xen_string((char *)ref_data);~%\
else if (ref_actual_length > 0) data_val = C_string_to_Xen_string_with_length((char *)ref_data, ref_actual_length * ref_actual_format / 8);~%\
return(Xen_list_5(result, C_to_Xen_GdkAtom(ref_actual_property_type), C_to_Xen_gint(ref_actual_format), ~%\
C_to_Xen_gint(ref_actual_length), data_val));~%\
}~% }~%")
- )
- (begin
- (hey " return(Xen_list_~D(" (+ refargs (if using-result 1 0)))
- (if using-result (heyc "result"))
- (for-each
- (lambda (arg)
- (if (ref-arg? arg)
- (begin
- (if previous-arg (heyc ", "))
- (hey "C_to_Xen_~A(~A)" (no-stars (deref-type arg)) (deref-name arg))
- (set! previous-arg #t))))
- args)
- (hey "));~%")
- (if using-result (hey " }~%")))))
- ;; refargs = 0
- (begin
- (if (member name idlers)
- (hey " xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(~A)));~%" (cadar args)))
- (if return-type-void
- (hey " return(Xen_false);~%")))))))
- ))) ; 'begin
- (if (eq? spec 'free)
- (hey " rtn = C_to_Xen_~A(result);~% g_free(result);~% return(rtn);~% }~%" (no-stars return-type)))
- (hey "}~%~%")
- ))))
-
+ (begin
+ (hey " return(Xen_list_~D(" (+ refargs (if using-result 1 0)))
+ (if using-result (heyc "result"))
+ (for-each
+ (lambda (arg)
+ (when (ref-arg? arg)
+ (if previous-arg (heyc ", "))
+ (hey "C_to_Xen_~A(~A)" (no-stars (deref-type arg)) (deref-name arg))
+ (set! previous-arg #t)))
+ args)
+ (hey "));~%")
+ (if using-result (hey " }~%")))))
+ ;; refargs = 0
+ (begin
+ (if (member name idlers)
+ (hey " xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(~A)));~%" (cadar args)))
+ (if return-type-void
+ (hey " return(Xen_false);~%"))))))))
+ (if (eq? spec 'free)
+ (hey " rtn = C_to_Xen_~A(result);~% g_free(result);~% return(rtn);~% }~%" (no-stars return-type)))
+ (hey "}~%~%"))))))
+
(for-each handle-func (reverse funcs))
(for-each
@@ -2801,11 +2789,12 @@
all-funcs all-func-withs)
(define (cast-out func)
- (hey " Xg_define_procedure(~A, gxg_~A_w, 1, 0, 0, \"(~A obj) casts obj to ~A\", pl_bpt);~%"
- (no-arg (car func))
- (no-arg (car func))
- (no-arg (car func))
- (no-arg (car func))))
+ (let ((f (car func)))
+ (hey " Xg_define_procedure(~A, gxg_~A_w, 1, 0, 0, \"(~A obj) casts obj to ~A\", pl_bpt);~%"
+ (no-arg f)
+ (no-arg f)
+ (no-arg f)
+ (no-arg f))))
(hey " Xg_define_procedure(GPOINTER, gxg_GPOINTER_w, 1, 0, 0, \"(GPOINTER obj) casts obj to GPOINTER\", NULL);~%")
@@ -2829,12 +2818,13 @@
(hey " Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check, NULL);~%")
(define (check-out func)
- (hey " Xg_define_procedure(~A, gxg_~A_w, 1, 0, 0,~%~NC\"(~A obj): \" PROC_TRUE \" if obj is a ~A\", pl_bt);~%"
- (no-arg (car func))
- (no-arg (car func))
+ (let ((f (car func)))
+ (hey " Xg_define_procedure(~A, gxg_~A_w, 1, 0, 0,~%~NC\"(~A obj): \" PROC_TRUE \" if obj is a ~A\", pl_bt);~%"
+ (no-arg f)
+ (no-arg f)
22 #\space
- (no-arg (car func))
- (no-arg (car func))))
+ (no-arg f)
+ (no-arg f))))
(for-each check-out (reverse checks))
(for-each
@@ -2942,16 +2932,16 @@
(hey "static enummer_t enum_info[] = {~%")
(set! declared-names (sort! declared-names (lambda (a b)
(string<? (caddr a) (caddr b)))))
-(let ((version ""))
- (do ((names declared-names (cdr names)))
- ((null? names)
- (hey "#endif~%~NC{NULL, NULL, 0}};~%~%" 8 #\space)) ; end marker
- (unless (string=? (caddar names) version)
- (if (> (length version) 0)
- (hey "#endif~%"))
- (set! version (caddar names))
- (hey (string-append "#if GTK_CHECK_VERSION(" (substring version 0 1) ", " (substring version 2) ", 0)~%")))
- (hey "~NC{~S, ~S, ~A},~%" 8 #\space (caar names) (cadar names) (caar names))))
+(do ((version "")
+ (names declared-names (cdr names)))
+ ((null? names)
+ (hey "#endif~%~NC{NULL, NULL, 0}};~%~%" 8 #\space)) ; end marker
+ (unless (string=? (caddar names) version)
+ (if (> (length version) 0)
+ (hey "#endif~%"))
+ (set! version (caddar names))
+ (hey (string-append "#if GTK_CHECK_VERSION(" (substring version 0 1) ", " (substring version 2) ", 0)~%")))
+ (hey "~NC{~S, ~S, ~A},~%" 8 #\space (caar names) (cadar names) (caar names)))
(hey "static s7_pointer enum_value_to_name(s7_scheme *sc, long long int val, const char *type) ~%")
(hey "{ ~%")
diff --git a/tools/table.scm b/tools/table.scm
index 16ba6fb..41e6854 100755
--- a/tools/table.scm
+++ b/tools/table.scm
@@ -1,16 +1,16 @@
(define (no-dashes-or-cr str)
- (let ((len (length str))
- (newstr "")
- (last-ch #\-))
- (do ((i 0 (+ i 1)))
- ((= i (- len 1)))
- (let ((ch (string-ref str i)))
- (if (and (or (not (char=? ch #\-))
- (char-alphabetic? last-ch))
- (not (char=? ch #\newline)))
- (set! newstr (string-append newstr (make-string 1 ch))))
- (set! last-ch ch)))
- newstr))
+ (do ((len (length str))
+ (newstr "")
+ (last-ch #\-)
+ (i 0 (+ i 1)))
+ ((= i (- len 1))
+ newstr)
+ (let ((ch (string-ref str i)))
+ (if (and (or (not (char=? ch #\-))
+ (char-alphabetic? last-ch))
+ (not (char=? ch #\newline)))
+ (set! newstr (string-append newstr (make-string 1 ch))))
+ (set! last-ch ch))))
(let ((ctr 0))
(call-with-input-file
diff --git a/tools/tcopy.scm b/tools/tcopy.scm
index 9b86d6d..956b671 100644
--- a/tools/tcopy.scm
+++ b/tools/tcopy.scm
@@ -205,7 +205,7 @@
(do ((i 0 (+ i 1)))
((= i size))
(set! strs (cons (make-string size (integer->char (+ 1 (random 255)))) strs))
- (set! bvecs (cons (->byte-vector (make-string size (integer->char (random 256)))) bvecs))
+ (set! bvecs (cons (string->byte-vector (make-string size (integer->char (random 256)))) bvecs))
(set! vecs (cons (make-vector size i) vecs))
(set! ivecs (cons (make-int-vector size i) ivecs))
(set! fvecs (cons (make-float-vector size (* i 1.0)) fvecs))
@@ -219,7 +219,7 @@
(ifvec (apply vector-append ifvecs))
(allvec (apply vector-append allvecs))
(str (apply string-append strs))
- (bvec (->byte-vector (apply string-append bvecs))))
+ (bvec (string->byte-vector (apply string-append bvecs))))
(test (vector? vec) #t)
(test (length vec) (* size size))
(test (float-vector? fvec) #t)
diff --git a/tools/va.scm b/tools/va.scm
index 5da7cc6..35e2bf6 100755
--- a/tools/va.scm
+++ b/tools/va.scm
@@ -62,24 +62,24 @@
(let ((len (length line)))
(set! line-number (+ line-number 1))
(if (> len 8)
- (let ((start 0))
- (do ((i 1 (+ i 1)))
- ((>= i len))
- (let ((chr (line i)))
- (if (or (char-whitespace? chr)
- (char=? chr #\)))
- (let* ((name (substring line (+ 1 start) i))
- (name-len (length name)))
- (if (and (or (and (> name-len 4)
- (member (substring name 0 4) '("gtk_" "gdk_") string-ci=?))
- (and (> name-len 6)
- (member (substring name 0 6) '("pango_" "cairo_") string-ci=?)))
- (not (defined? (string->symbol name) *gtk*)))
- (format () "~A (~A[~D]) is not defined~%" name filename line-number))))
- (if (not (or (char=? chr #\_)
- (char-alphabetic? chr)
- (char-numeric? chr)))
- (set! start i))))))
+ (do ((start 0)
+ (i 1 (+ i 1)))
+ ((>= i len))
+ (let ((chr (line i)))
+ (if (or (char-whitespace? chr)
+ (char=? chr #\)))
+ (let* ((name (substring line (+ 1 start) i))
+ (name-len (length name)))
+ (if (and (or (and (> name-len 4)
+ (member (substring name 0 4) '("gtk_" "gdk_") string-ci=?))
+ (and (> name-len 6)
+ (member (substring name 0 6) '("pango_" "cairo_") string-ci=?)))
+ (not (defined? (string->symbol name) *gtk*)))
+ (format () "~A (~A[~D]) is not defined~%" name filename line-number))))
+ (if (not (or (char=? chr #\_)
+ (char-alphabetic? chr)
+ (char-numeric? chr)))
+ (set! start i)))))
(loop (read-line file #t)))))))))
; (if (string=? (substring filename (- (length filename) 3)) "scm")
diff --git a/tools/xgdata.scm b/tools/xgdata.scm
index e2e74e4..a7245d6 100644
--- a/tools/xgdata.scm
+++ b/tools/xgdata.scm
@@ -9146,8 +9146,8 @@
;;; 3.15.8:
-(CFNC-3.16 "void gtk_popover_set_transitions_enabled GtkPopover* popover gboolean transitions_enabled")
-(CFNC-3.16 "gboolean gtk_popover_get_transitions_enabled GtkPopover* popover")
+;;; 3.21.5 (CFNC-3.16 "void gtk_popover_set_transitions_enabled GtkPopover* popover gboolean transitions_enabled")
+;;; 3.21.5 (CFNC-3.16 "gboolean gtk_popover_get_transitions_enabled GtkPopover* popover")
;;; 3.16.0
;;; 3.16.1
@@ -9445,3 +9445,63 @@
(CFNC-3.22 "char* gtk_file_chooser_get_choice GtkFileChooser* chooser char* id" 'const)
;;; GVariant *gtk_file_filter_to_gvariant (GtkFileFilter *filter
;;; GtkFileFilter *gtk_file_filter_new_from_gvariant (GVariant *variant
+
+
+;;; 3.21.5:
+
+;;; GDK_SOURCE_TABLET_PAD "GdkInputSource"
+
+(CCAST-3.22 "GDK_DEVICE_PAD(object)" "GdkDevicePad*")
+(CCHK-3.22 "GDK_IS_DEVICE_PAD(object)" "GdkDevicePad*")
+
+(CINT-3.22 "GDK_DEVICE_PAD_FEATURE_BUTTON" "GdkDevicePadFeature")
+(CINT-3.22 "GDK_DEVICE_PAD_FEATURE_RING" "GdkDevicePadFeature")
+(CINT-3.22 "GDK_DEVICE_PAD_FEATURE_STRIP" "GdkDevicePadFeature")
+
+(CINT-3.22 "GDK_PAD_BUTTON_PRESS" "GdkEventType")
+(CINT-3.22 "GDK_PAD_BUTTON_RELEASE" "GdkEventType")
+(CINT-3.22 "GDK_PAD_RING" "GdkEventType")
+(CINT-3.22 "GDK_PAD_STRIP" "GdkEventType")
+(CINT-3.22 "GDK_PAD_GROUP_MODE" "GdkEventType")
+
+(CINT-3.22 "GDK_TABLET_PAD_MASK" "GdkEventMask")
+
+(CINT-3.22 "GDK_ANCHOR_FLIP_X" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_FLIP_Y" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_SLIDE_X" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_SLIDE_Y" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_RESIZE_X" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_RESIZE_Y" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_FLIP" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_SLIDE" "GdkAnchorHints")
+(CINT-3.22 "GDK_ANCHOR_RESIZE" "GdkAnchorHints")
+
+(CCAST-3.22 "GTK_PAD_CONTROLLER(object)" "GtkPadController*")
+(CCHK-3.22 "GTK_IS_PAD_CONTROLLER(object)" "GtkPadController*")
+
+(CINT-3.22 "GTK_PAD_ACTION_BUTTON" "GtkPadActionType")
+(CINT-3.22 "GTK_PAD_ACTION_RING" "GtkPadActionType")
+(CINT-3.22 "GTK_PAD_ACTION_STRIP" "GtkPadActionType")
+
+(CCAST-3.22 "GTK_SHORTCUT_LABEL(obj)" "GtkShortcutLabel*")
+(CCHK-3.22 "GTK_IS_SHORTCUT_LABEL(obj)" "GtkShortcutLabel*")
+
+(CFNC-3.22 "gint gdk_device_pad_get_n_groups GdkDevicePad* pad")
+(CFNC-3.22 "gint gdk_device_pad_get_group_n_modes GdkDevicePad* pad gint group_idx")
+(CFNC-3.22 "gint gdk_device_pad_get_n_features GdkDevicePad* pad GdkDevicePadFeature feature")
+(CFNC-3.22 "gint gdk_device_pad_get_feature_group GdkDevicePad* pad GdkDevicePadFeature feature gint feature_idx")
+(CFNC-3.22 "void gtk_menu_popup_at_rect GtkMenu* menu GdkWindow* rect_window const GdkRectangle* rect GdkGravity rect_anchor GdkGravity menu_anchor const GdkEvent* trigger_event")
+(CFNC-3.22 "void gtk_menu_popup_at_widget GtkMenu* menu GtkWidget* widget GdkGravity widget_anchor GdkGravity menu_anchor const GdkEvent* trigger_event")
+(CFNC-3.22 "void gtk_menu_popup_at_pointer GtkMenu* menu const GdkEvent* trigger_event")
+(CFNC-3.22 "GtkPadController* gtk_pad_controller_new GtkWindow* window GActionGroup* group GdkDevice* pad")
+(CFNC-3.22 "void gtk_pad_controller_set_action_entries GtkPadController* controller GtkPadActionEntry* entries gint n_entries")
+(CFNC-3.22 "void gtk_pad_controller_set_action GtkPadController* controller GtkPadActionType type gint index gint mode gchar* label gchar* action_name" 'const)
+(CFNC-3.22 "void gtk_popover_popup GtkPopover* popover")
+(CFNC-3.22 "void gtk_popover_popdown GtkPopover* popover")
+(CFNC-3.22 "GtkWidget* gtk_shortcut_label_new gchar* accelerator" 'const)
+(CFNC-3.22 "gchar* gtk_shortcut_label_get_accelerator GtkShortcutLabel* self" 'const-return)
+(CFNC-3.22 "void gtk_shortcut_label_set_accelerator GtkShortcutLabel* self gchar* accelerator" 'const)
+(CFNC-3.22 "gchar* gtk_shortcut_label_get_disabled_text GtkShortcutLabel* self" 'const-return)
+(CFNC-3.22 "void gtk_shortcut_label_set_disabled_text GtkShortcutLabel* self gchar* disabled_text" 'const)
+
+
diff --git a/write.scm b/write.scm
index 9c4a90e..53b8695 100644
--- a/write.scm
+++ b/write.scm
@@ -23,35 +23,35 @@
(format port "~%~NC" (+ n *pretty-print-left-margin*) #\space))
(define (stacked-list lst col)
- (do ((p lst (cdr p)))
+ (do ((p lst (cdr p))
+ (added 0 0))
((not (pair? p)))
- (let ((added 0))
- (if (not (eq? p lst)) (spaces col))
- (let ((len (length (object->string (car p)))))
- (if (and (keyword? (car p))
- (pair? (cdr p)))
- (begin
- (write (car p) port)
- (write-char #\space port)
- (set! added (+ 1 len))
- (set! p (cdr p))))
- (if (not (pair? p))
- (format port " . ~S" p)
- (if (and (pair? (car p))
- (pair? (cdar p))
- (null? (cddar p))
- (> len (/ *pretty-print-length* 2)))
- (begin
- (if (eq? (caar p) 'quote)
- (write-char #\' port)
- (begin
- (write-char #\( port)
- (pretty-print-1 (caar p) port col)
- (spaces (+ col 1))))
- (pretty-print-1 (cadar p) port (+ col 1))
- (if (not (eq? (caar p) 'quote))
- (write-char #\) port)))
- (pretty-print-1 (car p) port (+ col added))))))))
+ (if (not (eq? p lst)) (spaces col))
+ (let ((len (length (object->string (car p)))))
+ (if (and (keyword? (car p))
+ (pair? (cdr p)))
+ (begin
+ (write (car p) port)
+ (write-char #\space port)
+ (set! added (+ 1 len))
+ (set! p (cdr p))))
+ (if (not (pair? p))
+ (format port " . ~S" p)
+ (if (and (pair? (car p))
+ (pair? (cdar p))
+ (null? (cddar p))
+ (> len (/ *pretty-print-length* 2)))
+ (begin
+ (if (eq? (caar p) 'quote)
+ (write-char #\' port)
+ (begin
+ (write-char #\( port)
+ (pretty-print-1 (caar p) port col)
+ (spaces (+ col 1))))
+ (pretty-print-1 (cadar p) port (+ col 1))
+ (if (not (eq? (caar p) 'quote))
+ (write-char #\) port)))
+ (pretty-print-1 (car p) port (+ col added)))))))
(define (stacked-split-list lst col)
(if (not (pair? lst))
@@ -218,41 +218,41 @@
(write obj port)
(begin
(format port "(case ~A" (cadr obj)) ; send out the selector
- (do ((lst (cddr obj) (cdr lst)))
- ((not (pair? lst)))
- (spaces (+ column *pretty-print-spacing*))
- (if (not (pair? (car lst)))
- (write (car lst) port)
- (begin
- (write-char #\( port)
- (if (not (pair? (caar lst)))
- (write (caar lst) port)
- (let ((len (length (caar lst))))
- (if (< len 6)
- (write (caar lst) port)
- (let ((p (caar lst)))
- (write-char #\( port)
- (do ((i 0 (+ i 6)))
- ((>= i len))
- (do ((j 0 (+ j 1)))
- ((or (= j 6)
- (null? p))
- (if (pair? p) (spaces (+ column 4))))
- (write (car p) port)
- (set! p (cdr p))
- (if (pair? p) (write-char #\space port))))
- (write-char #\) port)))))
- (if (not (null? (cdar lst))) ; null here is a bug in the input case statement
- (if (and (pair? (cdar lst))
- (null? (cddar lst))
- (< (length (object->string (cadar lst))) 60))
- (begin
- (write-char #\space port)
- (write (cadar lst) port))
- (begin
- (spaces (+ column 3))
- (stacked-list (cdar lst) (+ column 3)))))
- (write-char #\) port))))
+ (for-each
+ (lambda (lst)
+ (spaces (+ column *pretty-print-spacing*))
+ (if (not (pair? lst))
+ (write lst port)
+ (begin
+ (write-char #\( port)
+ (if (not (pair? (car lst)))
+ (write (car lst) port)
+ (let ((len (length (car lst))))
+ (if (< len 6)
+ (write (car lst) port)
+ (let ((p (car lst)))
+ (write-char #\( port)
+ (do ((i 0 (+ i 6)))
+ ((>= i len))
+ (do ((j 0 (+ j 1)))
+ ((or (= j 6) (null? p)) (if (pair? p) (spaces (+ column 4))))
+ (write (car p) port)
+ (set! p (cdr p))
+ (if (pair? p)
+ (write-char #\space port))))
+ (write-char #\) port)))))
+ (if (not (null? (cdr lst)))
+ (if (and (pair? (cdr lst))
+ (null? (cddr lst))
+ (< (length (object->string (cadr lst))) 60))
+ (begin
+ (write-char #\space port)
+ (write (cadr lst) port))
+ (begin
+ (spaces (+ column 3))
+ (stacked-list (cdr lst) (+ column 3)))))
+ (write-char #\) port))))
+ (cddr obj))
(write-char #\) port))))
((begin call-with-exit call/cc call-with-current-continuation with-baffle with-output-to-string call-with-output-string)
@@ -429,26 +429,26 @@
(begin
(write-char #\space port)
(stacked-list (cdr obj) line-start))
- (let ((obj-start line-start))
- (do ((lst (cdr obj) (cdr lst)))
- ((null? lst))
- (let* ((str (format #f "~S" (car lst)))
- (strlen1 (length str)))
- (if (and (> strlen1 (- *pretty-print-length* obj-start))
- (not (eq? lst (cdr obj))))
- (begin
- (set! obj-start (+ line-start 1 strlen1))
- (spaces line-start)
- (pretty-print-1 (car lst) port line-start))
- (begin
- (set! obj-start (+ obj-start 1 strlen1))
- (if (> strlen1 40)
- (begin
- (spaces line-start)
- (pretty-print-1 (car lst) port line-start))
- (begin
- (write-char #\space port)
- (display str port))))))))))))
+ (do ((obj-start line-start)
+ (lst (cdr obj) (cdr lst)))
+ ((null? lst))
+ (let* ((str (format #f "~S" (car lst)))
+ (strlen1 (length str)))
+ (if (and (> strlen1 (- *pretty-print-length* obj-start))
+ (not (eq? lst (cdr obj))))
+ (begin
+ (set! obj-start (+ line-start 1 strlen1))
+ (spaces line-start)
+ (pretty-print-1 (car lst) port line-start))
+ (begin
+ (set! obj-start (+ obj-start 1 strlen1))
+ (if (> strlen1 40)
+ (begin
+ (spaces line-start)
+ (pretty-print-1 (car lst) port line-start))
+ (begin
+ (write-char #\space port)
+ (display str port)))))))))))
(if (not (eq? (car obj) 'quote))
(write-char #\) port)))))))))))
(else
diff --git a/ws.scm b/ws.scm
index bdc14db..055ca4d 100644
--- a/ws.scm
+++ b/ws.scm
@@ -245,11 +245,11 @@
(if output-to-file
(if to-snd
(maxamp snd-output #t) ; this is a list of chan maxs '(.1 .2)
- (let ((lst (mus-sound-maxamp output-1)))
- (do ((i 0 (+ i 2)))
- ((>= i (length lst)))
- (set! (lst i) (/ (lst i) *clm-srate*)))
- lst))
+ (do ((lst (mus-sound-maxamp output-1))
+ (i 0 (+ i 2)))
+ ((>= i (length lst))
+ lst)
+ (set! (lst i) (/ (lst i) *clm-srate*))))
(if (vector? output-1)
(list (maxamp output-1))
'(0.0)))
@@ -282,11 +282,10 @@
(scaled-to
(let ((pk (maxamp output-1)))
(if (> pk 0.0)
- (let ((scl (/ scaled-to pk)))
- (do ((i 0 (+ i 1)))
- ((= i (length output-1)))
- (set! (output-1 i) (* scl (output-1 i))))))))
-
+ (do ((scl (/ scaled-to pk))
+ (i 0 (+ i 1)))
+ ((= i (length output-1)))
+ (set! (output-1 i) (* scl (output-1 i)))))))
(else
(do ((i 0 (+ i 1)))
((= i (length output-1)))
diff --git a/xen.h b/xen.h
index 6945a2e..0ab0188 100644
--- a/xen.h
+++ b/xen.h
@@ -10,11 +10,13 @@
*/
#define XEN_MAJOR_VERSION 3
-#define XEN_MINOR_VERSION 25
-#define XEN_VERSION "3.25"
+#define XEN_MINOR_VERSION 26
+#define XEN_VERSION "3.26"
/* HISTORY:
*
+ * 29-Jul-16: Xen_define_unsafe_typed_procedure.
+ * --------
* 20-Aug-15: Xen_define_typed_procedure, Xen_define_typed_dilambda.
* --------
* 27-Dec: Xen_arity in s7 now uses s7_arity. Xen_define_integer_procedure, Xen_define_dilambda.
@@ -1697,10 +1699,12 @@ void xen_no_ext_lang_check_args(const char *name, int args, int req_args, int op
#if HAVE_SCHEME
#define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) s7_define_typed_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc, Sig)
+#define Xen_define_unsafe_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) s7_define_unsafe_typed_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc, Sig)
#define Xen_define_typed_dilambda(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt, Get_Sig, Set_Sig) \
s7_typed_dilambda(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help, Get_Sig, Set_Sig)
#else
#define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) Xen_define_safe_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc)
+#define Xen_define_unsafe_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) Xen_define_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc)
#define Xen_define_typed_dilambda(a, b, c, d, e, f, g, h, i, j, k) XEN_DEFINE_PROCEDURE_WITH_SETTER(a, b, c, d, e, f, g, h, i)
#endif
diff --git a/xg.c b/xg.c
index a11c9b2..dc22b43 100644
--- a/xg.c
+++ b/xg.c
@@ -200,7 +200,7 @@ static void define_xm_obj(void)
#define Xg_field_pre "F"
#endif
-static Xen xg_GdkDrawingContext__symbol, xg_GdkSubpixelLayout_symbol, xg_menu_symbol, xg_gtk_menu_place_on_monitor_symbol, xg_GdkMonitor__symbol, xg_GdkDeviceTool__symbol, xg_GdkAxisFlags_symbol, xg_GdkSeatGrabPrepareFunc_symbol, xg_GdkSeatCapabilities_symbol, xg_GdkGrabStatus_symbol, xg_GtkPopoverConstraint_symbol, xg_GtkShortcutsWindow__symbol, xg_GtkStackSidebar__symbol, xg_GtkSearchEntry__symbol, xg_GtkPopoverMenu__symbol, xg_GtkStyleContext__symbol, xg_GdkGLContext__symbol, xg_GtkGLArea__symbol, xg_GtkPropagationPhase_symbol, xg_GtkEventController__symbol, xg_GtkGestureZoom__symbol, xg_GtkGestureSwipe__symbol, xg_GtkGestureSingle__symbol, xg_GtkGestureRotate__symbol, xg_GtkGestureMultiPress__symbol, xg_GtkGesturePan__symbol, xg_GtkGestureDrag__symbol, xg_GdkEventSequence__symbol, xg_GtkEventSequenceState_symbol, xg_GtkGesture__symbol, xg_GtkPopover__symbol, xg_GtkActionBar__symbol, xg_GtkFlowBox__symbol, xg_GtkFlowBoxChild__symbol, xg_GdkEventType_symbol, xg_GtkSearchBar__symbol, xg_GtkListBox__symbol, xg_GtkListBoxRow__symbol, xg_GtkHeaderBar__symbol, xg_GtkRevealerTransitionType_symbol, xg_GtkRevealer__symbol, xg_GtkStackTransitionType_symbol, xg_GtkStack__symbol, xg_GtkStackSwitcher__symbol, xg_GtkPlacesSidebar__symbol, xg_GtkPlacesOpenFlags_symbol, xg_GtkBaselinePosition_symbol, xg_GdkFullscreenMode_symbol, xg_GtkInputHints_symbol, xg_GtkInputPurpose_symbol, xg_GtkLevelBarMode_symbol, xg_GtkLevelBar__symbol, xg_GtkMenuButton__symbol, xg_GtkColorChooser__symbol, xg_GtkApplicationWindow__symbol, xg_GtkApplication__symbol, xg_GMenuModel__symbol, xg_guint___symbol, xg_GdkModifierIntent_symbol, xg_GtkFontChooser__symbol, xg_GdkScrollDirection_symbol, xg_GtkOverlay__symbol, xg_GtkWidgetPath__symbol, xg_GtkStateFlags_symbol, xg_GdkScreen___symbol, xg_GtkToolShell__symbol, xg_GtkWindowGroup__symbol, xg_GtkInvisible__symbol, xg_GtkOrientable__symbol, xg_GtkCellArea__symbol, xg_GtkBorder__symbol, xg_GtkSwitch__symbol, xg_GtkScrollablePolicy_symbol, xg_GtkScrollable__symbol, xg_GtkGrid__symbol, xg_GdkRGBA__symbol, xg_GtkComboBoxText__symbol, xg_GtkAlign_symbol, xg_GtkContainerClass__symbol, xg_GtkSizeRequestMode_symbol, xg_cairo_region_overlap_t_symbol, xg_cairo_rectangle_int_t__symbol, xg_double__symbol, xg_cairo_rectangle_t__symbol, xg_cairo_device_t__symbol, xg_cairo_bool_t_symbol, xg_cairo_text_cluster_flags_t__symbol, xg_cairo_text_cluster_t___symbol, xg_cairo_glyph_t___symbol, xg_cairo_text_cluster_flags_t_symbol, xg_cairo_text_cluster_t__symbol, xg_cairo_region_t__symbol, xg_GtkMessageDialog__symbol, xg_GdkDevice__symbol, xg_GtkAccessible__symbol, xg_GdkModifierType__symbol, xg_GtkToolPaletteDragTargets_symbol, xg_GtkToolItemGroup__symbol, xg_GtkToolPalette__symbol, xg_GtkSpinner__symbol, xg_GtkEntryBuffer__symbol, xg_GtkMessageType_symbol, xg_GtkInfoBar__symbol, xg_GIcon__symbol, xg_GtkEntryIconPosition_symbol, xg_GFile__symbol, xg_GtkScaleButton__symbol, xg_GtkCalendarDetailFunc_symbol, xg_GtkTooltip__symbol, xg_cairo_rectangle_list_t__symbol, xg_void__symbol, xg_cairo_filter_t_symbol, xg_cairo_extend_t_symbol, xg_cairo_format_t_symbol, xg_cairo_path_t__symbol, xg_cairo_destroy_func_t_symbol, xg_cairo_user_data_key_t__symbol, xg_cairo_text_extents_t__symbol, xg_cairo_font_extents_t__symbol, xg_cairo_font_face_t__symbol, xg_cairo_glyph_t__symbol, xg_cairo_scaled_font_t__symbol, xg_cairo_font_weight_t_symbol, xg_cairo_font_slant_t_symbol, xg_cairo_hint_metrics_t_symbol, xg_cairo_hint_style_t_symbol, xg_cairo_subpixel_order_t_symbol, xg_cairo_status_t_symbol, xg_bool_symbol, xg_cairo_matrix_t__symbol, xg_cairo_line_join_t_symbol, xg_cairo_line_cap_t_symbol, xg_cairo_fill_rule_t_symbol, xg_cairo_antialias_t_symbol, xg_cairo_operator_t_symbol, xg_cairo_pattern_t__symbol, xg_cairo_content_t_symbol, xg_GtkPageSet_symbol, xg_GtkPageRange__symbol, xg_GtkPrintPages_symbol, xg_GtkPrintQuality_symbol, xg_GtkPrintDuplex_symbol, xg_GtkPaperSize__symbol, xg_GtkPageOrientation_symbol, xg_GtkPrintSettingsFunc_symbol, xg_GtkPrintOperationPreview__symbol, xg_GtkPageSetupDoneFunc_symbol, xg_GtkPrintStatus_symbol, xg_GtkPrintOperationAction_symbol, xg_GtkPrintOperationResult_symbol, xg_GtkUnit_symbol, xg_GtkPrintSettings__symbol, xg_GtkPrintOperation__symbol, xg_GtkPageSetup__symbol, xg_GtkPrintContext__symbol, xg_cairo_surface_t__symbol, xg_GtkTreeViewGridLines_symbol, xg_GtkRecentData__symbol, xg_GtkTextBufferDeserializeFunc_symbol, xg_GtkTextBufferSerializeFunc_symbol, xg_time_t_symbol, xg_GtkRecentChooserMenu__symbol, xg_GtkRecentManager__symbol, xg_GtkRecentFilter__symbol, xg_GtkRecentSortFunc_symbol, xg_GtkRecentSortType_symbol, xg_GtkRecentChooser__symbol, xg_GtkLinkButton__symbol, xg_GtkAssistantPageType_symbol, xg_GtkAssistantPageFunc_symbol, xg_GtkAssistant__symbol, xg_GDestroyNotify_symbol, xg_GtkTreeViewSearchPositionFunc_symbol, xg_GtkSensitivityType_symbol, xg_GtkClipboardRichTextReceivedFunc_symbol, xg_GtkMenuBar__symbol, xg_GtkPackDirection_symbol, xg_GtkIconViewDropPosition_symbol, xg_GValue__symbol, xg_GLogFunc_symbol, xg_PangoMatrix__symbol, xg_PangoRenderPart_symbol, xg_PangoRenderer__symbol, xg_GtkClipboardImageReceivedFunc_symbol, xg_GtkMenuToolButton__symbol, xg_GtkFileChooserButton__symbol, xg_PangoScriptIter__symbol, xg_PangoScript_symbol, xg_PangoAttrFilterFunc_symbol, xg_PangoEllipsizeMode_symbol, xg_GtkIconViewForeachFunc_symbol, xg_GtkAboutDialog__symbol, xg_GtkTreeViewRowSeparatorFunc_symbol, xg_GtkCellView__symbol, xg_GtkAccelMap__symbol, xg_GtkClipboardTargetsReceivedFunc_symbol, xg_GtkOrientation_symbol, xg_GtkToolButton__symbol, xg_GtkIconLookupFlags_symbol, xg_GtkIconInfo__symbol, xg_GtkIconTheme__symbol, xg_GtkFileChooser__symbol, xg_GtkCellLayoutDataFunc_symbol, xg_GtkCellLayout__symbol, xg_GtkFileFilterFunc_symbol, xg_GtkFileFilterFlags_symbol, xg_GtkFileFilter__symbol, xg_GSourceFunc_symbol, xg_GtkToggleToolButton__symbol, xg_GtkSeparatorToolItem__symbol, xg_GtkRadioToolButton__symbol, xg_GtkEntryCompletionMatchFunc_symbol, xg_GtkFontButton__symbol, xg_GtkExpander__symbol, xg_GtkComboBox__symbol, xg_GtkTreeModelFilter__symbol, xg_GtkFileChooserAction_symbol, xg_GtkToolItem__symbol, xg_GtkEventBox__symbol, xg_GtkCalendarDisplayOptions_symbol, xg_GdkScreen__symbol, xg_PangoLayoutRun__symbol, xg_PangoLayoutIter__symbol, xg_PangoLayoutLine__symbol, xg_int__symbol, xg_PangoAlignment_symbol, xg_PangoWrapMode_symbol, xg_PangoItem__symbol, xg_PangoGlyphString__symbol, xg_PangoFontMap__symbol, xg_PangoGlyph_symbol, xg_PangoFontFace__symbol, xg_PangoFontFace___symbol, xg_PangoFontFamily__symbol, xg_PangoFontMask_symbol, xg_PangoFontDescription___symbol, xg_PangoCoverageLevel_symbol, xg_PangoCoverage__symbol, xg_PangoFontMetrics__symbol, xg_PangoFontset__symbol, xg_PangoFont__symbol, xg_PangoFontFamily___symbol, xg_PangoLogAttr__symbol, xg_PangoAnalysis__symbol, xg_PangoAttrList___symbol, xg_PangoAttrIterator__symbol, xg_PangoRectangle__symbol, xg_PangoUnderline_symbol, xg_PangoStretch_symbol, xg_PangoVariant_symbol, xg_PangoWeight_symbol, xg_PangoStyle_symbol, xg_guint16_symbol, xg_PangoAttribute__symbol, xg_PangoAttrType_symbol, xg_PangoColor__symbol, xg_GdkGravity_symbol, xg_GtkWindowPosition_symbol, xg_GtkWindowType_symbol, xg_GtkWindow__symbol, xg_GtkTextDirection_symbol, xg_AtkObject__symbol, xg_GtkDirectionType_symbol, xg_GtkAllocation__symbol, xg_GtkViewport__symbol, xg_GtkTreeViewSearchEqualFunc_symbol, xg_GtkTreeViewDropPosition_symbol, xg_GtkTreeViewMappingFunc_symbol, xg_GtkTreeViewColumnDropFunc_symbol, xg_GtkTreeViewColumnSizing_symbol, xg_GtkTreeCellDataFunc_symbol, xg_GtkTreeStore__symbol, xg_GtkTreeIterCompareFunc_symbol, xg_GtkSortType_symbol, xg_GtkTreeSortable__symbol, xg_GtkTreeSelectionForeachFunc_symbol, xg_GtkTreeModel___symbol, xg_GtkTreeSelectionFunc_symbol, xg_GtkSelectionMode_symbol, xg_GtkTreeModelSort__symbol, xg_GtkTreeModelForeachFunc_symbol, xg_GtkTreeModelFlags_symbol, xg_GtkTreeRowReference__symbol, xg_GtkTreeDragDest__symbol, xg_GtkTreeDragSource__symbol, xg_GtkToolbarStyle_symbol, xg_GtkToolbar__symbol, xg_GtkToggleButton__symbol, xg_PangoTabArray__symbol, xg_GtkWrapMode_symbol, xg_GtkTextWindowType_symbol, xg_GtkTextView__symbol, xg_GtkTextTagTableForeach_symbol, xg_GtkTextSearchFlags_symbol, xg_GtkTextCharPredicate_symbol, xg_GtkTextAttributes__symbol, xg_GtkTextMark__symbol, xg_GtkTextChildAnchor__symbol, xg_GtkTextIter__symbol, xg_GtkTextTagTable__symbol, xg_GtkTextBuffer__symbol, xg_GtkStatusbar__symbol, xg_GtkSpinType_symbol, xg_GtkSpinButtonUpdatePolicy_symbol, xg_GtkSpinButton__symbol, xg_GtkSizeGroupMode_symbol, xg_GtkSizeGroup__symbol, xg_GtkSettings__symbol, xg_GtkCornerType_symbol, xg_GtkPolicyType_symbol, xg_GtkScrolledWindow__symbol, xg_GtkScale__symbol, xg_GtkRange__symbol, xg_GtkRadioMenuItem__symbol, xg_GtkRadioButton__symbol, xg_GtkProgressBar__symbol, xg_GtkPaned__symbol, xg_GtkPositionType_symbol, xg_GtkNotebook__symbol, xg_GtkMenuShell__symbol, xg_GtkMenuItem__symbol, xg_GtkMenuPositionFunc_symbol, xg_PangoLanguage__symbol, xg_GtkListStore__symbol, xg_GtkLayout__symbol, xg_GtkJustification_symbol, xg_GtkLabel__symbol, xg_guint16__symbol, xg_GtkIMContextSimple__symbol, xg_GdkEventKey__symbol, xg_PangoAttrList__symbol, xg_GtkIMContext__symbol, xg_GtkImageType_symbol, xg_GtkImage__symbol, xg_GtkShadowType_symbol, xg_GtkFrame__symbol, xg_GtkFixed__symbol, xg_PangoLayout__symbol, xg_GtkEntry__symbol, xg_GtkEditable__symbol, xg_GtkTargetList__symbol, xg_GtkDestDefaults_symbol, xg_etc_symbol, xg_GtkDialog__symbol, xg_GtkCallback_symbol, xg_GtkContainer__symbol, xg_GtkClipboardTextReceivedFunc_symbol, xg_GtkClipboardReceivedFunc_symbol, xg_GtkClipboardClearFunc_symbol, xg_GtkClipboardGetFunc_symbol, xg_GtkTargetEntry__symbol, xg_GtkCheckMenuItem__symbol, xg_GtkCellRendererToggle__symbol, xg_GtkCellRendererText__symbol, xg_GtkCellRendererState_symbol, xg_GtkCellEditable__symbol, xg_GtkCalendar__symbol, xg_GtkReliefStyle_symbol, xg_GtkButton__symbol, xg_GtkPackType_symbol, xg_GtkBox__symbol, xg_GtkBin__symbol, xg_GtkBindingSet__symbol, xg_GtkButtonBox__symbol, xg_GtkButtonBoxStyle_symbol, xg_GtkAspectFrame__symbol, xg_GtkAdjustment__symbol, xg_GtkAccelMapForeach_symbol, xg_GtkAccelLabel__symbol, xg_GtkAccelGroupEntry__symbol, xg_lambda3_symbol, xg_GSList__symbol, xg_GObject__symbol, xg_GtkAccelFlags_symbol, xg_GtkAccelGroup__symbol, xg_GTimeVal__symbol, xg_GdkPixbufAnimationIter__symbol, xg_GdkPixbufAnimation__symbol, xg_GdkInterpType_symbol, xg_double_symbol, xg_gfloat_symbol, xg_guchar_symbol, xg_char___symbol, xg_GdkPixbufDestroyNotify_symbol, xg_GError__symbol, xg_int_symbol, xg_GdkColorspace_symbol, xg_GdkWindowTypeHint_symbol, xg_GdkWindowHints_symbol, xg_GdkGeometry__symbol, xg_GdkWindowEdge_symbol, xg_GdkWMFunction_symbol, xg_GdkWMDecoration_symbol, xg_GdkEventMask_symbol, xg_GdkWindowState_symbol, xg_GdkFilterFunc_symbol, xg_GdkWindowType_symbol, xg_GdkWindowAttr__symbol, xg_GdkVisualType__symbol, xg_gint__symbol, xg_GdkVisualType_symbol, xg_GdkPropMode_symbol, xg_guchar__symbol, xg_PangoContext__symbol, xg_PangoDirection_symbol, xg_GdkKeymapKey__symbol, xg_GdkKeymap__symbol, xg_GdkRectangle__symbol, xg_char__symbol, xg_gchar___symbol, xg_GdkEventFunc_symbol, xg_gdouble_symbol, xg_GList__symbol, xg_guint32_symbol, xg_GdkDragAction_symbol, xg_GdkDragContext__symbol, xg_GdkCursorType_symbol, xg_GdkDisplay__symbol, xg_GdkCursor__symbol, xg_GdkVisual__symbol, xg_GSignalMatchType_symbol, xg_GConnectFlags_symbol, xg_GtkDestroyNotify_symbol, xg_GSignalEmissionHook_symbol, xg_gulong_symbol, xg_GSignalInvocationHint__symbol, xg_GQuark_symbol, xg_guint__symbol, xg_GSignalQuery__symbol, xg_GType__symbol, xg_GSignalCMarshaller_symbol, xg_gpointer_symbol, xg_GSignalAccumulator_symbol, xg_GSignalFlags_symbol, xg_GType_symbol, xg_GClosureNotify_symbol, xg_GCallback_symbol, xg_GNormalizeMode_symbol, xg_glong_symbol, xg_gssize_symbol, xg_gunichar__symbol, xg_void_symbol, xg_GdkSeat__symbol, xg_GtkRecentInfo__symbol, xg_gsize_symbol, xg_guint8__symbol, xg_GdkAtom_symbol, xg_GLogLevelFlags_symbol, xg_GdkPixbuf__symbol, xg_GtkIconView__symbol, xg_GtkEntryCompletion__symbol, xg_GtkFileFilterInfo__symbol, xg_GtkTreeSelection__symbol, xg_GtkCellRenderer__symbol, xg_GtkTreeViewColumn__symbol, xg_GtkTreeView__symbol, xg_gunichar_symbol, xg_GdkAtom__symbol, xg_GtkSelectionData__symbol, xg_GtkClipboard__symbol, xg_GtkTreeIter__symbol, xg_GtkTreePath__symbol, xg_GtkTreeModel__symbol, xg_GdkModifierType_symbol, xg_guint_symbol, xg_gchar__symbol, xg_GtkTextTag__symbol, xg_gboolean_symbol, xg_gint_symbol, xg_GtkMenu__symbol, xg_GdkXEvent__symbol, xg_GtkWidget__symbol, xg_lambda_data_symbol, xg_GClosure__symbol, xg_GtkAccelKey__symbol, xg_GdkEventMotion__symbol, xg_gdouble__symbol, xg_GdkEventAny__symbol, xg_GdkEvent__symbol, xg_GdkWindow__symbol, xg_cairo_t__symbol, xg_cairo_font_options_t__symbol, xg_PangoFontDescription__symbol, xg_idler_symbol, xg_GtkCellRendererPixbuf__symbol, xg_GtkCheckButton__symbol, xg_GtkDrawingArea__symbol, xg_GtkScrollbar__symbol, xg_GtkSeparator__symbol, xg_GtkSeparatorMenuItem__symbol, xg_GdkEventExpose__symbol, xg_GdkEventNoExpose__symbol, xg_GdkEventVisibility__symbol, xg_GdkEventButton__symbol, xg_GdkEventScroll__symbol, xg_GdkEventCrossing__symbol, xg_GdkEventFocus__symbol, xg_GdkEventConfigure__symbol, xg_GdkEventProperty__symbol, xg_GdkEventSelection__symbol, xg_GdkEventProximity__symbol, xg_GdkEventSetting__symbol, xg_GdkEventWindowState__symbol, xg_GdkEventDND__symbol, xg_GtkFileChooserDialog__symbol, xg_GtkFileChooserWidget__symbol, xg_GtkColorButton__symbol, xg_GtkAccelMap_symbol, xg_GtkCellRendererCombo__symbol, xg_GtkCellRendererProgress__symbol, xg_GtkCellRendererAccel__symbol, xg_GtkCellRendererSpin__symbol, xg_GtkRecentChooserDialog__symbol, xg_GtkRecentChooserWidget__symbol, xg_GtkCellRendererSpinner__symbol, xg_gboolean__symbol, xg_GtkFontChooserDialog__symbol, xg_GtkFontChooserWidget__symbol, xg_GtkColorChooserDialog__symbol, xg_GtkColorChooserWidget__symbol, xg_GtkColorWidget__symbol, xg_GtkGestureLongPress__symbol;
+static Xen xg_GtkShortcutLabel__symbol, xg_GtkPadActionType_symbol, xg_GtkPadActionEntry__symbol, xg_GActionGroup__symbol, xg_GtkPadController__symbol, xg_menu_anchor_symbol, xg_rect_anchor_symbol, xg_rect_symbol, xg_const_symbol, xg_GdkDevicePadFeature_symbol, xg_GdkDevicePad__symbol, xg_GdkDrawingContext__symbol, xg_GdkSubpixelLayout_symbol, xg_menu_symbol, xg_gtk_menu_place_on_monitor_symbol, xg_GdkMonitor__symbol, xg_GdkDeviceTool__symbol, xg_GdkAxisFlags_symbol, xg_GdkSeatGrabPrepareFunc_symbol, xg_GdkSeatCapabilities_symbol, xg_GdkGrabStatus_symbol, xg_GtkPopoverConstraint_symbol, xg_GtkShortcutsWindow__symbol, xg_GtkStackSidebar__symbol, xg_GtkSearchEntry__symbol, xg_GtkPopoverMenu__symbol, xg_GtkStyleContext__symbol, xg_GdkGLContext__symbol, xg_GtkGLArea__symbol, xg_GtkPropagationPhase_symbol, xg_GtkEventController__symbol, xg_GtkGestureZoom__symbol, xg_GtkGestureSwipe__symbol, xg_GtkGestureSingle__symbol, xg_GtkGestureRotate__symbol, xg_GtkGestureMultiPress__symbol, xg_GtkGesturePan__symbol, xg_GtkGestureDrag__symbol, xg_GdkEventSequence__symbol, xg_GtkEventSequenceState_symbol, xg_GtkGesture__symbol, xg_GtkPopover__symbol, xg_GtkActionBar__symbol, xg_GtkFlowBox__symbol, xg_GtkFlowBoxChild__symbol, xg_GdkEventType_symbol, xg_GtkSearchBar__symbol, xg_GtkListBox__symbol, xg_GtkListBoxRow__symbol, xg_GtkHeaderBar__symbol, xg_GtkRevealerTransitionType_symbol, xg_GtkRevealer__symbol, xg_GtkStackTransitionType_symbol, xg_GtkStack__symbol, xg_GtkStackSwitcher__symbol, xg_GtkPlacesSidebar__symbol, xg_GtkPlacesOpenFlags_symbol, xg_GtkBaselinePosition_symbol, xg_GdkFullscreenMode_symbol, xg_GtkInputHints_symbol, xg_GtkInputPurpose_symbol, xg_GtkLevelBarMode_symbol, xg_GtkLevelBar__symbol, xg_GtkMenuButton__symbol, xg_GtkColorChooser__symbol, xg_GtkApplicationWindow__symbol, xg_GtkApplication__symbol, xg_GMenuModel__symbol, xg_guint___symbol, xg_GdkModifierIntent_symbol, xg_GtkFontChooser__symbol, xg_GdkScrollDirection_symbol, xg_GtkOverlay__symbol, xg_GtkWidgetPath__symbol, xg_GtkStateFlags_symbol, xg_GdkScreen___symbol, xg_GtkToolShell__symbol, xg_GtkWindowGroup__symbol, xg_GtkInvisible__symbol, xg_GtkOrientable__symbol, xg_GtkCellArea__symbol, xg_GtkBorder__symbol, xg_GtkSwitch__symbol, xg_GtkScrollablePolicy_symbol, xg_GtkScrollable__symbol, xg_GtkGrid__symbol, xg_GdkRGBA__symbol, xg_GtkComboBoxText__symbol, xg_GtkAlign_symbol, xg_GtkContainerClass__symbol, xg_GtkSizeRequestMode_symbol, xg_cairo_region_overlap_t_symbol, xg_cairo_rectangle_int_t__symbol, xg_double__symbol, xg_cairo_rectangle_t__symbol, xg_cairo_device_t__symbol, xg_cairo_bool_t_symbol, xg_cairo_text_cluster_flags_t__symbol, xg_cairo_text_cluster_t___symbol, xg_cairo_glyph_t___symbol, xg_cairo_text_cluster_flags_t_symbol, xg_cairo_text_cluster_t__symbol, xg_cairo_region_t__symbol, xg_GtkMessageDialog__symbol, xg_GdkDevice__symbol, xg_GtkAccessible__symbol, xg_GdkModifierType__symbol, xg_GtkToolPaletteDragTargets_symbol, xg_GtkToolItemGroup__symbol, xg_GtkToolPalette__symbol, xg_GtkSpinner__symbol, xg_GtkEntryBuffer__symbol, xg_GtkMessageType_symbol, xg_GtkInfoBar__symbol, xg_GIcon__symbol, xg_GtkEntryIconPosition_symbol, xg_GFile__symbol, xg_GtkScaleButton__symbol, xg_GtkCalendarDetailFunc_symbol, xg_GtkTooltip__symbol, xg_cairo_rectangle_list_t__symbol, xg_void__symbol, xg_cairo_filter_t_symbol, xg_cairo_extend_t_symbol, xg_cairo_format_t_symbol, xg_cairo_path_t__symbol, xg_cairo_destroy_func_t_symbol, xg_cairo_user_data_key_t__symbol, xg_cairo_text_extents_t__symbol, xg_cairo_font_extents_t__symbol, xg_cairo_font_face_t__symbol, xg_cairo_glyph_t__symbol, xg_cairo_scaled_font_t__symbol, xg_cairo_font_weight_t_symbol, xg_cairo_font_slant_t_symbol, xg_cairo_hint_metrics_t_symbol, xg_cairo_hint_style_t_symbol, xg_cairo_subpixel_order_t_symbol, xg_cairo_status_t_symbol, xg_bool_symbol, xg_cairo_matrix_t__symbol, xg_cairo_line_join_t_symbol, xg_cairo_line_cap_t_symbol, xg_cairo_fill_rule_t_symbol, xg_cairo_antialias_t_symbol, xg_cairo_operator_t_symbol, xg_cairo_pattern_t__symbol, xg_cairo_content_t_symbol, xg_GtkPageSet_symbol, xg_GtkPageRange__symbol, xg_GtkPrintPages_symbol, xg_GtkPrintQuality_symbol, xg_GtkPrintDuplex_symbol, xg_GtkPaperSize__symbol, xg_GtkPageOrientation_symbol, xg_GtkPrintSettingsFunc_symbol, xg_GtkPrintOperationPreview__symbol, xg_GtkPageSetupDoneFunc_symbol, xg_GtkPrintStatus_symbol, xg_GtkPrintOperationAction_symbol, xg_GtkPrintOperationResult_symbol, xg_GtkUnit_symbol, xg_GtkPrintSettings__symbol, xg_GtkPrintOperation__symbol, xg_GtkPageSetup__symbol, xg_GtkPrintContext__symbol, xg_cairo_surface_t__symbol, xg_GtkTreeViewGridLines_symbol, xg_GtkRecentData__symbol, xg_GtkTextBufferDeserializeFunc_symbol, xg_GtkTextBufferSerializeFunc_symbol, xg_time_t_symbol, xg_GtkRecentChooserMenu__symbol, xg_GtkRecentManager__symbol, xg_GtkRecentFilter__symbol, xg_GtkRecentSortFunc_symbol, xg_GtkRecentSortType_symbol, xg_GtkRecentChooser__symbol, xg_GtkLinkButton__symbol, xg_GtkAssistantPageType_symbol, xg_GtkAssistantPageFunc_symbol, xg_GtkAssistant__symbol, xg_GDestroyNotify_symbol, xg_GtkTreeViewSearchPositionFunc_symbol, xg_GtkSensitivityType_symbol, xg_GtkClipboardRichTextReceivedFunc_symbol, xg_GtkMenuBar__symbol, xg_GtkPackDirection_symbol, xg_GtkIconViewDropPosition_symbol, xg_GValue__symbol, xg_GLogFunc_symbol, xg_PangoMatrix__symbol, xg_PangoRenderPart_symbol, xg_PangoRenderer__symbol, xg_GtkClipboardImageReceivedFunc_symbol, xg_GtkMenuToolButton__symbol, xg_GtkFileChooserButton__symbol, xg_PangoScriptIter__symbol, xg_PangoScript_symbol, xg_PangoAttrFilterFunc_symbol, xg_PangoEllipsizeMode_symbol, xg_GtkIconViewForeachFunc_symbol, xg_GtkAboutDialog__symbol, xg_GtkTreeViewRowSeparatorFunc_symbol, xg_GtkCellView__symbol, xg_GtkAccelMap__symbol, xg_GtkClipboardTargetsReceivedFunc_symbol, xg_GtkOrientation_symbol, xg_GtkToolButton__symbol, xg_GtkIconLookupFlags_symbol, xg_GtkIconInfo__symbol, xg_GtkIconTheme__symbol, xg_GtkFileChooser__symbol, xg_GtkCellLayoutDataFunc_symbol, xg_GtkCellLayout__symbol, xg_GtkFileFilterFunc_symbol, xg_GtkFileFilterFlags_symbol, xg_GtkFileFilter__symbol, xg_GSourceFunc_symbol, xg_GtkToggleToolButton__symbol, xg_GtkSeparatorToolItem__symbol, xg_GtkRadioToolButton__symbol, xg_GtkEntryCompletionMatchFunc_symbol, xg_GtkFontButton__symbol, xg_GtkExpander__symbol, xg_GtkComboBox__symbol, xg_GtkTreeModelFilter__symbol, xg_GtkFileChooserAction_symbol, xg_GtkToolItem__symbol, xg_GtkEventBox__symbol, xg_GtkCalendarDisplayOptions_symbol, xg_GdkScreen__symbol, xg_PangoLayoutRun__symbol, xg_PangoLayoutIter__symbol, xg_PangoLayoutLine__symbol, xg_int__symbol, xg_PangoAlignment_symbol, xg_PangoWrapMode_symbol, xg_PangoItem__symbol, xg_PangoGlyphString__symbol, xg_PangoFontMap__symbol, xg_PangoGlyph_symbol, xg_PangoFontFace__symbol, xg_PangoFontFace___symbol, xg_PangoFontFamily__symbol, xg_PangoFontMask_symbol, xg_PangoFontDescription___symbol, xg_PangoCoverageLevel_symbol, xg_PangoCoverage__symbol, xg_PangoFontMetrics__symbol, xg_PangoFontset__symbol, xg_PangoFont__symbol, xg_PangoFontFamily___symbol, xg_PangoLogAttr__symbol, xg_PangoAnalysis__symbol, xg_PangoAttrList___symbol, xg_PangoAttrIterator__symbol, xg_PangoRectangle__symbol, xg_PangoUnderline_symbol, xg_PangoStretch_symbol, xg_PangoVariant_symbol, xg_PangoWeight_symbol, xg_PangoStyle_symbol, xg_guint16_symbol, xg_PangoAttribute__symbol, xg_PangoAttrType_symbol, xg_PangoColor__symbol, xg_GdkGravity_symbol, xg_GtkWindowPosition_symbol, xg_GtkWindowType_symbol, xg_GtkWindow__symbol, xg_GtkTextDirection_symbol, xg_AtkObject__symbol, xg_GtkDirectionType_symbol, xg_GtkAllocation__symbol, xg_GtkViewport__symbol, xg_GtkTreeViewSearchEqualFunc_symbol, xg_GtkTreeViewDropPosition_symbol, xg_GtkTreeViewMappingFunc_symbol, xg_GtkTreeViewColumnDropFunc_symbol, xg_GtkTreeViewColumnSizing_symbol, xg_GtkTreeCellDataFunc_symbol, xg_GtkTreeStore__symbol, xg_GtkTreeIterCompareFunc_symbol, xg_GtkSortType_symbol, xg_GtkTreeSortable__symbol, xg_GtkTreeSelectionForeachFunc_symbol, xg_GtkTreeModel___symbol, xg_GtkTreeSelectionFunc_symbol, xg_GtkSelectionMode_symbol, xg_GtkTreeModelSort__symbol, xg_GtkTreeModelForeachFunc_symbol, xg_GtkTreeModelFlags_symbol, xg_GtkTreeRowReference__symbol, xg_GtkTreeDragDest__symbol, xg_GtkTreeDragSource__symbol, xg_GtkToolbarStyle_symbol, xg_GtkToolbar__symbol, xg_GtkToggleButton__symbol, xg_PangoTabArray__symbol, xg_GtkWrapMode_symbol, xg_GtkTextWindowType_symbol, xg_GtkTextView__symbol, xg_GtkTextTagTableForeach_symbol, xg_GtkTextSearchFlags_symbol, xg_GtkTextCharPredicate_symbol, xg_GtkTextAttributes__symbol, xg_GtkTextMark__symbol, xg_GtkTextChildAnchor__symbol, xg_GtkTextIter__symbol, xg_GtkTextTagTable__symbol, xg_GtkTextBuffer__symbol, xg_GtkStatusbar__symbol, xg_GtkSpinType_symbol, xg_GtkSpinButtonUpdatePolicy_symbol, xg_GtkSpinButton__symbol, xg_GtkSizeGroupMode_symbol, xg_GtkSizeGroup__symbol, xg_GtkSettings__symbol, xg_GtkCornerType_symbol, xg_GtkPolicyType_symbol, xg_GtkScrolledWindow__symbol, xg_GtkScale__symbol, xg_GtkRange__symbol, xg_GtkRadioMenuItem__symbol, xg_GtkRadioButton__symbol, xg_GtkProgressBar__symbol, xg_GtkPaned__symbol, xg_GtkPositionType_symbol, xg_GtkNotebook__symbol, xg_GtkMenuShell__symbol, xg_GtkMenuItem__symbol, xg_GtkMenuPositionFunc_symbol, xg_PangoLanguage__symbol, xg_GtkListStore__symbol, xg_GtkLayout__symbol, xg_GtkJustification_symbol, xg_GtkLabel__symbol, xg_guint16__symbol, xg_GtkIMContextSimple__symbol, xg_GdkEventKey__symbol, xg_PangoAttrList__symbol, xg_GtkIMContext__symbol, xg_GtkImageType_symbol, xg_GtkImage__symbol, xg_GtkShadowType_symbol, xg_GtkFrame__symbol, xg_GtkFixed__symbol, xg_PangoLayout__symbol, xg_GtkEntry__symbol, xg_GtkEditable__symbol, xg_GtkTargetList__symbol, xg_GtkDestDefaults_symbol, xg_etc_symbol, xg_GtkDialog__symbol, xg_GtkCallback_symbol, xg_GtkContainer__symbol, xg_GtkClipboardTextReceivedFunc_symbol, xg_GtkClipboardReceivedFunc_symbol, xg_GtkClipboardClearFunc_symbol, xg_GtkClipboardGetFunc_symbol, xg_GtkTargetEntry__symbol, xg_GtkCheckMenuItem__symbol, xg_GtkCellRendererToggle__symbol, xg_GtkCellRendererText__symbol, xg_GtkCellRendererState_symbol, xg_GtkCellEditable__symbol, xg_GtkCalendar__symbol, xg_GtkReliefStyle_symbol, xg_GtkButton__symbol, xg_GtkPackType_symbol, xg_GtkBox__symbol, xg_GtkBin__symbol, xg_GtkBindingSet__symbol, xg_GtkButtonBox__symbol, xg_GtkButtonBoxStyle_symbol, xg_GtkAspectFrame__symbol, xg_GtkAdjustment__symbol, xg_GtkAccelMapForeach_symbol, xg_GtkAccelLabel__symbol, xg_GtkAccelGroupEntry__symbol, xg_lambda3_symbol, xg_GSList__symbol, xg_GObject__symbol, xg_GtkAccelFlags_symbol, xg_GtkAccelGroup__symbol, xg_GTimeVal__symbol, xg_GdkPixbufAnimationIter__symbol, xg_GdkPixbufAnimation__symbol, xg_GdkInterpType_symbol, xg_double_symbol, xg_gfloat_symbol, xg_guchar_symbol, xg_char___symbol, xg_GdkPixbufDestroyNotify_symbol, xg_GError__symbol, xg_int_symbol, xg_GdkColorspace_symbol, xg_GdkWindowTypeHint_symbol, xg_GdkWindowHints_symbol, xg_GdkGeometry__symbol, xg_GdkWindowEdge_symbol, xg_GdkWMFunction_symbol, xg_GdkWMDecoration_symbol, xg_GdkEventMask_symbol, xg_GdkWindowState_symbol, xg_GdkFilterFunc_symbol, xg_GdkWindowType_symbol, xg_GdkWindowAttr__symbol, xg_GdkVisualType__symbol, xg_gint__symbol, xg_GdkVisualType_symbol, xg_GdkPropMode_symbol, xg_guchar__symbol, xg_PangoContext__symbol, xg_PangoDirection_symbol, xg_GdkKeymapKey__symbol, xg_GdkKeymap__symbol, xg_GdkRectangle__symbol, xg_char__symbol, xg_gchar___symbol, xg_GdkEventFunc_symbol, xg_gdouble_symbol, xg_GList__symbol, xg_guint32_symbol, xg_GdkDragAction_symbol, xg_GdkDragContext__symbol, xg_GdkCursorType_symbol, xg_GdkDisplay__symbol, xg_GdkCursor__symbol, xg_GdkVisual__symbol, xg_GSignalMatchType_symbol, xg_GConnectFlags_symbol, xg_GtkDestroyNotify_symbol, xg_GSignalEmissionHook_symbol, xg_gulong_symbol, xg_GSignalInvocationHint__symbol, xg_GQuark_symbol, xg_guint__symbol, xg_GSignalQuery__symbol, xg_GType__symbol, xg_GSignalCMarshaller_symbol, xg_gpointer_symbol, xg_GSignalAccumulator_symbol, xg_GSignalFlags_symbol, xg_GType_symbol, xg_GClosureNotify_symbol, xg_GCallback_symbol, xg_GNormalizeMode_symbol, xg_glong_symbol, xg_gssize_symbol, xg_gunichar__symbol, xg_void_symbol, xg_GdkSeat__symbol, xg_GtkRecentInfo__symbol, xg_gsize_symbol, xg_guint8__symbol, xg_GdkAtom_symbol, xg_GLogLevelFlags_symbol, xg_GdkPixbuf__symbol, xg_GtkIconView__symbol, xg_GtkEntryCompletion__symbol, xg_GtkFileFilterInfo__symbol, xg_GtkTreeSelection__symbol, xg_GtkCellRenderer__symbol, xg_GtkTreeViewColumn__symbol, xg_GtkTreeView__symbol, xg_gunichar_symbol, xg_GdkAtom__symbol, xg_GtkSelectionData__symbol, xg_GtkClipboard__symbol, xg_GtkTreeIter__symbol, xg_GtkTreePath__symbol, xg_GtkTreeModel__symbol, xg_GdkModifierType_symbol, xg_guint_symbol, xg_gchar__symbol, xg_GtkTextTag__symbol, xg_gboolean_symbol, xg_gint_symbol, xg_GtkMenu__symbol, xg_GdkXEvent__symbol, xg_GtkWidget__symbol, xg_lambda_data_symbol, xg_GClosure__symbol, xg_GtkAccelKey__symbol, xg_GdkEventMotion__symbol, xg_gdouble__symbol, xg_GdkEventAny__symbol, xg_GdkEvent__symbol, xg_GdkWindow__symbol, xg_cairo_t__symbol, xg_cairo_font_options_t__symbol, xg_PangoFontDescription__symbol, xg_idler_symbol, xg_GtkCellRendererPixbuf__symbol, xg_GtkCheckButton__symbol, xg_GtkDrawingArea__symbol, xg_GtkScrollbar__symbol, xg_GtkSeparator__symbol, xg_GtkSeparatorMenuItem__symbol, xg_GdkEventExpose__symbol, xg_GdkEventNoExpose__symbol, xg_GdkEventVisibility__symbol, xg_GdkEventButton__symbol, xg_GdkEventScroll__symbol, xg_GdkEventCrossing__symbol, xg_GdkEventFocus__symbol, xg_GdkEventConfigure__symbol, xg_GdkEventProperty__symbol, xg_GdkEventSelection__symbol, xg_GdkEventProximity__symbol, xg_GdkEventSetting__symbol, xg_GdkEventWindowState__symbol, xg_GdkEventDND__symbol, xg_GtkFileChooserDialog__symbol, xg_GtkFileChooserWidget__symbol, xg_GtkColorButton__symbol, xg_GtkAccelMap_symbol, xg_GtkCellRendererCombo__symbol, xg_GtkCellRendererProgress__symbol, xg_GtkCellRendererAccel__symbol, xg_GtkCellRendererSpin__symbol, xg_GtkRecentChooserDialog__symbol, xg_GtkRecentChooserWidget__symbol, xg_GtkCellRendererSpinner__symbol, xg_gboolean__symbol, xg_GtkFontChooserDialog__symbol, xg_GtkFontChooserWidget__symbol, xg_GtkColorChooserDialog__symbol, xg_GtkColorChooserWidget__symbol, xg_GtkColorWidget__symbol, xg_GtkGestureLongPress__symbol;
#define wrap_for_Xen(Name, Value) Xen_list_2(xg_ ## Name ## _symbol, Xen_wrap_C_pointer(Value))
#define is_wrapped(Name, Value) (Xen_is_pair(Value) && (Xen_car(Value) == xg_ ## Name ## _symbol))
@@ -967,6 +967,21 @@ Xm_type(menu, menu)
#define Xen_to_C_GdkSubpixelLayout(Arg) (GdkSubpixelLayout)(Xen_integer_to_C_int(Arg))
#define Xen_is_GdkSubpixelLayout(Arg) Xen_is_integer(Arg)
Xm_type_Ptr(GdkDrawingContext_, GdkDrawingContext*)
+Xm_type_Ptr(GdkDevicePad_, GdkDevicePad*)
+#define C_to_Xen_GdkDevicePadFeature(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkDevicePadFeature(Arg) (GdkDevicePadFeature)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkDevicePadFeature(Arg) Xen_is_integer(Arg)
+Xm_type(const, const)
+Xm_type(rect, rect)
+Xm_type(rect_anchor, rect_anchor)
+Xm_type(menu_anchor, menu_anchor)
+Xm_type_Ptr(GtkPadController_, GtkPadController*)
+Xm_type_Ptr(GActionGroup_, GActionGroup*)
+Xm_type_Ptr(GtkPadActionEntry_, GtkPadActionEntry*)
+#define C_to_Xen_GtkPadActionType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkPadActionType(Arg) (GtkPadActionType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkPadActionType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkShortcutLabel_, GtkShortcutLabel*)
#endif
Xm_type_Ptr(cairo_surface_t_, cairo_surface_t*)
@@ -31627,23 +31642,6 @@ static Xen gxg_gtk_stack_sidebar_get_stack(Xen sidebar)
return(C_to_Xen_GtkStack_(gtk_stack_sidebar_get_stack(Xen_to_C_GtkStackSidebar_(sidebar))));
}
-static Xen gxg_gtk_popover_set_transitions_enabled(Xen popover, Xen transitions_enabled)
-{
- #define H_gtk_popover_set_transitions_enabled "void gtk_popover_set_transitions_enabled(GtkPopover* popover, \
-gboolean transitions_enabled)"
- Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_set_transitions_enabled", "GtkPopover*");
- Xen_check_type(Xen_is_gboolean(transitions_enabled), transitions_enabled, 2, "gtk_popover_set_transitions_enabled", "gboolean");
- gtk_popover_set_transitions_enabled(Xen_to_C_GtkPopover_(popover), Xen_to_C_gboolean(transitions_enabled));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_popover_get_transitions_enabled(Xen popover)
-{
- #define H_gtk_popover_get_transitions_enabled "gboolean gtk_popover_get_transitions_enabled(GtkPopover* popover)"
- Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_get_transitions_enabled", "GtkPopover*");
- return(C_to_Xen_gboolean(gtk_popover_get_transitions_enabled(Xen_to_C_GtkPopover_(popover))));
-}
-
#endif
#if GTK_CHECK_VERSION(3, 18, 0)
@@ -32521,6 +32519,174 @@ static Xen gxg_gtk_file_chooser_get_choice(Xen chooser, Xen id)
return(C_to_Xen_char_(gtk_file_chooser_get_choice(Xen_to_C_GtkFileChooser_(chooser), (const char*)Xen_to_C_char_(id))));
}
+static Xen gxg_gdk_device_pad_get_n_groups(Xen pad)
+{
+ #define H_gdk_device_pad_get_n_groups "gint gdk_device_pad_get_n_groups(GdkDevicePad* pad)"
+ Xen_check_type(Xen_is_GdkDevicePad_(pad), pad, 1, "gdk_device_pad_get_n_groups", "GdkDevicePad*");
+ return(C_to_Xen_gint(gdk_device_pad_get_n_groups(Xen_to_C_GdkDevicePad_(pad))));
+}
+
+static Xen gxg_gdk_device_pad_get_group_n_modes(Xen pad, Xen group_idx)
+{
+ #define H_gdk_device_pad_get_group_n_modes "gint gdk_device_pad_get_group_n_modes(GdkDevicePad* pad, \
+gint group_idx)"
+ Xen_check_type(Xen_is_GdkDevicePad_(pad), pad, 1, "gdk_device_pad_get_group_n_modes", "GdkDevicePad*");
+ Xen_check_type(Xen_is_gint(group_idx), group_idx, 2, "gdk_device_pad_get_group_n_modes", "gint");
+ return(C_to_Xen_gint(gdk_device_pad_get_group_n_modes(Xen_to_C_GdkDevicePad_(pad), Xen_to_C_gint(group_idx))));
+}
+
+static Xen gxg_gdk_device_pad_get_n_features(Xen pad, Xen feature)
+{
+ #define H_gdk_device_pad_get_n_features "gint gdk_device_pad_get_n_features(GdkDevicePad* pad, GdkDevicePadFeature feature)"
+ Xen_check_type(Xen_is_GdkDevicePad_(pad), pad, 1, "gdk_device_pad_get_n_features", "GdkDevicePad*");
+ Xen_check_type(Xen_is_GdkDevicePadFeature(feature), feature, 2, "gdk_device_pad_get_n_features", "GdkDevicePadFeature");
+ return(C_to_Xen_gint(gdk_device_pad_get_n_features(Xen_to_C_GdkDevicePad_(pad), Xen_to_C_GdkDevicePadFeature(feature))));
+}
+
+static Xen gxg_gdk_device_pad_get_feature_group(Xen pad, Xen feature, Xen feature_idx)
+{
+ #define H_gdk_device_pad_get_feature_group "gint gdk_device_pad_get_feature_group(GdkDevicePad* pad, \
+GdkDevicePadFeature feature, gint feature_idx)"
+ Xen_check_type(Xen_is_GdkDevicePad_(pad), pad, 1, "gdk_device_pad_get_feature_group", "GdkDevicePad*");
+ Xen_check_type(Xen_is_GdkDevicePadFeature(feature), feature, 2, "gdk_device_pad_get_feature_group", "GdkDevicePadFeature");
+ Xen_check_type(Xen_is_gint(feature_idx), feature_idx, 3, "gdk_device_pad_get_feature_group", "gint");
+ return(C_to_Xen_gint(gdk_device_pad_get_feature_group(Xen_to_C_GdkDevicePad_(pad), Xen_to_C_GdkDevicePadFeature(feature),
+ Xen_to_C_gint(feature_idx))));
+}
+
+static Xen gxg_gtk_menu_popup_at_rect(Xen menu, Xen rect_window, Xen GdkRectangle*, Xen GdkGravity, Xen GdkGravity, Xen const, Xen trigger_event)
+{
+ #define H_gtk_menu_popup_at_rect "void gtk_menu_popup_at_rect(GtkMenu* menu, GdkWindow* rect_window, \
+const GdkRectangle*, rect GdkGravity, rect_anchor GdkGravity, menu_anchor const, GdkEvent* trigger_event)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_popup_at_rect", "GtkMenu*");
+ Xen_check_type(Xen_is_GdkWindow_(rect_window), rect_window, 2, "gtk_menu_popup_at_rect", "GdkWindow*");
+ Xen_check_type(Xen_is_const(GdkRectangle*), GdkRectangle*, 3, "gtk_menu_popup_at_rect", "const");
+ Xen_check_type(Xen_is_rect(GdkGravity), GdkGravity, 4, "gtk_menu_popup_at_rect", "rect");
+ Xen_check_type(Xen_is_rect_anchor(GdkGravity), GdkGravity, 5, "gtk_menu_popup_at_rect", "rect_anchor");
+ Xen_check_type(Xen_is_menu_anchor(const), const, 6, "gtk_menu_popup_at_rect", "menu_anchor");
+ Xen_check_type(Xen_is_GdkEvent_(trigger_event), trigger_event, 7, "gtk_menu_popup_at_rect", "GdkEvent*");
+ gtk_menu_popup_at_rect(Xen_to_C_GtkMenu_(menu), Xen_to_C_GdkWindow_(rect_window), Xen_to_C_const(GdkRectangle*), Xen_to_C_rect(GdkGravity),
+ Xen_to_C_rect_anchor(GdkGravity), Xen_to_C_menu_anchor(const), Xen_to_C_GdkEvent_(trigger_event));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_menu_popup_at_widget(Xen menu, Xen widget, Xen widget_anchor, Xen menu_anchor, Xen GdkEvent*)
+{
+ #define H_gtk_menu_popup_at_widget "void gtk_menu_popup_at_widget(GtkMenu* menu, GtkWidget* widget, \
+GdkGravity widget_anchor, GdkGravity menu_anchor, const GdkEvent*, trigger_event)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_popup_at_widget", "GtkMenu*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_menu_popup_at_widget", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkGravity(widget_anchor), widget_anchor, 3, "gtk_menu_popup_at_widget", "GdkGravity");
+ Xen_check_type(Xen_is_GdkGravity(menu_anchor), menu_anchor, 4, "gtk_menu_popup_at_widget", "GdkGravity");
+ Xen_check_type(Xen_is_const(GdkEvent*), GdkEvent*, 5, "gtk_menu_popup_at_widget", "const");
+ gtk_menu_popup_at_widget(Xen_to_C_GtkMenu_(menu), Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkGravity(widget_anchor), Xen_to_C_GdkGravity(menu_anchor),
+ Xen_to_C_const(GdkEvent*));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_menu_popup_at_pointer(Xen menu, Xen GdkEvent*)
+{
+ #define H_gtk_menu_popup_at_pointer "void gtk_menu_popup_at_pointer(GtkMenu* menu, const GdkEvent*, \
+trigger_event)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_popup_at_pointer", "GtkMenu*");
+ Xen_check_type(Xen_is_const(GdkEvent*), GdkEvent*, 2, "gtk_menu_popup_at_pointer", "const");
+ gtk_menu_popup_at_pointer(Xen_to_C_GtkMenu_(menu), Xen_to_C_const(GdkEvent*));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_pad_controller_new(Xen window, Xen group, Xen pad)
+{
+ #define H_gtk_pad_controller_new "GtkPadController* gtk_pad_controller_new(GtkWindow* window, GActionGroup* group, \
+GdkDevice* pad)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_pad_controller_new", "GtkWindow*");
+ Xen_check_type(Xen_is_GActionGroup_(group), group, 2, "gtk_pad_controller_new", "GActionGroup*");
+ Xen_check_type(Xen_is_GdkDevice_(pad), pad, 3, "gtk_pad_controller_new", "GdkDevice*");
+ return(C_to_Xen_GtkPadController_(gtk_pad_controller_new(Xen_to_C_GtkWindow_(window), Xen_to_C_GActionGroup_(group), Xen_to_C_GdkDevice_(pad))));
+}
+
+static Xen gxg_gtk_pad_controller_set_action_entries(Xen controller, Xen entries, Xen n_entries)
+{
+ #define H_gtk_pad_controller_set_action_entries "void gtk_pad_controller_set_action_entries(GtkPadController* controller, \
+GtkPadActionEntry* entries, gint n_entries)"
+ Xen_check_type(Xen_is_GtkPadController_(controller), controller, 1, "gtk_pad_controller_set_action_entries", "GtkPadController*");
+ Xen_check_type(Xen_is_GtkPadActionEntry_(entries), entries, 2, "gtk_pad_controller_set_action_entries", "GtkPadActionEntry*");
+ Xen_check_type(Xen_is_gint(n_entries), n_entries, 3, "gtk_pad_controller_set_action_entries", "gint");
+ gtk_pad_controller_set_action_entries(Xen_to_C_GtkPadController_(controller), Xen_to_C_GtkPadActionEntry_(entries), Xen_to_C_gint(n_entries));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_pad_controller_set_action(Xen controller, Xen type, Xen index, Xen mode, Xen label, Xen action_name)
+{
+ #define H_gtk_pad_controller_set_action "void gtk_pad_controller_set_action(GtkPadController* controller, \
+GtkPadActionType type, gint index, gint mode, gchar* label, gchar* action_name)"
+ Xen_check_type(Xen_is_GtkPadController_(controller), controller, 1, "gtk_pad_controller_set_action", "GtkPadController*");
+ Xen_check_type(Xen_is_GtkPadActionType(type), type, 2, "gtk_pad_controller_set_action", "GtkPadActionType");
+ Xen_check_type(Xen_is_gint(index), index, 3, "gtk_pad_controller_set_action", "gint");
+ Xen_check_type(Xen_is_gint(mode), mode, 4, "gtk_pad_controller_set_action", "gint");
+ Xen_check_type(Xen_is_gchar_(label), label, 5, "gtk_pad_controller_set_action", "gchar*");
+ Xen_check_type(Xen_is_gchar_(action_name), action_name, 6, "gtk_pad_controller_set_action", "gchar*");
+ gtk_pad_controller_set_action(Xen_to_C_GtkPadController_(controller), Xen_to_C_GtkPadActionType(type), Xen_to_C_gint(index),
+ Xen_to_C_gint(mode), (const gchar*)Xen_to_C_gchar_(label), (const gchar*)Xen_to_C_gchar_(action_name));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_popover_popup(Xen popover)
+{
+ #define H_gtk_popover_popup "void gtk_popover_popup(GtkPopover* popover)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_popup", "GtkPopover*");
+ gtk_popover_popup(Xen_to_C_GtkPopover_(popover));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_popover_popdown(Xen popover)
+{
+ #define H_gtk_popover_popdown "void gtk_popover_popdown(GtkPopover* popover)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_popdown", "GtkPopover*");
+ gtk_popover_popdown(Xen_to_C_GtkPopover_(popover));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_shortcut_label_new(Xen accelerator)
+{
+ #define H_gtk_shortcut_label_new "GtkWidget* gtk_shortcut_label_new(gchar* accelerator)"
+ Xen_check_type(Xen_is_gchar_(accelerator), accelerator, 1, "gtk_shortcut_label_new", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_shortcut_label_new((const gchar*)Xen_to_C_gchar_(accelerator))));
+}
+
+static Xen gxg_gtk_shortcut_label_get_accelerator(Xen self)
+{
+ #define H_gtk_shortcut_label_get_accelerator "gchar* gtk_shortcut_label_get_accelerator(GtkShortcutLabel* self)"
+ Xen_check_type(Xen_is_GtkShortcutLabel_(self), self, 1, "gtk_shortcut_label_get_accelerator", "GtkShortcutLabel*");
+ return(C_to_Xen_gchar_((gchar*)gtk_shortcut_label_get_accelerator(Xen_to_C_GtkShortcutLabel_(self))));
+}
+
+static Xen gxg_gtk_shortcut_label_set_accelerator(Xen self, Xen accelerator)
+{
+ #define H_gtk_shortcut_label_set_accelerator "void gtk_shortcut_label_set_accelerator(GtkShortcutLabel* self, \
+gchar* accelerator)"
+ Xen_check_type(Xen_is_GtkShortcutLabel_(self), self, 1, "gtk_shortcut_label_set_accelerator", "GtkShortcutLabel*");
+ Xen_check_type(Xen_is_gchar_(accelerator), accelerator, 2, "gtk_shortcut_label_set_accelerator", "gchar*");
+ gtk_shortcut_label_set_accelerator(Xen_to_C_GtkShortcutLabel_(self), (const gchar*)Xen_to_C_gchar_(accelerator));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_shortcut_label_get_disabled_text(Xen self)
+{
+ #define H_gtk_shortcut_label_get_disabled_text "gchar* gtk_shortcut_label_get_disabled_text(GtkShortcutLabel* self)"
+ Xen_check_type(Xen_is_GtkShortcutLabel_(self), self, 1, "gtk_shortcut_label_get_disabled_text", "GtkShortcutLabel*");
+ return(C_to_Xen_gchar_((gchar*)gtk_shortcut_label_get_disabled_text(Xen_to_C_GtkShortcutLabel_(self))));
+}
+
+static Xen gxg_gtk_shortcut_label_set_disabled_text(Xen self, Xen disabled_text)
+{
+ #define H_gtk_shortcut_label_set_disabled_text "void gtk_shortcut_label_set_disabled_text(GtkShortcutLabel* self, \
+gchar* disabled_text)"
+ Xen_check_type(Xen_is_GtkShortcutLabel_(self), self, 1, "gtk_shortcut_label_set_disabled_text", "GtkShortcutLabel*");
+ Xen_check_type(Xen_is_gchar_(disabled_text), disabled_text, 2, "gtk_shortcut_label_set_disabled_text", "gchar*");
+ gtk_shortcut_label_set_disabled_text(Xen_to_C_GtkShortcutLabel_(self), (const gchar*)Xen_to_C_gchar_(disabled_text));
+ return(Xen_false);
+}
+
#endif
static Xen gxg_cairo_create(Xen target)
@@ -35181,6 +35347,9 @@ static Xen gxg_GDK_SEAT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list
static Xen gxg_GDK_DEVICE_TOOL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkDeviceTool__symbol, Xen_cadr(obj)) : Xen_false);}
static Xen gxg_GDK_MONITOR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkMonitor__symbol, Xen_cadr(obj)) : Xen_false);}
static Xen gxg_GDK_DRAWING_CONTEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkDrawingContext__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_DEVICE_PAD(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkDevicePad__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_PAD_CONTROLLER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPadController__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SHORTCUT_LABEL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkShortcutLabel__symbol, Xen_cadr(obj)) : Xen_false);}
#endif
static Xen gxg_GDK_IS_DRAG_CONTEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_DRAG_CONTEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
@@ -35399,6 +35568,9 @@ static Xen gxg_GDK_IS_SEAT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped
static Xen gxg_GDK_IS_DEVICE_TOOL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_DEVICE_TOOL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
static Xen gxg_GDK_IS_MONITOR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_MONITOR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
static Xen gxg_GDK_IS_DRAWING_CONTEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_DRAWING_CONTEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_DEVICE_PAD(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_DEVICE_PAD((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_PAD_CONTROLLER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PAD_CONTROLLER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SHORTCUT_LABEL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SHORTCUT_LABEL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
#endif
@@ -39161,8 +39333,6 @@ Xen_wrap_2_args(gxg_gtk_notebook_detach_tab_w, gxg_gtk_notebook_detach_tab)
Xen_wrap_no_args(gxg_gtk_stack_sidebar_new_w, gxg_gtk_stack_sidebar_new)
Xen_wrap_2_args(gxg_gtk_stack_sidebar_set_stack_w, gxg_gtk_stack_sidebar_set_stack)
Xen_wrap_1_arg(gxg_gtk_stack_sidebar_get_stack_w, gxg_gtk_stack_sidebar_get_stack)
-Xen_wrap_2_args(gxg_gtk_popover_set_transitions_enabled_w, gxg_gtk_popover_set_transitions_enabled)
-Xen_wrap_1_arg(gxg_gtk_popover_get_transitions_enabled_w, gxg_gtk_popover_get_transitions_enabled)
#endif
#if GTK_CHECK_VERSION(3, 18, 0)
@@ -39274,6 +39444,23 @@ Xen_wrap_5_args(gxg_gtk_file_chooser_add_choice_w, gxg_gtk_file_chooser_add_choi
Xen_wrap_2_args(gxg_gtk_file_chooser_remove_choice_w, gxg_gtk_file_chooser_remove_choice)
Xen_wrap_3_args(gxg_gtk_file_chooser_set_choice_w, gxg_gtk_file_chooser_set_choice)
Xen_wrap_2_args(gxg_gtk_file_chooser_get_choice_w, gxg_gtk_file_chooser_get_choice)
+Xen_wrap_1_arg(gxg_gdk_device_pad_get_n_groups_w, gxg_gdk_device_pad_get_n_groups)
+Xen_wrap_2_args(gxg_gdk_device_pad_get_group_n_modes_w, gxg_gdk_device_pad_get_group_n_modes)
+Xen_wrap_2_args(gxg_gdk_device_pad_get_n_features_w, gxg_gdk_device_pad_get_n_features)
+Xen_wrap_3_args(gxg_gdk_device_pad_get_feature_group_w, gxg_gdk_device_pad_get_feature_group)
+Xen_wrap_7_args(gxg_gtk_menu_popup_at_rect_w, gxg_gtk_menu_popup_at_rect)
+Xen_wrap_5_args(gxg_gtk_menu_popup_at_widget_w, gxg_gtk_menu_popup_at_widget)
+Xen_wrap_2_args(gxg_gtk_menu_popup_at_pointer_w, gxg_gtk_menu_popup_at_pointer)
+Xen_wrap_3_args(gxg_gtk_pad_controller_new_w, gxg_gtk_pad_controller_new)
+Xen_wrap_3_args(gxg_gtk_pad_controller_set_action_entries_w, gxg_gtk_pad_controller_set_action_entries)
+Xen_wrap_6_args(gxg_gtk_pad_controller_set_action_w, gxg_gtk_pad_controller_set_action)
+Xen_wrap_1_arg(gxg_gtk_popover_popup_w, gxg_gtk_popover_popup)
+Xen_wrap_1_arg(gxg_gtk_popover_popdown_w, gxg_gtk_popover_popdown)
+Xen_wrap_1_arg(gxg_gtk_shortcut_label_new_w, gxg_gtk_shortcut_label_new)
+Xen_wrap_1_arg(gxg_gtk_shortcut_label_get_accelerator_w, gxg_gtk_shortcut_label_get_accelerator)
+Xen_wrap_2_args(gxg_gtk_shortcut_label_set_accelerator_w, gxg_gtk_shortcut_label_set_accelerator)
+Xen_wrap_1_arg(gxg_gtk_shortcut_label_get_disabled_text_w, gxg_gtk_shortcut_label_get_disabled_text)
+Xen_wrap_2_args(gxg_gtk_shortcut_label_set_disabled_text_w, gxg_gtk_shortcut_label_set_disabled_text)
#endif
Xen_wrap_1_arg(gxg_cairo_create_w, gxg_cairo_create)
@@ -39786,6 +39973,9 @@ Xen_wrap_1_arg(gxg_GDK_SEAT_w, gxg_GDK_SEAT)
Xen_wrap_1_arg(gxg_GDK_DEVICE_TOOL_w, gxg_GDK_DEVICE_TOOL)
Xen_wrap_1_arg(gxg_GDK_MONITOR_w, gxg_GDK_MONITOR)
Xen_wrap_1_arg(gxg_GDK_DRAWING_CONTEXT_w, gxg_GDK_DRAWING_CONTEXT)
+Xen_wrap_1_arg(gxg_GDK_DEVICE_PAD_w, gxg_GDK_DEVICE_PAD)
+Xen_wrap_1_arg(gxg_GTK_PAD_CONTROLLER_w, gxg_GTK_PAD_CONTROLLER)
+Xen_wrap_1_arg(gxg_GTK_SHORTCUT_LABEL_w, gxg_GTK_SHORTCUT_LABEL)
#endif
Xen_wrap_1_arg(gxg_GDK_IS_DRAG_CONTEXT_w, gxg_GDK_IS_DRAG_CONTEXT)
@@ -40004,11 +40194,14 @@ Xen_wrap_1_arg(gxg_GDK_IS_SEAT_w, gxg_GDK_IS_SEAT)
Xen_wrap_1_arg(gxg_GDK_IS_DEVICE_TOOL_w, gxg_GDK_IS_DEVICE_TOOL)
Xen_wrap_1_arg(gxg_GDK_IS_MONITOR_w, gxg_GDK_IS_MONITOR)
Xen_wrap_1_arg(gxg_GDK_IS_DRAWING_CONTEXT_w, gxg_GDK_IS_DRAWING_CONTEXT)
+Xen_wrap_1_arg(gxg_GDK_IS_DEVICE_PAD_w, gxg_GDK_IS_DEVICE_PAD)
+Xen_wrap_1_arg(gxg_GTK_IS_PAD_CONTROLLER_w, gxg_GTK_IS_PAD_CONTROLLER)
+Xen_wrap_1_arg(gxg_GTK_IS_SHORTCUT_LABEL_w, gxg_GTK_IS_SHORTCUT_LABEL)
#endif
#if HAVE_SCHEME
static s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_gtk_enum_t, s_pair_false;
-static s7_pointer pl_iur, pl_iuisi, pl_pig, pl_iuuui, pl_iuuuui, pl_iuis, pl_iug, pl_ius, pl_iusi, pl_iu, pl_iuui, pl_pi, pl_iui, pl_iuisut, pl_piu, pl_pit, pl_t, pl_tts, pl_tti, pl_dust, pl_dut, pl_du, pl_dusr, pl_dus, pl_pr, pl_s, pl_tsb, pl_st, pl_tsu, pl_tsig, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_p, pl_ssig, pl_ssi, pl_tusiuiuit, pl_tussu, pl_tubu, pl_tuurru, pl_tuurrrrgr, pl_tuurrrrg, pl_tuuur, pl_tusg, pl_tuuuui, pl_tuusb, pl_tugui, pl_turru, pl_tuuugi, pl_tuuuub, pl_tuttti, pl_tuuttti, pl_tuisi, pl_tugb, pl_tugs, pl_tugug, pl_turgs, pl_tubi, pl_tuttigsi, pl_tuiiiiui, pl_tuurb, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_tuiggu, pl_turrrb, pl_tuubbi, pl_tuubbig, pl_pt, pl_tuuti, pl_tubbi, pl_tusiu, pl_tuuutti, pl_tuti, pl_tutti, pl_tutui, pl_tutisi, pl_tuuri, pl_tuusit, pl_tuurbr, pl_tuuiu, pl_tugiiu, pl_tuugi, pl_tuit, pl_tusr, pl_tusrt, pl_tusi, pl_turt, pl_tuui, pl_tut, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tuiiu, pl_tusb, pl_tuuut, pl_tug, pl_tutb, pl_tust, pl_tuub, pl_tuus, pl_tuug, pl_tuibu, pl_tuut, pl_tuuig, pl_tuguig, pl_tuubr, pl_tuuub, pl_tuuiuui, pl_tugu, pl_tuuir, pl_tugr, pl_tugi, pl_tuuui, pl_tuib, pl_tusu, pl_tuusi, pl_tugt, pl_tuis, pl_tuiu, pl_tubiiiu, pl_tusiis, pl_tusiuiu, pl_tusiuibu, pl_tusiiu, pl_tuuug, pl_tusuig, pl_tuuubr, pl_psgi, pl_suiig, pl_sug, pl_psgbiiiit, pl_psrrrb, pl_sui, pl_suuub, pl_psu, pl_psb, pl_su, pl_sus, pl_ps, pl_psg, pl_psi, pl_psugt, pl_psut, pl_pur, pl_puuui, pl_puiu, pl_pusiig, pl_pusiigu, pl_pusiiugu, pl_puuiig, pl_puur, pl_puiiui, pl_pugi, pl_puuig, pl_pubi, pl_puiig, pl_puiigi, pl_puigu, pl_puuusuug, pl_pusi, pl_puri, pl_pusub, pl_pust, pl_pub, pl_pu, pl_puutu, pl_pui, pl_pusu, pl_pus, pl_pug, pl_put, pl_pusigu, pl_pusig, pl_puui, pl_pusiiu, pl_igi, pl_gi, pl_g, pl_tg, pl_sg, pl_gs, pl_gussitu, pl_gurrsiu, pl_gus, pl_guut, pl_guuut, pl_guiu, pl_guugbuut, pl_pgr, pl_pgu, pl_pgi, pl_gug, pl_pgbi, pl_gu, pl_gugu, pl_pg, pl_gui, pl_big, pl_bi, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_bsiu, pl_bsiuub, pl_bsu, pl_bsigb, pl_bsiiuusu, pl_bur, pl_buug, pl_buut, pl_buigu, pl_busiu, pl_buuti, pl_buttiiiu, pl_butib, pl_buiuig, pl_buuusuug, pl_buuit, pl_butu, pl_buti, pl_butti, pl_busi, pl_buusib, pl_busib, pl_buuuub, pl_buuub, pl_buttu, pl_busgu, pl_buurbr, pl_buui, pl_buus, pl_buuui, pl_busu, pl_bug, pl_bu, pl_buuubu, pl_bus, pl_bui, pl_buutuuiu, pl_but, pl_bussu, pl_buib, pl_buiu, pl_buiiu, pl_bub, pl_buub, pl_pb, pl_buig, pl_buuiiu, pl_buuig, pl_iiit, pl_iit, pl_i, pl_itiiub, pl_itsub, pl_itstttg, pl_itgiiut, pl_tiu, pl_ti, pl_it, pl_isigutttiiu, pl_isi, pl_isgt, pl_sig, pl_si, pl_is, pl_trrru, pl_bpt;
+static s7_pointer pl_isigutttiiu, pl_isi, pl_isgt, pl_sig, pl_si, pl_is, pl_t, pl_g, pl_tts, pl_tti, pl_tg, pl_iur, pl_iugi, pl_iuisi, pl_pig, pl_iuuui, pl_iuuuui, pl_iuis, pl_iug, pl_ius, pl_iusi, pl_iu, pl_iuui, pl_pi, pl_iui, pl_iuisut, pl_piu, pl_pit, pl_s, pl_dust, pl_dut, pl_du, pl_dusr, pl_dus, pl_pr, pl_tsb, pl_st, pl_tsu, pl_tsig, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_sg, pl_gs, pl_p, pl_tusiuiuit, pl_tussu, pl_tuuttttu, pl_tuuggt, pl_tugiis, pl_tubu, pl_tuurru, pl_tuurrrrgr, pl_tuurrrrg, pl_tuuur, pl_tusg, pl_tuuuui, pl_tuusb, pl_tugui, pl_turru, pl_tuuugi, pl_tuuuub, pl_tuttti, pl_tuuttti, pl_tuisi, pl_tugb, pl_tugs, pl_tugug, pl_turgs, pl_tubi, pl_tuttigsi, pl_tuiiiiui, pl_tuurb, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_tuiggu, pl_turrrb, pl_tuubbi, pl_tuubbig, pl_pt, pl_tuuti, pl_tubbi, pl_tusiu, pl_tuuutti, pl_tuti, pl_tutti, pl_tutui, pl_tutisi, pl_tuuri, pl_tuusit, pl_tuurbr, pl_tuuiu, pl_tugiiu, pl_tuugi, pl_tuit, pl_tusr, pl_tusrt, pl_tusi, pl_turt, pl_tuui, pl_tut, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tuiiu, pl_tusb, pl_tuuut, pl_tug, pl_tutb, pl_tust, pl_tuub, pl_tuus, pl_tuug, pl_tuibu, pl_tuut, pl_tuuig, pl_tuguig, pl_tuubr, pl_tuuub, pl_tuuiuui, pl_tugu, pl_tuuir, pl_tugr, pl_tugi, pl_tuuui, pl_tuib, pl_tusu, pl_tuusi, pl_tugt, pl_tuis, pl_tuiu, pl_tubiiiu, pl_tusiis, pl_tusiuiu, pl_tusiuibu, pl_tusiiu, pl_tuuug, pl_tusuig, pl_tuuubr, pl_gussitu, pl_gurrsiu, pl_gus, pl_guut, pl_guuut, pl_guiu, pl_guugbuut, pl_pgr, pl_pgu, pl_pgi, pl_gug, pl_pgbi, pl_gu, pl_gugu, pl_pg, pl_gui, pl_ssig, pl_ssi, pl_psgi, pl_suiig, pl_sug, pl_psgbiiiit, pl_psrrrb, pl_sui, pl_suuub, pl_psu, pl_psb, pl_su, pl_sus, pl_ps, pl_psg, pl_psi, pl_psugt, pl_psut, pl_pur, pl_puuui, pl_puiu, pl_pusiig, pl_pusiigu, pl_pusiiugu, pl_puuiig, pl_puur, pl_puiiui, pl_pugi, pl_puuig, pl_pubi, pl_puiig, pl_puiigi, pl_puigu, pl_puuusuug, pl_pusi, pl_puri, pl_pusub, pl_pust, pl_pub, pl_pu, pl_puutu, pl_pui, pl_pusu, pl_pus, pl_pug, pl_put, pl_pusigu, pl_pusig, pl_puui, pl_pusiiu, pl_big, pl_bi, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_bsiu, pl_bsiuub, pl_bsu, pl_bsigb, pl_bsiiuusu, pl_bur, pl_buug, pl_buut, pl_buigu, pl_busiu, pl_buuti, pl_buttiiiu, pl_butib, pl_buiuig, pl_buuusuug, pl_buuit, pl_butu, pl_buti, pl_butti, pl_busi, pl_buusib, pl_busib, pl_buuuub, pl_buuub, pl_buttu, pl_busgu, pl_buurbr, pl_buui, pl_buus, pl_buuui, pl_busu, pl_bug, pl_bu, pl_buuubu, pl_bus, pl_bui, pl_buutuuiu, pl_but, pl_bussu, pl_buib, pl_buiu, pl_buiiu, pl_bub, pl_buub, pl_pb, pl_buig, pl_buuiiu, pl_buuig, pl_iiit, pl_iit, pl_i, pl_itiiub, pl_itsub, pl_itstttg, pl_itgiiut, pl_tiu, pl_ti, pl_it, pl_igi, pl_gi, pl_trrru, pl_bpt;
#endif
static void define_functions(void)
@@ -40030,7 +40223,19 @@ static void define_functions(void)
s_gtk_enum_t = s7_make_symbol(s7, "gtk_enum_t?");
s_any = s7_t(s7);
+ pl_isigutttiiu = s7_make_circular_signature(s7, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false);
+ pl_isi = s7_make_circular_signature(s7, 2, 3, s_integer, s_string, s_integer);
+ pl_isgt = s7_make_circular_signature(s7, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any);
+ pl_sig = s7_make_circular_signature(s7, 2, 3, s_string, s_integer, s_gtk_enum_t);
+ pl_si = s7_make_circular_signature(s7, 1, 2, s_string, s_integer);
+ pl_is = s7_make_circular_signature(s7, 1, 2, s_integer, s_string);
+ pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
+ pl_g = s7_make_circular_signature(s7, 0, 1, s_gtk_enum_t);
+ pl_tts = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_string);
+ pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer);
+ pl_tg = s7_make_circular_signature(s7, 1, 2, s_any, s_gtk_enum_t);
pl_iur = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_real);
+ pl_iugi = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_gtk_enum_t, s_integer);
pl_iuisi = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer);
pl_pig = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_gtk_enum_t);
pl_iuuui = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_pair_false, s_pair_false, s_integer);
@@ -40046,16 +40251,13 @@ static void define_functions(void)
pl_iuisut = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any);
pl_piu = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_pair_false);
pl_pit = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_any);
- pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
- pl_tts = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_string);
- pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer);
+ pl_s = s7_make_circular_signature(s7, 0, 1, s_string);
pl_dust = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_any);
pl_dut = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_any);
pl_du = s7_make_circular_signature(s7, 1, 2, s_float, s_pair_false);
pl_dusr = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_real);
pl_dus = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_string);
pl_pr = s7_make_circular_signature(s7, 1, 2, s_pair, s_real);
- pl_s = s7_make_circular_signature(s7, 0, 1, s_string);
pl_tsb = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_boolean);
pl_st = s7_make_circular_signature(s7, 1, 2, s_string, s_any);
pl_tsu = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_pair_false);
@@ -40065,11 +40267,14 @@ static void define_functions(void)
pl_tsiu = s7_make_circular_signature(s7, 3, 4, s_any, s_string, s_integer, s_pair_false);
pl_tsiiuui = s7_make_circular_signature(s7, 6, 7, s_any, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_integer);
pl_tsiuui = s7_make_circular_signature(s7, 5, 6, s_any, s_string, s_integer, s_pair_false, s_pair_false, s_integer);
+ pl_sg = s7_make_circular_signature(s7, 1, 2, s_string, s_gtk_enum_t);
+ pl_gs = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_string);
pl_p = s7_make_circular_signature(s7, 0, 1, s_pair);
- pl_ssig = s7_make_circular_signature(s7, 3, 4, s_string, s_string, s_integer, s_gtk_enum_t);
- pl_ssi = s7_make_circular_signature(s7, 2, 3, s_string, s_string, s_integer);
pl_tusiuiuit = s7_make_circular_signature(s7, 8, 9, s_any, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false, s_integer, s_any);
pl_tussu = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_string, s_string, s_pair_false);
+ pl_tuuttttu = s7_make_circular_signature(s7, 7, 8, s_any, s_pair_false, s_pair_false, s_any, s_any, s_any, s_any, s_pair_false);
+ pl_tuuggt = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_gtk_enum_t, s_gtk_enum_t, s_any);
+ pl_tugiis = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_gtk_enum_t, s_integer, s_integer, s_string);
pl_tubu = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_boolean, s_pair_false);
pl_tuurru = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_real, s_real, s_pair_false);
pl_tuurrrrgr = s7_make_circular_signature(s7, 8, 9, s_any, s_pair_false, s_pair_false, s_real, s_real, s_real, s_real, s_gtk_enum_t, s_real);
@@ -40163,6 +40368,24 @@ static void define_functions(void)
pl_tuuug = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t);
pl_tusuig = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_string, s_pair_false, s_integer, s_gtk_enum_t);
pl_tuuubr = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_real);
+ pl_gussitu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false);
+ pl_gurrsiu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false);
+ pl_gus = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_string);
+ pl_guut = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any);
+ pl_guuut = s7_make_circular_signature(s7, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any);
+ pl_guiu = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_integer, s_pair_false);
+ pl_guugbuut = s7_make_circular_signature(s7, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any);
+ pl_pgr = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_real);
+ pl_pgu = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_pair_false);
+ pl_pgi = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_integer);
+ pl_gug = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t);
+ pl_pgbi = s7_make_circular_signature(s7, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer);
+ pl_gu = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_pair_false);
+ pl_gugu = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_gtk_enum_t, s_pair_false);
+ pl_pg = s7_make_circular_signature(s7, 1, 2, s_pair, s_gtk_enum_t);
+ pl_gui = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_integer);
+ pl_ssig = s7_make_circular_signature(s7, 3, 4, s_string, s_string, s_integer, s_gtk_enum_t);
+ pl_ssi = s7_make_circular_signature(s7, 2, 3, s_string, s_string, s_integer);
pl_psgi = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_gtk_enum_t, s_integer);
pl_suiig = s7_make_circular_signature(s7, 4, 5, s_string, s_pair_false, s_integer, s_integer, s_gtk_enum_t);
pl_sug = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_gtk_enum_t);
@@ -40211,28 +40434,6 @@ static void define_functions(void)
pl_pusig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_integer, s_gtk_enum_t);
pl_puui = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_pair_false, s_integer);
pl_pusiiu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false);
- pl_igi = s7_make_circular_signature(s7, 2, 3, s_integer, s_gtk_enum_t, s_integer);
- pl_gi = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_integer);
- pl_g = s7_make_circular_signature(s7, 0, 1, s_gtk_enum_t);
- pl_tg = s7_make_circular_signature(s7, 1, 2, s_any, s_gtk_enum_t);
- pl_sg = s7_make_circular_signature(s7, 1, 2, s_string, s_gtk_enum_t);
- pl_gs = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_string);
- pl_gussitu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false);
- pl_gurrsiu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false);
- pl_gus = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_string);
- pl_guut = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any);
- pl_guuut = s7_make_circular_signature(s7, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any);
- pl_guiu = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_integer, s_pair_false);
- pl_guugbuut = s7_make_circular_signature(s7, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any);
- pl_pgr = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_real);
- pl_pgu = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_pair_false);
- pl_pgi = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_integer);
- pl_gug = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t);
- pl_pgbi = s7_make_circular_signature(s7, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer);
- pl_gu = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_pair_false);
- pl_gugu = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_gtk_enum_t, s_pair_false);
- pl_pg = s7_make_circular_signature(s7, 1, 2, s_pair, s_gtk_enum_t);
- pl_gui = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_integer);
pl_big = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_gtk_enum_t);
pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
pl_b = s7_make_circular_signature(s7, 0, 1, s_boolean);
@@ -40298,12 +40499,8 @@ static void define_functions(void)
pl_tiu = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_pair_false);
pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer);
pl_it = s7_make_circular_signature(s7, 1, 2, s_integer, s_any);
- pl_isigutttiiu = s7_make_circular_signature(s7, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false);
- pl_isi = s7_make_circular_signature(s7, 2, 3, s_integer, s_string, s_integer);
- pl_isgt = s7_make_circular_signature(s7, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any);
- pl_sig = s7_make_circular_signature(s7, 2, 3, s_string, s_integer, s_gtk_enum_t);
- pl_si = s7_make_circular_signature(s7, 1, 2, s_string, s_integer);
- pl_is = s7_make_circular_signature(s7, 1, 2, s_integer, s_string);
+ pl_igi = s7_make_circular_signature(s7, 2, 3, s_integer, s_gtk_enum_t, s_integer);
+ pl_gi = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_integer);
pl_trrru = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_pair_false);
pl_bpt = s7_make_signature(s7, 2, s_pair_false, s_any);
#endif
@@ -43620,8 +43817,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_stack_sidebar_new, gxg_gtk_stack_sidebar_new_w, 0, 0, 0, H_gtk_stack_sidebar_new, pl_p);
Xg_define_procedure(gtk_stack_sidebar_set_stack, gxg_gtk_stack_sidebar_set_stack_w, 2, 0, 0, H_gtk_stack_sidebar_set_stack, pl_tu);
Xg_define_procedure(gtk_stack_sidebar_get_stack, gxg_gtk_stack_sidebar_get_stack_w, 1, 0, 0, H_gtk_stack_sidebar_get_stack, pl_pu);
- Xg_define_procedure(gtk_popover_set_transitions_enabled, gxg_gtk_popover_set_transitions_enabled_w, 2, 0, 0, H_gtk_popover_set_transitions_enabled, pl_tub);
- Xg_define_procedure(gtk_popover_get_transitions_enabled, gxg_gtk_popover_get_transitions_enabled_w, 1, 0, 0, H_gtk_popover_get_transitions_enabled, pl_bu);
#endif
#if GTK_CHECK_VERSION(3, 18, 0)
@@ -43733,6 +43928,23 @@ static void define_functions(void)
Xg_define_procedure(gtk_file_chooser_remove_choice, gxg_gtk_file_chooser_remove_choice_w, 2, 0, 0, H_gtk_file_chooser_remove_choice, pl_tus);
Xg_define_procedure(gtk_file_chooser_set_choice, gxg_gtk_file_chooser_set_choice_w, 3, 0, 0, H_gtk_file_chooser_set_choice, pl_tus);
Xg_define_procedure(gtk_file_chooser_get_choice, gxg_gtk_file_chooser_get_choice_w, 2, 0, 0, H_gtk_file_chooser_get_choice, pl_sus);
+ Xg_define_procedure(gdk_device_pad_get_n_groups, gxg_gdk_device_pad_get_n_groups_w, 1, 0, 0, H_gdk_device_pad_get_n_groups, pl_iu);
+ Xg_define_procedure(gdk_device_pad_get_group_n_modes, gxg_gdk_device_pad_get_group_n_modes_w, 2, 0, 0, H_gdk_device_pad_get_group_n_modes, pl_iui);
+ Xg_define_procedure(gdk_device_pad_get_n_features, gxg_gdk_device_pad_get_n_features_w, 2, 0, 0, H_gdk_device_pad_get_n_features, pl_iug);
+ Xg_define_procedure(gdk_device_pad_get_feature_group, gxg_gdk_device_pad_get_feature_group_w, 3, 0, 0, H_gdk_device_pad_get_feature_group, pl_iugi);
+ Xg_define_procedure(gtk_menu_popup_at_rect, gxg_gtk_menu_popup_at_rect_w, 7, 0, 0, H_gtk_menu_popup_at_rect, pl_tuuttttu);
+ Xg_define_procedure(gtk_menu_popup_at_widget, gxg_gtk_menu_popup_at_widget_w, 5, 0, 0, H_gtk_menu_popup_at_widget, pl_tuuggt);
+ Xg_define_procedure(gtk_menu_popup_at_pointer, gxg_gtk_menu_popup_at_pointer_w, 2, 0, 0, H_gtk_menu_popup_at_pointer, pl_tut);
+ Xg_define_procedure(gtk_pad_controller_new, gxg_gtk_pad_controller_new_w, 3, 0, 0, H_gtk_pad_controller_new, pl_pu);
+ Xg_define_procedure(gtk_pad_controller_set_action_entries, gxg_gtk_pad_controller_set_action_entries_w, 3, 0, 0, H_gtk_pad_controller_set_action_entries, pl_tuui);
+ Xg_define_procedure(gtk_pad_controller_set_action, gxg_gtk_pad_controller_set_action_w, 6, 0, 0, H_gtk_pad_controller_set_action, pl_tugiis);
+ Xg_define_procedure(gtk_popover_popup, gxg_gtk_popover_popup_w, 1, 0, 0, H_gtk_popover_popup, pl_tu);
+ Xg_define_procedure(gtk_popover_popdown, gxg_gtk_popover_popdown_w, 1, 0, 0, H_gtk_popover_popdown, pl_tu);
+ Xg_define_procedure(gtk_shortcut_label_new, gxg_gtk_shortcut_label_new_w, 1, 0, 0, H_gtk_shortcut_label_new, pl_ps);
+ Xg_define_procedure(gtk_shortcut_label_get_accelerator, gxg_gtk_shortcut_label_get_accelerator_w, 1, 0, 0, H_gtk_shortcut_label_get_accelerator, pl_su);
+ Xg_define_procedure(gtk_shortcut_label_set_accelerator, gxg_gtk_shortcut_label_set_accelerator_w, 2, 0, 0, H_gtk_shortcut_label_set_accelerator, pl_tus);
+ Xg_define_procedure(gtk_shortcut_label_get_disabled_text, gxg_gtk_shortcut_label_get_disabled_text_w, 1, 0, 0, H_gtk_shortcut_label_get_disabled_text, pl_su);
+ Xg_define_procedure(gtk_shortcut_label_set_disabled_text, gxg_gtk_shortcut_label_set_disabled_text_w, 2, 0, 0, H_gtk_shortcut_label_set_disabled_text, pl_tus);
#endif
Xg_define_procedure(cairo_create, gxg_cairo_create_w, 1, 0, 0, H_cairo_create, pl_pu);
@@ -44237,6 +44449,9 @@ static void define_functions(void)
Xg_define_procedure(GDK_DEVICE_TOOL, gxg_GDK_DEVICE_TOOL_w, 1, 0, 0, "(GDK_DEVICE_TOOL obj) casts obj to GDK_DEVICE_TOOL", pl_bpt);
Xg_define_procedure(GDK_MONITOR, gxg_GDK_MONITOR_w, 1, 0, 0, "(GDK_MONITOR obj) casts obj to GDK_MONITOR", pl_bpt);
Xg_define_procedure(GDK_DRAWING_CONTEXT, gxg_GDK_DRAWING_CONTEXT_w, 1, 0, 0, "(GDK_DRAWING_CONTEXT obj) casts obj to GDK_DRAWING_CONTEXT", pl_bpt);
+ Xg_define_procedure(GDK_DEVICE_PAD, gxg_GDK_DEVICE_PAD_w, 1, 0, 0, "(GDK_DEVICE_PAD obj) casts obj to GDK_DEVICE_PAD", pl_bpt);
+ Xg_define_procedure(GTK_PAD_CONTROLLER, gxg_GTK_PAD_CONTROLLER_w, 1, 0, 0, "(GTK_PAD_CONTROLLER obj) casts obj to GTK_PAD_CONTROLLER", pl_bpt);
+ Xg_define_procedure(GTK_SHORTCUT_LABEL, gxg_GTK_SHORTCUT_LABEL_w, 1, 0, 0, "(GTK_SHORTCUT_LABEL obj) casts obj to GTK_SHORTCUT_LABEL", pl_bpt);
#endif
Xg_define_procedure(c-array->list, c_array_to_xen_list_w, 2, 0, 0, NULL, NULL);
@@ -44645,6 +44860,12 @@ static void define_functions(void)
"(GDK_IS_MONITOR obj): " PROC_TRUE " if obj is a GDK_IS_MONITOR", pl_bt);
Xg_define_procedure(GDK_IS_DRAWING_CONTEXT, gxg_GDK_IS_DRAWING_CONTEXT_w, 1, 0, 0,
"(GDK_IS_DRAWING_CONTEXT obj): " PROC_TRUE " if obj is a GDK_IS_DRAWING_CONTEXT", pl_bt);
+ Xg_define_procedure(GDK_IS_DEVICE_PAD, gxg_GDK_IS_DEVICE_PAD_w, 1, 0, 0,
+ "(GDK_IS_DEVICE_PAD obj): " PROC_TRUE " if obj is a GDK_IS_DEVICE_PAD", pl_bt);
+ Xg_define_procedure(GTK_IS_PAD_CONTROLLER, gxg_GTK_IS_PAD_CONTROLLER_w, 1, 0, 0,
+ "(GTK_IS_PAD_CONTROLLER obj): " PROC_TRUE " if obj is a GTK_IS_PAD_CONTROLLER", pl_bt);
+ Xg_define_procedure(GTK_IS_SHORTCUT_LABEL, gxg_GTK_IS_SHORTCUT_LABEL_w, 1, 0, 0,
+ "(GTK_IS_SHORTCUT_LABEL obj): " PROC_TRUE " if obj is a GTK_IS_SHORTCUT_LABEL", pl_bt);
#endif
}
@@ -45872,6 +46093,27 @@ static void define_integers(void)
define_integer(GDK_SUBPIXEL_LAYOUT_HORIZONTAL_BGR);
define_integer(GDK_SUBPIXEL_LAYOUT_VERTICAL_RGB);
define_integer(GDK_SUBPIXEL_LAYOUT_VERTICAL_BGR);
+ define_integer(GDK_DEVICE_PAD_FEATURE_BUTTON);
+ define_integer(GDK_DEVICE_PAD_FEATURE_RING);
+ define_integer(GDK_DEVICE_PAD_FEATURE_STRIP);
+ define_integer(GDK_PAD_BUTTON_PRESS);
+ define_integer(GDK_PAD_BUTTON_RELEASE);
+ define_integer(GDK_PAD_RING);
+ define_integer(GDK_PAD_STRIP);
+ define_integer(GDK_PAD_GROUP_MODE);
+ define_integer(GDK_TABLET_PAD_MASK);
+ define_integer(GDK_ANCHOR_FLIP_X);
+ define_integer(GDK_ANCHOR_FLIP_Y);
+ define_integer(GDK_ANCHOR_SLIDE_X);
+ define_integer(GDK_ANCHOR_SLIDE_Y);
+ define_integer(GDK_ANCHOR_RESIZE_X);
+ define_integer(GDK_ANCHOR_RESIZE_Y);
+ define_integer(GDK_ANCHOR_FLIP);
+ define_integer(GDK_ANCHOR_SLIDE);
+ define_integer(GDK_ANCHOR_RESIZE);
+ define_integer(GTK_PAD_ACTION_BUTTON);
+ define_integer(GTK_PAD_ACTION_RING);
+ define_integer(GTK_PAD_ACTION_STRIP);
#endif
define_integer(CAIRO_STATUS_SUCCESS);
@@ -46067,6 +46309,17 @@ static void define_atoms(void)
static void define_symbols(void)
{
+ xg_GtkShortcutLabel__symbol = C_string_to_Xen_symbol("GtkShortcutLabel_");
+ xg_GtkPadActionType_symbol = C_string_to_Xen_symbol("GtkPadActionType");
+ xg_GtkPadActionEntry__symbol = C_string_to_Xen_symbol("GtkPadActionEntry_");
+ xg_GActionGroup__symbol = C_string_to_Xen_symbol("GActionGroup_");
+ xg_GtkPadController__symbol = C_string_to_Xen_symbol("GtkPadController_");
+ xg_menu_anchor_symbol = C_string_to_Xen_symbol("menu_anchor");
+ xg_rect_anchor_symbol = C_string_to_Xen_symbol("rect_anchor");
+ xg_rect_symbol = C_string_to_Xen_symbol("rect");
+ xg_const_symbol = C_string_to_Xen_symbol("const");
+ xg_GdkDevicePadFeature_symbol = C_string_to_Xen_symbol("GdkDevicePadFeature");
+ xg_GdkDevicePad__symbol = C_string_to_Xen_symbol("GdkDevicePad_");
xg_GdkDrawingContext__symbol = C_string_to_Xen_symbol("GdkDrawingContext_");
xg_GdkSubpixelLayout_symbol = C_string_to_Xen_symbol("GdkSubpixelLayout");
xg_menu_symbol = C_string_to_Xen_symbol("menu");
@@ -47651,6 +47904,27 @@ static enummer_t enum_info[] = {
{"GDK_SUBPIXEL_LAYOUT_HORIZONTAL_BGR", "GdkSubpixelLayout", GDK_SUBPIXEL_LAYOUT_HORIZONTAL_BGR},
{"GDK_SUBPIXEL_LAYOUT_VERTICAL_RGB", "GdkSubpixelLayout", GDK_SUBPIXEL_LAYOUT_VERTICAL_RGB},
{"GDK_SUBPIXEL_LAYOUT_VERTICAL_BGR", "GdkSubpixelLayout", GDK_SUBPIXEL_LAYOUT_VERTICAL_BGR},
+ {"GDK_DEVICE_PAD_FEATURE_BUTTON", "GdkDevicePadFeature", GDK_DEVICE_PAD_FEATURE_BUTTON},
+ {"GDK_DEVICE_PAD_FEATURE_RING", "GdkDevicePadFeature", GDK_DEVICE_PAD_FEATURE_RING},
+ {"GDK_DEVICE_PAD_FEATURE_STRIP", "GdkDevicePadFeature", GDK_DEVICE_PAD_FEATURE_STRIP},
+ {"GDK_PAD_BUTTON_PRESS", "GdkEventType", GDK_PAD_BUTTON_PRESS},
+ {"GDK_PAD_BUTTON_RELEASE", "GdkEventType", GDK_PAD_BUTTON_RELEASE},
+ {"GDK_PAD_RING", "GdkEventType", GDK_PAD_RING},
+ {"GDK_PAD_STRIP", "GdkEventType", GDK_PAD_STRIP},
+ {"GDK_PAD_GROUP_MODE", "GdkEventType", GDK_PAD_GROUP_MODE},
+ {"GDK_TABLET_PAD_MASK", "GdkEventMask", GDK_TABLET_PAD_MASK},
+ {"GDK_ANCHOR_FLIP_X", "GdkAnchorHints", GDK_ANCHOR_FLIP_X},
+ {"GDK_ANCHOR_FLIP_Y", "GdkAnchorHints", GDK_ANCHOR_FLIP_Y},
+ {"GDK_ANCHOR_SLIDE_X", "GdkAnchorHints", GDK_ANCHOR_SLIDE_X},
+ {"GDK_ANCHOR_SLIDE_Y", "GdkAnchorHints", GDK_ANCHOR_SLIDE_Y},
+ {"GDK_ANCHOR_RESIZE_X", "GdkAnchorHints", GDK_ANCHOR_RESIZE_X},
+ {"GDK_ANCHOR_RESIZE_Y", "GdkAnchorHints", GDK_ANCHOR_RESIZE_Y},
+ {"GDK_ANCHOR_FLIP", "GdkAnchorHints", GDK_ANCHOR_FLIP},
+ {"GDK_ANCHOR_SLIDE", "GdkAnchorHints", GDK_ANCHOR_SLIDE},
+ {"GDK_ANCHOR_RESIZE", "GdkAnchorHints", GDK_ANCHOR_RESIZE},
+ {"GTK_PAD_ACTION_BUTTON", "GtkPadActionType", GTK_PAD_ACTION_BUTTON},
+ {"GTK_PAD_ACTION_RING", "GtkPadActionType", GTK_PAD_ACTION_RING},
+ {"GTK_PAD_ACTION_STRIP", "GtkPadActionType", GTK_PAD_ACTION_STRIP},
#endif
#if GTK_CHECK_VERSION(3, 4, 0)
{"GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR", "GdkModifierIntent", GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR},
@@ -47842,7 +48116,7 @@ void Init_libxg(void)
#else
Xen_provide_feature("gtk2");
#endif
- Xen_define("xg-version", C_string_to_Xen_string("26-Jul-16"));
+ Xen_define("xg-version", C_string_to_Xen_string("30-Aug-16"));
xg_already_inited = true;
#if HAVE_SCHEME
#if USE_SND
diff --git a/xm-enved.scm b/xm-enved.scm
index f8012be..824a83a 100644
--- a/xm-enved.scm
+++ b/xm-enved.scm
@@ -250,9 +250,9 @@
(g_signal_lookup "configure_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
0 gf #f))
(let ((gf (g_cclosure_new (lambda (w e d)
- (let ((coords (gdk_event_get_coords (GDK_EVENT e))))
+ (let ((coords (cdr (gdk_event_get_coords (GDK_EVENT e)))))
(set! dragging #t)
- (xe-mouse-press editor (cadr coords) (caddr coords)))
+ (xe-mouse-press editor (car coords) (cadr coords)))
#f)
#f #f)))
(g_signal_connect_closure_by_id (GPOINTER drawer)
@@ -268,8 +268,8 @@
0 gf #f))
(let ((gf (g_cclosure_new (lambda (w e d)
(if dragging
- (let ((coords (gdk_event_get_coords (GDK_EVENT e))))
- (xe-mouse-drag editor (cadr coords) (caddr coords))))
+ (let ((coords (cdr (gdk_event_get_coords (GDK_EVENT e)))))
+ (xe-mouse-drag editor (car coords) (cadr coords))))
#f)
#f #f)))
(g_signal_connect_closure_by_id (GPOINTER drawer)
@@ -296,7 +296,7 @@
(let* ((cur-env (xe-envelope drawer))
(widget (drawer 1))
(dpy (and (provided? 'snd-motif) ((*motif* 'XtDisplay) widget)))
- (wn (if (provided? 'snd-motif) ((*motif* 'XtWindow) widget) ((*gtk* 'gtk_widget_get_window) widget)))
+ (wn ((if (provided? 'snd-motif) (*motif* 'XtWindow) (*gtk* 'gtk_widget_get_window)) widget))
(ax-pix (drawer 2))
(ax-inf (drawer 3))
(gc (car (drawer 4)))
@@ -305,9 +305,7 @@
(get_realized (if (provided? 'snd-gtk) (*gtk* 'gtk_widget_get_realized))))
(when (and (list? ax-pix)
(list? cur-env)
- (if (provided? 'snd-motif)
- ((*motif* 'XtIsManaged) widget)
- (get_realized widget)))
+ ((if (provided? 'snd-motif) (*motif* 'XtIsManaged) get_realized) widget))
(let ((py0 (ax-pix 1))
(py1 (ax-pix 3))
(ix0 (ax-inf 0))
--
snd packaging
More information about the pkg-multimedia-commits
mailing list