From c1feb55a2013116c3291cf0df26f9ab39ad3e8c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 9 May 2020 21:43:16 +0200 Subject: New parser now on feature parity with old. --- module/util/exceptions.scm | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) (limited to 'module/util/exceptions.scm') diff --git a/module/util/exceptions.scm b/module/util/exceptions.scm index 41efaff5..4673b182 100644 --- a/module/util/exceptions.scm +++ b/module/util/exceptions.scm @@ -2,7 +2,8 @@ #:use-module (srfi srfi-1) #:use-module (util) #:export (throw-returnable - catch-multiple)) + catch-multiple + assert)) (define-syntax-rule (throw-returnable symb args ...) (call/cc (lambda (cont) (throw symb cont args ...)))) @@ -52,3 +53,21 @@ (display (apply (warning-handler) fmt (or args '())) (current-error-port))) + +(define (prettify-tree tree) + (cond [(null? tree) '()] + [(pair? tree) (cons (prettify-tree (car tree)) + (prettify-tree (cdr tree)))] + [(list? tree) (map prettify-tree 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))))) -- cgit v1.2.3