update Redex to cooperate with the new undefined semantics

pkgs/redex-pkgs/redex-lib/redex/private/defined-checks.rkt

@@ -16,4 +16,8 @@
     (thunk)))
 
 (define (report-undefined name desc)
-  (redex-error #f "reference to ~a ~s before its definition" desc name))
+  (raise
+   (exn:fail:contract:variable
+    (format "~s: undefined;\n cannot use ~a before its definition" name desc)
+    (current-continuation-marks)
+    name)))

pkgs/redex-pkgs/redex-lib/redex/private/reduction-semantics.rkt

@@ -1197,8 +1197,11 @@
                                prev-metafunction))
          (with-syntax ([(name2 name-predicate) (generate-temporaries (list name name))]
                        [name name])
+           (with-syntax ([name2+prop (syntax-property #'name2
+                                                      'undefined-error-name
+                                                      (syntax-e #'name))])
              (with-syntax ([defs #`(begin
-                                   (define-values (name2 name-predicate)
+                                     (define-values (name2+prop name-predicate)
                                        (generate-metafunction #,orig-stx
                                                               lang
                                                               #,prev-metafunction
@@ -1214,9 +1217,9 @@
                    ; metafunction definition at the top-level.
                    (syntax 
                     (begin 
-                    (define-syntaxes (name2 name-predicate) (values))
+                      (define-syntaxes (name2+prop name-predicate) (values))
                       defs))
-                 (syntax defs))))))]))
+                   (syntax defs)))))))]))
 
 (define-for-syntax (extract-clause-names stuffss)
   (for/list ([stuffs (in-list (syntax->list stuffss))])

pkgs/redex-pkgs/redex-lib/redex/private/term-fn.rkt

@@ -43,7 +43,8 @@
        (cond [(syntax-local-value stx (λ () #f)) => p?]
              [else #f])))
 
-(define-struct judgment-form (name mode proc mk-proc lang lws rule-names gen-clauses mk-gen-clauses term-proc relation?)
+(define-struct judgment-form (name mode proc mk-proc lang lws rule-names 
+                                   gen-clauses mk-gen-clauses term-proc relation?)
   #:transparent)
 
 (define-struct defined-term (value))
@@ -76,7 +77,11 @@
 (define pattern-symbols '(any number natural integer real string variable 
                               variable-not-otherwise-mentioned hole symbol))
 
-(define-values (struct:metafunc-proc make-metafunc-proc metafunc-proc? metafunc-proc-ref metafunc-proc-set!)
+(define-values (struct:metafunc-proc
+                make-metafunc-proc
+                metafunc-proc?
+                metafunc-proc-ref
+                metafunc-proc-set!)
   (make-struct-type 'metafunc-proc #f 10 0 #f null (current-inspector) 0))
 (define metafunc-proc-clause-names (make-struct-field-accessor metafunc-proc-ref 1))
 (define metafunc-proc-pict-info (make-struct-field-accessor metafunc-proc-ref 2))

pkgs/redex-pkgs/redex-test/redex/tests/defined-checks-test.rkt

@@ -1,24 +0,0 @@
-#lang racket
-
-(require "test-util.rkt"
-         redex/private/error
-         redex/private/defined-checks)
-
-(reset-count)
-
-(define expected-message "reference to thing x before its definition")
-
-(test (with-handlers ([exn:fail:redex? exn-message])
-        (check-defined-lexical x 'x "thing")
-        (define x 4)
-        "")
-      expected-message)
-
-(test (with-handlers ([exn:fail:redex? exn-message])
-        (check-defined-module (λ () x) 'x "thing")
-        "")
-      expected-message)
-
-(define x 4)
-
-(print-tests-passed 'defined-checks-test.rkt)

pkgs/redex-pkgs/redex-test/redex/tests/run-tests.rkt

@@ -33,7 +33,6 @@
      "pict-test.rkt"
      "hole-test.rkt"
      "stepper-test.rkt"
-     "defined-checks-test.rkt"
      "check-syntax-test.rkt"
      "test-docs-complete.rkt"
      "tut-subst-test.rkt"
@@ -58,28 +57,27 @@
 
 (define (flush)
   ;; these flushes are here for running under cygwin, 
-  ;; which somehow makes mzscheme think it isn't using
+  ;; which somehow makes racket think it isn't using
   ;; an interative port
   (flush-output (current-error-port))
   (flush-output (current-output-port)))
 
-(for-each
+(for ([test-file (in-list test-files)])
- (λ (test-file)
+  (define-values (file provided action)
-   (let-values ([(file provided action)
     (match test-file
       [(list (? string? file) id)
        (values file id (λ (x) (x)))]
       [(? string?) 
-                    (values test-file #f values)])])
+       (values test-file #f values)]))
   (flush)
   (printf "running ~a\n" file)
   (flush)
-     (define path (if (regexp-match #rx"<redex-examples>" file)
+  (define path
+    (if (regexp-match #rx"<redex-examples>" file)
         (build-path examples-path (cadr (regexp-match #rx"^<redex-examples>/(.*)$" file)))
         (build-path here file)))
   (action (dynamic-require path provided))
-     (flush)))
+  (flush))
- test-files)
 
 (printf "\nWARNING: didn't run color-test.rkt\n")
 (flush)
@@ -91,4 +89,3 @@
   (parameterize ([current-command-line-arguments
                   (vector "--examples" "--no-bitmap-gui")])
     (dynamic-require (quote-module-path "..") #f)))
-

pkgs/redex-pkgs/redex-test/redex/tests/tl-test.rkt

@@ -1217,17 +1217,17 @@
                      (term (q))
                      (define-language L)
                      (define-metafunction L [(q) ()])))
-            (with-handlers ([exn:fail:redex? exn-message])
+            (with-handlers ([exn:fail:contract:variable? exn-message])
               (eval '(require 'm))
               #f)))
-        "reference to metafunction q before its definition")
+        #rx"^q: undefined;\n[^\n]*use[^\n]*before")
-  (test (with-handlers ([exn:fail:redex? exn-message])
+  (test (with-handlers ([exn:fail:contract:variable? exn-message])
           (let ()
             (term (q))
             (define-language L)
             (define-metafunction L [(q) ()])
             #f))
-        "reference to metafunction q before its definition")
+        #rx"^q: undefined;\n[^\n]*use[^\n]*before")
   
 ;                                                                                                 
 ;