From 7303c0c04adadaeeb7cb654402f40c057a303f73 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 23 Aug 1991 18:23:54 +0000 Subject: [PATCH] Added code to compile the argument to TIME when possible, and print a warning when it isn't. --- code/time.lisp | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/code/time.lisp b/code/time.lisp index 5d60c1b7e..aaa23322e 100644 --- a/code/time.lisp +++ b/code/time.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.6 1991/02/08 13:36:25 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.7 1991/08/23 18:23:54 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -274,8 +274,28 @@ "Evaluates the Form and prints timing information on *Trace-Output*." `(%time #'(lambda () ,form))) +;;; MASSAGE-TIME-FUNCTION -- Internal +;;; +;;; Try to compile the closure arg to %TIME if it is interpreted. +;;; +(defun massage-time-function (fun) + (cond + ((eval:interpreted-function-p fun) + (multiple-value-bind (def env-p) + (function-lambda-expression fun) + (declare (ignore def)) + (cond + (env-p + (warn "TIME form in a non-null environment, forced to interpret.~@ + Compiling entire form will produce more accurate times.") + fun) + (t + (compile nil fun))))) + (t fun))) + (defun %time (fun) - (let (old-run-utime + (let ((fun (massage-time-function fun)) + old-run-utime new-run-utime old-run-stime new-run-stime -- GitLab