From 4a1ee8bb44d7512f734f741cc6c4fe293c3bef7d Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Wed, 9 Sep 2009 15:18:14 +0000 Subject: [PATCH] Check that the operands of `one-of' don't yield contracts. svn: r15936 --- .../deinprogramm/contract/contract-syntax.ss | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/collects/deinprogramm/contract/contract-syntax.ss b/collects/deinprogramm/contract/contract-syntax.ss index 40470927ca..8c99eb5bc3 100644 --- a/collects/deinprogramm/contract/contract-syntax.ss +++ b/collects/deinprogramm/contract/contract-syntax.ss @@ -29,9 +29,24 @@ (list ?contract-expr ...) ?stx))) ((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)) - #'(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) (with-syntax ((?stx (phase-lift stx)) (?name name))