GNU bug report logs - #17147
Performance regression by 3000000% for evaluating "and" form

Previous Next

Full log

View this message in rfc822 format

From: David Kastrup <dak <at> gnu.org>
To: 17147 <at> debbugs.gnu.org
Cc: David Kastrup <dak <at> gnu.org>
Subject: bug#17147: [PATCH] Add versions of and/or avoiding O(n^2) argument matching
Date: Wed,  4 Jun 2014 16:18:29 +0200

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 <dak <at> gnu.org>
---
 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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.