1	# RIFF WAVE. PCM is little-endian signed 16-bit. Float is IEEE binary32.
2	import Base
3	
4	# a parsed wave. kind 1 is signed 16-bit, kind 3 is binary32. frames are interleaved.
5	type Wav is Data:
6	  Wav{rate: U32, channels: U32, kind: U32, frames: List<&2, U32>}
7	
8	# fmt fields that passed the PCM checks
9	type Fm is Data:
10	  Fm{kind: U32, ch: U32, rate: U32}
11	
12	# the chunk walker: phase 0 tag, 1 size, 2 payload, 3 pad byte
13	type St is Data:
14	  St{
15	    phase: U32, left: U32, tag: U32, sz: U32, seen: U32, kind: U32, ch: U32,
16	    rate: U32, acc: List<&2, U32>, frames: List<&2, U32>
17	  }
18	
19	# 'RIFF'
20	def tag.riff() -> U32:
21	  1380533830
22	
23	# 'WAVE'
24	def tag.wave() -> U32:
25	  1463899717
26	
27	# 'fmt '
28	def tag.fmt() -> U32:
29	  1718449184
30	
31	# 'data'
32	def tag.data() -> U32:
33	  1684108385
34	
35	def be.u32(+aa: U32, +bb: U32, +cc: U32, +dd: U32) -> U32:
36	  ((((aa << 24n : U32) .|. (bb << 16n : U32) : U32) .|. (cc << 8n : U32) : U32) .|. dd : U32)
37	
38	def le.u16(+aa: U32, +bb: U32) -> U32:
39	  (aa .|. (bb << 8n : U32) : U32)
40	
41	def le.u32(+aa: U32, +bb: U32, +cc: U32, +dd: U32) -> U32:
42	  (le.u16(aa, bb) .|. (le.u16(cc, dd) << 16n : U32) : U32)
43	
44	def put.u16(+vv: U32) -> List<&2, U32>:
45	  [(vv .&. 255 : U32), ((vv >> 8n : U32) .&. 255 : U32)]
46	
47	def put.u32(+vv: U32) -> List<&2, U32>:
48	  List.append(&2, U32, put.u16(vv), put.u16((vv >> 16n : U32)))
49	
50	def put.be(+vv: U32) -> List<&2, U32>:
51	  [((vv >> 24n : U32) .&. 255 : U32), ((vv >> 16n : U32) .&. 255 : U32),
52	   ((vv >> 8n : U32) .&. 255 : U32), (vv .&. 255 : U32)]
53	
54	def put.lo(+vv: U32) -> U32:
55	  (vv .&. 255 : U32)
56	
57	def put.hi(+vv: U32) -> U32:
58	  ((vv >> 8n : U32) .&. 255 : U32)
59	
60	def put.b2(+vv: U32) -> U32:
61	  ((vv >> 16n : U32) .&. 255 : U32)
62	
63	def put.b3(+vv: U32) -> U32:
64	  ((vv >> 24n : U32) .&. 255 : U32)
65	
66	def word4.pick(big: Bool, +aa: U32, +bb: U32, +cc: U32, +dd: U32) -> U32:
67	  match big:
68	    case True{}:
69	      be.u32(aa, bb, cc, dd)
70	    case False{}:
71	      le.u32(aa, bb, cc, dd)
72	
73	def word.of(xs: List<&2, U32>, +big: U32) -> U32:
74	  match xs:
75	    case +dd <> +cc <> +bb <> +aa <> _tl:
76	      word4.pick(U32.is_eq(big, 1), aa, bb, cc, dd)
77	    case _:
78	      0
79	
80	def st.empty() -> St:
81	  St{0, 4, 0, 0, 0, 0, 0, 0, [], []}
82	
83	def st.set(
84	  +phase: U32, +left: U32, +tag: U32, +sz: U32, +seen: U32, +kind: U32, +ch: U32,
85	  +rate: U32, acc: List<&2, U32>, frames: List<&2, U32>
86	) -> St:
87	  St{phase, left, tag, sz, seen, kind, ch, rate, acc, frames}
88	
89	def fmt.rate(ok: Bool, +kind: U32, +ch: U32, +rate: U32) -> Maybe<&2, Fm>:
90	  match ok:
91	    case True{}:
92	      Some{Fm{kind, ch, rate}}
93	    case False{}:
94	      None{}
95	
96	def fmt.ok(+kind: U32, +ch: U32, +rate: U32, +br: U32, +al: U32, +bits: U32) -> Maybe<&2, Fm>:
97	  match kind ch bits:
98	    case 1 1 16:
99	      fmt.rate(U32.is_eq(al, 2) && U32.is_eq(br, (rate * 2 : U32)) && U32.is_ne(rate, 0), kind, ch, rate)
100	    case 1 2 16:
101	      fmt.rate(U32.is_eq(al, 4) && U32.is_eq(br, (rate * 4 : U32)) && U32.is_ne(rate, 0), kind, ch, rate)
102	    case 3 1 32:
103	      fmt.rate(U32.is_eq(al, 4) && U32.is_eq(br, (rate * 4 : U32)) && U32.is_ne(rate, 0), kind, ch, rate)
104	    case 3 2 32:
105	      fmt.rate(U32.is_eq(al, 8) && U32.is_eq(br, (rate * 8 : U32)) && U32.is_ne(rate, 0), kind, ch, rate)
106	    case _ _ _:
107	      None{}
108	
109	def fmt.pack(
110	  +k0: U32, +k1: U32, +c0: U32, +c1: U32, +r0: U32, +r1: U32, +r2: U32, +r3: U32,
111	  +b0: U32, +b1: U32, +b2: U32, +b3: U32, +a0: U32, +a1: U32, +t0: U32, +t1: U32
112	) -> Maybe<&2, Fm>:
113	  fmt.ok(
114	    le.u16(k0, k1), le.u16(c0, c1), le.u32(r0, r1, r2, r3), le.u32(b0, b1, b2, b3),
115	    le.u16(a0, a1), le.u16(t0, t1))
116	
117	def fmt.fields(ys: List<&2, U32>) -> Maybe<&2, Fm>:
118	  match ys:
119	    case +k0 <> +k1 <> +c0 <> +c1 <> +r0 <> +r1 <> +r2 <> +r3 <> +b0 <> +b1 <> +b2 <> +b3
120	      <> +a0 <> +a1 <> +t0 <> +t1 <> _rest:
121	      fmt.pack(k0, k1, c0, c1, r0, r1, r2, r3, b0, b1, b2, b3, a0, a1, t0, t1)
122	    case _:
123	      None{}
124	
125	def pcm.cons(got: Maybe<&2, List<&2, U32>>, +vv: U32) -> Maybe<&2, List<&2, U32>>:
126	  match got:
127	    case None{}:
128	      None{}
129	    case Some{rest}:
130	      Some{vv <> rest}
131	
132	def pcm.s16(xs: List<&2, U32>) -> Maybe<&2, List<&2, U32>>:
133	  match xs:
134	    case Nil{}:
135	      Some{[]}
136	    case +lo <> +hi <> tl:
137	      pcm.cons(pcm.s16(tl), le.u16(lo, hi))
138	    case _:
139	      None{}
140	
141	def pcm.f32(xs: List<&2, U32>) -> Maybe<&2, List<&2, U32>>:
142	  match xs:
143	    case Nil{}:
144	      Some{[]}
145	    case +a0 <> +a1 <> +a2 <> +a3 <> tl:
146	      pcm.cons(pcm.f32(tl), le.u32(a0, a1, a2, a3))
147	    case _:
148	      None{}
149	
150	def pcm.of(+kind: U32, ys: List<&2, U32>) -> Maybe<&2, List<&2, U32>>:
151	  match kind:
152	    case 1:
153	      pcm.s16(ys)
154	    case _:
155	      pcm.f32(ys)
156	
157	def done.ok(ok: Bool, +rt: U32, +ch: U32, +kd: U32, fr: List<&2, U32>) -> Maybe<&2, Wav>:
158	  match ok:
159	    case True{}:
160	      Some{Wav{rt, ch, kd, fr}}
161	    case False{}:
162	      None{}
163	
164	def st.done(st: St) -> Maybe<&2, Wav>:
165	  match st:
166	    case St{ph, lf, _tg, _sz, sn, kd, ch, rt, _ac, fr}:
167	      done.ok(U32.is_eq(ph, 0) && U32.is_eq(lf, 4) && U32.is_eq(sn, 2), rt, ch, kd, fr)
168	
169	def step.next.pad(
170	  odd: Bool, +sz: U32, +tag: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32,
171	  frames: List<&2, U32>
172	) -> St:
173	  match odd:
174	    case True{}:
175	      st.set(3, 1, tag, sz, seen, kind, ch, rate, [], frames)
176	    case False{}:
177	      st.set(0, 4, tag, sz, seen, kind, ch, rate, [], frames)
178	
179	def step.next(
180	  +sz: U32, +tag: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32, frames: List<&2, U32>
181	) -> St:
182	  step.next.pad(U32.is_eq((sz .&. 1 : U32), 1), sz, tag, seen, kind, ch, rate, frames)
183	
184	def step.fmt.got(got: Maybe<&2, Fm>, +sz: U32, frames: List<&2, U32>) -> St:
185	  match got:
186	    case None{}:
187	      step.next(sz, tag.fmt(), 3, 0, 0, 0, frames)
188	    case Some{Fm{kd, cc, rt}}:
189	      step.next(sz, tag.fmt(), 1, kd, cc, rt, frames)
190	
191	def step.fmt(
192	  +sz: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32, ys: List<&2, U32>,
193	  frames: List<&2, U32>
194	) -> St:
195	  match seen:
196	    case 0:
197	      step.fmt.got(fmt.fields(ys), sz, frames)
198	    case _:
199	      step.next(sz, tag.fmt(), seen, kind, ch, rate, frames)
200	
201	def step.pcm.got(
202	  got: Maybe<&2, List<&2, U32>>, +sz: U32, +kind: U32, +ch: U32, +rate: U32
203	) -> St:
204	  match got:
205	    case None{}:
206	      step.next(sz, tag.data(), 3, kind, ch, rate, [])
207	    case Some{fr}:
208	      step.next(sz, tag.data(), 2, kind, ch, rate, fr)
209	
210	def step.pcm(
211	  ready: Bool, +sz: U32, +kind: U32, +ch: U32, +rate: U32, ys: List<&2, U32>,
212	  frames: List<&2, U32>
213	) -> St:
214	  match ready:
215	    case False{}:
216	      step.next(sz, tag.data(), 3, kind, ch, rate, frames)
217	    case True{}:
218	      step.pcm.got(pcm.of(kind, ys), sz, kind, ch, rate)
219	
220	def step.dat(
221	  isd: Bool, +tag: U32, +sz: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32,
222	  ys: List<&2, U32>, frames: List<&2, U32>
223	) -> St:
224	  match isd:
225	    case False{}:
226	      step.next(sz, tag, seen, kind, ch, rate, frames)
227	    case True{}:
228	      step.pcm(U32.is_eq(seen, 1), sz, kind, ch, rate, ys, frames)
229	
230	def step.chunk.on(
231	  isf: Bool, +tag: U32, +sz: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32,
232	  ys: List<&2, U32>, frames: List<&2, U32>
233	) -> St:
234	  match isf:
235	    case True{}:
236	      step.fmt(sz, seen, kind, ch, rate, ys, frames)
237	    case False{}:
238	      step.dat(U32.is_eq(tag, tag.data()), tag, sz, seen, kind, ch, rate, ys, frames)
239	
240	def step.chunk(
241	  +tag: U32, +sz: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32,
242	  ys: List<&2, U32>, frames: List<&2, U32>
243	) -> St:
244	  step.chunk.on(U32.is_eq(tag, tag.fmt()), tag, sz, seen, kind, ch, rate, ys, frames)
245	
246	def step.tag.at(
247	  last: Bool, +left: U32, +sz: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32,
248	  acc: List<&2, U32>, frames: List<&2, U32>
249	) -> St:
250	  match last:
251	    case False{}:
252	      st.set(0, (left - 1 : U32), 0, sz, seen, kind, ch, rate, acc, frames)
253	    case True{}:
254	      st.set(1, 4, word.of(acc, 1), sz, seen, kind, ch, rate, [], frames)
255	
256	def step.tag(st: St, +hd: U32) -> St:
257	  match st:
258	    case St{_ph, +left, _tg, sz, seen, kind, ch, rate, acc, frames}:
259	      step.tag.at(U32.is_eq(left, 1), left, sz, seen, kind, ch, rate, hd <> acc, frames)
260	
261	def step.size.done(
262	  +sz: U32, +tag: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32, frames: List<&2, U32>
263	) -> St:
264	  match sz:
265	    case 0:
266	      st.set(0, 4, tag, sz, seen, kind, ch, rate, [], frames)
267	    case _:
268	      st.set(2, sz, tag, sz, seen, kind, ch, rate, [], frames)
269	
270	def step.size.at(
271	  last: Bool, +left: U32, +tag: U32, +seen: U32, +kind: U32, +ch: U32, +rate: U32,
272	  acc: List<&2, U32>, frames: List<&2, U32>
273	) -> St:
274	  match last:
275	    case False{}:
276	      st.set(1, (left - 1 : U32), tag, 0, seen, kind, ch, rate, acc, frames)
277	    case True{}:
278	      step.size.done(word.of(acc, 0), tag, seen, kind, ch, rate, frames)
279	
280	def step.size(st: St, +hd: U32) -> St:
281	  match st:
282	    case St{_ph, +left, tag, _sz, seen, kind, ch, rate, acc, frames}:
283	      step.size.at(U32.is_eq(left, 1), left, tag, seen, kind, ch, rate, hd <> acc, frames)
284	
285	def step.pad(st: St) -> St:
286	  match st:
287	    case St{_phase, _left, tag, sz, seen, kind, ch, rate, _acc, frames}:
288	      st.set(0, 4, tag, sz, seen, kind, ch, rate, [], frames)
289	
290	def step.pay.at(
291	  last: Bool, +left: U32, +tag: U32, +sz: U32, +seen: U32, +kind: U32, +ch: U32,
292	  +rate: U32, acc: List<&2, U32>, frames: List<&2, U32>
293	) -> St:
294	  match last:
295	    case False{}:
296	      st.set(2, (left - 1 : U32), tag, sz, seen, kind, ch, rate, acc, frames)
297	    case True{}:
298	      step.chunk(tag, sz, seen, kind, ch, rate, List.reverse(&2, U32, acc), frames)
299	
300	def step.pay(st: St, +hd: U32) -> St:
301	  match st:
302	    case St{_ph, +left, tag, sz, seen, kind, ch, rate, acc, frames}:
303	      step.pay.at(U32.is_eq(left, 1), left, tag, sz, seen, kind, ch, rate, hd <> acc, frames)
304	
305	def step.err.dec(
306	  last: Bool, +phase: U32, +left: U32, +tag: U32, +sz: U32, +kind: U32, +ch: U32,
307	  +rate: U32, acc: List<&2, U32>, frames: List<&2, U32>
308	) -> St:
309	  match last:
310	    case False{}:
311	      st.set(phase, (left - 1 : U32), tag, sz, 3, kind, ch, rate, acc, frames)
312	    case True{}:
313	      st.set(0, 4, tag, sz, 3, kind, ch, rate, [], frames)
314	
315	def step.err.keep(+_phase: U32, st: St, +hd: U32) -> St:
316	  match st:
317	    case St{phase, +left, tag, sz, _sn, kind, ch, rate, acc, frames}:
318	      step.err.dec(U32.is_eq(left, 1), phase, left, tag, sz, kind, ch, rate, hd <> acc, frames)
319	
320	def step.on(+phase: U32, st: St, +hd: U32) -> St:
321	  match phase:
322	    case 0:
323	      step.tag(st, hd)
324	    case 1:
325	      step.size(st, hd)
326	    case 2:
327	      step.pay(st, hd)
328	    case _:
329	      step.pad(st)
330	
331	def step.bad(bad: Bool, +phase: U32, st: St, +hd: U32) -> St:
332	  match bad:
333	    case True{}:
334	      step.err.keep(phase, st, hd)
335	    case False{}:
336	      step.on(phase, st, hd)
337	
338	def step.byte(st: St, +hd: U32) -> St:
339	  match st:
340	    case St{+phase, +left, +tag, +sz, +seen, +kind, +ch, +rate, +acc, +frames}:
341	      step.bad(
342	        U32.is_eq(seen, 3), phase,
343	        st.set(phase, left, tag, sz, seen, kind, ch, rate, acc, frames), hd)
344	
345	def walk.go(xs: List<&2, U32>, st: St) -> Maybe<&2, Wav>:
346	  match xs:
347	    case Nil{}:
348	      st.done(st)
349	    case +hd <> tl:
350	      walk.go(tl, step.byte(st, hd))
351	
352	def open.ok(ok: Bool, rest: List<&2, U32>) -> Maybe<&2, List<&2, U32>>:
353	  match ok:
354	    case True{}:
355	      Some{rest}
356	    case False{}:
357	      None{}
358	
359	def open.riff(xs: List<&2, U32>) -> Maybe<&2, List<&2, U32>>:
360	  match xs:
361	    case +a <> +b <> +c <> +d <> +s0 <> +s1 <> +s2 <> +s3 <> +w0 <> +w1 <> +w2 <> +w3 <> rest:
362	      open.ok(
363	        U32.is_eq(be.u32(a, b, c, d), tag.riff()) && U32.is_eq(be.u32(w0, w1, w2, w3), tag.wave()),
364	        rest)
365	    case _:
366	      None{}
367	
368	def wav.go(got: Maybe<&2, List<&2, U32>>) -> Maybe<&2, Wav>:
369	  match got:
370	    case None{}:
371	      None{}
372	    case Some{rest}:
373	      walk.go(rest, st.empty())
374	
375	# bytes to a wave, or none when the form is not mono or stereo PCM or float
376	def wav.parse(xs: List<&2, U32>) -> Maybe<&2, Wav>:
377	  wav.go(open.riff(xs))
378	
379	def enc.s16(xs: List<&2, U32>) -> List<&2, U32>:
380	  match xs:
381	    case Nil{}:
382	      []
383	    case +hd <> tl:
384	      put.lo(hd) <> put.hi(hd) <> enc.s16(tl)
385	
386	def enc.f32(xs: List<&2, U32>) -> List<&2, U32>:
387	  match xs:
388	    case Nil{}:
389	      []
390	    case +hd <> tl:
391	      put.lo(hd) <> put.hi(hd) <> put.b2(hd) <> put.b3(hd) <> enc.f32(tl)
392	
393	def enc.pcm(+kind: U32, xs: List<&2, U32>) -> List<&2, U32>:
394	  match kind:
395	    case 1:
396	      enc.s16(xs)
397	    case _:
398	      enc.f32(xs)
399	
400	def enc.ch(+nc: U32) -> Bool:
401	  match nc:
402	    case 1:
403	      True{}
404	    case 2:
405	      True{}
406	    case _:
407	      False{}
408	
409	def enc.both(okc: Bool, okr: Bool) -> Bool:
410	  match okc:
411	    case False{}:
412	      False{}
413	    case True{}:
414	      okr
415	
416	def enc.ok(+nc: U32, +fk: U32, +rt: U32) -> Bool:
417	  match fk:
418	    case 1:
419	      enc.both(enc.ch(nc), U32.is_ne(rt, 0))
420	    case 3:
421	      enc.both(enc.ch(nc), U32.is_ne(rt, 0))
422	    case _:
423	      False{}
424	
425	def enc.bytes(+kind: U32, +ns: U32) -> U32:
426	  match kind:
427	    case 1:
428	      (ns * 2 : U32)
429	    case _:
430	      (ns * 4 : U32)
431	
432	def enc.cat(xs: List<&2, U32>, ys: List<&2, U32>) -> List<&2, U32>:
433	  List.append(&2, U32, xs, ys)
434	
435	def align.of(+kind: U32, +ch: U32) -> U32:
436	  match kind:
437	    case 1:
438	      (ch * 2 : U32)
439	    case _:
440	      (ch * 4 : U32)
441	
442	def width.of(+kind: U32) -> U32:
443	  match kind:
444	    case 1:
445	      16
446	    case _:
447	      32
448	
449	def enc.head(+rate: U32, +ch: U32, +kind: U32, +nb: U32) -> List<&2, U32>:
450	  enc.cat(put.be(tag.riff()),
451	    enc.cat(put.u32((36 + nb : U32)),
452	      enc.cat(put.be(tag.wave()),
453	        enc.cat(put.be(tag.fmt()),
454	          enc.cat(put.u32(16),
455	            enc.cat(put.u16(kind),
456	              enc.cat(put.u16(ch),
457	                enc.cat(put.u32(rate),
458	                  enc.cat(put.u32((rate * align.of(kind, ch) : U32)),
459	                    enc.cat(put.u16(align.of(kind, ch)),
460	                      enc.cat(put.u16(width.of(kind)),
461	                        enc.cat(put.be(tag.data()), put.u32(nb)))))))))))))
462	
463	def write.some(
464	  +rate: U32, +ch: U32, +kind: U32, frames: List<&2, U32>, pcm: List<&2, U32>
465	) -> Maybe<&2, List<&2, U32>>:
466	  nb = enc.bytes(kind, U32.from_nat(List.length(&2, U32, frames)))
467	  Some{enc.cat(enc.head(rate, ch, kind, nb), pcm)}
468	
469	def write.if(
470	  ok: Bool, +rate: U32, +ch: U32, +kind: U32, +frames: List<&2, U32>
471	) -> Maybe<&2, List<&2, U32>>:
472	  match ok:
473	    case False{}:
474	      None{}
475	    case True{}:
476	      write.some(rate, ch, kind, frames, enc.pcm(kind, frames))
477	
478	# a wave file, or none when the clip is not 16-bit PCM or 32-bit float, mono or stereo
479	def wav.write(+rate: U32, +ch: U32, +kind: U32, frames: List<&2, U32>) -> Maybe<&2, List<&2, U32>>:
480	  write.if(enc.ok(ch, kind, rate), rate, ch, kind, frames)