Make the DeinProgramm / DMdA one-of' / case' contracts use beginner-equal?.

svn: r16556

collects/deinprogramm/contract/contract-syntax.ss

@@ -10,7 +10,8 @@
 	 scheme/promise
 	 (for-syntax scheme/base)
 	 (for-syntax syntax/stx)
-	 (for-syntax stepper/private/shared))
+	 (for-syntax stepper/private/shared)
+	 (only-in lang/private/teachprims beginner-equal?))
 
 (define-for-syntax (phase-lift stx)
   (with-syntax ((?stx stx))
@@ -46,7 +47,7 @@
 			   (syntax->list #'((?temp ?exp) ...)))))
        #'(let ((?temp ?exp) ...)
 	   ?check ...
-	   (make-case-contract '?name (list ?temp ...) ?stx)))))
+	   (make-case-contract '?name (list ?temp ...) beginner-equal? ?stx)))))
     ((predicate ?exp)
      (with-syntax ((?stx (phase-lift stx))
 		   (?name name))

collects/deinprogramm/contract/contract.ss

@@ -194,7 +194,7 @@
    syntax
    #f))
 
-(define (make-case-contract name cases syntax)
+(define (make-case-contract name cases =? syntax)
   (make-contract
    name
    (lambda (self obj)
@@ -203,12 +203,12 @@
 	((null? cases)
 	 (contract-violation obj self #f #f)
 	 obj)
-	((equal? (car cases) obj)
+	((=? (car cases) obj)
 	 obj)
 	(else
 	 (loop (cdr cases))))))
    syntax
-   (delay (apply arbitrary-one-of equal? cases))))
+   (delay (apply arbitrary-one-of =? cases))))
 
 (define-struct procedure-to-blame (proc syntax))
 

collects/tests/deinprogramm/contract.ss

@@ -129,7 +129,7 @@
 
    (test-case
     "case"
-    (define foo-or-bar (make-case-contract 'foo-or-bar '("foo" "bar") 'foo-or-bar-marker))
+    (define foo-or-bar (make-case-contract 'foo-or-bar '("foo" "bar") equal? 'foo-or-bar-marker))
     (check-equal? (say-no (apply-contract foo-or-bar #f))
 		  'no)
     (check-equal? (say-no (apply-contract foo-or-bar "foo"))