[-- Attachment #1: Type: text/plain, Size: 1049 bytes --]
Hi there!
Aleix and I noticed that equal? has a lot higher overhead than eqv? on chars, which means using (ice-9 match) for chars was suboptimal. This patch fixes that.
With this patch, guile now turns (equal? #\b var) into (eqv? #\b var) and (equal? any-non-fixnum-number-literal var) into (eqv? any-non-fixnum-number-literal var). This fixes the (ice-9 match) problem, and means you can dispatch to equal? in macros and guile will just do the right thing is there are any literals.
There is one regression: it is not o(n). Currently the primitve expander is run once per call, which means a (equal? #\a b c d e) becomes (and (eqv? #\a b) (eqv? b c d e)) and that second call gets run through the primitive expander once again, which checks all the arguments again. The solution I see is to manually build the conditional code, or to just extend the old code, where only the comparisons directly involving the literal is optimized: (equal? a b #\c) -> (and (equal? a b) (eqv? b #\c)).
Any feedback is welcome.
--
Linus Björnstam
[-- Attachment #2: 0001-Make-equal-to-eqv-or-eq-if-any-suitable-literals-are.patch --]
[-- Type: application/octet-stream, Size: 5637 bytes --]
From 6e5c418f508a772ca7ee55135b61af591e01e2d6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Linus=20Bj=C3=B6rnstam?= <linus.bjornstam@fastmail.se>
Date: Wed, 13 May 2020 13:03:40 +0200
Subject: [PATCH] Make equal? to eqv? or eq? if any suitable literals are found
* module/language/tree-il/primitives.scm: Rename maybe-simplify-to-eq
to maybe-simplify-equality. Instead of just folding equal and eqv? to
eq? it now folds equal? to eqv? when appropriate.
* test-suite/tests/tree-il.test (primitives/equal? and primitives/eqv? tests): Remove
re-ordering of arguments made by previous code, and add tests for
folding equal? to eqv?.
---
module/language/tree-il/primitives.scm | 56 ++++++++++++++++----------
test-suite/tests/tree-il.test | 20 ++++++---
2 files changed, 49 insertions(+), 27 deletions(-)
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 300080d45..db2204fe7 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -601,31 +601,45 @@
(char=? . =)))
;; Appropriate for use with either 'eqv?' or 'equal?'.
-(define (maybe-simplify-to-eq prim)
+(define (maybe-simplify-equality prim)
+ ;; Checks whether v can be compared using eq?
+ (define (eq-able? v)
+ (or (memq v '(#f #t () #nil))
+ (symbol? v)
+ (and (integer? v)
+ (exact? v)
+ (<= v most-positive-fixnum)
+ (>= v most-negative-fixnum))))
+ ;; Check whether v is comparable using eqv?
+ (define (eqv-able? v)
+ (or (char? v) (number? v)))
+ ;; Return the most suitable "prim" for comparing the elements of
+ ;; lst. If any element is eq-able? just return eq? if any element is
+ ;; eqv-able? we propagate eqv? as the prim to be used.
+ (define (maybe-change-prim prim lst)
+ (if (null? lst)
+ prim
+ (if (const? (car lst))
+ (cond
+ ((eq-able? (const-exp (car lst)))
+ 'eq?)
+ ((eqv-able? (const-exp (car lst)))
+ (maybe-change-prim 'eqv? (cdr lst)))
+ (else (maybe-change-prim prim (cdr lst))))
+ (maybe-change-prim prim (cdr lst)))))
(case-lambda
((src) (make-const src #t))
((src a) (make-const src #t))
- ((src a b)
- ;; Simplify cases where either A or B is constant.
- (define (maybe-simplify a b)
- (and (const? a)
- (let ((v (const-exp a)))
- (and (or (memq v '(#f #t () #nil))
- (symbol? v)
- (and (integer? v)
- (exact? v)
- (<= v most-positive-fixnum)
- (>= v most-negative-fixnum)))
- (make-primcall src 'eq? (list a b))))))
- (or (maybe-simplify a b) (maybe-simplify b a)))
((src a b . rest)
- (make-conditional src (make-primcall src prim (list a b))
- (make-primcall src prim (cons b rest))
- (make-const src #f)))
- (else #f)))
-
-(define-primitive-expander! 'eqv? (maybe-simplify-to-eq 'eqv?))
-(define-primitive-expander! 'equal? (maybe-simplify-to-eq 'equal?))
+ (define prim (maybe-change-prim prim (cons a (cons b rest))))
+ (if (null? rest)
+ (make-primcall src prim (list a b))
+ (make-conditional src (make-primcall src prim (list a b))
+ (make-primcall src prim (cons b rest))
+ (make-const src #f))))))
+
+(define-primitive-expander! 'eqv? (maybe-simplify-equality 'eqv?))
+(define-primitive-expander! 'equal? (maybe-simplify-equality 'equal?))
(define (expand-chained-comparisons prim)
(case-lambda
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index e650a2f00..60b79dfc4 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -59,12 +59,12 @@
(with-test-prefix "eqv?"
(pass-if-primitives-resolved
- (primcall eqv? (toplevel x) (const #f))
+ (primcall eqv? (const #f) (toplevel x))
(primcall eq? (const #f) (toplevel x)))
(pass-if-primitives-resolved
(primcall eqv? (toplevel x) (const ()))
- (primcall eq? (const ()) (toplevel x)))
+ (primcall eq? (toplevel x) (const ())))
(pass-if-primitives-resolved
(primcall eqv? (const #t) (lexical x y))
@@ -90,11 +90,11 @@
(pass-if-primitives-resolved
(primcall equal? (toplevel x) (const #f))
- (primcall eq? (const #f) (toplevel x)))
+ (primcall eq? (toplevel x) (const #f)))
(pass-if-primitives-resolved
(primcall equal? (toplevel x) (const ()))
- (primcall eq? (const ()) (toplevel x)))
+ (primcall eq? (toplevel x) (const ())))
(pass-if-primitives-resolved
(primcall equal? (const #t) (lexical x y))
@@ -110,11 +110,19 @@
(pass-if-primitives-resolved
(primcall equal? (const 42.0) (toplevel x))
- (primcall equal? (const 42.0) (toplevel x)))
+ (primcall eqv? (const 42.0) (toplevel x)))
(pass-if-primitives-resolved
(primcall equal? (const #nil) (toplevel x))
- (primcall eq? (const #nil) (toplevel x))))
+ (primcall eq? (const #nil) (toplevel x)))
+
+ (pass-if-primitives-resolved
+ (primcall equal? (const #\a) (toplevel x))
+ (primcall eqv? (const #\a) (toplevel x)))
+
+ (pass-if-primitives-resolved
+ (primcall equal? (const 1/10) (toplevel x))
+ (primcall eqv? (const 1/10) (toplevel x))))
(with-test-prefix "error"
(pass-if-primitives-resolved
--
2.26.0