Changeset 5869


Ignore:
Timestamp:
02/18/04 17:30:08 (17 years ago)
Author:
piso
Message:

JVM-COMPILE reader and writer functions if possible.

File:
1 edited

Legend:

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

    r5866 r5869  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: defstruct.lisp,v 1.45 2004-02-18 15:31:37 piso Exp $
     4;;; $Id: defstruct.lisp,v 1.46 2004-02-18 17:30:08 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    288288                 (typep object ',*dd-name*))))))))
    289289
    290 (defun get-slot-accessor (index)
     290(defun slot-reader (index)
    291291  (cond ((eq *dd-type* 'list)
    292292         `(lambda (instance) (elt instance ,index)))
     
    300300           (2 #'%structure-ref-2)
    301301           (t
    302             `(lambda (instance) (%structure-ref instance ,index)))))))
    303 
    304 (defun get-slot-mutator (index)
     302            (let ((code (make-closure
     303                         `(lambda (instance)
     304                            (%structure-ref instance ,index))
     305                         nil)))
     306              (if (and (fboundp 'jvm:jvm-compile)
     307                       (not (autoloadp 'jvm:jvm-compile)))
     308                  (jvm:jvm-compile nil code)
     309                  code)))))))
     310
     311(defun slot-writer (index)
    305312  (cond ((eq *dd-type* 'list)
    306313         `(lambda (instance value) (%set-elt instance ,index value)))
     
    314321           (2 #'%structure-set-2)
    315322           (t
    316             `(lambda (instance value) (%structure-set instance ,index value)))))))
     323            (let ((code (make-closure
     324                         `(lambda (instance value)
     325                            (%structure-set instance ,index value))
     326                         nil)))
     327              (if (and (fboundp 'jvm:jvm-compile)
     328                       (not (autoloadp 'jvm:jvm-compile)))
     329                  (jvm:jvm-compile nil code)
     330                  code)))))))
    317331
    318332(defun define-access-function (slot-name index)
     
    321335             (intern (concatenate 'string (symbol-name *dd-conc-name*) (symbol-name slot-name)))
    322336             slot-name)))
    323     `((setf (symbol-function ',accessor) ,(get-slot-accessor index))
    324       (%put ',accessor 'setf-inverse ,(get-slot-mutator index )))))
     337    `((setf (symbol-function ',accessor) ,(slot-reader index))
     338      (%put ',accessor 'setf-inverse ,(slot-writer index )))))
    325339
    326340(defun define-access-functions ()
Note: See TracChangeset for help on using the changeset viewer.