[Small-cl-src] "Fast floats" macro(s)
Ingvar
ingvar at cathouse.bofh.se
Wed Jun 15 06:22:25 UTC 2005
;;; There recently was a discussion about using arrays with suitably-declared
;;; element-type s to store floats without needing boxing and unboxing.
;;; This is obviously quite a hassle, as and when one wants to use.
;;;
;;; But, this is lisp and macros are (as always) ready to leap to the rescue.
;;; This code is Copyright Ingvar Mattsson, 2005 <ingvar at hexapodia.net>
;;; You are free to use and/or modify this code as you see fit, as long
;;; as this comment block is retained and modifications noted by at least
;;; the modifyer's name.
(defpackage #:net.hexapodia.fastfloats
(:nicknames #:fastfloats)
(:use #:cl)
(:export #:double-float-let #:single-float-let :float-let))
(in-package #:net.hexapodia.fastfloats)
(defun float-let-expander (type initform body)
(let ((syms (loop for spec in initform
for n from 0
if (symbolp spec)
collect (cons spec n)
else
collect (cons (car spec) n)))
(inits (loop for spec in initform
unless (symbolp spec)
collect (list (gensym) spec)))
(storage (gensym)))
`(let ,(loop for (sym spec) in inits
collect (list sym (cadr spec)))
(let ((,storage (make-array ,(length syms)
:element-type ',type
:initial-element (coerce 0.0 ',type))))
(symbol-macrolet ,(loop for (sym . n) in syms
collect (list sym (list 'aref storage n)))
; Init section
,@(loop for (sym val) in inits
collect (list 'setf (car val) sym))
, at body)))))
(defmacro double-float-let (initform &body body)
(float-let-expander 'double-float initform body))
(defmacro single-float-let (initform &body body)
(float-let-expander 'single-float initform body))
(defmacro float-let (initform &body body)
(float-let-expander *read-default-float-format* initform body))
;;; //Ingvar
More information about the Small-cl-src
mailing list