Make LETREC and LETREC* be ordinary macros. Avoid adding integrate declarations...

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index f8860fb5fef5f5cf9515d83e32e1de251e53c717..245e5869f88305ef4fdcc8e3a9e9d6114fd2b696 100644 (file)
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -253,6 +253,45 @@ USA.
              `(,let-keyword ,bindings ,@body)))
        `(,let-keyword ,bindings ,@body))))
 
+(define-syntax :letrec
+  (er-macro-transformer
+   (lambda (form rename compare)
+     (declare (ignore compare))
+     (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form)
+     (let ((bindings (cadr form))
+          (r-lambda (rename 'LAMBDA))
+          (r-named-lambda (rename 'NAMED-LAMBDA))
+          (r-set!   (rename 'SET!)))
+       (let ((temps (map (lambda (binding)
+                          (make-synthetic-identifier
+                           (identifier->symbol (car binding)))) bindings)))
+        `((,r-named-lambda (,lambda-tag:unnamed ,@(map car bindings))
+                           ((,r-lambda ,temps
+                                       ,@(map (lambda (binding temp)
+                                                `(,r-set! ,(car binding) ,temp)) bindings temps))
+                            ,@(map cadr bindings))
+                           ((,r-lambda () ,@(cddr form))))
+          ,@(map (lambda (binding)
+                   (declare (ignore binding))
+                   (unassigned-expression)) bindings)))))))
+
+(define-syntax :letrec*
+  (er-macro-transformer
+   (lambda (form rename compare)
+     (declare (ignore compare))
+     (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form)
+     (let ((bindings (cadr form))
+          (r-lambda (rename 'LAMBDA))
+          (r-named-lambda (rename 'NAMED-LAMBDA))
+          (r-set!   (rename 'SET!)))
+       `((,r-named-lambda (,lambda-tag:unnamed ,@(map car bindings))
+                         ,@(map (lambda (binding)
+                                  `(,r-set! ,@binding)) bindings)
+                         ((,r-lambda () ,@(cddr form))))
+        ,@(map (lambda (binding)
+                 (declare (ignore binding))
+                 (unassigned-expression)) bindings))))))
+\f
 (define-syntax :and
   (er-macro-transformer
    (lambda (form rename compare)
@@ -555,7 +594,10 @@ USA.
              `(,r-begin
                (,r-declare (INTEGRATE-OPERATOR ,(caadr form)))
                (,r-define ,(cadr form)
-                          (,r-declare (INTEGRATE ,@(cdadr form)))
+                          ,@(let ((arguments (cdadr form)))
+                              (if (null? arguments)
+                                  '()
+                                  `((,r-declare (INTEGRATE ,@arguments)))))
                           ,@(cddr form))))
             (else
              (ill-formed-syntax form)))))))

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index a2d3a91837eb8d2e4b8c205998d50345d57ca413..17522c64bf4e715f77a4d01533199168e240e8d7 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -193,47 +193,6 @@ USA.
                          variable-binding-theory
                          output/let)))))
 
-(define (classifier:letrec form environment definition-environment)
-  definition-environment
-  (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form)
-  (let* ((binding-environment
-         (make-internal-syntactic-environment environment))
-        (value-environment
-         (make-internal-syntactic-environment binding-environment))
-        (body-environment
-         (make-internal-syntactic-environment binding-environment)))
-    (for-each (let ((item (make-reserved-name-item)))
-               (lambda (binding)
-                 (syntactic-environment/define binding-environment
-                                               (car binding)
-                                               item)))
-             (cadr form))
-    (classify/let-like form
-                      value-environment
-                      binding-environment
-                      body-environment
-                      variable-binding-theory
-                      output/letrec)))
-
-(define (classifier:letrec* form environment definition-environment)
-  definition-environment
-  (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form)
-  (let* ((binding-environment
-         (make-internal-syntactic-environment environment))
-        (body-environment
-         (make-internal-syntactic-environment binding-environment)))
-    (for-each (let ((item (make-reserved-name-item)))
-               (lambda (binding)
-                 (syntactic-environment/define binding-environment
-                                               (car binding)
-                                               item)))
-             (cadr form))
-    (classify/let-like form
-                      binding-environment
-                      binding-environment
-                      body-environment
-                      variable-binding-theory
-                      output/letrec*)))
 \f
 (define (classifier:let-syntax form environment definition-environment)
   definition-environment

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a52f9aed9a8a89856300c265b06fbd405a88ba7f..23ee71521f7c61407f884d26dfd4eba8d9cb51c1 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4696,7 +4696,6 @@ USA.
          output/lambda
          output/let
          output/letrec
-         output/letrec*
          output/local-declare
          output/named-lambda
          output/post-process-expression
@@ -4739,8 +4738,6 @@ USA.
          classifier:define-syntax
          classifier:er-macro-transformer
          classifier:let-syntax
-         classifier:letrec
-         classifier:letrec*
          classifier:letrec-syntax
          classifier:local-declare
          classifier:non-hygienic-macro-transformer
@@ -4783,6 +4780,8 @@ USA.
          (let :let)
          (let* :let*)
          (let*-syntax :let*-syntax)
+         (letrec :letrec)
+         (letrec* :letrec*)
          (quasiquote :quasiquote)
          (receive :receive)
          supported-srfi-features)

diff --git a/src/runtime/syntax-definitions.scm b/src/runtime/syntax-definitions.scm
index c69e1e2d3e7155cbf33857477dcc09b271be6c27..0a1e21b5d9facf8e5ffc5a8bfec8ca738fba54de 100644 (file)
--- a/src/runtime/syntax-definitions.scm
+++ b/src/runtime/syntax-definitions.scm
@@ -45,8 +45,6 @@ USA.
   (define-classifier 'DEFINE-SYNTAX classifier:define-syntax)
   (define-classifier 'ER-MACRO-TRANSFORMER classifier:er-macro-transformer)
   (define-classifier 'LET-SYNTAX classifier:let-syntax)
-  (define-classifier 'LETREC classifier:letrec)
-  (define-classifier 'LETREC* classifier:letrec*)
   (define-classifier 'LETREC-SYNTAX classifier:letrec-syntax)
   (define-classifier 'LOCAL-DECLARE classifier:local-declare)
   (define-classifier 'NON-HYGIENIC-MACRO-TRANSFORMER

diff --git a/src/runtime/syntax-output.scm b/src/runtime/syntax-output.scm
index 7cfd678d8453d91ff4793531c61bace545a0e384..272891d93b3ea3acd4fa216641326ea251fa9f0b 100644 (file)
--- a/src/runtime/syntax-output.scm
+++ b/src/runtime/syntax-output.scm
@@ -108,17 +108,6 @@ USA.
                   (output/let '() '() body)
                   body))))))))
 
-(define (output/letrec* names values body)
-  (output/let
-   names (map (lambda (name) name (output/unassigned)) names)
-   (make-sequence
-    (append! (map make-assignment 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)))
                  (if (pair? declarations)