[Sbcl-commits] master: Change encapsulation to use functions instead of evaluation forms.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  c89ad479253aa806c7d2f5ed1e9cd7d3a0ac2281 (commit)
      from  6d5b30308bf7481577544b7ee469f5189a13e503 (commit)

- Log -----------------------------------------------------------------
commit c89ad479253aa806c7d2f5ed1e9cd7d3a0ac2281
Author: Stas Boukarev <sta...@gm...>
Date:   Sun Feb 23 20:12:27 2014 +0400

    Change encapsulation to use functions instead of evaluation forms.
    
    In preparation for making sb-profile use ENCAPSULATE, reducing
    profiling overhead from evaluation.
---
 src/code/fdefinition.lisp |    8 ++++----
 src/code/ntrace.lisp      |    3 ++-
 src/pcl/methods.lisp      |    9 +++++----
 3 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp
index f004d2d..87b8074 100644
--- a/src/code/fdefinition.lisp
+++ b/src/code/fdefinition.lisp
@@ -98,17 +98,17 @@
 
 ;;; Replace the definition of NAME with a function that binds NAME's
 ;;; arguments to a variable named ARG-LIST, binds name's definition
-;;; to a variable named BASIC-DEFINITION, and evaluates BODY in that
+;;; to a variable named BASIC-DEFINITION, and calls FUNCTION in that
 ;;; context. TYPE is whatever you would like to associate with this
 ;;; encapsulation for identification in case you need multiple
 ;;; encapsulations of the same name.
-(defun encapsulate (name type body)
+(defun encapsulate (name type function)
   (let ((fdefn (fdefinition-object name nil)))
     (unless (and fdefn (fdefn-fun fdefn))
       (error 'undefined-function :name name))
     (when (typep (fdefn-fun fdefn) 'generic-function)
       (return-from encapsulate
-        (encapsulate-generic-function (fdefn-fun fdefn) type body)))
+        (encapsulate-generic-function (fdefn-fun fdefn) type function)))
     ;; We must bind and close over INFO. Consider the case where we
     ;; encapsulate (the second) an encapsulated (the first)
     ;; definition, and later someone unencapsulates the encapsulated
@@ -124,7 +124,7 @@
               (declare (special arg-list))
               (let ((basic-definition (encapsulation-info-definition info)))
                 (declare (special basic-definition))
-                (eval body)))))))
+                (funcall function)))))))
 
 ;;; This is like FIND-IF, except that we do it on a compiled closure's
 ;;; environment.
diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index 912fd2c..d9b41dd 100644
--- a/src/code/ntrace.lisp
+++ b/src/code/ntrace.lisp
@@ -411,7 +411,8 @@
            (unless named
              (error "can't use encapsulation to trace anonymous function ~S"
                     fun))
-           (encapsulate function-or-name 'trace `(trace-call ',info)))
+           (encapsulate function-or-name 'trace
+                        (lambda () (trace-call info))))
           (t
            (multiple-value-bind (start-fun cookie-fun)
                (trace-start-breakpoint-fun info)
diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index 4398a2c..c8dcba2 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -1632,9 +1632,10 @@
 ;;; identity of the function bound to a name, which breaks anything
 ;;; class-based, so we implement the encapsulation ourselves in the
 ;;; discriminating function.
-(defun sb-impl::encapsulate-generic-function (gf type body)
-  (push (cons type body) (generic-function-encapsulations gf))
+(defun sb-impl::encapsulate-generic-function (gf type function)
+  (push (cons type function) (generic-function-encapsulations gf))
   (reinitialize-instance gf))
+
 (defun sb-impl::unencapsulate-generic-function (gf type)
   (setf (generic-function-encapsulations gf)
         (remove type (generic-function-encapsulations gf)
@@ -1647,12 +1648,12 @@
       std
       (let ((inner (maybe-encapsulate-discriminating-function
                     gf (cdr encs) std))
-            (body (cdar encs)))
+            (function (cdar encs)))
         (lambda (&rest args)
           (let ((sb-int:arg-list args)
                 (sb-int:basic-definition inner))
             (declare (special sb-int:arg-list sb-int:basic-definition))
-            (eval body))))))
+            (funcall function))))))
 (defmethod compute-discriminating-function ((gf standard-generic-function))
   (standard-compute-discriminating-function gf))
 (defmethod compute-discriminating-function :around ((gf standard-generic-function))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL