aboutsummaryrefslogtreecommitdiff
path: root/module/hnh/util.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/hnh/util.scm')
-rw-r--r--module/hnh/util.scm39
1 files changed, 22 insertions, 17 deletions
diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index 8cbc8c8d..3019b35b 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -13,6 +13,7 @@
and=>> label
print-and-return
begin1
+ catch*
)
#:replace (let* set! define-syntax
when unless))
@@ -247,18 +248,20 @@
;; and the other items in some order.
;; Ord b => (list a) [, (b, b -> bool), (a -> b)] -> a, (list a)
(define*-public (find-extreme items optional: (< <) (access identity))
- (if (null? items)
- (error "Can't find extreme in an empty list")
- (fold-values
- (lambda (c min other)
- (if (< (access c) (access min))
- ;; Current stream head is smaller that previous min
- (values c (cons min other))
- ;; Previous min is still smallest
- (values min (cons c other))))
- (cdr items)
- ;; seeds:
- (car items) '())))
+ (when (null? items)
+ (scm-error 'wrong-type-arg "find-extreme"
+ "Can't find extreme in an empty list"
+ #f #f))
+ (fold-values
+ (lambda (c min other)
+ (if (< (access c) (access min))
+ ;; Current stream head is smaller that previous min
+ (values c (cons min other))
+ ;; Previous min is still smallest
+ (values min (cons c other))))
+ (cdr items)
+ ;; seeds:
+ (car items) '()))
(define*-public (find-min list optional: (access identity))
(find-extreme list < access))
@@ -576,8 +579,10 @@
(for-each (lambda (pair) (setenv (car pair) (caddr pair)))
env-pairs))))]))
-
-(define-public (uuidgen)
- ((@ (rnrs io ports) call-with-port)
- ((@ (ice-9 popen) open-input-pipe) "uuidgen")
- (@ (ice-9 rdelim) read-line)))
+(define-syntax catch*
+ (syntax-rules ()
+ ((_ thunk (key handler))
+ (catch (quote key) thunk handler))
+ ((_ thunk (key handler) rest ...)
+ (catch* (lambda () (catch (quote key) thunk handler))
+ rest ...))))