mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 14:21:10 +02:00
inline dispatch to program cmethods, tick in return, remove old goops methods
* libguile/objects.c (scm_apply_generic): Inline the case when the generic is a program. * libguile/vm-i-system.c (return): Tick when functions return. * module/oop/goops.scm (object-eqv?, object-equal?): Remove these historical methods.
This commit is contained in:
parent
e94ecc68c2
commit
ef7e18683c
3 changed files with 7 additions and 8 deletions
|
@ -39,6 +39,8 @@
|
||||||
#include "libguile/ports.h"
|
#include "libguile/ports.h"
|
||||||
#include "libguile/strings.h"
|
#include "libguile/strings.h"
|
||||||
#include "libguile/vectors.h"
|
#include "libguile/vectors.h"
|
||||||
|
#include "libguile/programs.h"
|
||||||
|
#include "libguile/vm.h"
|
||||||
|
|
||||||
#include "libguile/validate.h"
|
#include "libguile/validate.h"
|
||||||
#include "libguile/objects.h"
|
#include "libguile/objects.h"
|
||||||
|
@ -162,7 +164,9 @@ SCM
|
||||||
scm_apply_generic (SCM gf, SCM args)
|
scm_apply_generic (SCM gf, SCM args)
|
||||||
{
|
{
|
||||||
SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args);
|
SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args);
|
||||||
if (scm_is_pair (cmethod))
|
if (SCM_PROGRAM_P (cmethod))
|
||||||
|
return scm_vm_apply (scm_the_vm (), cmethod, args);
|
||||||
|
else if (scm_is_pair (cmethod))
|
||||||
return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
|
return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
|
||||||
SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
|
SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
|
||||||
args,
|
args,
|
||||||
|
|
|
@ -979,6 +979,8 @@ VM_DEFINE_INSTRUCTION (48, return, "return", 0, 0, 1)
|
||||||
vm_return:
|
vm_return:
|
||||||
EXIT_HOOK ();
|
EXIT_HOOK ();
|
||||||
RETURN_HOOK ();
|
RETURN_HOOK ();
|
||||||
|
SYNC_REGISTER ();
|
||||||
|
SCM_TICK; /* allow interrupt here */
|
||||||
{
|
{
|
||||||
SCM ret, *data;
|
SCM ret, *data;
|
||||||
data = SCM_FRAME_DATA_ADDRESS (fp);
|
data = SCM_FRAME_DATA_ADDRESS (fp);
|
||||||
|
|
|
@ -38,7 +38,6 @@
|
||||||
make-extended-generic
|
make-extended-generic
|
||||||
make-accessor ensure-accessor
|
make-accessor ensure-accessor
|
||||||
make-method add-method!
|
make-method add-method!
|
||||||
object-eqv? object-equal?
|
|
||||||
class-slot-ref class-slot-set! slot-unbound slot-missing
|
class-slot-ref class-slot-set! slot-unbound slot-missing
|
||||||
slot-definition-name slot-definition-options
|
slot-definition-name slot-definition-options
|
||||||
slot-definition-allocation
|
slot-definition-allocation
|
||||||
|
@ -622,12 +621,6 @@
|
||||||
(define-method (eqv? x y) #f)
|
(define-method (eqv? x y) #f)
|
||||||
(define-method (equal? x y) (eqv? x y))
|
(define-method (equal? x y) (eqv? x y))
|
||||||
|
|
||||||
;;; These following two methods are for backward compatibility only.
|
|
||||||
;;; They are not called by the Guile interpreter.
|
|
||||||
;;;
|
|
||||||
(define-method (object-eqv? x y) #f)
|
|
||||||
(define-method (object-equal? x y) (eqv? x y))
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; methods to display/write an object
|
;;; methods to display/write an object
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue