From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 10 Feb 2019 22:09:48 +0000 (+0000)
Subject: Use internal definitions for LETREC* and unary LETREC.
X-Git-Tag: mit-scheme-pucked-10.1.10~6^2~7^2~19
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8e57468344961c4b7481b98d62d85de76f7aac7d;p=mit-scheme.git

Use internal definitions for LETREC* and unary LETREC.

The compiler will recognize these better than LET and SET!; teaching
it to recognize LET and SET! is more trouble than I want to deal with
at the moment.  Internal definitions at the scode level have LETREC*
semantics anyway, and with only a single binding, LETREC and LETREC*
coincide.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 54f5d0a04..ea33c9048 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -156,21 +156,29 @@ USA.
 	 `(,(let-bindings-pattern)
 	   (+ any))
        (lambda (bindings body-forms)
-	 (let* ((ids (map car bindings))
-		(vals (map cadr bindings))
-		(temps (map new-identifier ids)))
-	   (scons-let (map (lambda (id)
-			     (list id (unassigned-expression)))
-			   ids)
-	     (cond ((not (pair? ids))
-		    (default-object))
-		   ((not (pair? (cdr ids)))
-		    (scons-set! (car ids) (car vals)))
-		   (else
-		    (apply scons-let
-			   (map list temps vals)
-			   (map scons-set! ids temps))))
-	     (scons-call (apply scons-lambda '() body-forms)))))))))
+	 (let ((ids (map car bindings))
+	       (vals (map cadr bindings))
+	       ;; Create a distinct nested scope for definitions in the
+	       ;; body.
+	       (body (scons-call (apply scons-lambda '() body-forms))))
+	   (cond ((not (pair? ids))
+		  body)
+		 ((not (pair? (cdr ids)))
+		  ;; Internal definitions have LETREC* semantics, but
+		  ;; for a single binding, LETREC* is equivalent to
+		  ;; LETREC.
+		  (scons-let '()
+		    (scons-define (car ids) (car vals))
+		    body))
+		 (else
+		  (let ((temps (map new-identifier ids)))
+		    (scons-let (map (lambda (id)
+				      (list id (unassigned-expression)))
+				    ids)
+		      (apply scons-let
+			     (map list temps vals)
+			     (map scons-set! ids temps))
+		      body))))))))))
 
 (define $letrec*
   (spar-transformer->runtime
@@ -181,10 +189,11 @@ USA.
        (lambda (bindings body-forms)
 	 (let ((ids (map car bindings))
 	       (vals (map cadr bindings)))
-	   (scons-let (map (lambda (id)
-			     (list id (unassigned-expression)))
-			   ids)
-	     (apply scons-begin (map scons-set! ids vals))
+	   ;; Internal definitions in scode have LETREC* semantics.
+	   (scons-let '()
+	     (apply scons-begin (map scons-define ids vals))
+	     ;; Create a distinct nested scope for definitions in the
+	     ;; body.
 	     (scons-call (apply scons-lambda '() body-forms)))))))))
 
 (define $let-values