bug#17147: [PATCH] Add versions of and/or avoiding O(n^2) argument matching

[David Kastrup]

Fixes <http://bugs.gnu.org/17147>

* module/ice-9/boot-9.scm (and, or): Add syntax rules that only do one
  pattern matching operation per and/or rather than per argument.

Signed-off-by: David Kastrup <address@hidden>
---
 module/ice-9/boot-9.scm | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7f38c4b..d2f34d9 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -426,6 +426,8 @@ file with the given name already exists, the effect is 
unspecified."
 ;; The binding for `macroexpand' has now been overridden, making psyntax the
 ;; expander now.
 
+;; quasisyntax requires simple definitions of and/or for bootstrapping.
+
 (define-syntax and
   (syntax-rules ()
     ((_) #t)
@@ -440,6 +442,30 @@ file with the given name already exists, the effect is 
unspecified."
 
 (include-from-path "ice-9/quasisyntax")
 
+;; Don't use syntactically recursive definitions of and/or for speed
+;; reasons as they need to match the whole argument list for each
+;; iteration.
+
+(define-syntax and
+  (lambda (expr)
+    (syntax-case expr ()
+      ((_) #'#t)
+      ((_ x y ...)
+       (let loop ((x #'x) (y #'(y ...)))
+         (if (null? y)
+             x
+             #`(if #,x #,(loop (car y) (cdr y)) #f)))))))
+
+(define-syntax or
+  (lambda (expr)
+    (syntax-case expr ()
+      ((_) #'#f)
+      ((_ x y ...)
+       (let loop ((x #'x) (y #'(y ...)))
+        (if (null? y)
+            x
+            #`(let ((t #,x)) (if t t #,(loop (car y) (cdr y))))))))))
+
 (define-syntax-rule (when test stmt stmt* ...)
   (if test (begin stmt stmt* ...)))
 
-- 
1.9.1