From 2d78e18454545801fbf3ac02c1d32ea68ef65de2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 25 Apr 2019 11:39:38 +0200 Subject: Clean up util and move exceptions. --- module/util/exceptions.scm | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 module/util/exceptions.scm (limited to 'module/util') diff --git a/module/util/exceptions.scm b/module/util/exceptions.scm new file mode 100644 index 00000000..d649643c --- /dev/null +++ b/module/util/exceptions.scm @@ -0,0 +1,40 @@ +(define-module (util exceptions) + #:use-module (srfi srfi-1) + #:use-module (util) + #:export (throw-returnable + catch-multiple)) + +(define-syntax-rule (throw-returnable symb args ...) + (call/cc (lambda (cont) (throw symb cont args ...)))) + +;; Takes a (non nested) list, and replaces all single underscore +;; symbols with a generated symbol. For macro usage. +(define (multiple-ignore lst) + (map/dotted (lambda (symb) (if (eq? symb '_) (gensym "ignored_") symb)) + lst)) + +;; Like @var{catch}, but multiple handlers can be specified. +;; Each handler is on the form +;; @example +;; [err-symb (args ...) body ...] +;; @end example +;; +;; Only errors with a handler are caught. Error can *not* be given as +;; an early argument. +(define-macro (catch-multiple thunk . cases) + (let catch-recur% ((errs (map car cases)) (cases cases)) + (let* ((v (car errs)) + (case other (partition (lambda (case) (eq? v (car case))) cases)) + (g!rest (gensym "rest"))) + `(catch (quote ,v) + ,(if (null? (cdr errs)) + thunk + `(lambda () ,(catch-recur% (cdr errs) other))) + (lambda (err . ,g!rest) + (apply (lambda ,(let ((param-list (second (car case)))) + (if (not (pair? param-list)) + param-list + (multiple-ignore param-list))) + ,@(cddr (car case))) + ,g!rest)))))) + -- cgit v1.2.3