DEFWRAPPERS for typed math

defwrappers.lisp

;;;; Double float math

(defparameter *standard-operators*
  '(+ - * / 1+ 1- exp expt log sqrt abs
    sin cos tan cis asin acos
    atan sinh cosh tanh asinh acosh atanh))

(defmacro defwrappers (type prefix &optional (operators *standard-operators*))
  "Define TYPE-specific macros for OPERATORS named with PREFIX.
The prefixed operators coerce all values (operands and results) to TYPE."
  (labels ((wrapper (op)
             `(defwrapper ,(symbolicate prefix op) ,op ,type)))
    `(progn ,@(mapcar #'wrapper operators))))

(defmacro defwrapper (typed-op base-op type)
  "Expand (TYPED-OP ...) => (BASE-OP ...) with all values coerced to TYPE."
  (with-unique-names (args)
    `(defmacro ,typed-op (&rest ,args)
       (wrap (cons ',base-op ,args) ',type))))

(defun wrap (exp type)
  "Rewrite EXP with result and each argument coerced to TYPE."
  (flet ((coerced (e)
           `(coerce ,e ',type)))
    (coerced (cons (first exp)
                   (mapcar #'coerced (rest exp))))))