Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding assert macro

Browse source
This commit is contained in:
Alex Shinn 2021-03-26 23:12:37 +09:00
parent adec61993b
commit 26d3a010df
1 changed files with 53 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
lib/chibi/assert.sld Normal file
View file

@ -0,0 +1,53 @@
(define-library (chibi assert)
(export assert)
(cond-expand
(chibi
(import (chibi))
(begin
(define-syntax check-identifier
(er-macro-transformer
(lambda (expr rename compare)
(if (identifier? (cadr expr))
(car (cddr expr))
(cadr (cddr expr))))))))
(else
(import (scheme base))
(begin
;; from match.scm
(define-syntax check-identifier
(syntax-rules ()
((_ (x . y) success-k failure-k) failure-k)
((_ #(x ...) success-k failure-k) failure-k)
((_ x success-k failure-k)
(let-syntax
((sym?
(syntax-rules ()
((sym? x sk fk) sk)
((sym? y sk fk) fk))))
(sym? abracadabra success-k failure-k))))))))
(begin
(define-syntax report-vars
(syntax-rules ()
((report-vars 'x (next ...) res)
(next ... res))
((report-vars `x (next ...) res)
(next ... res))
((report-vars (op arg0 arg1 ...) next res)
(report-vars arg0 (report-vars (op arg1 ...) next) res))
((report-vars (op . x) (next ...) res)
(next ... res))
((report-vars x (next ...) (res ...))
(check-identifier x
(next ... (res ... (x ,x)))
(next ... (res ...))))))
(define-syntax report-final
(syntax-rules ()
((report-final expr (vars ...))
(error "assertion failed" 'expr `vars ...))))
(define-syntax assert
(syntax-rules ()
((assert test0 test1 ...)
(if test0
(assert test1 ...)
(report-vars test0 (report-final test0) ())))
((assert) #t)))))