accidentally pushed a commit I didn't intend to

Revert "IN PROGRESS: started on redex undefined check update"

This reverts commit 3859a6f69e.

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

@@ -0,0 +1,19 @@
+#lang racket/base
+
+(require "error.rkt"
+         racket/undefined)
+(provide check-defined-lexical
+         check-defined-module)
+
+(define (check-defined-lexical value name desc)
+  ;; Needed?
+  (when (eq? undefined value)
+    (report-undefined name desc)))
+
+(define (check-defined-module thunk name desc)
+  (with-handlers ([exn:fail:contract:variable?
+                   (λ (_) (report-undefined name desc))])
+    (thunk)))
+
+(define (report-undefined name desc)
+  (redex-error #f "reference to ~a ~s before its definition" desc name))

pkgs/redex-pkgs/redex-lib/redex/private/judgment-form.rkt

@@ -231,7 +231,7 @@
                         [(binding-constraint ...) binding-constraints])
             #`(begin
                 #,syncheck-exp
-                (void #,(defined-check judgment-proc #:external #'form-name))
+                (void #,(defined-check judgment-proc "judgment form" #:external #'form-name))
                 (judgment-form-bind-withs/proc
                  #,rt-lang
                  `#,output-pattern

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

@@ -1,7 +1,6 @@
 #lang racket/base
 
-(require (for-template racket/base
+(require (for-template racket/base "defined-checks.rkt"))
-                       racket/unsafe/undefined))
 (provide make-term-fn
          term-fn?
          term-fn-get-id
@@ -44,17 +43,17 @@
        (cond [(syntax-local-value stx (λ () #f)) => p?]
              [else #f])))
 
-(define-struct judgment-form (name mode proc mk-proc lang lws rule-names
+(define-struct judgment-form (name mode proc mk-proc lang lws rule-names gen-clauses mk-gen-clauses term-proc relation?)
-                                   gen-clauses mk-gen-clauses term-proc relation?)
   #:transparent)
 
 (define-struct defined-term (value))
 (define (defined-term-id? stx)
   (transformer-predicate defined-term? stx))
 
-(define (defined-check id #:external [external id])
+(define (defined-check id desc #:external [external id])
-  (quasisyntax/loc external
+  (if (eq? (identifier-binding id) 'lexical)
-    (check-not-unsafe-undefined #,id '#,external)))
+      (quasisyntax/loc external (check-defined-lexical #,id '#,external #,desc))
+      (quasisyntax/loc external (check-defined-module (λ () #,id) '#,external #,desc))))
 
 (define (not-expression-context stx)
   (when (eq? (syntax-local-context) 'expression)
@@ -77,11 +76,7 @@
 (define pattern-symbols '(any number natural integer real string variable 
                               variable-not-otherwise-mentioned hole symbol))
 
-(define-values (struct:metafunc-proc 
+(define-values (struct:metafunc-proc make-metafunc-proc metafunc-proc? metafunc-proc-ref metafunc-proc-set!)
-                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-lib/redex/private/term.rkt

@@ -210,7 +210,7 @@
                    (syntax-local-introduce #'x))])
          (check-id (syntax->datum #'x) stx ellipsis-allowed?)
          (with-syntax ([v #`(begin
-                              #,(defined-check ref #:external #'x)
+                              #,(defined-check ref "term" #:external #'x)
                               #,ref)])
            (values #`(undatum v) 0)))]
       [(unquote x)
@@ -293,7 +293,7 @@
        #`(begin
            #,@(free-identifier-mapping-map
                applied-mfs
-               (λ (f _) (defined-check f)))
+               (λ (f _) (defined-check f "metafunction")))
            #,(let loop ([bs outer-bindings])
                (cond
                  [(null? bs) (syntax t)]

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

@@ -0,0 +1,24 @@
+#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,6 +33,7 @@
      "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"
@@ -57,27 +58,28 @@
 
 (define (flush)
   ;; these flushes are here for running under cygwin, 
-  ;; which somehow makes racket think it isn't using
+  ;; which somehow makes mzscheme think it isn't using
   ;; an interative port
   (flush-output (current-error-port))
   (flush-output (current-output-port)))
 
-(for ([test-file (in-list test-files)])
+(for-each
-  (define-values (file provided action)
+ (λ (test-file)
-    (match test-file
+   (let-values ([(file provided action)
-      [(list (? string? file) id)
+                 (match test-file
-       (values file id (λ (x) (x)))]
+                   [(list (? string? file) id)
-      [(? string?) 
+                    (values file id (λ (x) (x)))]
-       (values test-file #f values)]))
+                   [(? string?) 
-  (flush)
+                    (values test-file #f values)])])
-  (printf "running ~a\n" file)
+     (flush)
-  (flush)
+     (printf "running ~a\n" file)
-  (define path
+     (flush)
-    (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 examples-path (cadr (regexp-match #rx"^<redex-examples>/(.*)$" file)))
-        (build-path here file)))
+                      (build-path here file)))
-  (action (dynamic-require path provided))
+     (action (dynamic-require path provided))
-  (flush))
+     (flush)))
+ test-files)
 
 (printf "\nWARNING: didn't run color-test.rkt\n")
 (flush)
@@ -89,3 +91,4 @@
   (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:contract:variable? exn-message])
+            (with-handlers ([exn:fail:redex? exn-message])
               (eval '(require 'm))
               #f)))
-        #rx"^q:[^\n]*use[^\n]*before")
+        "reference to metafunction q before its definition")
-  (test (with-handlers ([exn:fail:contract:variable? exn-message])
+  (test (with-handlers ([exn:fail:redex? exn-message])
           (let ()
             (term (q))
             (define-language L)
             (define-metafunction L [(q) ()])
             #f))
-        #rx"^q:[^\n]*use[^\n]*before")
+        "reference to metafunction q before its definition")
   
 ;                                                                                                 
 ;