Changeset 5876


Ignore:
Timestamp:
02/19/04 15:38:25 (17 years ago)
Author:
piso
Message:

STD-COMPUTE-DISCRIMINATING-FUNCTION: JVM-COMPILE discriminating function if possible.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/clos.lisp

    r5863 r5876  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: clos.lisp,v 1.87 2004-02-17 16:53:15 piso Exp $
     4;;; $Id: clos.lisp,v 1.88 2004-02-19 15:38:25 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    12821282
    12831283(defun std-compute-discriminating-function (gf)
    1284   (if (methods-contain-eql-specializer-p (generic-function-methods gf))
    1285       #'(lambda (&rest args)
    1286          (slow-method-lookup gf args nil))
    1287       #'(lambda (&rest args)
    1288          (let* ((classes (mapcar #'class-of
    1289                                  (required-portion gf args)))
    1290                 (emfun (gethash classes (classes-to-emf-table gf) nil)))
    1291            (if emfun
    1292                (funcall emfun args)
    1293                (slow-method-lookup gf args classes))))))
     1284  (let ((code
     1285         (if (methods-contain-eql-specializer-p (generic-function-methods gf))
     1286             (make-closure `(lambda (&rest args)
     1287                              (slow-method-lookup ,gf args nil))
     1288                           nil)
     1289             (make-closure
     1290              `(lambda (&rest args)
     1291                 (let* ((classes (mapcar #'class-of (required-portion ,gf args)))
     1292                        (emfun (gethash classes (classes-to-emf-table ,gf) nil)))
     1293                   (if emfun
     1294                       (funcall emfun args)
     1295                       (slow-method-lookup ,gf args classes))))
     1296              nil))))
     1297    (when (and (fboundp 'jvm:jvm-compile)
     1298               (not (autoloadp 'jvm:jvm-compile)))
     1299      (setf code (jvm:jvm-compile nil code)))
     1300    code))
    12941301
    12951302(defun method-applicable-p (method args)
Note: See TracChangeset for help on using the changeset viewer.