diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-22 17:23:16 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-22 17:23:32 +0200 |
commit | c7d2a84f70103552a9fe7ba7f051d9975ee9663f (patch) | |
tree | 43e50d304fd70f1512f0dc01b2dd050d4b3f2562 /module/hnh | |
parent | Add sample cpp "binary". (diff) | |
download | calp-c7d2a84f70103552a9fe7ba7f051d9975ee9663f.tar.gz calp-c7d2a84f70103552a9fe7ba7f051d9975ee9663f.tar.xz |
Add procedures for referencing specifier value.
Diffstat (limited to 'module/hnh')
-rw-r--r-- | module/hnh/util/values.scm | 20 |
1 files changed, 18 insertions, 2 deletions
diff --git a/module/hnh/util/values.scm b/module/hnh/util/values.scm index 79f06cff..75db638f 100644 --- a/module/hnh/util/values.scm +++ b/module/hnh/util/values.scm @@ -1,7 +1,11 @@ (define-module (hnh util values) :use-module (ice-9 control) - :export (abort* on-fst on-snd apply/values) - ) + :use-module (hnh util lens) + :export (abort* on-fst on-snd + on-nth + value-ref + value-refx + apply/values)) (define-syntax-rule (abort* form) @@ -21,7 +25,19 @@ (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))))) + +(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)) |