blob: ddabb10cbfaf786623792dd335d25288fabda6f2 (
plain)
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
|
(define-module (hnh util values)
:use-module (ice-9 control)
:use-module (hnh util lens)
:export (abort* on-fst on-snd
on-nth
value-ref
value-refx
apply/values))
(define-syntax-rule (abort* form)
(call-with-values (lambda () form) abort))
;; (on-fst (+ 2 (abort* (values 3 4))))
;; ⇒ 5 ⇒ 4
(define-syntax-rule (on-fst form)
(% form
(lambda (prompt fst . rest)
(apply values (prompt fst) rest))))
(define-syntax-rule (on-snd form)
(% form
(lambda (prompt fst snd . rest)
(apply values fst (prompt snd) rest))))
(define-syntax-rule (on-nth idx form)
(% form
(lambda (prompt . rets)
(apply values (modify rets (ref idx) prompt)))))
;; TODO value-ref becomes value
(define-syntax-rule (value-ref form idx)
(call-with-values (lambda () form)
(lambda returns (list-ref returns idx))))
(define-syntax-rule (value-refx idx form)
(value-ref form idx))
;; TODO replace this with apply/mv from srfi-210
(define-syntax-rule (apply/values proc form)
(call-with-values (lambda () form)
proc))
|
