#langracket;;; Racket Science Collection
;;; unsafe-ops-utils.ss
;;; Copyright (c) 2010 M. Douglas Williams
;;;
;;; This file is part of the Racket Science Collection.
;;;
;;; The Racket Science Collection is free software: you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the License or
;;; (at your option) any later version.
;;;
;;; The Racket Science Collection is distributed in the hope that it will be
;;; useful, but WITHOUT WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public License
;;; along with the Racket Science Collection. If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; -----------------------------------------------------------------------------
;;;
;;; This code has utility functions that can be used to assure floats for unsafe
;;; code. The basic philosophy we are taking is to use the unsafe operations
;;; where it makes sense, but to protect the code so that the operands to unsafe
;;; operations are guaranteed to be of the correct type.
;;;
;;; Version Date Description
;;; 4.0.0 05/16/10 Moved the unsafe ops utility functions from math.ss and
;;; added with-fixed. (MDW)
(requirescheme/flonum)
(requirescheme/unsafe/ops)
;;; (real->float x) -> inexact-real?
;;; x : real?
;;; Returns an inexact real (i.e., a float) given real x. Raises an error if x
;;; is not a real. This can be used to assure a real value is a float, even in
;;; unsafe code.
(define (real->floatx)
(if (real?x)
(exact->inexactx)
(error"expected real, given"x)))
;;; (real-vector->float-vector v) -> (vectorof inexact-real?)
;;; v : (vectorof real?)
;;; Returns a vector of inexact reals (i.e., floats) given a vector of reals, v.
;;; Raises an error if an element of v is not a real.
(define (real-vector->float-vectorv)
(build-vector
(vector-lengthv)
(lambda (i)
(real->float (vector-refvi)))))
;;; (real-vector->flvector v) -> flvector?
;;; v : (vectorof real?)
;;; Returns an flvector given a vector of reals, v. Raises an error if an element
;;; of v is not a real.
(define (real-vector->flvectorv)
(let ((fl-v (make-flvector (vector-lengthv))))
(for ((i (in-range (vector-lengthv))))
(unsafe-flvector-set!fl-vi
(real->float (unsafe-vector-refvi))))
fl-v))
;;; (with-fixed (x ...)
;;; expr ...)
;;; Executes the expr's with the x's guaranteed to be fixnums. All of the x's
;;; must be identifiers. Note that this does not attempt to coerce anything to a
;;; fixnum, just assure that they are.
(define-syntax (with-fixedstx)
(syntax-casestx ()
((with-fized (x...) expr...)
(for ((id (in-list (syntax->list#'(x...)))))
(unless (identifier?id)
(raise-syntax-error#f"not an identifier"stxid)))
#`(let ((x (if (fixnum?x)
x
(error"expected fixed integer, given"x)))
...)
expr...))))
;;; (with-float (x ...)
;;; expr ...)
;;; Executes the expr's with the x's guaranteed to be floats. All of the x's
;;; must be identifiers.
(define-syntax (with-floatstx)
(syntax-casestx ()
((with-float (x...) expr...)
(for ((id (in-list (syntax->list#'(x...)))))
(unless (identifier?id)
(raise-syntax-error#f"not an identifier"stxid)))
#`(let ((x (if (real?x)
(exact->inexactx)
(error"expected real, given"x)))
...)
expr...))))
;;; Module Contracts
(providewith-fixedwith-float)
(provide/contract
(real->float
(->real?inexact-real?))
(real-vector->float-vector
(-> (vectorofreal?) (vectorofinexact-real?)))
(real-vector->flvector
(-> (vectorofreal?) flvector?)))