From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 28 Mar 2018 04:33:56 +0000 (-0700)
Subject: Add some simple optimizations.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~169
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=96875b7477c50b6c62d442bc8a7d55b80eb209e2;p=mit-scheme.git

Add some simple optimizations.
---

diff --git a/src/runtime/syntax-constructor.scm b/src/runtime/syntax-constructor.scm
index 7b59f34c3..76d82c796 100644
--- a/src/runtime/syntax-constructor.scm
+++ b/src/runtime/syntax-constructor.scm
@@ -58,14 +58,19 @@ USA.
 (define (scons-and . exprs)
   (make-open-expr
    (lambda (close)
-     (cons (close 'and)
-	   (close-parts close exprs)))))
+     (let ((closed (close-parts close (delq #t exprs))))
+       (case (length closed)
+	 ((0) #t)
+	 ((1) (car closed))
+	 (else (cons (close 'and) closed)))))))
 
 (define (scons-begin . exprs)
   (make-open-expr
    (lambda (close)
-     (cons (close 'begin)
-	   (close-parts close (remove default-object? exprs))))))
+     (let ((closed (close-parts close (remove default-object? exprs))))
+       (case (length closed)
+	 ((1) (car closed))
+	 (else (cons (close 'begin) closed)))))))
 
 (define (scons-call operator . operands)
   (make-open-expr
@@ -117,8 +122,11 @@ USA.
 (define (scons-or . exprs)
   (make-open-expr
    (lambda (close)
-     (cons (close 'or)
-	   (close-parts close exprs)))))
+     (let ((closed (close-parts close (delq #f exprs))))
+       (case (length closed)
+	 ((0) #f)
+	 ((1) (car closed))
+	 (else (cons (close 'or) closed)))))))
 
 (define (scons-quote datum)
   (make-open-expr