Merge commit '58147d67806e1f54c447d7eabac35b1a5086c3a6'
authorAndy Wingo <wingo@pobox.com>
Fri, 7 Feb 2014 14:07:14 +0000 (15:07 +0100)
committerAndy Wingo <wingo@pobox.com>
Fri, 7 Feb 2014 14:12:35 +0000 (15:12 +0100)
1  2 
module/language/tree-il/primitives.scm

  (define-primitive-expander f64vector-set! (vec i x)
    (bytevector-ieee-double-native-set! vec (* i 8) x))
  
 -     (let* ((prim (make-primitive-ref src prim-name))
 -            (b-sym (gensym "b"))
+ (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-application src prim (list a b*))
 -                                   (make-application src prim (cons 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
 +(define (maybe-simplify-to-eq prim)
    (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)