search

marcoheisig / fast-generic-functions

Seal your generic functions for an extra boost in performance.
MIT License
93 stars 4 forks source link

return-from does not work #7

Closed nneuss closed 3 years ago

nneuss commented 4 years ago

Hi, I have to reopen an issue which I thought erroneously to have vanished. return-from does not work in a f-g-f method. For example, the following does not work:

(defmacro def-fgf (name args &rest rest)
  `(defgeneric ,name ,args
     (:generic-function-class fast-generic-functions:fast-generic-function)
     ,@rest))

(def-fgf test (x))

(defmethod test (x)
  (return-from test nil))

More precisely, it returns an error and a style-warning (which is also inconsistent with the behaviour for standard generic functions):

; in: DEFMETHOD TEST (T)
;     (RETURN-FROM FL.AMOP::TEST NIL)
; 
; caught ERROR:
;   return for unknown block: TEST

;     (#:METHOD-FUNCTION (FL.AMOP::X)
;      (DECLARE
;       (SB-C::SOURCE-FORM (LAMBDA (FL.AMOP::X) (RETURN-FROM FL.AMOP::TEST NIL))))
;      (RETURN-FROM FL.AMOP::TEST NIL))
; 
; caught STYLE-WARNING:
;   The variable X is defined but never used.
marcoheisig commented 3 years ago

I cannot reproduce this bug. Are you sure you are using the most recent version of fast-generic-functions?

nneuss commented 3 years ago

Strange. I am very sure that I use the most recent f-g-f version and also a recent SBCL. Here is a simplified test which is going wrong:

neuss@leis:~/CL-HOME/fast-generic-functions$ git pull
Already up to date.
neuss@leis:~/CL-HOME/fast-generic-functions$ sbcl
This is SBCL 2.1.0.37-617158a6a, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
* (asdf:make :fast-generic-functions)
T
* (slot-value (asdf:find-system :fast-generic-functions) 'asdf::absolute-pathname)
#P"/home/neuss/CL-HOME/fast-generic-functions/code/"
* (defgeneric test (x) (:generic-function-class fast-generic-functions:fast-generic-function))
#<FAST-GENERIC-FUNCTIONS:FAST-GENERIC-FUNCTION COMMON-LISP-USER::TEST (0)>
* (defmethod test (x) (return-from test nil))
; in: DEFMETHOD TEST (T)
;     (RETURN-FROM TEST NIL)
; 
; caught ERROR:
;   return for unknown block: TEST

;     (#:METHOD-FUNCTION (X)
;      (DECLARE (SB-C::SOURCE-FORM (LAMBDA (X) (RETURN-FROM TEST NIL))))
;      (RETURN-FROM TEST NIL))
; 
; caught STYLE-WARNING:
;   The variable X is defined but never used.
; 
; compilation unit finished
;   caught 1 ERROR condition
;   caught 1 STYLE-WARNING condition
#<FAST-GENERIC-FUNCTIONS:FAST-METHOD COMMON-LISP-USER::TEST (T) {1004479F33}>
*
marcoheisig commented 3 years ago

Can you show me the output of

(sb-cltl2:macroexpand-all '(defmethod test (x) (return-from test nil)))

In an environment where test is defined as a fast generic function

nneuss commented 3 years ago

Hi Marco, here you are. Thanks for looking into this problem.

* (sb-cltl2:macroexpand-all '(defmethod test (x) (return-from test nil)))
(PROGN
 (EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE)
   (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'TEST))
 (EVAL-WHEN (:LOAD-TOPLEVEL)
   (SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'TEST 'NIL (LIST (FIND-CLASS 'T))
                           '(X)
                           (LIST* :FUNCTION
                                  (LET* ((SB-PCL::FMF
                                          (SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD
                                                                TEST (T))
                                              (SB-PCL::.PV.
                                               SB-PCL::.NEXT-METHOD-CALL. X)
                                            (DECLARE
                                             (IGNORABLE SB-PCL::.PV.
                                              SB-PCL::.NEXT-METHOD-CALL.)
                                             (DISABLE-PACKAGE-LOCKS
                                              SB-PCL::PV-ENV-ENVIRONMENT))
                                            (DECLARE (SB-PCL::%PARAMETER X))
                                            (DECLARE (TYPE T X))
                                            (DECLARE (IGNORABLE X))
                                            (SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT
                                                               SB-PCL::DEFAULT))
                                              (FLET ((NEXT-METHOD-P ()
                                                       (DECLARE
                                                        (OPTIMIZE
                                                         (SB-C:INSERT-STEP-CONDITIONS
                                                          0)))
                                                       (NOT
                                                        (NULL
                                                         SB-PCL::.NEXT-METHOD-CALL.))))
                                                (DECLARE
                                                 (IGNORABLE
                                                  (FUNCTION NEXT-METHOD-P)))
                                                (LET* ((SB-PCL::.ARGS-TAIL.
                                                        NIL)
                                                       (SB-PCL::.DUMMY0.))
                                                  (DECLARE
                                                   (IGNORABLE
                                                    SB-PCL::.ARGS-TAIL.
                                                    SB-PCL::.DUMMY0.))
                                                  (LOCALLY
                                                   (DECLARE
                                                    (DISABLE-PACKAGE-LOCKS
                                                     SB-PCL::%PARAMETER-BINDING-MODIFIED))
                                                   (SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED
                                                                      (QUOTE)))
                                                     (DECLARE
                                                      (ENABLE-PACKAGE-LOCKS
                                                       SB-PCL::%PARAMETER-BINDING-MODIFIED))
                                                     (BLOCK TEST
                                                       (RETURN-FROM TEST
                                                         NIL)))))))))
                                         (SB-PCL::MF
                                          (SB-PCL::%MAKE-METHOD-FUNCTION
                                           SB-PCL::FMF)))
                                    (SB-MOP:SET-FUNCALLABLE-INSTANCE-FUNCTION
                                     SB-PCL::MF
                                     (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION
                                      SB-PCL::FMF '(:ARG-INFO (1))))
                                    SB-PCL::MF)
                                  '(SB-PCL::PLIST (:ARG-INFO (1))
                                    SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
                           (SB-C:SOURCE-LOCATION)))
 (EVAL-WHEN (:EXECUTE)
   (SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'TEST 'NIL (LIST (FIND-CLASS 'T))
                           '(X)
                           (LIST* :FUNCTION
                                  (LET* ((SB-PCL::FMF
                                          (SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD
                                                                TEST (T))
                                              (SB-PCL::.PV.
                                               SB-PCL::.NEXT-METHOD-CALL. X)
                                            (DECLARE
                                             (IGNORABLE SB-PCL::.PV.
                                              SB-PCL::.NEXT-METHOD-CALL.)
                                             (DISABLE-PACKAGE-LOCKS
                                              SB-PCL::PV-ENV-ENVIRONMENT))
                                            (DECLARE (SB-PCL::%PARAMETER X))
                                            (DECLARE (TYPE T X))
                                            (DECLARE (IGNORABLE X))
                                            (SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT
                                                               SB-PCL::DEFAULT))
                                              (FLET ((NEXT-METHOD-P ()
                                                       (DECLARE
                                                        (OPTIMIZE
                                                         (SB-C:INSERT-STEP-CONDITIONS
                                                          0)))
                                                       (NOT
                                                        (NULL
                                                         SB-PCL::.NEXT-METHOD-CALL.))))
                                                (DECLARE
                                                 (IGNORABLE
                                                  (FUNCTION NEXT-METHOD-P)))
                                                (LET* ((SB-PCL::.ARGS-TAIL.
                                                        NIL)
                                                       (SB-PCL::.DUMMY0.))
                                                  (DECLARE
                                                   (IGNORABLE
                                                    SB-PCL::.ARGS-TAIL.
                                                    SB-PCL::.DUMMY0.))
                                                  (LOCALLY
                                                   (DECLARE
                                                    (DISABLE-PACKAGE-LOCKS
                                                     SB-PCL::%PARAMETER-BINDING-MODIFIED))
                                                   (SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED
                                                                      (QUOTE)))
                                                     (DECLARE
                                                      (ENABLE-PACKAGE-LOCKS
                                                       SB-PCL::%PARAMETER-BINDING-MODIFIED))
                                                     (BLOCK TEST
                                                       (RETURN-FROM TEST
                                                         NIL)))))))))
                                         (SB-PCL::MF
                                          (SB-PCL::%MAKE-METHOD-FUNCTION
                                           SB-PCL::FMF)))
                                    (SB-MOP:SET-FUNCALLABLE-INSTANCE-FUNCTION
                                     SB-PCL::MF
                                     (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION
                                      SB-PCL::FMF '(:ARG-INFO (1))))
                                    SB-PCL::MF)
                                  '(SB-PCL::PLIST (:ARG-INFO (1))
                                    SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
                           (SB-C:SOURCE-LOCATION))))
nneuss commented 3 years ago

Sorry - that was another test. The correct one will come immediately.

nneuss commented 3 years ago

Here is the correct version:

(PROGN
 (EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE)
   (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'TEST))
 (EVAL-WHEN (:LOAD-TOPLEVEL)
   (SB-PCL::LOAD-DEFMETHOD 'FAST-GENERIC-FUNCTIONS:FAST-METHOD 'TEST 'NIL
                           (LIST (FIND-CLASS 'T)) '(X)
                           (LIST* :FUNCTION
                                  (SB-INT:NAMED-LAMBDA (SB-PCL::SLOW-METHOD
                                                        TEST (T))
                                      (#:ARGS #:NEXT-METHODS &REST #:MORE-ARGS)
                                    (DECLARE
                                     (IGNORABLE #:ARGS #:NEXT-METHODS
                                      #:MORE-ARGS))
                                    (FLET ((CALL-NEXT-METHOD
                                               (&REST CLOSER-MOP::ARGS)
                                             (IF #:NEXT-METHODS
                                                 (APPLY
                                                  (SB-MOP:METHOD-FUNCTION
                                                   (FIRST #:NEXT-METHODS))
                                                  (IF CLOSER-MOP::ARGS
                                                      CLOSER-MOP::ARGS
                                                      #:ARGS)
                                                  (REST #:NEXT-METHODS)
                                                  #:MORE-ARGS)
                                                 (APPLY #'NO-NEXT-METHOD
                                                        (GETF #:MORE-ARGS
                                                              :GENERIC-FUNCTION)
                                                        (GETF #:MORE-ARGS
                                                              :METHOD)
                                                        (IF CLOSER-MOP::ARGS
                                                            CLOSER-MOP::ARGS
                                                            #:ARGS))))
                                           (NEXT-METHOD-P ()
                                             (NOT (NULL #:NEXT-METHODS))))
                                      (DECLARE
                                       (INLINE CALL-NEXT-METHOD NEXT-METHOD-P)
                                       (IGNORABLE (FUNCTION CALL-NEXT-METHOD)
                                        (FUNCTION NEXT-METHOD-P)))
                                      (FLET ((#:METHOD-FUNCTION (X)
                                               (RETURN-FROM TEST NIL)))
                                        (DECLARE (INLINE #:METHOD-FUNCTION))
                                        (APPLY #'#:METHOD-FUNCTION #:ARGS))))
                                  '(FAST-GENERIC-FUNCTIONS::.LAMBDA.
                                    (LAMBDA (X)
                                      (DECLARE (IGNORABLE X))
                                      (BLOCK TEST (RETURN-FROM TEST NIL)))
                                    SEALABLE-METAOBJECTS::.METHOD-PROPERTIES.
                                    NIL))
                           (SB-C:SOURCE-LOCATION)))
 (EVAL-WHEN (:EXECUTE)
   (SB-PCL::LOAD-DEFMETHOD 'FAST-GENERIC-FUNCTIONS:FAST-METHOD 'TEST 'NIL
                           (LIST (FIND-CLASS 'T)) '(X)
                           (LIST* :FUNCTION
                                  (SB-INT:NAMED-LAMBDA (SB-PCL::SLOW-METHOD
                                                        TEST (T))
                                      (#:ARGS #:NEXT-METHODS &REST #:MORE-ARGS)
                                    (DECLARE
                                     (IGNORABLE #:ARGS #:NEXT-METHODS
                                      #:MORE-ARGS))
                                    (FLET ((CALL-NEXT-METHOD
                                               (&REST CLOSER-MOP::ARGS)
                                             (IF #:NEXT-METHODS
                                                 (APPLY
                                                  (SB-MOP:METHOD-FUNCTION
                                                   (FIRST #:NEXT-METHODS))
                                                  (IF CLOSER-MOP::ARGS
                                                      CLOSER-MOP::ARGS
                                                      #:ARGS)
                                                  (REST #:NEXT-METHODS)
                                                  #:MORE-ARGS)
                                                 (APPLY #'NO-NEXT-METHOD
                                                        (GETF #:MORE-ARGS
                                                              :GENERIC-FUNCTION)
                                                        (GETF #:MORE-ARGS
                                                              :METHOD)
                                                        (IF CLOSER-MOP::ARGS
                                                            CLOSER-MOP::ARGS
                                                            #:ARGS))))
                                           (NEXT-METHOD-P ()
                                             (NOT (NULL #:NEXT-METHODS))))
                                      (DECLARE
                                       (INLINE CALL-NEXT-METHOD NEXT-METHOD-P)
                                       (IGNORABLE (FUNCTION CALL-NEXT-METHOD)
                                        (FUNCTION NEXT-METHOD-P)))
                                      (FLET ((#:METHOD-FUNCTION (X)
                                               (RETURN-FROM TEST NIL)))
                                        (DECLARE (INLINE #:METHOD-FUNCTION))
                                        (APPLY #'#:METHOD-FUNCTION #:ARGS))))
                                  '(FAST-GENERIC-FUNCTIONS::.LAMBDA.
                                    (LAMBDA (X)
                                      (DECLARE (IGNORABLE X))
                                      (BLOCK TEST (RETURN-FROM TEST NIL)))
                                    SEALABLE-METAOBJECTS::.METHOD-PROPERTIES.
                                    NIL))
                           (SB-C:SOURCE-LOCATION))))
marcoheisig commented 3 years ago

I think I see the problem. And I already fixed it upstream in closer-mop some time ago (https://github.com/pcostanza/closer-mop/commit/8cca090619450b0804204bc787ddbba974b676b3).

So you just need to pick a more recent version of closer-mop and you should be fine.

nneuss commented 3 years ago

Thank you Marco. It works. And I have learned that I have to keep more than one library up-to-date.