Translate assume to a noop when assumptions are disabled

This commit is contained in:
Marc Nieper-Wißkirchen 2020-08-29 11:11:46 +02:00
parent 043e4c2214
commit 251464eade

View file

@ -1,30 +1,23 @@
(define-library (srfi 145) (define-library (srfi 145)
(export assume) (export assume)
(import (scheme base)) (import (scheme base))
(cond-expand (cond-expand
(elide-assumptions ((or elide-assumptions
(begin (and (not assumptions)
(define-syntax assume (not debug)))
(syntax-rules () (begin
((assume expression objs ...) (define-syntax assume
expression) (syntax-rules ()
((assume) ((assume expression objs ...)
(syntax-error "assume requires an expression")))))) expression)
(else ((assume)
(begin (syntax-error "assume requires an expression"))))))
(define-syntax assume (else
(syntax-rules () (begin
((assume expression objs ...) (define-syntax assume
(or expression (syntax-rules ()
(fatal-error "invalid assumption" 'expression objs ...))) ((assume expression objs ...)
((assume) (or expression
(syntax-error "assume requires an expression"))))))) (error "invalid assumption" 'expression objs ...)))
(cond-expand ((assume)
(debug (syntax-error "assume requires an expression"))))))))
(begin
(define fatal-error error)))
(else
(begin
(define (fatal-error message . objs)
(car 0))))))