Skip to content

Commit

Permalink
0.6.12.61:
Browse files Browse the repository at this point in the history
	copied transforms for TRUNCATE, FLOOR, and CEILING from
		CMU CL 18c. (Like various other efficiency fixes,
		they're in contrib/compiler-extras.lisp instead
		of the main system. My plan is to merge all the
		contrib/*-extra.lisp stuff into the main system
		in version 0.7.x.)
  • Loading branch information
William Harold Newman committed Aug 1, 2001
1 parent 853b48c commit b1a5083
Show file tree
Hide file tree
Showing 2 changed files with 37 additions and 1 deletion.
36 changes: 36 additions & 0 deletions contrib/compiler-extras.lisp
Expand Up @@ -424,3 +424,39 @@
(check-inlineability-of-find-position-if sequence from-end)
'(%find-position-vector-macro item sequence
from-end start end key test))

^L
;;;; optimizations for floating point FLOOR, CEILING, TRUNCATE, and
;;;; ROUND, lifted from CMU CL 18c
;;;;
;;;; (Without these optimizations, these functions cons!)

;; Convert (TRUNCATE x y) to the obvious implementation. We only want
;; this when under certain conditions and let the generic TRUNCATE
;; handle the rest. (Note: if Y = 1, the divide and multiply by Y
;; should be removed by other DEFTRANSFORMs.)

(deftransform truncate ((x &optional y)
(float &optional (or float integer)))
'(let ((res (%unary-truncate (/ x y))))
(values res (- x (* y res)))))

(deftransform floor ((number &optional divisor)
(float &optional (or integer float)))
'(multiple-value-bind (tru rem) (truncate number divisor)
(if (and (not (zerop rem))
(if (minusp divisor)
(plusp number)
(minusp number)))
(values (1- tru) (+ rem divisor))
(values tru rem))))

(deftransform ceiling ((number &optional divisor)
(float &optional (or integer float)))
'(multiple-value-bind (tru rem) (truncate number divisor)
(if (and (not (zerop rem))
(if (minusp divisor)
(minusp number)
(plusp number)))
(values (1+ tru) (- rem divisor))
(values tru rem))))
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -16,4 +16,4 @@
;;; four numeric fields, is used for versions which aren't released
;;; but correspond only to CVS tags or snapshots.

"0.6.12.60"
"0.6.12.61"

0 comments on commit b1a5083

Please sign in to comment.