- (let* ((res1 (core-call-top-level-lambda lambda *compile-object*))
- (result (or name res1)))
- (fix-core-source-info *source-info* *compile-object* res1)
- (when name
- (setf (fdefinition name) res1))
- result))))))
+ (let ((compiled-fun (core-call-top-level-lambda lambda
+ *compile-object*)))
+ (fix-core-source-info *source-info* *compile-object* compiled-fun)
+ compiled-fun))))))
+
+(defun compile (name &optional (definition (fdefinition name)))
+ #!+sb-doc
+ "Coerce DEFINITION (by default, the function whose name is NAME)
+ to a compiled function, returning (VALUES THING WARNINGS-P FAILURE-P),
+ where if NAME is NIL, THING is the result of compilation, and
+ otherwise THING is NAME. When NAME is not NIL, the compiled function
+ is also set into (MACRO-FUNCTION NAME) if NAME names a macro, or into
+ (FDEFINITION NAME) otherwise."
+ (multiple-value-bind (compiled-definition warnings-p failure-p)
+ (if (compiled-function-p definition)
+ (values definition nil nil)
+ (actually-compile name definition))
+ (cond (name
+ (if (macro-function name)
+ (setf (macro-function name) compiled-definition)
+ (setf (fdefinition name) compiled-definition))
+ (values name warnings-p failure-p))
+ (t
+ (values compiled-definition warnings-p failure-p)))))