Changeset 14933


Ignore:
Timestamp:
12/28/16 09:19:00 (5 years ago)
Author:
Mark Evenson
Message:

(Alan Ruttenberg) small changes to enable better introspection

Small jss tweak that caused some trouble.

Location:
trunk/abcl
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/contrib/jss/invoke.lisp

    r14929 r14933  
    244244                 ,@body)))))))
    245245
    246 (defun lookup-class-name (name &key (muffle *muffle-warnings*))
     246(defun lookup-class-name (name &key (table *class-name-to-full-case-insensitive*) (muffle-warning nil) (return-ambiguous nil))
    247247  (setq name (string name))
    248248  (let* (;; cant (last-name-pattern (#"compile" '|java.util.regex.Pattern| ".*?([^.]*)$"))
     
    264264                      (length full)))
    265265                 (ambiguous (choices)
    266                    (error "Ambiguous class name: ~a can be ~{~a~^, ~}" name choices)))
     266       (if return-ambiguous
     267           (return-from lookup-class-name choices)
     268           (error "Ambiguous class name: ~a can be ~{~a~^, ~}" name choices))))
    267269            (if (zerop bucket-length)
    268270    (progn (unless muffle (warn "can't find class named ~a" name)) nil)
     
    482484      (jclass-method-names class)))
    483485
    484 (setf (symbol-function 'jcmn) 'java-class-method-names)
     486(setf (symbol-function 'jcmn) #'java-class-method-names)
    485487
    486488(defun path-to-class (classname)
  • trunk/abcl/src/org/armedbear/lisp/fdefinition.lisp

    r14916 r14933  
    110110
    111111|# 
    112   (unless SYS::*LOAD-TRUENAME-FASL*
    113112    (unless source-pathname
    114113      (setf source-pathname (or *source* :top-level)))
     
    118117          (list source-pathname source-position)
    119118          (list source-pathname))))
    120       (let ((sym (if (consp name) (second name) name)))
    121   (put sym 'sys::source (cons `(,type ,(if (symbolp (car source)) (car source) (namestring (car source))) ,(second source)) (get sym  'sys::source nil)))))))
     119      (let ((sym (if (consp name) (second name) name))
     120            (new `(,type ,(if (symbolp (car source)) (car source) (namestring (car source))) ,(second source))))
     121        (if (autoloadp 'delete)
     122   (put sym 'sys::source (cons new (get sym  'sys::source nil)))
     123         (put sym 'sys::source (cons new (delete new (get sym  'sys::source nil)
     124               :test (lambda(a b) (and (equalp (car a) (car b)) (equalp (second a) (second b) ))))))))))
    122125
    123126;; Redefined in trace.lisp.
     
    129132  (declare (ignore name))
    130133  nil)
     134
     135(%defvar '*fset-hooks* nil)
    131136
    132137(defun fset (name function &optional source-position arglist documentation)
     
    147152  (when (functionp function) ; FIXME Is this test needed?
    148153    (%set-lambda-name function name))
     154  (dolist (hook *fset-hooks*) (ignore-errors (funcall hook name function)))
    149155  (trace-redefined-update name function)
    150156  function)
  • trunk/abcl/src/org/armedbear/lisp/print.lisp

    r14112 r14933  
    148148         (let ((s (sys::%write-to-string object)))
    149149           (xp::write-string++ s stream 0 (length s))))
     150  ((functionp object)
     151    (print-object object stream))
    150152        (t
    151153         (%output-object object stream))))
     154
    152155
    153156;;;; circularity detection stuff
Note: See TracChangeset for help on using the changeset viewer.