Changeset 8399


Ignore:
Timestamp:
01/24/05 19:17:41 (17 years ago)
Author:
piso
Message:

2005

Location:
trunk/j/src/org/armedbear/lisp
Files:
3 edited

Legend:

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

    r8392 r8399  
    22 * Keyword.java
    33 *
    4  * Copyright (C) 2002-2004 Peter Graves
    5  * $Id: Keyword.java,v 1.37 2005-01-24 14:02:57 asimon Exp $
     4 * Copyright (C) 2002-2005 Peter Graves
     5 * $Id: Keyword.java,v 1.38 2005-01-24 19:10:49 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
  • trunk/j/src/org/armedbear/lisp/clos.lisp

    r8391 r8399  
    11;;; clos.lisp
    22;;;
    3 ;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: clos.lisp,v 1.133 2005-01-24 14:00:06 asimon Exp $
     3;;; Copyright (C) 2003-2005 Peter Graves
     4;;; $Id: clos.lisp,v 1.134 2005-01-24 19:15:06 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    546546      (let ((name1 (canonical-slot-name s1)))
    547547        (dolist (s2 (cdr (memq s1 slots)))
    548     (when (eq name1 (canonical-slot-name s2))
     548          (when (eq name1 (canonical-slot-name s2))
    549549            (error 'program-error "Duplicate slot ~S" name1))))))
    550550  ;; Check for duplicate argument names in :DEFAULT-INITARGS.
     
    642642  (or (gethash object *eql-specializer-table*)
    643643      (setf (gethash object *eql-specializer-table*)
    644       (make-eql-specializer :object object))))
     644            (make-eql-specializer :object object))))
    645645
    646646(defclass standard-generic-function (generic-function)
     
    11081108                        but ~?~:>"
    11091109                        :format-arguments (list method gf string args)))
    1110      (comparison-description (x y)
     1110           (comparison-description (x y)
    11111111                                   (if (> x y) "more" "fewer")))
    11121112      (let ((gf-nreq (arg-info-number-required arg-info))
    1113       (gf-nopt (arg-info-number-optional arg-info))
    1114       (gf-key/rest-p (arg-info-key/rest-p arg-info))
    1115       (gf-keywords (arg-info-keys arg-info)))
    1116   (unless (= nreq gf-nreq)
    1117     (lose
    1118      "the method has ~A required arguments than the generic function."
    1119      (comparison-description nreq gf-nreq)))
    1120   (unless (= nopt gf-nopt)
    1121     (lose
    1122      "the method has ~A optional arguments than the generic function."
    1123      (comparison-description nopt gf-nopt)))
    1124   (unless (eq (or keysp restp) gf-key/rest-p)
    1125     (lose
    1126      "the method and generic function differ in whether they accept~_~
    1127       &REST or &KEY arguments."))
    1128   (when (consp gf-keywords)
    1129     (unless (or (and restp (not keysp))
    1130           allow-other-keys-p
    1131           (every (lambda (k) (memq k keywords)) gf-keywords))
    1132       (lose "the method does not accept each of the &KEY arguments~2I~_~
     1113            (gf-nopt (arg-info-number-optional arg-info))
     1114            (gf-key/rest-p (arg-info-key/rest-p arg-info))
     1115            (gf-keywords (arg-info-keys arg-info)))
     1116        (unless (= nreq gf-nreq)
     1117          (lose
     1118           "the method has ~A required arguments than the generic function."
     1119           (comparison-description nreq gf-nreq)))
     1120        (unless (= nopt gf-nopt)
     1121          (lose
     1122           "the method has ~A optional arguments than the generic function."
     1123           (comparison-description nopt gf-nopt)))
     1124        (unless (eq (or keysp restp) gf-key/rest-p)
     1125          (lose
     1126           "the method and generic function differ in whether they accept~_~
     1127            &REST or &KEY arguments."))
     1128        (when (consp gf-keywords)
     1129          (unless (or (and restp (not keysp))
     1130                      allow-other-keys-p
     1131                      (every (lambda (k) (memq k keywords)) gf-keywords))
     1132            (lose "the method does not accept each of the &KEY arguments~2I~_~
    11331133            ~S."
    1134       gf-keywords)))))))
     1134                  gf-keywords)))))))
    11351135
    11361136(defun check-method-lambda-list (method-lambda-list gf-lambda-list)
     
    14581458                              (funcall (method-function after) args nil)))))
    14591459                    nil)))
    1460        (setf code (or (compile nil code) code))
     1460             (setf code (or (compile nil code) code))
    14611461             code))
    14621462          (t
     
    18521852
    18531853(defmacro define-condition (name (&rest parent-types) (&rest slot-specs)
    1854         &body options)
     1854                                &body options)
    18551855  (let ((parent-types (or parent-types '(condition)))
    18561856        (report nil))
     
    18721872                 (call-next-method)
    18731873                 (funcall ,report condition stream)))
    1874      (setf (get ',name 'sys::condition-report-function) ,report)
     1874           (setf (get ',name 'sys::condition-report-function) ,report)
    18751875           ',name)
    18761876        `(progn
     
    18861886(defun coerce-to-condition (datum arguments default-type fun-name)
    18871887  (cond ((typep datum 'condition)
    1888   (when arguments
     1888        (when arguments
    18891889           (error 'simple-type-error
    18901890                  :datum arguments
     
    18921892                  :format-control "You may not supply additional arguments when giving ~S to ~S."
    18931893                  :format-arguments (list datum fun-name)))
    1894   datum)
    1895   ((symbolp datum)
    1896   (apply #'make-condition datum arguments))
    1897   ((or (stringp datum) (functionp datum))
    1898   (make-condition default-type
     1894        datum)
     1895        ((symbolp datum)
     1896        (apply #'make-condition datum arguments))
     1897        ((or (stringp datum) (functionp datum))
     1898        (make-condition default-type
    18991899                         :format-control datum
    19001900                         :format-arguments arguments))
    1901   (t
    1902   (error 'simple-type-error
    1903     :datum datum
    1904     :expected-type '(or symbol string)
    1905     :format-control "Bad argument to ~S: ~S."
    1906     :format-arguments (list fun-name datum)))))
     1901        (t
     1902        (error 'simple-type-error
     1903                :datum datum
     1904                :expected-type '(or symbol string)
     1905                :format-control "Bad argument to ~S: ~S."
     1906                :format-arguments (list fun-name datum)))))
    19071907
    19081908;; Originally defined in Primitives.java. Redefined here to support arbitrary
     
    19381938(defmethod no-applicable-method (generic-function &rest args)
    19391939  (error "No applicable method for the generic function ~S when called with arguments ~S."
    1940   generic-function
    1941   args))
     1940        generic-function
     1941        args))
    19421942
    19431943(provide 'clos)
  • trunk/j/src/org/armedbear/lisp/debug.lisp

    r8391 r8399  
    11;;; debug.lisp
    22;;;
    3 ;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: debug.lisp,v 1.29 2005-01-24 14:00:08 asimon Exp $
     3;;; Copyright (C) 2003-2005 Peter Graves
     4;;; $Id: debug.lisp,v 1.30 2005-01-24 19:17:41 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
Note: See TracChangeset for help on using the changeset viewer.