> Thanks to Stavros for the code,
> but it seems that either it was uncorrectly transmitted via
> email, or it needs some finishing.
No, sorry, it was just a stupid oversight on my part. And it was such a
simple fix, that I didn't test it :-( . Code below should be better. I
even tested it.
-s
(defun coerce-float-fun (expr &optional lvars)
(cond ((and (consp expr) (functionp expr))
expr)
((and (symbolp expr) (not (member expr lvars)))
(cond ((fboundp expr) expr)
(t
(let* ((mexpr (mget expr 'mexpr))
(args (nth 1 mexpr)))
(or mexpr (merror "Undefined function ~a" expr))
(coerce `(lambda ,(cdr args)
(declare (special ,@(cdr args)))
($float ($realpart(meval* ',(nth 2
mexpr)))))
'function)))))
(t
(let ((vars (or lvars ($sort ($listofvars expr))))
;(na (gensym "TMPF"))
)
(coerce `(lambda ,(cdr vars) (declare (special ,@(cdr vars)))
($float ($realpart (meval* ',expr))))
'function)))))