File: snd-lint.scm

package info (click to toggle)
snd 19.1-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 52,736 kB
  • sloc: ansic: 390,251; lisp: 242,546; ruby: 71,383; sh: 3,284; fortran: 2,342; csh: 1,259; cpp: 294; makefile: 287; python: 47
file content (270 lines) | stat: -rw-r--r-- 16,570 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
;;; Snd extensions for lint

(require lint.scm)
;;; *lint* is the lint environment, so everything in lint.scm is accessible here

;;; --------------------------------
;;; this sends lint's output to the Snd repl's widget
(define (snd-lint file)
  (lint file (openlet 
	      (inlet :name "lint-output-port"
		     :format            (lambda (p str . args) (snd-print (apply format #f str args)))
		     :write             (lambda (obj p)	       (snd-print (object->string obj #t)))
		     :display           (lambda (obj p)	       (snd-print (object->string obj #f)))
		     :write-string      (lambda (str p)        (snd-print str))
		     :write-char        (lambda (ch p)	       (snd-print (string ch)))
		     :newline           (lambda (p)	       (snd-print (string #\newline)))
		     :close-output-port (lambda (p) #f)
		     :flush-output-port (lambda (p) #f)))))


;;; ---------------- deprecated funcs ----------------
;;; Snd deprecated funcs, to be reported by lint

(let ((deprecated-ops '((data-format . sample-type)
			(mus-sound-frames . mus-sound-framples)
			(mus-sound-data-format . mus-sound-sample-type)
			(mus-data-format-name . mus-sample-type-name)
			(mus-data-format->string . mus-sample-type->string)
			(default-output-data-format . default-output-sample-type)
			(channel->vct . channel->float-vector)
			(vct->channel . float-vector->channel)
			(region->vct . region->float-vector)
			(mix->vct . mix->float-vector)
			(transform->vct . transform->float-vector)
			(make-vct . make-float-vector)
			(vct-add! . float-vector-add!)
			(vct-subtract! . float-vector-subtract!)
			(vct-copy . copy)
			(vct-length . length)
			(vct-multiply! . float-vector-multiply!)
			(vct-offset! . float-vector-offset!)
			(vct-ref . float-vector-ref)
			(vct-scale! . float-vector-scale!)
			(vct-abs! . float-vector-abs!)
			(vct-fill! . fill!)
			(vct-set! . float-vector-set!)
			(vct-peak . float-vector-peak)
			(vct-peak-and-location . float-vector-peak-and-location)
			(vct-equal? . equal?)
			(vct? . float-vector?)
			(list->vct . list->float-vector)
			(vct->list . float-vector->list)
			(vector->vct . vector->float-vector)
			(vct->vector . float-vector->vector)
			(vct-move! . float-vector-move!)
			(vct-subseq . float-vector-subseq)
			(vct-reverse! . reverse!)
			(vct->string . float-vector->string)
			(vct* . float-vector*)
			(vct+ . float-vector+))))

  (define (snd-lint-deprecate caller head form env)
    ((*lint* 'lint-format) "~A is deprecated; use ~A" caller head (cond ((assq head deprecated-ops) => cdr))))

  (for-each (lambda (op)
	      (hash-table-set! (*lint* 'special-case-functions) (car op) snd-lint-deprecate))
	    deprecated-ops))


;;; ---------------- snd-display ----------------
;;; check snd-display using format's lint code

(hash-table-set! (*lint* 'special-case-functions) 'snd-display
		 (hash-table-ref (*lint* 'special-case-functions) 'format))


;;; ---------------- defgenerator ----------------
;;; a lint walker for defgenerator (it defines various functions in the current environment)

(let ()
  (define (get-generator caller form env)
    (with-let (sublet *lint* :caller caller :form form :env env)
      (when (pair? (cdr form))
	(let ((name (symbol->string ((if (pair? (cadr form)) caadr cadr) form))))
	  
	  (if (and (pair? (cadr form))
		   (pair? (cdadr form)))
	      (lint-walk caller (cdadr form) env))
	  
	  (let ((gen? (symbol name "?"))
		(gen-make (symbol "make-" name)))
	    (list (make-fvar gen? 'define (list 'x) `(define (,gen? x) (let? x)) env)
		  (make-fvar gen-make 'define* (list :rest 'x :allow-other-keys) `(define* (,gen-make :rest x :allow-other-keys) (apply inlet x)) env)))))))
  
  (hash-table-set! (*lint* 'walker-functions) 'defgenerator
		   (lambda (caller form env)
		     (append (get-generator caller form env) env))))

	
;;; ---------------- no side effect Snd functions ----------------
;;; Snd functions that don't affect anything outside or mess with their arguments

(let ((h (*lint* 'no-side-effect-functions)))
  (for-each
   (lambda (s)
     (hash-table-set! h s #t))
   '(all-chans all-pass-bank? all-pass? apropos array-interp ask-about-unsaved-edits ask-before-overwrite
     asymmetric-fm? axis-color axis-info axis-label-font axis-numbers-font basic-color
     beats-per-measure beats-per-minute bes-i0 bes-i1 bes-in bes-j0 bes-j1 bes-jn bes-k0 bes-k1 bes-kn bes-y0 bes-y1 bes-yn
     bold-peaks-font channel-amp-envs channel-data channel-properties channel-property channel-style
     channel-sync channel-widgets channels channels-equal? channels=? chans clipping
     clm-table-size color->list color-cutoff color-inverted color-scale
     color? colormap colormap-name colormap-ref colormap-size colormap? comb-bank?
     comb? combined-data-color comment contrast-control contrast-control-amp contrast-control-bounds contrast-control?
     contrast-enhancement convolve? count-matches current-font
     current-time cursor cursor-color cursor-location-offset cursor-position cursor-size cursor-style
     cursor-update-interval 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 degrees->radians delay?
     dialog-widgets disk-kspace dot-product dot-size
     edit-fragment edit-fragment-type-name edit-list->function edit-properties edit-property
     edit-tree edits edot-product env? enved-base enved-clip?
     enved-envelope enved-filter enved-filter-order enved-in-dB enved-power enved-style enved-target
     enved-wave? enved-waveform-color envelope-interp eps-bottom-margin eps-file eps-left-margin
     eps-size erf erfc even-multiple even-weight expand-control expand-control-bounds
     expand-control-hop expand-control-jitter expand-control-length expand-control-ramp expand-control? feql ffeql
     fffneq ffneq fft-log-frequency fft-log-magnitude fft-window fft-window-alpha
     fft-window-beta fft-with-phases file->frample? file->sample? file-name file-write-date filter-control-coeffs filter-control-envelope
     filter-control-in-dB filter-control-in-hz filter-control-order filter-control-waveform-color filter-control? filter? filtered-comb-bank?
     filtered-comb? find-dialog find-mark find-sound fir-filter? firmant? float-vector-equal? float-vector-max float-vector-min float-vector-peak
     float-vector-peak-and-location fneq foreground-color formant-bank? formant? frample
     framples ftell fveql get-internal-real-time getcwd getpid granulate? graph-color graph-cursor
     graph-style graphs-horizontal grid-density gsl-ellipj gsl-ellipk gsl-roots header-type html-dir html-program hz->radians
     identity iir-filter? initial-beg initial-dur 
     integer->mark integer->mix integer->region integer->sound integer->transform just-sounds key-binding
     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-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
     mix-length mix-name mix-properties mix-property mix-sampler? mix-sync mix-sync-max mix-tag-height mix-tag-width mix-tag-y mix-waveform-height mix? mixes
     move-sound? moving-average? moving-max? moving-norm? mus-alsa-buffer-size
     mus-alsa-buffers mus-alsa-capture-device mus-alsa-device mus-alsa-playback-device mus-alsa-squelch-warning mus-array-print-length mus-bytes-per-sample
     mus-channel mus-channels mus-chebyshev-t-sum mus-chebyshev-tu-sum mus-chebyshev-u-sum mus-clipping mus-data
     mus-describe mus-error-type->string mus-expand-filename mus-file-buffer-size mus-file-clipping mus-file-name
     mus-float-equal-fudge-factor mus-frequency mus-generator? mus-header-raw-defaults mus-header-type->string mus-header-type-name mus-header-writable
     mus-hop mus-increment mus-input? mus-interp-type mus-interpolate mus-length mus-location mus-max-malloc mus-max-table-size mus-name mus-offset mus-order
     mus-output? mus-phase mus-ramp mus-sample-type->string mus-sample-type-name mus-scaler
     mus-sound-chans mus-sound-comment mus-sound-data-location mus-sound-datum-size mus-sound-duration mus-sound-frames
     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-sample-type mus-sound-samples mus-sound-srate
     mus-sound-type-specifier mus-sound-write-date mus-srate mus-type mus-width mus-xcoeff mus-xcoeffs
     mus-ycoeff mus-ycoeffs mus_header_t? ncos? notch? nrxycos? nrxysin?
     nsin? odd-multiple odd-weight one-pole-all-pass? one-pole? one-zero? oscil-bank?
     oscil? partials->polynomial partials->wave pausing peak-env-dir peaks-font
     phase-partials->wave phase-vocoder-amp-increments phase-vocoder-amps phase-vocoder-freqs phase-vocoder-phase-increments phase-vocoder-phases phase-vocoder?
     phases-get-peak play-arrow-size player-home player? players playing polyshape?
     polywave? position->x position->y position-color pulse-train? pulsed-env? radians->degrees radians->hz rand-interp?
     rand? readin? region->integer region-chans region-framples region-graph-style region-home
     region-maxamp region-maxamp-position region-position region-sample region-sampler? region-srate region?
     regions 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? right-sample rxyk!cos? rxyk!sin? sample sample-type
     sampler-at-end? sampler-home sampler-position sampler? samples samples->seconds sash-color
     sawtooth-wave? script-arg script-args search-procedure seconds->samples selected-channel selected-data-color
     selected-graph-color selected-sound selection selection-chans selection-creates-region selection-framples selection-maxamp
     selection-maxamp-position selection-member? selection-position selection-srate selection? short-file-name
     sinc-width singer-filter singer-nose-filter snd->sample? snd-gcs snd-global-state snd-help snd-tempnam
     snd-url snd-urls snd-version sound->integer sound-file-extensions sound-file?
     sound-files-in-directory sound-loop-info sound-properties sound-property sound-widgets sound? soundfont-info
     sounds spectro-hop spectro-x-angle spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle
     spectro-z-scale spectrum-end spectrum-start speed-control speed-control-bounds speed-control-style
     speed-control-tones square-wave? srate src? ssb-am? strftime sync-max sync-style syncd-marks table-lookup? tap? temp-dir
     text-focus-color time-graph-style time-graph-type time-graph? tiny-font tmpnam tracking-cursor-style
     transform->integer transform-graph-style transform-graph-type transform-graph?
     transform-normalization transform-sample transform-size transform-type transform? triangle-wave? two-pole?
     two-zero? variable-graph? wave-train? wavelet-type
     wavo-hop wavo-trace widget-position widget-size widget-text window-height window-width
     window-x window-y with-background-processes with-file-monitor with-gl with-inset-graph with-interrupts
     with-menu-icons with-mix-tags with-pointer-focus with-relative-panes with-smpte-label 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 y->position y-axis-label y-bounds y-position-slider y-zoom-slider zoom-color
     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-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)

(for-each (lambda (tchk)
	    (hash-table-set! (*lint* 'booleans) tchk #t))
	  '(all-pass? all-pass-bank? asymmetric-fm? comb? comb-bank? convolve? delay? env? file->sample? filter? filtered-comb?
	    filtered-comb-bank? fir-filter? firmant? formant-bank? formant? granulate? iir-filter? locsig? move-sound? moving-average?
	    moving-max? moving-norm? mus-generator? mus-input? mus-output? ncos? notch? nrxycos? nrxysin? nsin? one-pole? one-pole-all-pass? 
	    one-zero? oscil? oscil-bank? phase-vocoder? polyshape? polywave? pulse-train? pulsed-env? rand-interp? rand? readin?
	    rxyk!cos? rxyk!sin? sample->file? sawtooth-wave? square-wave? src? ssb-am? table-lookup? tap? triangle-wave? two-pole?
	    two-zero? wave-train? file->frample? frample->file?

	    mark? mix? mix-sampler? region?))

#|
;;; a more complicated search:

(let ((old-do-walker (hash-table-ref (*lint* 'walker-functions) 'do)))
  ;; look for forms like (do ((i 0 (+ i 1))) ((= i 123)) (float-vector-set! v i (* .2 (float-vector-ref v i))))

  (hash-table-set! (*lint* 'walker-functions) 'do
		   (lambda (caller form env)
		     (when (and (pair? (cdr form))
				(pair? (cddr form)))
		       (let ((vars (cadr form))
			     (end+res (caddr form))
			     (body (cdddr form)))
			 (when (and (pair? vars)
				    (null? (cdr vars))
				    (pair? body)
				    (null? (cdr body))
				    (pair? (car body))
				    (eq? (caar body) 'float-vector-set!)
					;(eqv? 0 (cadar vars)) -- we'll use subvector if not 0
				    (pair? (cddar vars))
				    (eqv? (length (caddar vars)) 3))
			   (let ((stepper (caddar vars))
				 (expr (cdar body))
				 (end (car end+res)))
			     (when (and (eq? (car stepper) '+)
					(memq (caar vars) stepper)
					(memv 1 stepper)
					(eqv? (length end) 3)
					(memq (caar vars) end)
					(memq (car end) '(= >=))
					(symbol? (car expr))
					(eq? (cadr expr) (caar vars))
					(pair? (caddr expr)))
			       (let ((ref (caddr expr)))
				 (when (and (eq? (car ref) '*)
					    (or (and (pair? (cadr ref))
						     (eq? (caadr ref) 'float-vector-ref)
						     (eq? (cadadr ref) (car expr))
						     (eq? (caddr (cadr ref)) (caar vars)))
						(and (pair? (caddr ref))
						     (eq? (caaddr ref) 'float-vector-ref)
						     (eq? (cadr (caddr ref)) (car expr))
						     (eq? (caddr (caddr ref)) (caar vars)))))
				   (format *stderr* "possible float-vector-scale: ~A~%" form))))))))
		       (old-do-walker caller form env))))
|#