Check that the operands of `one-of' don't yield contracts.
svn: r15936
This commit is contained in:
parent
9a613d0d57
commit
4a1ee8bb44
|
@ -29,9 +29,24 @@
|
||||||
(list ?contract-expr ...)
|
(list ?contract-expr ...)
|
||||||
?stx)))
|
?stx)))
|
||||||
((one-of ?exp ...)
|
((one-of ?exp ...)
|
||||||
(with-syntax ((?stx (phase-lift stx))
|
(with-syntax ((((?temp ?exp) ...)
|
||||||
|
(map list
|
||||||
|
(generate-temporaries #'(?exp ...)) (syntax->list #'(?exp ...))))
|
||||||
|
(?stx (phase-lift stx))
|
||||||
(?name name))
|
(?name name))
|
||||||
#'(make-case-contract '?name (list ?exp ...) ?stx)))
|
(with-syntax (((?check ...)
|
||||||
|
(map (lambda (lis)
|
||||||
|
(with-syntax (((?temp ?exp) lis))
|
||||||
|
(with-syntax ((?raise
|
||||||
|
(syntax/loc
|
||||||
|
#'?exp
|
||||||
|
(error 'contracts "hier kein Vertrag zulässig, nur normaler Wert"))))
|
||||||
|
#'(when (contract? ?temp)
|
||||||
|
?raise))))
|
||||||
|
(syntax->list #'((?temp ?exp) ...)))))
|
||||||
|
#'(let ((?temp ?exp) ...)
|
||||||
|
?check ...
|
||||||
|
(make-case-contract '?name (list ?temp ...) ?stx)))))
|
||||||
((predicate ?exp)
|
((predicate ?exp)
|
||||||
(with-syntax ((?stx (phase-lift stx))
|
(with-syntax ((?stx (phase-lift stx))
|
||||||
(?name name))
|
(?name name))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user