diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt index 090469cb54..5ad87209eb 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/rewrite-error-message.rkt @@ -135,6 +135,8 @@ (lambda (all) "list")) (list #rx"assignment disallowed;\n cannot set variable before its definition\n variable:" (lambda (all) "cannot set variable before its definition:")) + (list #rx"^(.*): undefined;\n cannot use before initialization" + (λ (all one) (format "local variable used before its definition: ~a" one))) ;; When do these show up? I see only `#' errors, currently. (list (regexp-quote "#(struct:object:image% ...)") (lambda (all) "an image")) diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt index 82ed4618e3..b4b9c8e5d0 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt @@ -87,16 +87,6 @@ (format "~a: question result is not true or false: ~e" where b) (current-continuation-marks))))) - ;; Wrapped around uses of local-bound variables: - (define (teach-check-not-undefined name val) - (if (eq? undefined val) - (raise - (make-exn:fail:contract:variable - (format "local variable used before its definition: ~a" name) - (current-continuation-marks) - name)) - val)) - (define (identifier-is-bound? id) (or (identifier-binding id) ;; identifier-binding returns #f for variable bound at the top-level, @@ -1144,18 +1134,6 @@ ;; a good error message, we need to wait, and that's what ;; beginner-app-delay does. - ;; For intermediate: - - ;; This application form disallows rator expressions that aren't - ;; top-level identifiers or of the form `(teach-check-not-undefined ...)'. - - ;; The latter is probably surprising. It turns out that every use of - ;; a `local'-bound identifier gets converted to an undefined check, - ;; and the call to `teach-check-not-undefined' can't be forged by the - ;; programmer. So the pattern-match effectively recognizes uses of - ;; `local'-bound identifiers, which are legal as rator - ;; expressions. (`let' and `letrec' get converted to `local'.) - (define-values (beginner-app/proc intermediate-app/proc) (let ([mk-app (lambda (lex-ok?) @@ -1163,10 +1141,6 @@ (syntax-case stx () [(_ rator rand ...) (let* ([fun (syntax rator)] - [undef-check? (syntax-case fun (teach-check-not-undefined) - [(teach-check-not-undefined id) - #t] - [_else #f])] [binding (and (identifier? fun) (identifier-binding fun))] [lex? (eq? 'lexical binding)] @@ -1177,7 +1151,7 @@ fun "expected a function after the open parenthesis, but found ~a" what))]) - (unless (and (identifier? fun) (or lex-ok? undef-check? (not lex?))) + (unless (and (identifier? fun) (or lex-ok? (not lex?))) (bad-app (if lex? "a variable" (something-else fun)))) @@ -1748,8 +1722,8 @@ (syntax ((define-syntaxes (def-id/prop ...) (values - (make-undefined-check - (quote-syntax teach-check-not-undefined) + (redirect-identifier-to + (quote-syntax set!) (quote-syntax tmp-id)) ...)) ...)))]) @@ -1817,8 +1791,8 @@ (syntax->list (syntax (rhs-expr ...))))]) (quasisyntax/loc stx (#%stratified-body - (define-syntaxes (name) (make-undefined-check - (quote-syntax teach-check-not-undefined) + (define-syntaxes (name) (redirect-identifier-to + (quote-syntax set!) (quote-syntax tmp-id))) ... (define-values (tmp-id) rhs-expr) @@ -1852,8 +1826,8 @@ (quasisyntax/loc stx (let-values ([(tmp-id) rhs-expr] ...) #,(stepper-syntax-property - #`(let-syntaxes ([(name) (make-undefined-check - (quote-syntax teach-check-not-undefined) + #`(let-syntaxes ([(name) (redirect-identifier-to + (quote-syntax set!t) (quote-syntax tmp-id))] ...) expr) diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt index 3d66862474..ede0d44680 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/teachhelp.rkt @@ -4,11 +4,10 @@ stepper/private/syntax-property (for-template (prefix r: racket/base))) - (provide make-undefined-check - make-first-order-function) + (provide make-first-order-function + redirect-identifier-to) - (define (make-undefined-check check-proc tmp-id) - (let ([set!-stx (datum->syntax-object check-proc 'set!)]) + (define (redirect-identifier-to set!-stx tmp-id) (make-set!-transformer (lambda (stx) (syntax-case stx () @@ -24,15 +23,10 @@ stx)] [id (stepper-syntax-property - (datum->syntax-object - check-proc - (list check-proc - (list 'quote (syntax id)) - tmp-id) - stx) + tmp-id 'stepper-skipto (append skipto/cdr - skipto/third))]))))) + skipto/third))])))) #; (define (appropriate-use what) (case what