mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

Merge commit '58147d6780'

Browse source
This commit is contained in:
Andy Wingo 2014-02-07 15:07:14 +01:00
commit 04f59ec2e7
1 changed files with 22 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/language/tree-il/primitives.scm
View file

@ -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