From 96875b7477c50b6c62d442bc8a7d55b80eb209e2 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 27 Mar 2018 21:33:56 -0700 Subject: [PATCH] Add some simple optimizations. --- src/runtime/syntax-constructor.scm | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) 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 -- 2.25.1