From 4dc4b86e858d391d20d0ea2551614a89fa3bd4d1 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 28 Jan 2014 17:44:22 -0500 Subject: [PATCH 1/2] Primitive expand numerical comparisons with more than 2 arguments. * module/language/tree-il/primitives.scm (chained-comparison-expander): New procedure. (*primitive-expand-table*): Add primitive expanders for '<', '>', '<=', '>=', and '='. --- module/language/tree-il/primitives.scm | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index f140eeca2..e9fd0e968 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -491,6 +491,26 @@ (define-primitive-expander f64vector-set! (vec i x) (bytevector-ieee-double-native-set! vec (* i 8) x)) +(define (chained-comparison-expander prim-name) + (case-lambda + ((src) (make-const src #t)) + ((src a) #f) + ((src a b) #f) + ((src a b . rest) + (make-conditional src + (make-application src + (make-primitive-ref src prim-name) + (list a b)) + (make-application src + (make-primitive-ref src prim-name) + (cons b rest)) + (make-const src #f))))) + +(for-each (lambda (prim-name) + (hashq-set! *primitive-expand-table* prim-name + (chained-comparison-expander prim-name))) + '(< > <= >= =)) + ;; Appropriate for use with either 'eqv?' or 'equal?'. (define maybe-simplify-to-eq (case-lambda From e6c1c5f6cb16913eadeb8758cd817c5a58d146b8 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 31 Jan 2014 04:01:12 -0500 Subject: [PATCH 2/2] Revert "Primitive expand numerical comparisons with more than 2 arguments." This reverts commit 4dc4b86e858d391d20d0ea2551614a89fa3bd4d1. --- module/language/tree-il/primitives.scm | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index e9fd0e968..f140eeca2 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -491,26 +491,6 @@ (define-primitive-expander f64vector-set! (vec i x) (bytevector-ieee-double-native-set! vec (* i 8) x)) -(define (chained-comparison-expander prim-name) - (case-lambda - ((src) (make-const src #t)) - ((src a) #f) - ((src a b) #f) - ((src a b . rest) - (make-conditional src - (make-application src - (make-primitive-ref src prim-name) - (list a b)) - (make-application src - (make-primitive-ref src prim-name) - (cons b rest)) - (make-const src #f))))) - -(for-each (lambda (prim-name) - (hashq-set! *primitive-expand-table* prim-name - (chained-comparison-expander prim-name))) - '(< > <= >= =)) - ;; Appropriate for use with either 'eqv?' or 'equal?'. (define maybe-simplify-to-eq (case-lambda