suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix fl comparison with more than inline-args-limit arguments

Browse Source 
original commit: 0efbfb50b372009d0974edc01e6194179d7300ef
This commit is contained in:
Matthew Flatt 2020-06-01 06:59:03 -06:00
parent 43e2bc0327
commit f3209ca63c
2 changed files with 22 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
mats/fl.ms
View File

@ -1105,4 +1105,16 @@
(bytevector-ieee-double-native-set! bv 0 (fl+ v 0.1))
(fl* v 0.99)))))
(begin
(define many-compare
(lambda (a b c d e f g h i j k)
(fl<= a b c d e f g h i j k)))
(many-compare 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 11.0))
(begin
(define many-add
(lambda (a b c d e f g h i j k)
(fl+ a b c d e f g h i j k)))
(fl= 66.0 (many-add 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 11.0)))
)

16
s/cpnanopass.ss
View File

@ -7667,14 +7667,18 @@
,(build-fl= e1)
,(build-libcall #t src sexpr op e1 e1))))]
[(e1 e2) (build-bind-and-check src sexpr op e1 e2 (builder args ...))]
[(e1 e2 . e*) (build-check-fp-arguments (cons* e1 e2 e*)
(lambda (e1 e2) (build-libcall #t src sexpr op e1 e2))
(lambda (e1 e2 . e*) (reducer src sexpr moi e1 e2 e*)))])
[(e1 e2 . e*) (and
(fx<= (length e*) (fx- inline-args-limit 2))
(build-check-fp-arguments (cons* e1 e2 e*)
(lambda (e1 e2) (build-libcall #t src sexpr op e1 e2))
(lambda (e1 e2 . e*) (reducer src sexpr moi e1 e2 e*))))])
(define-inline 2 r6rs:op
[(e1 e2) (build-bind-and-check src sexpr r6rs:op e1 e2 (builder args ...))]
[(e1 e2 . e*) (build-check-fp-arguments (cons* e1 e2 e*)
(lambda (e1 e2) (build-libcall #t src sexpr r6rs:op e1 e2))
(lambda (e1 e2 . e*) (reducer src sexpr moi e1 e2 e*)))])))])))
[(e1 e2 . e*) (and
(fx<= (length e*) (fx- inline-args-limit 2))
(build-check-fp-arguments (cons* e1 e2 e*)
(lambda (e1 e2) (build-libcall #t src sexpr r6rs:op e1 e2))
(lambda (e1 e2 . e*) (reducer src sexpr moi e1 e2 e*))))])))])))
(define-fl-cmp-inline fl= fl=? build-fl= #f #f)
(define-fl-cmp-inline fl< fl<? build-fl< #t #f)