Properly fix problem with LETREC/definition interaction. This

requires an extra environment frame in the syntax expander, to model
the frame that is potentially inserted in the output.  And we must
continue to use the "auxiliary" variable mechanism, since the compiler
and several other things depend on it in order to recognize
LETREC-like structures.

diff --git a/v7/src/runtime/mit-syntax.scm b/v7/src/runtime/mit-syntax.scm
index b90928163d40db723f987b6e8b67965ac0708a6b..650108537d3f1ea28c6d6c631d8e376859695e74 100644 (file)
--- a/v7/src/runtime/mit-syntax.scm
+++ b/v7/src/runtime/mit-syntax.scm
@@ -1,25 +1,26 @@
-;;; -*-Scheme-*-
-;;;
-;;; $Id: mit-syntax.scm,v 14.10 2002/12/13 18:55:07 cph Exp $
-;;;
-;;; Copyright (c) 1989-1991, 2001, 2002 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: mit-syntax.scm,v 14.11 2003/02/12 19:39:52 cph Exp $
+
+Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
 
 ;;;; MIT Scheme Syntax
 
@@ -396,10 +397,13 @@
         (classifier->keyword
          (lambda (form environment definition-environment history)
            definition-environment
-           (let ((body-environment
-                  (make-internal-syntactic-environment environment)))
+           (let* ((binding-environment
+                   (make-internal-syntactic-environment environment))
+                  (body-environment
+                   (make-internal-syntactic-environment binding-environment)))
              (classify/let-like form
                                 environment
+                                binding-environment
                                 body-environment
                                 body-environment
                                 history
@@ -434,15 +438,19 @@
   (lambda (form environment definition-environment history)
     definition-environment
     (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form history)
-    (let ((body-environment (make-internal-syntactic-environment environment)))
+    (let* ((binding-environment
+           (make-internal-syntactic-environment environment))
+          (body-environment
+           (make-internal-syntactic-environment binding-environment)))
       (for-each (let ((item (make-reserved-name-item history)))
                  (lambda (binding)
-                   (syntactic-environment/define body-environment
+                   (syntactic-environment/define binding-environment
                                                  (car binding)
                                                  item)))
                (cadr form))
       (classify/let-like form
-                        body-environment
+                        binding-environment
+                        binding-environment
                         body-environment
                         body-environment
                         history
@@ -459,15 +467,19 @@
 \f
 (define-classifier 'LET-SYNTAX system-global-environment
   (lambda (form environment definition-environment history)
-    definition-environment
     (syntax-check '(KEYWORD (* (IDENTIFIER EXPRESSION)) + FORM) form history)
-    (classify/let-like form
-                      environment
-                      definition-environment
-                      (make-internal-syntactic-environment environment)
-                      history
-                      syntactic-binding-theory
-                      output/let)))
+    (let* ((binding-environment
+           (make-internal-syntactic-environment environment))
+          (body-environment
+           (make-internal-syntactic-environment binding-environment)))
+      (classify/let-like form
+                        environment
+                        binding-environment
+                        body-environment
+                        definition-environment
+                        history
+                        syntactic-binding-theory
+                        output/let))))
 
 (define-er-macro-transformer 'LET*-SYNTAX system-global-environment
   (lambda (form rename compare)
@@ -476,38 +488,47 @@
 
 (define-classifier 'LETREC-SYNTAX system-global-environment
   (lambda (form environment definition-environment history)
-    definition-environment
     (syntax-check '(KEYWORD (* (IDENTIFIER EXPRESSION)) + FORM) form history)
-    (let ((body-environment (make-internal-syntactic-environment environment)))
+    (let* ((binding-environment
+           (make-internal-syntactic-environment environment))
+          (body-environment
+           (make-internal-syntactic-environment binding-environment)))
       (for-each (let ((item (make-reserved-name-item history)))
                  (lambda (binding)
-                   (syntactic-environment/define body-environment
+                   (syntactic-environment/define binding-environment
                                                  (car binding)
                                                  item)))
                (cadr form))
       (classify/let-like form
+                        binding-environment
+                        binding-environment
                         body-environment
                         definition-environment
-                        body-environment
                         history
                         syntactic-binding-theory
                         output/letrec))))
 \f
-(define (classify/let-like form environment definition-environment
-                          body-environment history binding-theory output/let)
+(define (classify/let-like form
+                          value-environment
+                          binding-environment
+                          body-environment
+                          definition-environment
+                          history
+                          binding-theory
+                          output/let)
   ;; Classify right-hand sides first, in order to catch references to
   ;; reserved names.  Then bind names prior to classifying body.
   (let* ((bindings
          (delete-matching-items!
              (map (lambda (binding item)
-                    (binding-theory body-environment
+                    (binding-theory binding-environment
                                     (car binding)
                                     item
                                     history))
                   (cadr form)
                   (select-map (lambda (binding selector)
                                 (classify/subexpression (cadr binding)
-                                                        environment
+                                                        value-environment
                                                         history
                                                         (selector/add-cadr
                                                          selector)))

diff --git a/v7/src/runtime/syntax-output.scm b/v7/src/runtime/syntax-output.scm
index 4ae043c9a09e9fcad885203ee691c86005680f44..5ffb68caff1f37709ee3cb89bd657a92a3c0e3a1 100644 (file)
--- a/v7/src/runtime/syntax-output.scm
+++ b/v7/src/runtime/syntax-output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syntax-output.scm,v 14.7 2003/02/09 01:58:09 cph Exp $
+$Id: syntax-output.scm,v 14.8 2003/02/12 19:40:38 cph Exp $
 
 Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology
 
@@ -68,17 +68,9 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
   (output/named-lambda lambda-tag:unnamed lambda-list body))
 
 (define (output/named-lambda name lambda-list body)
-  (output/lambda-internal name lambda-list '() body))
-
-(define (output/lambda-internal name lambda-list declarations body)
   (call-with-values (lambda () (parse-mit-lambda-list lambda-list))
     (lambda (required optional rest)
-      (make-lambda* name required optional rest
-                   (let ((declarations (apply append declarations)))
-                     (if (pair? declarations)
-                         (make-sequence (make-block-declaration declarations)
-                                        body)
-                         body))))))
+      (make-lambda* name required optional rest body))))
 
 (define (output/delay expression)
   (make-delay expression))
@@ -96,19 +88,14 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
   (output/combination (output/named-lambda lambda-tag:let names body) values))
 
 (define (output/letrec names values body)
-  (output/let names
-             (map (lambda (name) name (output/unassigned)) names)
+  (output/let '() '()
              (make-sequence
-              (map* (list (scan-defines body
-                            (lambda (names declarations body)
-                              (if (or (pair? names)
-                                      (pair? declarations))
-                                  (output/let '() '()
-                                              (make-open-block names
-                                                               declarations
-                                                               body))
-                                  body))))
-                    output/assignment names values))))
+              (append! (map make-definition names values)
+                       (list
+                        (let ((body (scan-defines body make-open-block)))
+                          (if (open-block? body)
+                              (output/let '() '() body)
+                              body)))))))
 
 (define (output/body declarations body)
   (scan-defines (let ((declarations (apply append declarations)))