From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 10 Feb 2019 22:37:18 +0000 (+0000)
Subject: Convert multi-LETREC to internal definitions in lambda-list.scm.
X-Git-Tag: mit-scheme-pucked-10.1.10~6^2~7^2~14
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=05dbe169b6228cec868e567a3b0a82eb9e4c77e0;p=mit-scheme.git

Convert multi-LETREC to internal definitions in lambda-list.scm.
---

diff --git a/src/runtime/lambda-list.scm b/src/runtime/lambda-list.scm
index 190427e2f..1cb3b5320 100644
--- a/src/runtime/lambda-list.scm
+++ b/src/runtime/lambda-list.scm
@@ -90,56 +90,51 @@ USA.
 	   (error:not-a r4rs-lambda-list? bvl)))))
 
 (define (mit-lambda-list? object)
-  (letrec
-      ((parse-required
-	(lambda (object seen)
-	  (or (null? object)
-	      (if (identifier? object)
-		  (not (memq object seen))
-		  (and (pair? object)
-		       (cond ((eq? (car object) lambda-tag:optional)
-			      (and (pair? (cdr object))
-				   (parse-parameter (cadr object) seen
-				     (lambda (seen)
-				       (parse-optional (cddr object) seen)))))
-			     ((eq? (car object) lambda-tag:rest)
-			      (parse-rest (cdr object) seen))
-			     (else
-			      (parse-parameter (car object) seen
-				(lambda (seen)
-				  (parse-required (cdr object) seen))))))))))
-       (parse-optional
-	(lambda (object seen)
-	  (or (null? object)
-	      (if (identifier? object)
-		  (not (memq object seen))
-		  (and (pair? object)
-		       (cond ((eq? (car object) lambda-tag:optional)
-			      #f)
-			     ((eq? (car object) lambda-tag:rest)
-			      (parse-rest (cdr object) seen))
-			     (else
-			      (parse-parameter (car object) seen
-				(lambda (seen)
-				  (parse-optional (cdr object) seen))))))))))
-       (parse-rest
-	(lambda (object seen)
-	  (and (pair? object)
-	       (parse-parameter (car object) seen
-		 (lambda (seen)
-		   seen
-		   (null? (cdr object)))))))
-       (parse-parameter
-	(lambda (object seen k)
-	  (if (identifier? object)
-	      (and (not (memq object seen))
-		   (k (cons object seen)))
-	      (and (pair? object)
-		   (identifier? (car object))
-		   (list? (cdr object))
-		   (not (memq (car object) seen))
-		   (k (cons (car object) seen)))))))
-    (parse-required object '())))
+  (define (parse-required object seen)
+    (or (null? object)
+	(if (identifier? object)
+	    (not (memq object seen))
+	    (and (pair? object)
+		 (cond ((eq? (car object) lambda-tag:optional)
+			(and (pair? (cdr object))
+			     (parse-parameter (cadr object) seen
+			       (lambda (seen)
+				 (parse-optional (cddr object) seen)))))
+		       ((eq? (car object) lambda-tag:rest)
+			(parse-rest (cdr object) seen))
+		       (else
+			(parse-parameter (car object) seen
+			  (lambda (seen)
+			    (parse-required (cdr object) seen)))))))))
+  (define (parse-optional object seen)
+    (or (null? object)
+	(if (identifier? object)
+	    (not (memq object seen))
+	    (and (pair? object)
+		 (cond ((eq? (car object) lambda-tag:optional)
+			#f)
+		       ((eq? (car object) lambda-tag:rest)
+			(parse-rest (cdr object) seen))
+		       (else
+			(parse-parameter (car object) seen
+			  (lambda (seen)
+			    (parse-optional (cdr object) seen)))))))))
+  (define (parse-rest object seen)
+    (and (pair? object)
+	 (parse-parameter (car object) seen
+	   (lambda (seen)
+	     seen
+	     (null? (cdr object))))))
+  (define (parse-parameter object seen k)
+    (if (identifier? object)
+	(and (not (memq object seen))
+	     (k (cons object seen)))
+	(and (pair? object)
+	     (identifier? (car object))
+	     (list? (cdr object))
+	     (not (memq (car object) seen))
+	     (k (cons (car object) seen)))))
+  (parse-required object '()))
 
 (define lambda-tag:optional (object-new-type (ucode-type constant) 3))
 (define lambda-tag:rest (object-new-type (ucode-type constant) 4))