all necessary changes to check references to uninitialized letrec variables

includes a new pass, letrec_check, two new primitives, and
changes to packages that grabbed the letrec undefined value

pkgs/algol60/runtime.rkt

@@ -1,4 +1,5 @@
 (module runtime mzscheme
+  (require racket/undefined)
   
   (provide (struct a60:array (vec dimens))
            (struct a60:switch (choices))
@@ -17,7 +18,6 @@
   (define-struct a60:array (vec dimens))
   (define-struct a60:switch (choices))
   
-  (define undefined (letrec ([x x]) x))
   (define (check-boolean b) b)
   (define (goto f) (f))
   (define (get-value v) (v))

pkgs/compatibility-pkgs/compatibility-lib/mzlib/unit200.rkt

@@ -7,14 +7,13 @@
 		      syntax/name
 		      syntax/context
                       racket/syntax
+                      racket/undefined
 		      (only racket/base filter)
 		      "private/unitidmap.rkt")
 
   ;; ----------------------------------------------------------------------
   ;; Structures and helpers
 
-  (define undefined (letrec ([x x]) x)) ; initial value
-
   (define insp (current-inspector)) ; for named structures
 
   (define-struct unit (num-imports exports go)) ; unit value

pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt

@@ -38,6 +38,7 @@
            mzlib/math
            mzlib/pconvert-prop
            scheme/match
+           racket/undefined
            "set-result.rkt"
            (only racket/base define-struct)
 	   racket/struct-info
@@ -87,15 +88,14 @@
         (current-continuation-marks)))))
 
   ;; Wrapped around uses of local-bound variables:
-  (define (check-not-undefined name val)
+  (define (teach-check-not-undefined name val)
-    (if (eq? val undefined)
+    (if (undefined? val)
       (raise
        (make-exn:fail:contract:variable
         (format "local variable used before its definition: ~a" name)
         (current-continuation-marks)
         name))
       val))
-  (define undefined (letrec ([x x]) x))
 
   (define (identifier-is-bound? id)
     (or (identifier-binding id)
@@ -1147,11 +1147,11 @@
     ;; For intermediate:
 
     ;; This application form disallows rator expressions that aren't
-    ;; top-level identifiers or of the form `(check-not-undefined ...)'.
+    ;; 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 `check-not-undefined' can't be forged by the
+    ;; 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'.)
@@ -1163,8 +1163,8 @@
 		 (syntax-case stx ()
 		   [(_ rator rand ...)
 		    (let* ([fun (syntax rator)]
-			   [undef-check? (syntax-case fun (check-not-undefined)
+			   [undef-check? (syntax-case fun (teach-check-not-undefined)
-					   [(check-not-undefined id)
+					   [(teach-check-not-undefined id)
 					    #t]
 					   [_else #f])]
 			   [binding (and (identifier? fun)
@@ -1749,7 +1749,7 @@
 					      ((define-syntaxes (def-id/prop ...)
 						 (values
 						  (make-undefined-check
-						   (quote-syntax check-not-undefined)
+						   (quote-syntax teach-check-not-undefined)
 						   (quote-syntax tmp-id))
 						  ...))
 					       ...)))])
@@ -1818,7 +1818,7 @@
 	      (quasisyntax/loc stx
                 (#%stratified-body
                   (define-syntaxes (name) (make-undefined-check
-                                           (quote-syntax check-not-undefined)
+                                           (quote-syntax teach-check-not-undefined)
                                            (quote-syntax tmp-id)))
                   ...
                   (define-values (tmp-id) rhs-expr)
@@ -1853,7 +1853,7 @@
                 (let-values ([(tmp-id) rhs-expr] ...)
                   #,(stepper-syntax-property
                      #`(let-syntaxes ([(name) (make-undefined-check
-                                               (quote-syntax check-not-undefined)
+                                               (quote-syntax teach-check-not-undefined)
                                                (quote-syntax tmp-id))]
                                       ...)
                                      expr)

pkgs/pconvert-lib/mzlib/pconvert.rkt

@@ -4,7 +4,8 @@
   (require (only racket/base sort)
            compatibility/mlist
 	   "pconvert-prop.rkt"
-           racket/class)
+           racket/class
+           racket/undefined)
   
   (provide show-sharing
            constructor-style-printing
@@ -27,8 +28,6 @@
            current-build-share-hook
            current-print-convert-hook)
   
-  (define undefined-val (letrec ([x x]) x))
-  
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; the value stored in the hash table.  Contains the name
   ;; <which is a number unless we are in donkey and it already has a name>
@@ -123,7 +122,9 @@
                         (boolean? expr)
                         (char? expr) (void? expr)
                         (null? expr)
-                        (eq? expr undefined-val) ; #<undefined> test - yuck
+                        ;; #<undefined> test - yuck, and maybe not worth checking
+                        ;; anymore, since undefined generally shouldn't escape
+                        (undefined? expr) 
                         )
                     'atomic]
                    [(and (not (struct? expr))  ;; struct names are the wrong thing, here

pkgs/plai/datatype.rkt

@@ -2,7 +2,8 @@
 (require (for-syntax racket/base
                      racket/list)
          racket/list
-         racket/contract)
+         racket/contract
+         racket/undefined)
 
 (provide define-type type-case)
 
@@ -86,11 +87,6 @@
                 stx)]
               [_ (transfer-srcloc orig stx)]))))
 
-(define the-undefined
-  (letrec ([x x]) x))
-(define (undefined? x)
-  (eq? the-undefined x))
-
 (define-syntax (define-type stx)
   (syntax-parse
       stx

pkgs/r5rs-pkgs/r5rs-lib/r5rs/main.rkt

@@ -1,5 +1,6 @@
 (module main scheme/base
   (require scheme/mpair
+           racket/undefined
            (for-syntax scheme/base syntax/kerncase
                        "private/r5rs-trans.rkt")
            (only-in mzscheme transcript-on transcript-off))
@@ -243,7 +244,6 @@
 
   ;; Copied from R5rS, but with an added `let' around body,
   ;; and with optimization for precedure letrecs
-  (define undefined (letrec ([u u]) u))
   (define-for-syntax (immediate-value? stx)
     (let ([v (syntax-e stx)])
       (or (number? v)

pkgs/racket-pkgs/racket-doc/scribblings/reference/data.scrbl

@@ -174,15 +174,27 @@ The @|void-const| value is always @racket[eq?] to itself.
 @; ----------------------------------------------------------------------
 @section[#:tag "undefined"]{Undefined}
 
-The constant @|undefined-const| is used as the initial value for
+@note-lib[racket/undefined]
-@racket[letrec] bindings and in other places where a placeholder value
-is needed before a specific value can be assigned. Use
-@racket[undefined] (which is bound to @|undefined-const|) as a last resort.
 
-The @|undefined-const| value is always @racket[eq?] to itself.
+The constant @racket[undefined] is conceptually used as a placeholder
+value for a binding, so that a reference to a binding before its
+definition can be detected. Such references are normally protected
+implicitly via @racket[check-not-undefined], so that an expression does
+not normally produce an @racket[undefined] value.
 
-@note-lib-only[racket/undefined]
+The @racket[undefined] value is always @racket[eq?] to itself.
 
-@defthing[undefined any/c]{The @|undefined-const| constant.}
+@defproc[(undefined? [v any/c]) boolean?]{Returns @racket[#t] if @racket[v] is the
+ constant @racket[undefined], @racket[#f] otherwise.}
 
-@history[#:added "6.0.0.6"]
+
+@defthing[undefined undefined?]{The ``undefined'' constant.}
+
+@defproc[(check-not-undefined [v any/c] [sym symbol?]) (and/c any/c (not/c undefined?))]{
+
+Checks whether @racket[v] is @racket[undefined], and raises
+@racket[exn:fail:contract:variable] in that case with an error message
+along the lines of ``@racket[sym]: variable used before its definition.''
+If @racket[v] is not @racket[undefined], then it is returned.
+
+}

pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl

@@ -918,6 +918,9 @@
 (test-comp '(let ([x 8][y 9]) (lambda () (+ x y)))
 	   '(let ([x 8][y 9]) (lambda () (if #f y (+ x y)))))
 
+;; Don't optimize away use before definition:
+(test-comp '(letrec ([x (begin x 5)]) x) '5 #f)
+
 (test-comp '(let ([x 5]) (set! x 2)) '(let ([x 5]) (set! x x) (set! x 2)))
 
 (test-comp '(let* () (f 5))

pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl

@@ -87,8 +87,8 @@
   (let ((x 4))
     (lambda (y) (+ x y))))
 (test 10 add4 6)
-(test (letrec([x x]) x) 'lambda (let ([x (lambda () (define d d) d)]) (x)))
+(err/rt-test (let ([x (lambda () (define d d) d)]) (x)) exn:fail:contract:variable?)
-(test (letrec([x x]) x) 'lambda ((lambda () (define d d) d)))
+(err/rt-test ((lambda () (define d d) d)) exn:fail:contract:variable?)
 (test '(3 4 5 6) (lambda x x) 3 4 5 6)
 (test '(5 6) (lambda (x y . z) z) 3 4 5 6)
 (test 'second (lambda () (cons 'first 2) 'second))
@@ -643,8 +643,8 @@
 (test 'twox 'let*-values (let*-values ([() (values)][() (values)]) 'twox))
 (test 'threex 'letrec-values (letrec-values ([() (values)][() (values)]) 'threex))
 
-(letrec ([undef undef])
+(err/rt-test (letrec-values ([(a b c) (values 1 a b)]) (list a b c))
-  (test (list 1 undef undef) 'no-split-letrec (letrec-values ([(a b c) (values 1 a b)]) (list a b c))))
+              exn:fail:contract:variable?)
 
 (test '(10 11) 'letrec-values (letrec-values ([(names kps)
 					       (letrec ([oloop 10])
@@ -1642,13 +1642,15 @@
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; check that the compiler is not too agressive with `letrec' -> `let*'
 
-(test "#<undefined>\nready\n"
+(test "<undefined>\nready\n"
       get-output-string
       (let ([p (open-output-string)])
         (parameterize ([current-output-port p])
           (let ([restart void])
             (letrec ([dummy1 (let/cc k (set! restart k))]
-                     [dummy2 (displayln maybe-ready)]
+                     [dummy2 (displayln (with-handlers ([exn:fail:contract:variable?
+                                                         (lambda (exn) '<undefined>)])
+                                          maybe-ready))]
                      [maybe-ready 'ready])
               (let ([rs restart])
                 (set! restart void)

pkgs/swindle/tiny-clos.rkt

@@ -116,7 +116,8 @@
 ;;; OK, now let's get going.  But, as usual, before we can do anything
 ;;; interesting, we have to muck around for a bit first.  First, we need to
 ;;; load the support library.  [-- replaced with a module.]
-(require swindle/misc)
+(require swindle/misc
+         racket/undefined)
 
 ;; This is a convenient function for raising exceptions
 (define (raise* exn-maker fmt . args)
@@ -219,7 +220,7 @@
 ;;>   This is Racket's `unspecified' value which is used as the default
 ;;>   value for unbound slots.  It is provided so you can check if a slot is
 ;;>   unbound.
-(define* ??? (letrec ([x x]) x)) ; this is Racket's #<undefined> value
+(define* ??? undefined)
 (define unspecified-initializer (lambda args ???))
 (define false-func (lambda args #f))
 

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt

@@ -8,6 +8,7 @@
          racket/list
          racket/match
          racket/function
+         racket/undefined
          unstable/function
 
          (prefix-in c: (contract-req))
@@ -91,8 +92,8 @@
 (define/decl -Boolean (Un -False -True))
 (define/decl -Undefined
   (make-Base 'Undefined
-             #'(lambda (x) (equal? (letrec ([y y]) y) x)) ; initial value of letrec bindings
+             #'undefined? ; initial value of letrec bindings
-             (lambda (x) (equal? (letrec ([y y]) y) x))))
+             undefined?))
 (define/decl -Bytes (make-Base 'Bytes #'bytes? bytes?))
 (define/decl -Base-Regexp (make-Base 'Base-Regexp
                            #'(and/c regexp? (not/c pregexp?))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/any-wrap.rkt

@@ -3,15 +3,14 @@
 (require racket/match racket/contract/combinator
          racket/fixnum racket/flonum
          racket/set
+         racket/undefined
          (only-in (combine-in racket/private/promise)
                   promise?
                   prop:force promise-forcer))
 
-(define undef (letrec ([x x]) x))
-
 (define (base-val? e)
   (or (number? e) (string? e) (char? e) (symbol? e)
-      (null? e) (regexp? e) (eq? undef e) (path? e)
+      (null? e) (regexp? e) (undefined? e) (path? e)
       (regexp? e) (keyword? e) (bytes? e) (boolean? e) (void? e)
       ;; Base values because you can only store flonums/fixnums in these
       ;; and not any higher-order values. This isn't sound if we ever

racket/collects/racket/contract/private/misc.rkt

@@ -557,26 +557,23 @@
   (apply or/c ss))
 
 (define atomic-value? 
-  (let ([undefined (letrec ([x x]) x)])
+  (λ (x)
-    (λ (x)
+     (or (char? x) (symbol? x) (boolean? x)
-      (or (char? x) (symbol? x) (boolean? x)
+         (null? x) (keyword? x) (number? x)
-          (null? x) (keyword? x) (number? x)
+         (void? x))))
-          (void? x) (eq? x undefined)))))
 
 (define/final-prop (one-of/c . elems)
   (for ([arg (in-list elems)]
         [i (in-naturals)])
     (unless (atomic-value? arg)
       (raise-argument-error 'one-of/c
-                            "char, symbol, boolean, null, keyword, number, void, or undefined"
+                            "char, symbol, boolean, null, keyword, number, or void"
                             i
                             elems)))
-  (define (undefined? x) (eq? x (letrec ([x x]) x)))
   (define or/c-args
     (map (λ (x)
            (cond
              [(void? x) void?]
-             [(undefined? x) undefined?]
              [else x]))
          elems))
   (apply or/c or/c-args))

racket/collects/racket/private/class-c-old.rkt

@@ -3,6 +3,7 @@
                      racket/stxparam
                      syntax/parse)
          racket/stxparam
+         racket/undefined
          "class-wrapped.rkt"
          "class-internal.rkt"
          "../contract/base.rkt"
@@ -20,8 +21,6 @@
          build-internal-class/c internal-class/c-proj
          class/c-internal-name-clauses)
 
-(define undefined (letrec ([x x]) x))
-
 ;; Shorthand contracts that treat the implicit object argument as if it were
 ;; contracted with any/c.
 (define-syntax-rule (->m . stx)

racket/collects/racket/private/class-internal.rkt

@@ -9,6 +9,7 @@
          (only-in "../contract/region.rkt" current-contract-region)
          "../contract/base.rkt"
          "../contract/combinator.rkt"
+         racket/undefined
          (for-syntax racket/stxparam
                      syntax/kerncase
                      syntax/stx
@@ -4375,8 +4376,6 @@ An example
 ;;  misc utils
 ;;--------------------------------------------------------------------
 
-(define undefined (letrec ([x x]) x))
-
 (define-struct (exn:fail:object exn:fail) () #:inspector insp)
 
 (struct as-write (content))

racket/collects/racket/private/classidmap.rkt

@@ -3,6 +3,7 @@
 (require syntax/stx
          (for-syntax racket/base)
          (for-template racket/base
+                       racket/undefined
                        "class-wrapped.rkt"))
 
 (define insp (variable-reference->module-declaration-inspector
@@ -83,12 +84,12 @@
             [(id . args)
              (with-syntax ([bindings (syntax/loc stx ([obj obj-expr]))]
                            [call (quasisyntax/loc stx
-                                   (((unsyntax field-accessor) obj) . args))])
+                                   ((check-not-undefined ((unsyntax field-accessor) obj) 'id) . args))])
                (syntax/loc stx (let* bindings call)))]
             [id
              (with-syntax ([bindings (syntax/loc stx ([obj obj-expr]))]
                            [get (quasisyntax/loc stx
-                                  ((unsyntax field-accessor) obj))])
+                                  (check-not-undefined ((unsyntax field-accessor) obj) 'id))])
                (syntax/loc stx (let* bindings get)))])))))))
 
 (define (make-method-map the-finder the-obj the-binder the-binder-localized method-accessor)

racket/collects/racket/private/pre-base.rkt

@@ -179,7 +179,8 @@
                               procedure->method procedure-rename
                               chaperone-procedure impersonate-procedure
                               assq assv assoc
-                              prop:incomplete-arity prop:method-arity-error)
+                              prop:incomplete-arity prop:method-arity-error
+                              check-not-undefined undefined)
              (all-from "reqprov.rkt")
              (all-from-except "for.rkt"
                               define-in-vector-like

racket/collects/racket/private/unit-runtime.rkt

@@ -2,7 +2,7 @@
 
 (require (for-syntax "unit-syntax.rkt" racket/base))
 (provide define-syntax/err-param
-         undefined (rename-out [make-a-unit make-unit]) unit-import-sigs unit-export-sigs unit-go unit? unit-deps
+         (rename-out [make-a-unit make-unit]) unit-import-sigs unit-export-sigs unit-go unit? unit-deps
          check-unit check-no-imports check-sigs check-deps check-helper)
   
 (define-syntax define-syntax/err-param
@@ -12,9 +12,6 @@
        (parameterize ((error-syntax arg))
          body)))))
 
-;; initial value
-(define undefined (letrec ([x x]) x))
-
 ;; for named structures
 (define insp (current-inspector))
 

racket/collects/racket/shared.rkt

@@ -3,14 +3,14 @@
                      syntax/kerncase
                      syntax/struct
                      racket/struct-info
-                     racket/include))
+                     racket/include)
+         racket/undefined)
 
 (provide shared)
 
 (define-for-syntax code-insp (variable-reference->module-declaration-inspector
                               (#%variable-reference)))
 
-(define undefined (letrec ([x x]) x))
 (require (only-in racket/base [cons the-cons]))
 
 (define-syntax shared

racket/collects/racket/undefined.rkt

@@ -1,8 +1,8 @@
 #lang racket/base
+(require '#%kernel)
 
-(provide undefined)
+(provide check-not-undefined
+         undefined
+         undefined?)
 
-;; In a future version of Racket, this `letrec` pattern
+(define (undefined? v) (eq? v undefined))
-;; will not work, but the `racket/undefined` library will
-;; still export an `undefined`:
-(define undefined (letrec ([x x]) x))

racket/collects/racket/unit.rkt

@@ -17,6 +17,7 @@
                      "private/unit-syntax.rkt"))
 
 (require racket/block
+         racket/undefined
          racket/contract/base
          racket/contract/region
          racket/stxparam
@@ -1186,7 +1187,8 @@
         (lambda (int/ext-name index ctc)
           (bound-identifier-mapping-put! def-table
                                          (car int/ext-name)
-                                         #`(vector-ref #,v #,index))
+                                         #`(check-not-undefined (vector-ref #,v #,index)
+                                                                '#,(car int/ext-name)))
           (bound-identifier-mapping-put! ctc-table
                                          (car int/ext-name)
                                          ctc)

racket/collects/syntax/toplevel.rkt

@@ -1,5 +1,6 @@
 (module toplevel racket/base
-  (require "kerncase.rkt")
+  (require "kerncase.rkt"
+           racket/undefined)
   
   (provide eval-compile-time-part-of-top-level
            eval-compile-time-part-of-top-level/compile
@@ -74,8 +75,7 @@
 	 (begin0
 	  (when compile? (compile-syntax stx))
 	  (for-each (lambda (id)
-		      (with-syntax ([id id]
+		      (with-syntax ([id id])
-				    [undefined (letrec ([x x]) x)])
 			(eval-syntax (syntax (define-values (id) undefined)))))
 		    (syntax->list (syntax (id ...)))))]
         [_else 

racket/src/racket/gc2/Makefile.in

@@ -76,6 +76,7 @@ OBJS =  salloc.@LTO@ \
 	jitprep.@LTO@ \
 	jitstack.@LTO@ \
 	jitstate.@LTO@ \
+	letrec_check.@LTO@ \
 	list.@LTO@ \
 	marshal.@LTO@ \
 	module.@LTO@ \
@@ -135,6 +136,7 @@ XSRCS = $(XSRCDIR)/salloc.c \
 	$(XSRCDIR)/jitprep.c \
 	$(XSRCDIR)/jitstack.c \
 	$(XSRCDIR)/jitstate.c \
+	$(XSRCDIR)/letrec_check.c \
 	$(XSRCDIR)/list.c \
 	$(XSRCDIR)/marshal.c \
 	$(XSRCDIR)/module.c \
@@ -253,6 +255,8 @@ $(XSRCDIR)/marshal.c: ../src/marshal.@LTO@ $(XFORMDEP) $(SRCDIR)/mzrt.h
 	$(XFORM) $(XSRCDIR)/marshal.c $(SRCDIR)/marshal.c
 $(XSRCDIR)/module.c: ../src/module.@LTO@ $(XFORMDEP) $(SRCDIR)/mzrt.h
 	$(XFORM) $(XSRCDIR)/module.c $(SRCDIR)/module.c
+$(XSRCDIR)/letrec_check.c: ../src/letrec_check.@LTO@ $(XFORMDEP)
+	$(XFORM) $(XSRCDIR)/letrec_check.c $(SRCDIR)/letrec_check.c
 $(XSRCDIR)/list.c: ../src/list.@LTO@ $(XFORMDEP)
 	$(XFORM) $(XSRCDIR)/list.c $(SRCDIR)/list.c
 $(XSRCDIR)/network.c: ../src/network.@LTO@ $(XFORMDEP)
@@ -360,6 +364,8 @@ jitstack.@LTO@: $(XSRCDIR)/jitstack.c
 	$(CC) $(ALL_CFLAGS) -c $(XSRCDIR)/jitstack.c -o jitstack.@LTO@
 jitstate.@LTO@: $(XSRCDIR)/jitstate.c
 	$(CC) $(ALL_CFLAGS) -c $(XSRCDIR)/jitstate.c -o jitstate.@LTO@
+letrec_check.@LTO@: $(XSRCDIR)/letrec_check.c
+	$(CC) $(ALL_CFLAGS) -c $(XSRCDIR)/letrec_check.c -o letrec_check.@LTO@
 list.@LTO@: $(XSRCDIR)/list.c
 	$(CC) $(ALL_CFLAGS) -c $(XSRCDIR)/list.c -o list.@LTO@
 marshal.@LTO@: $(XSRCDIR)/marshal.c

racket/src/racket/src/Makefile.in

@@ -39,6 +39,7 @@ OBJS =  salloc.@LTO@ \
 	jitprep.@LTO@ \
 	jitstack.@LTO@ \
 	jitstate.@LTO@ \
+	letrec_check.@LTO@ \
 	list.@LTO@ \
 	marshal.@LTO@ \
 	module.@LTO@ \
@@ -96,6 +97,7 @@ SRCS =  $(srcdir)/salloc.c \
 	$(srcdir)/jitprep.c \
 	$(srcdir)/jitstack.c \
 	$(srcdir)/jitstate.c \
+	$(srcdir)/letrec_check.c \
 	$(srcdir)/list.c \
 	$(srcdir)/marshal.c \
 	$(srcdir)/module.c \
@@ -226,6 +228,8 @@ jitstack.@LTO@: $(srcdir)/jitstack.c
 	$(CC) $(ALL_CFLAGS) -c $(srcdir)/jitstack.c -o jitstack.@LTO@
 jitstate.@LTO@: $(srcdir)/jitstate.c
 	$(CC) $(ALL_CFLAGS) -c $(srcdir)/jitstate.c -o jitstate.@LTO@
+letrec_check.@LTO@: $(srcdir)/letrec_check.c
+	$(CC) $(ALL_CFLAGS) -c $(srcdir)/letrec_check.c -o letrec_check.@LTO@
 list.@LTO@: $(srcdir)/list.c
 	$(CC) $(ALL_CFLAGS) -c $(srcdir)/list.c -o list.@LTO@
 marshal.@LTO@: $(srcdir)/marshal.c
@@ -362,6 +366,8 @@ jitprep.@LTO@: $(COMMON_HEADERS) \
 jitstack.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS) $(srcdir)/codetab.inc \
         $(srcdir)/unwind/libunwind.h
 jitstate.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
+letrec_check.@LTO@: $(COMMON_HEADERS) \
+        $(srcdir)/stypes.h  
 list.@LTO@: $(COMMON_HEADERS) \
         $(srcdir)/stypes.h  
 marshal.@LTO@: $(COMMON_HEADERS) \

racket/src/racket/src/compenv.c

@@ -28,6 +28,10 @@
 
 #define TABLE_CACHE_MAX_SIZE 2048
 
+/* Pre-allocate local variable reference objects.
+   first dimension: position in the current stack frame
+   second dimension: 0 for local variables, 1 for unboxed local variables
+   third dimension: flags. TODO has to do with whether something is an unboxed fixnum, flonum, or extnum */
 READ_ONLY static Scheme_Object *scheme_local[MAX_CONST_LOCAL_POS][MAX_CONST_LOCAL_TYPES][MAX_CONST_LOCAL_FLAG_VAL + 1];
 READ_ONLY static Scheme_Object *toplevels[MAX_CONST_TOPLEVEL_DEPTH][MAX_CONST_TOPLEVEL_POS][SCHEME_TOPLEVEL_FLAGS_MASK + 1];
 
@@ -853,11 +857,14 @@ static Scheme_Object *alloc_local(short type, int pos)
   return (Scheme_Object *)v;
 }
 
+/* type should be either scheme_local_type or scheme_local_unbox_type
+   TODO: double check that */
 Scheme_Object *scheme_make_local(Scheme_Type type, int pos, int flags)
 {
   int k;
   Scheme_Object *v, *key;
 
+  /* k is 0 if type is scheme_local_type and 1 if type is scheme_local_unbox_type */
   k = type - scheme_local_type;
   
   /* Helper for reading bytecode: make sure flags is a valid value */
@@ -899,7 +906,9 @@ static Scheme_Local *get_frame_loc(Scheme_Comp_Env *frame,
   int cnt, u;
 
   u = COMPILE_DATA(frame)->use[i];
-  
+
+  // flags -= (flags & SCHEME_APP_POS);
+
   u |= (((flags & (SCHEME_APP_POS | SCHEME_SETTING))
 	 ? CONSTRAINED_USE
 	 : ((u & (ARBITRARY_USE | ONE_ARBITRARY_USE)) ? ARBITRARY_USE : ONE_ARBITRARY_USE))

racket/src/racket/src/compile.c

@@ -1210,18 +1210,6 @@ set_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
   rec[drec].value_name = SCHEME_STX_SYM(name);
 
   val = scheme_compile_expr(body, scheme_no_defines(env), rec, drec);
-
-  /* check for (set! x x) */
-  if (SAME_TYPE(SCHEME_TYPE(var), SCHEME_TYPE(val))) {
-    if (SAME_TYPE(SCHEME_TYPE(var), scheme_local_type)
-	|| SAME_TYPE(SCHEME_TYPE(var), scheme_local_unbox_type)) {
-      /* local */
-      if (SCHEME_LOCAL_POS(var) == SCHEME_LOCAL_POS(val))
-	return scheme_compiled_void();
-    } else {
-      /* global; can't do anything b/c var might be undefined or constant */
-    }
-  }
   
   set_undef = (rec[drec].comp_flags & COMP_ALLOW_SET_UNDEFINED);
  
@@ -2073,7 +2061,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
 		int star, int recursive, int multi, Scheme_Compile_Info *rec, int drec,
 		Scheme_Comp_Env *frame_already)
 {
-  Scheme_Object *bindings, *l, *binding, *name, **names, *forms, *defname;
+  Scheme_Object *bindings, *l, *binding, *name, **names, **clv_names, *forms, *defname;
   int num_clauses, num_bindings, i, j, k, m, pre_k;
   Scheme_Comp_Env *frame, *env, *rhs_env;
   Scheme_Compile_Info *recs;
@@ -2110,6 +2098,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
   post_bind = !recursive && !star;
   rev_bind_order = recursive;
 
+  /* forms ends up being the let body */
   forms = SCHEME_STX_CDR(form);
   forms = SCHEME_STX_CDR(forms);
   forms = scheme_datum_to_syntax(forms, form, form, 0, 0);
@@ -2266,6 +2255,16 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
     lv->count = (k - pre_k);
     lv->position = pre_k;
 
+    if (recursive) {
+      /* The names are only used for recursive bindings (in letrec_check),
+         currently. It would be ok if we record extra names, though. */
+      clv_names = MALLOC_N(Scheme_Object*, lv->count);
+      for (m = pre_k; m < k; m++) {
+        clv_names[m - pre_k] = SCHEME_STX_SYM(names[m]);
+      }
+      lv->names = clv_names;
+    }
+
     if (lv->count == 1)
       recs[i].value_name = SCHEME_STX_SYM(names[pre_k]);
 
@@ -2827,6 +2826,8 @@ do_begin_syntax(char *name,
   if (zero)
     env = scheme_no_defines(env);
 
+  /* if the begin has only one expression inside, drop the begin 
+     TODO: is this right */
   if (SCHEME_STX_NULLP(SCHEME_STX_CDR(forms))) {
     forms = SCHEME_STX_CAR(forms);
     return scheme_compile_expr(forms, env, rec, drec);
@@ -2924,9 +2925,9 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
       /* "Inline" nested begins */
       count += ((Scheme_Sequence *)v)->count;
       total++;
-    } else if (opt 
+    } else if (opt
-	       && (((opt > 0) && !last) || ((opt < 0) && !first))
+               && (((opt > 0) && !last) || ((opt < 0) && !first))
-	       && scheme_omittable_expr(v, -1, -1, 0, NULL, NULL, -1, 0)) {
+               && scheme_omittable_expr(v, -1, -1, 0, NULL, NULL, -1, 1)) {
       /* A value that is not the result. We'll drop it. */
       total++;
     } else {
@@ -2954,7 +2955,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
       /* can't optimize away a begin0 at read time; it's too late, since the
          return is combined with EXPD_BEGIN0 */
       addconst = 1;
-    } else if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL, NULL, -1, 0)) {
+    } else if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL, NULL, -1, 1)) {
       /* We can't optimize (begin0 expr cont) to expr because
 	 exp is not in tail position in the original (so we'd mess
 	 up continuation marks). */
@@ -2986,7 +2987,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
     } else if (opt 
 	       && (((opt > 0) && (k < total))
 		   || ((opt < 0) && k))
-	       && scheme_omittable_expr(v, -1, -1, 0, NULL, NULL, -1, 0)) {
+	       && scheme_omittable_expr(v, -1, -1, 0, NULL, NULL, -1, 1)) {
       /* Value not the result. Do nothing. */
     } else
       o->array[i++] = v;
@@ -3574,6 +3575,8 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object
 
   a = scheme_compile_expr_lift_to_let(a, eenv, &mrec, 0);
 
+  a = scheme_letrec_check_expr(a);
+
   oi = scheme_optimize_info_create(eenv->prefix, 1);
   if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
     scheme_optimize_info_never_inline(oi);

racket/src/racket/src/env.c

@@ -249,6 +249,7 @@ Scheme_Env *scheme_engine_instance_init()
 
   scheme_init_portable_case();
   scheme_init_compenv();
+  scheme_init_letrec_check();
   scheme_init_optimize();
   scheme_init_resolve();
   scheme_init_sfs();

racket/src/racket/src/eval.c

@@ -4061,6 +4061,8 @@ static void *compile_k(void)
 	  break;
       }
 
+      o = scheme_letrec_check_expr(o);
+
       oi = scheme_optimize_info_create(cenv->prefix, 1);
       scheme_optimize_info_enforce_const(oi, enforce_consts);
       if (!(comp_flags & COMP_CAN_INLINE))

racket/src/racket/src/fun.c

@@ -86,6 +86,7 @@ READ_ONLY Scheme_Object *scheme_values_func; /* the function bound to `values' *
 READ_ONLY Scheme_Object *scheme_procedure_p_proc;
 READ_ONLY Scheme_Object *scheme_procedure_arity_includes_proc;
 READ_ONLY Scheme_Object *scheme_void_proc;
+READ_ONLY Scheme_Object *scheme_check_not_undefined;
 READ_ONLY Scheme_Object *scheme_apply_proc;
 READ_ONLY Scheme_Object *scheme_call_with_values_proc; /* the function bound to `call-with-values' */
 READ_ONLY Scheme_Object *scheme_reduced_procedure_struct;
@@ -160,6 +161,7 @@ static Scheme_Object *extract_one_cc_mark (int argc, Scheme_Object *argv[]);
 static Scheme_Object *call_with_immediate_cc_mark (int argc, Scheme_Object *argv[]);
 static Scheme_Object *void_func (int argc, Scheme_Object *argv[]);
 static Scheme_Object *void_p (int argc, Scheme_Object *argv[]);
+static Scheme_Object *check_not_undefined (int argc, Scheme_Object *argv[]);
 static Scheme_Object *dynamic_wind (int argc, Scheme_Object *argv[]);
 #ifdef TIME_SYNTAX
 static Scheme_Object *time_apply(int argc, Scheme_Object *argv[]);
@@ -490,6 +492,14 @@ scheme_init_fun (Scheme_Env *env)
                                                             | SCHEME_PRIM_IS_OMITABLE);
   scheme_add_global_constant("void?", o, env);
 
+  /* adds the new primitive check-undefined to the kernel langauge
+     check-undefined has an arity of 1 and no flags */
+  REGISTER_SO(scheme_check_not_undefined);
+  scheme_check_not_undefined = scheme_make_prim_w_arity(check_not_undefined, "check-not-undefined", 2, 2);
+  scheme_add_global_constant("check-not-undefined", scheme_check_not_undefined, env);
+
+  scheme_add_global_constant("undefined", scheme_undefined, env);
+
 #ifdef TIME_SYNTAX
   scheme_add_global_constant("time-apply",
 			     scheme_make_prim_w_arity2(time_apply,
@@ -2523,6 +2533,23 @@ void_p (int argc, Scheme_Object *argv[])
   return SAME_OBJ(argv[0], scheme_void) ? scheme_true : scheme_false;
 }
 
+static Scheme_Object *
+check_not_undefined (int argc, Scheme_Object *argv[])
+{
+  if (!SCHEME_SYMBOLP(argv[1]))
+    scheme_wrong_contract("check-not-undefined", "symbol?", 1, argc, argv);
+
+  if (SAME_OBJ(argv[0], scheme_undefined)) {
+    scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE,
+                     argv[1],
+                     "%S: variable used before its definition",
+                     argv[1]);
+  }
+
+  return argv[0];
+}
+
+
 static Scheme_Object *
 procedure_p (int argc, Scheme_Object *argv[])
 {

racket/src/racket/src/mkmark.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
-(define re:start "^START ([a-z]+);")
+(define re:start "^START ([a-z_]+);")
-(define re:end "^END ([a-z]+);")
+(define re:end "^END ([a-z_]+);")
 
 (define re:form "^([a-zA-Z0-9_]+) [{]")
 
@@ -39,7 +39,7 @@
                            (loop (cdr l) (not skip?))]
                           [skip?
                            (loop (cdr l) #t)]
-                          [(regexp-match? #rx"(START|END)_[A-Z]+_ONLY;" (car l))
+                          [(regexp-match? #rx"(START|END)_[A-Z_]+_ONLY;" (car l))
                            (loop (cdr l) skip?)]
                           [else
                            (printf "~a\n" (car l))

racket/src/racket/src/module.c

@@ -8404,11 +8404,13 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
       /* Note: don't use MZCONFIG_USE_JIT for module bodies */
       use_jit = scheme_startup_use_jit;
 
+      o = scheme_letrec_check_expr((Scheme_Object *)env->genv->module);
+
       oi = scheme_optimize_info_create(env->prefix, 1);
       scheme_optimize_info_enforce_const(oi, rec[drec].comp_flags & COMP_ENFORCE_CONSTS);
       if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
         scheme_optimize_info_never_inline(oi);
-      o = scheme_optimize_expr((Scheme_Object *)env->genv->module, oi, 0);
+      o = scheme_optimize_expr(o, oi, 0);
 
       rp = scheme_resolve_prefix(0, env->prefix, 1);
       ri = scheme_resolve_info_create(rp);
@@ -9014,6 +9016,8 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
           if (!for_stx)
             lifted_reqs = scheme_append(scheme_frame_get_require_lifts(eenv), lifted_reqs);
 
+          m = scheme_letrec_check_expr(m);
+
 	  oi = scheme_optimize_info_create(eenv->prefix, 1);
           scheme_optimize_info_set_context(oi, (Scheme_Object *)env->genv->module);
           if (!(rec[drec].comp_flags & COMP_CAN_INLINE))

racket/src/racket/src/mzmark_letrec_check.inc

@@ -0,0 +1,78 @@
+/* >>>> Generated by mkmark.rkt from mzmarksrc.c <<<< */
+
+static int mark_letrec_check_frame_SIZE(void *p, struct NewGC *gc) {
+  return
+  gcBYTES_TO_WORDS(sizeof(Letrec_Check_Frame));
+}
+
+static int mark_letrec_check_frame_MARK(void *p, struct NewGC *gc) {
+  Letrec_Check_Frame *frame = (Letrec_Check_Frame *)p;
+  
+  gcMARK2(frame->def, gc);
+  gcMARK2(frame->next, gc);
+  gcMARK2(frame->ref, gc);
+  gcMARK2(frame->checked, gc);
+  gcMARK2(frame->head, gc);
+  gcMARK2(frame->deferred_with_rhs_ref, gc);
+  gcMARK2(frame->deferred_with_body_ref, gc);
+  gcMARK2(frame->deferred_with_no_ref, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Letrec_Check_Frame));
+}
+
+static int mark_letrec_check_frame_FIXUP(void *p, struct NewGC *gc) {
+  Letrec_Check_Frame *frame = (Letrec_Check_Frame *)p;
+  
+  gcFIXUP2(frame->def, gc);
+  gcFIXUP2(frame->next, gc);
+  gcFIXUP2(frame->ref, gc);
+  gcFIXUP2(frame->checked, gc);
+  gcFIXUP2(frame->head, gc);
+  gcFIXUP2(frame->deferred_with_rhs_ref, gc);
+  gcFIXUP2(frame->deferred_with_body_ref, gc);
+  gcFIXUP2(frame->deferred_with_no_ref, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Letrec_Check_Frame));
+}
+
+#define mark_letrec_check_frame_IS_ATOMIC 0
+#define mark_letrec_check_frame_IS_CONST_SIZE 1
+
+
+static int mark_scheme_deferred_expr_SIZE(void *p, struct NewGC *gc) {
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Deferred_Expr));
+}
+
+static int mark_scheme_deferred_expr_MARK(void *p, struct NewGC *gc) {
+  Scheme_Deferred_Expr *clos = (Scheme_Deferred_Expr *)p;
+  
+  gcMARK2(clos->expr, gc);
+  gcMARK2(clos->frame, gc);
+  gcMARK2(clos->uvars, gc);
+  gcMARK2(clos->pvars, gc);
+  gcMARK2(clos->subexpr_ls, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Deferred_Expr));
+}
+
+static int mark_scheme_deferred_expr_FIXUP(void *p, struct NewGC *gc) {
+  Scheme_Deferred_Expr *clos = (Scheme_Deferred_Expr *)p;
+  
+  gcFIXUP2(clos->expr, gc);
+  gcFIXUP2(clos->frame, gc);
+  gcFIXUP2(clos->uvars, gc);
+  gcFIXUP2(clos->pvars, gc);
+  gcFIXUP2(clos->subexpr_ls, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Deferred_Expr));
+}
+
+#define mark_scheme_deferred_expr_IS_ATOMIC 0
+#define mark_scheme_deferred_expr_IS_CONST_SIZE 1
+
+

racket/src/racket/src/mzmark_type.inc

@@ -628,6 +628,7 @@ static int comp_let_value_MARK(void *p, struct NewGC *gc) {
   gcMARK2(c->flags, gc);
   gcMARK2(c->value, gc);
   gcMARK2(c->body, gc);
+  gcMARK2(c->names, gc);
 
   return
   gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Let_Value));
@@ -639,6 +640,7 @@ static int comp_let_value_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(c->flags, gc);
   gcFIXUP2(c->value, gc);
   gcFIXUP2(c->body, gc);
+  gcFIXUP2(c->names, gc);
 
   return
   gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Let_Value));
@@ -1660,6 +1662,9 @@ static int input_port_MARK(void *p, struct NewGC *gc) {
   gcMARK2(ip->input_extras_ready, gc);
   gcMARK2(ip->unless, gc);
   gcMARK2(ip->unless_cache, gc);
+#ifdef WINDOWS_FILE_HANDLES
+  gcMARK2(ip->bufwidths, gc);
+#endif
 
   return
   gcBYTES_TO_WORDS(sizeof(Scheme_Input_Port));
@@ -1687,6 +1692,9 @@ static int input_port_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(ip->input_extras_ready, gc);
   gcFIXUP2(ip->unless, gc);
   gcFIXUP2(ip->unless_cache, gc);
+#ifdef WINDOWS_FILE_HANDLES
+  gcFIXUP2(ip->bufwidths, gc);
+#endif
 
   return
   gcBYTES_TO_WORDS(sizeof(Scheme_Input_Port));

racket/src/racket/src/mzmarksrc.c

@@ -235,6 +235,7 @@ comp_let_value {
   gcMARK2(c->flags, gc);
   gcMARK2(c->value, gc);
   gcMARK2(c->body, gc);
+  gcMARK2(c->names, gc);
 
  size:
   gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Let_Value));
@@ -1327,6 +1328,43 @@ END sfs;
 
 /**********************************************************************/
 
+START letrec_check;
+
+mark_letrec_check_frame {
+ mark:
+  Letrec_Check_Frame *frame = (Letrec_Check_Frame *)p;
+  
+  gcMARK2(frame->def, gc);
+  gcMARK2(frame->next, gc);
+  gcMARK2(frame->ref, gc);
+  gcMARK2(frame->checked, gc);
+  gcMARK2(frame->head, gc);
+  gcMARK2(frame->deferred_with_rhs_ref, gc);
+  gcMARK2(frame->deferred_with_body_ref, gc);
+  gcMARK2(frame->deferred_with_no_ref, gc);
+
+ size:
+  gcBYTES_TO_WORDS(sizeof(Letrec_Check_Frame));
+}
+
+mark_scheme_deferred_expr {
+ mark:
+  Scheme_Deferred_Expr *clos = (Scheme_Deferred_Expr *)p;
+  
+  gcMARK2(clos->expr, gc);
+  gcMARK2(clos->frame, gc);
+  gcMARK2(clos->uvars, gc);
+  gcMARK2(clos->pvars, gc);
+  gcMARK2(clos->subexpr_ls, gc);
+
+ size:
+  gcBYTES_TO_WORDS(sizeof(Scheme_Deferred_Expr));
+}
+
+END letrec_check;
+
+/**********************************************************************/
+
 START optimize;
 
 mark_optimize_info {

racket/src/racket/src/optimize.c

@@ -250,7 +250,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
         If warn_info is supplied, complain when a mismatch is detected.
         If no_id is 1, then an identifier doesn't count as omittable,
         unless the identifier is a consistent top-level; currently, this
-        is used to imply the absece of a continuation-mark impersonator. */
+        is used to imply the absence of a continuation-mark impersonator. */
 {
   Scheme_Type vtype;
 
@@ -439,6 +439,15 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
     return 0;
   }
 
+  /* check for (set! x x) */
+  if (vtype == scheme_set_bang_type) {
+    Scheme_Set_Bang *sb = (Scheme_Set_Bang *)o;
+    if (SAME_TYPE(scheme_local_type, SCHEME_TYPE(sb->var))
+        && SAME_TYPE(scheme_local_type, SCHEME_TYPE(sb->val))
+        && (SCHEME_LOCAL_POS(sb->var) == SCHEME_LOCAL_POS(sb->val)))
+      return 1;
+  }
+
   /* check for struct-type declaration: */
   {
     Scheme_Object *auto_e;
@@ -2568,6 +2577,16 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
 
   app = (Scheme_App3_Rec *)o;
 
+  if (SAME_OBJ(app->rator, scheme_check_not_undefined)
+      && SCHEME_SYMBOLP(app->rand2)) {
+    scheme_log(info->logger,
+               SCHEME_LOG_WARNING,
+               0,
+               "warning%s: use-before-definition check inserted on variable: %S",
+               scheme_optimize_context_to_string(info->context),
+               app->rand2);
+  }
+
   /* Check for (apply ... (list ...)) early: */
   le = direct_apply((Scheme_Object *)app, app->rator, app->rand2, info);
   if (le) return scheme_optimize_expr(le, info, context);

racket/src/racket/src/print.c

@@ -2028,6 +2028,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
   if (compact && (SCHEME_PROCP(obj) 
 		  || SCHEME_STRUCT_TYPEP(obj) 
 		  || SCHEME_EOFP(obj)
+                  || SAME_OBJ(scheme_undefined, obj)
 		  || SAME_TYPE(scheme_always_evt_type, SCHEME_TYPE(obj))
 		  || SAME_TYPE(scheme_never_evt_type, SCHEME_TYPE(obj))
 		  || SAME_TYPE(scheme_struct_property_type, SCHEME_TYPE(obj))

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1116
+#define EXPECTED_PRIM_COUNT 1118
 #define EXPECTED_UNSAFE_COUNT 101
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schpriv.h

@@ -18,6 +18,8 @@
 #ifndef __mzscheme_private__
 #define __mzscheme_private__
 
+// #define MZ_GC_STRESS_TESTING 1
+
 #include "scheme.h"
 #include "longdouble/longdouble.h"
 
@@ -263,6 +265,7 @@ void scheme_init_type();
 void scheme_init_custodian_extractors();
 void scheme_init_bignum();
 void scheme_init_compenv();
+void scheme_init_letrec_check();
 void scheme_init_optimize();
 void scheme_init_resolve();
 void scheme_init_sfs();
@@ -432,6 +435,7 @@ extern Scheme_Object *scheme_values_func;
 extern Scheme_Object *scheme_procedure_p_proc;
 extern Scheme_Object *scheme_procedure_arity_includes_proc;
 extern Scheme_Object *scheme_void_proc;
+extern Scheme_Object *scheme_check_not_undefined;
 extern Scheme_Object *scheme_pair_p_proc;
 extern Scheme_Object *scheme_mpair_p_proc;
 extern Scheme_Object *scheme_unsafe_cons_list_proc;
@@ -1346,6 +1350,7 @@ typedef struct Scheme_Compiled_Let_Value {
   int *flags;
   Scheme_Object *value;
   Scheme_Object *body;
+  Scheme_Object **names; /* NULL after letrec_check phase */
 } Scheme_Compiled_Let_Value;
 
 #define SCHEME_CLV_FLAGS(clv) MZ_OPT_HASH_KEY(&(clv)->iso)
@@ -2856,6 +2861,8 @@ typedef struct Scheme_Set_Bang {
 
 Scheme_Object *scheme_protect_quote(Scheme_Object *expr);
 
+Scheme_Object *scheme_letrec_check_expr(Scheme_Object *);
+
 Scheme_Object *scheme_optimize_expr(Scheme_Object *, Optimize_Info *, int context);
 Scheme_Object *scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, int context);
 

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.0.1.1"
+#define MZSCHEME_VERSION "6.0.1.2"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 0
 #define MZSCHEME_VERSION_Z 1
-#define MZSCHEME_VERSION_W 1
+#define MZSCHEME_VERSION_W 2
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

racket/src/racket/src/stypes.h

@@ -288,7 +288,9 @@ enum {
   scheme_rt_lightweight_cont,           /* 260 */
   scheme_rt_export_info,                /* 261 */
   scheme_rt_cont_jmp,                   /* 262 */
+  scheme_rt_letrec_check_frame,         /* 263 */
 #endif
+  scheme_deferred_expr_type,            /* 264 */
 
   _scheme_last_type_
 };