unsafe-ops-utils.rkt
```#lang racket
;;; Science Collection
;;; unsafe-ops-utils.rkt
;;; Copyright (c) 2010-2011 M. Douglas Williams
;;;
;;; This file is part of the Science Collection.
;;;
;;; The 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 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 Science Collection.  If not, see
;;;
;;; -----------------------------------------------------------------------------
;;;
;;; 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)

(require scheme/flonum
scheme/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->float x)
(if (real? x)
(exact->inexact x)
(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-vector v)
(build-vector
(vector-length v)
(lambda (i)
(real->float (vector-ref v i)))))

;;; (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->flvector v)
(let ((fl-v (make-flvector (vector-length v))))
(for ((i (in-range (vector-length v))))
(unsafe-flvector-set! fl-v i
(real->float (unsafe-vector-ref v i))))
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-fixed stx)
(syntax-case stx ()
((with-fized (x ...) expr ...)
(for ((id (in-list (syntax->list #'(x ...)))))
(unless (identifier? id)
(raise-syntax-error #f
"not an identifier"
stx
id)))
#`(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-float stx)
(syntax-case stx ()
((with-float (x ...) expr ...)
(for ((id (in-list (syntax->list #'(x ...)))))
(unless (identifier? id)
(raise-syntax-error #f
"not an identifier"
stx
id)))
#`(let ((x (if (real? x)
(exact->inexact x)
(error "expected real, given" x)))
...)
expr ...))))

;;; Module Contracts

(provide
with-fixed
with-float)

(provide/contract
(real->float
(-> real? inexact-real?))
(real-vector->float-vector
(-> (vectorof real?) (vectorof inexact-real?)))
(real-vector->flvector
(-> (vectorof real?) flvector?)))
```