From d3afa54144748685d12c159407194e03538e98de Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 24 Aug 2020 20:34:11 +0200
Subject: Move util modules into calp module..

---
 module/util/exceptions.scm | 95 ----------------------------------------------
 1 file changed, 95 deletions(-)
 delete mode 100644 module/util/exceptions.scm

(limited to 'module/util/exceptions.scm')

diff --git a/module/util/exceptions.scm b/module/util/exceptions.scm
deleted file mode 100644
index f316451d..00000000
--- a/module/util/exceptions.scm
+++ /dev/null
@@ -1,95 +0,0 @@
-(define-module (util exceptions)
-  #:use-module (srfi srfi-1)
-  #:use-module (util)
-  #:use-module (util config)
-  #:use-module (ice-9 format)
-  #:export (throw-returnable
-            catch-multiple
-            assert))
-
-(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))))))
-
-
-
-(define-public warning-handler
-  (make-parameter
-   (lambda (fmt . args)
-     (format #f "WARNING: ~?~%" fmt args))))
-
-(define-public warnings-are-errors
-  (make-parameter #f))
-
-(define-config warnings-are-errors #f
-  description: "Crash on warnings."
-  post: warnings-are-errors)
-
-;; forwards return from warning-hander. By default returns an unspecified value,
-;; but instances are free to provide a proper return value and use it.
-(define-public (warning fmt . args)
-  (display (apply (warning-handler) fmt (or args '()))
-           (current-error-port))
-  (when (warnings-are-errors)
-    (throw 'warning fmt args)))
-
-(define-public (fatal fmt . args)
-  (display (format #f "FATAL: ~?~%" fmt (or args '()))
-           (current-error-port))
-  (raise 2)
-  )
-
-(define (prettify-tree tree)
-  (cond [(pair? tree) (cons (prettify-tree (car tree))
-                            (prettify-tree (cdr tree)))]
-        [(and (procedure? tree) (procedure-name tree))
-         => identity]
-        [else tree]))
-
-
-
-(define-macro (assert form)
-  `(unless ,form
-     (throw 'assertion-error "Assertion for ~a failed, ~a"
-            (quote ,form)
-            ((@@ (util exceptions) prettify-tree) ,(cons 'list form)))))
-
-
-(define-syntax catch-warnings
-  (syntax-rules ()
-    ((_ default body ...)
-     (parametrize ((warnings-are-errors #t))
-       (catch 'warning
-         (lambda ()
-           body ...)
-         (lambda _ default))))))
-- 
cgit v1.2.3