Primitive expand numerical comparisons with more than 2 arguments.
authorMark H Weaver <mhw@netris.org>
Tue, 28 Jan 2014 22:44:22 +0000 (17:44 -0500)
committerMark H Weaver <mhw@netris.org>
Tue, 28 Jan 2014 22:44:22 +0000 (17:44 -0500)
* 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

index f140eec..e9fd0e9 100644 (file)
 (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