diff options
author | Andy Wingo <wingo@pobox.com> | 2014-02-07 15:07:14 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-02-07 15:12:35 +0100 |
commit | 04f59ec2e7ab73caacbbfa2c5905fe4f240c47c5 (patch) | |
tree | 4367241d85f4b347d2f873bb8bc7d4503cf177fa | |
parent | 08224c56fa735612fa6b33533c927c9c3eaf8d3d (diff) | |
parent | 58147d67806e1f54c447d7eabac35b1a5086c3a6 (diff) | |
download | guile-04f59ec2e7ab73caacbbfa2c5905fe4f240c47c5.tar.gz |
Merge commit '58147d67806e1f54c447d7eabac35b1a5086c3a6'
-rw-r--r-- | module/language/tree-il/primitives.scm | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 71437b2b6..2ea56427e 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -525,6 +525,28 @@ (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) + (let* ((b-sym (gensym "b")) + (b* (make-lexical-ref src 'b b-sym))) + (make-let src + '(b) + (list b-sym) + (list b) + (make-conditional src + (make-primcall src prim-name (list a b*)) + (make-primcall 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 prim) (case-lambda |