From 1af2544b178799b5fd3ef6e780c7d93a1cb3e82c Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Wed, 21 Oct 2015 09:07:52 -0400 Subject: [PATCH] Remove special var controlling interpreter macro memoization. Instead recognize (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)) as the set of policy qualities that inhibits flushing cached macros. The TRTAK and DEFLATE-FILE benchmarks in CL-bench are thereby automatically sped up by a factor of 2x. --- src/interpreter/env.lisp | 7 ------- src/interpreter/eval.lisp | 12 ++++++------ src/interpreter/sexpr.lisp | 32 +++++++++++++++++++------------- 3 files changed, 25 insertions(+), 26 deletions(-) diff --git a/src/interpreter/env.lisp b/src/interpreter/env.lisp index 0033c92ef..5ad2e052a 100644 --- a/src/interpreter/env.lisp +++ b/src/interpreter/env.lisp @@ -483,13 +483,6 @@ (declaim (type boolean *hook-all-functions*)) (defvar *hook-all-functions-p* nil) -;; Global macro re-expansion behavior: -;; :NEVER will never re-expand. -;; :LAZILY will (usually) expand again if it looks like something changed. -;; :ALWAYS will always re-expand. * Not implemented * -(declaim (type (member :lazily :never) *re-expand-macros*)) -(defvar *re-expand-macros* :lazily) - (declaim (ftype function interpreter-trampoline interpreter-hooked-trampoline)) (defun make-function (proto-fn env) diff --git a/src/interpreter/eval.lisp b/src/interpreter/eval.lisp index fd6eb3662..33e9e3c89 100644 --- a/src/interpreter/eval.lisp +++ b/src/interpreter/eval.lisp @@ -182,18 +182,18 @@ ;; CLHS 3.1.2.1.2.2 Macro Forms (multiple-value-bind (expansion keys) (tracing-macroexpand-1 form env) - (cond ((or (not keys) ; only builtin macros were used - (eq *re-expand-macros* :NEVER)) - (digest-form expansion env sexpr)) - (t (setf expansion (%sexpr expansion) + (cond (keys + (setf expansion (%sexpr expansion) (sexpr-handler sexpr) (digest-macro-form expansion fname keys)) - (dispatch expansion env)))) + (dispatch expansion env)) + (t + (digest-form expansion env sexpr)))) (progn (setf (sexpr-handler sexpr) (if frame-ptr ; a lexical function (digest-local-call frame-ptr (cdr form)) - (digest-global-call fname (cdr form) env))) + (digest-global-call fname (cdr form) env))) (%dispatch sexpr env)))))) ;;; full-eval has compiler-error-resignalling stuff in here. diff --git a/src/interpreter/sexpr.lisp b/src/interpreter/sexpr.lisp index 0a9568e97..d9452b79f 100644 --- a/src/interpreter/sexpr.lisp +++ b/src/interpreter/sexpr.lisp @@ -14,7 +14,7 @@ ;;;; preprocessing implementations which produce code which emulates compiled ;;;; code as closely as possible by performing macroexpansion once only, ;;;; we attempt to emulate a non-preprocessing interpreter. -;;;; The motivation for this is parenthetically revealed in; the X3J13 issue +;;;; The motivation for this is parenthetically revealed in the X3J13 issue ;;;; discussing the removal of COMPILER-LET, saying: ;;;; "Some users have indicated they dislike interpreters which do a semantic ;;;; prepass, because they like to be able to dynamically redefine macros @@ -930,6 +930,9 @@ Test case. (defun tracing-macroexpand-1 (form env &optional (predicate #'fluid-def-p) &aux (original-hook (valid-macroexpand-hook)) expanders) + (unless (allow-macro-redefinition env) + (return-from tracing-macroexpand-1 + (values (macroexpand-1 form env) nil))) (flet ((macroexpand-hook (function form env) (let ((expansion (funcall original-hook function form env))) (if (atom form) @@ -955,6 +958,13 @@ Test case. form expansion expanders)) (values expansion expanders)))) +;;; Return T if the evaluator should always consider that macros +;;; might be redefined. If NIL then cached expansions are permanent. +(defun allow-macro-redefinition (env) + (if (policy env (and (= speed 3) (= debug 0) (= safety 0))) + nil + t)) + (defun arglist-to-sexprs (args) (let ((argc (or (list-length args) (ip-error "Malformed function call")))) @@ -1059,13 +1069,10 @@ Test case. ;;; BAZ is not defined, this works in compiled code: ;;; (DEFUN FOO () (BAZ (SETF (SYMBOL-FUNCTION 'BAZ) (LAMBDA (X) `(HI ,X))))) ;;; -;;; But if *re-expand-macros* is :NEVER, then only check for unbound -;;; functions but don't check whether the function got redefined as a macro. -;;; ;;; Interpreted code needs an explicit check for NIL in an fdefn-fun. ;;; Compiled code doesn't because the 'raw-addr' slot is always ;;; something valid to jump to. -(defun apply-probably-fun (fdefinition args &aux (n-args 0)) +(defun apply-probably-fun (fdefinition args env &aux (n-args 0)) (multiple-value-setq (args n-args) (arglist-to-sexprs args)) (macrolet ((funcall-n (n) @@ -1103,13 +1110,12 @@ Test case. (apply (sb-c:safe-fdefn-fun fdefn) arglist)) (rplaca tail (dispatch (svref data (1+ i)) env)) (pop tail))))))))))))) - (ecase *re-expand-macros* - (:LAZILY (macrolet ((re-expand-p () - '(let ((f (fdefn-fun fdefn))) - (and f (%looks-like-macro-p f))))) - (generate-switch))) - (:NEVER (macrolet ((re-expand-p () nil)) - (generate-switch)))))) + (if (allow-macro-redefinition env) + (macrolet ((re-expand-p () + '(let ((f (fdefn-fun fdefn))) + (and f (%looks-like-macro-p f))))) + (generate-switch)) + (macrolet ((re-expand-p () nil)) (generate-switch))))) ;;; Evaluate the arguments to a function that can't be called, ;;; then call it. Very weird, yes! But this is reached in two situations: @@ -1181,7 +1187,7 @@ Test case. (when (fluid-def-p fname) ;; Return a handler that calls FNAME very carefully (return-from digest-global-call - (apply-probably-fun (find-or-create-fdefn fname) args)))) + (apply-probably-fun (find-or-create-fdefn fname) args env)))) ;; Try to recognize (FUNCALL constant-fun ...) ;; This syntax is required when using SETF functions, and it should -- 2.11.4.GIT