Changeset 8399

Timestamp:

01/24/05 19:17:41 (16 years ago)

Author:

piso

Message:

2005

Location:

trunk/j/src/org/armedbear/lisp

Files:

• Keyword.java (modified) (1 diff)
• clos.lisp (modified) (10 diffs)
• debug.lisp (modified) (1 diff)

trunk/j/src/org/armedbear/lisp/Keyword.java

@@ -2 +2 @@
  * Keyword.java
  *
- * Copyright (C) 2002-2004 Peter Graves
- * $Id: Keyword.java,v 1.37 2005-01-24 14:02:57 asimon Exp $
+ * Copyright (C) 2002-2005 Peter Graves
+ * $Id: Keyword.java,v 1.38 2005-01-24 19:10:49 piso Exp $
  *
  * This program is free software; you can redistribute it and/or

trunk/j/src/org/armedbear/lisp/clos.lisp

@@ -1 +1 @@
 ;;; clos.lisp
 ;;;
-;;; Copyright (C) 2003-2004 Peter Graves
-;;; $Id: clos.lisp,v 1.133 2005-01-24 14:00:06 asimon Exp $
+;;; Copyright (C) 2003-2005 Peter Graves
+;;; $Id: clos.lisp,v 1.134 2005-01-24 19:15:06 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -546 +546 @@
       (let ((name1 (canonical-slot-name s1)))
         (dolist (s2 (cdr (memq s1 slots)))
-    (when (eq name1 (canonical-slot-name s2))
+          (when (eq name1 (canonical-slot-name s2))
             (error 'program-error "Duplicate slot ~S" name1))))))
   ;; Check for duplicate argument names in :DEFAULT-INITARGS.
@@ -642 +642 @@
   (or (gethash object *eql-specializer-table*)
       (setf (gethash object *eql-specializer-table*)
-      (make-eql-specializer :object object))))
+            (make-eql-specializer :object object))))
 
 (defclass standard-generic-function (generic-function)
@@ -1108 +1108 @@
                         but ~?~:>"
                         :format-arguments (list method gf string args)))
-     (comparison-description (x y)
+           (comparison-description (x y)
                                    (if (> x y) "more" "fewer")))
       (let ((gf-nreq (arg-info-number-required arg-info))
-      (gf-nopt (arg-info-number-optional arg-info))
-      (gf-key/rest-p (arg-info-key/rest-p arg-info))
-      (gf-keywords (arg-info-keys arg-info)))
-  (unless (= nreq gf-nreq)
-    (lose
-     "the method has ~A required arguments than the generic function."
-     (comparison-description nreq gf-nreq)))
-  (unless (= nopt gf-nopt)
-    (lose
-     "the method has ~A optional arguments than the generic function."
-     (comparison-description nopt gf-nopt)))
-  (unless (eq (or keysp restp) gf-key/rest-p)
-    (lose
-     "the method and generic function differ in whether they accept~_~
-      &REST or &KEY arguments."))
-  (when (consp gf-keywords)
-    (unless (or (and restp (not keysp))
-          allow-other-keys-p
-          (every (lambda (k) (memq k keywords)) gf-keywords))
-      (lose "the method does not accept each of the &KEY arguments~2I~_~
+            (gf-nopt (arg-info-number-optional arg-info))
+            (gf-key/rest-p (arg-info-key/rest-p arg-info))
+            (gf-keywords (arg-info-keys arg-info)))
+        (unless (= nreq gf-nreq)
+          (lose
+           "the method has ~A required arguments than the generic function."
+           (comparison-description nreq gf-nreq)))
+        (unless (= nopt gf-nopt)
+          (lose
+           "the method has ~A optional arguments than the generic function."
+           (comparison-description nopt gf-nopt)))
+        (unless (eq (or keysp restp) gf-key/rest-p)
+          (lose
+           "the method and generic function differ in whether they accept~_~
+            &REST or &KEY arguments."))
+        (when (consp gf-keywords)
+          (unless (or (and restp (not keysp))
+                      allow-other-keys-p
+                      (every (lambda (k) (memq k keywords)) gf-keywords))
+            (lose "the method does not accept each of the &KEY arguments~2I~_~
             ~S."
-      gf-keywords)))))))
+                  gf-keywords)))))))
 
 (defun check-method-lambda-list (method-lambda-list gf-lambda-list)
@@ -1458 +1458 @@
                               (funcall (method-function after) args nil)))))
                     nil)))
-       (setf code (or (compile nil code) code))
+             (setf code (or (compile nil code) code))
              code))
           (t
@@ -1852 +1852 @@
 
 (defmacro define-condition (name (&rest parent-types) (&rest slot-specs)
-         &body options)
+                                 &body options)
   (let ((parent-types (or parent-types '(condition)))
         (report nil))
@@ -1872 +1872 @@
                  (call-next-method)
                  (funcall ,report condition stream)))
-     (setf (get ',name 'sys::condition-report-function) ,report)
+           (setf (get ',name 'sys::condition-report-function) ,report)
            ',name)
         `(progn
@@ -1886 +1886 @@
 (defun coerce-to-condition (datum arguments default-type fun-name)
   (cond ((typep datum 'condition)
-   (when arguments
+         (when arguments
            (error 'simple-type-error
                   :datum arguments
@@ -1892 +1892 @@
                   :format-control "You may not supply additional arguments when giving ~S to ~S."
                   :format-arguments (list datum fun-name)))
-   datum)
-  ((symbolp datum)
-   (apply #'make-condition datum arguments))
-  ((or (stringp datum) (functionp datum))
-   (make-condition default-type
+         datum)
+        ((symbolp datum)
+         (apply #'make-condition datum arguments))
+        ((or (stringp datum) (functionp datum))
+         (make-condition default-type
                          :format-control datum
                          :format-arguments arguments))
-  (t
-   (error 'simple-type-error
-    :datum datum
-    :expected-type '(or symbol string)
-    :format-control "Bad argument to ~S: ~S."
-    :format-arguments (list fun-name datum)))))
+        (t
+         (error 'simple-type-error
+                :datum datum
+                :expected-type '(or symbol string)
+                :format-control "Bad argument to ~S: ~S."
+                :format-arguments (list fun-name datum)))))
 
 ;; Originally defined in Primitives.java. Redefined here to support arbitrary
@@ -1938 +1938 @@
 (defmethod no-applicable-method (generic-function &rest args)
   (error "No applicable method for the generic function ~S when called with arguments ~S."
-   generic-function
-   args))
+         generic-function
+         args))
 
 (provide 'clos)

trunk/j/src/org/armedbear/lisp/debug.lisp

@@ -1 +1 @@
 ;;; debug.lisp
 ;;;
-;;; Copyright (C) 2003-2004 Peter Graves
-;;; $Id: debug.lisp,v 1.29 2005-01-24 14:00:08 asimon Exp $
+;;; Copyright (C) 2003-2005 Peter Graves
+;;; $Id: debug.lisp,v 1.30 2005-01-24 19:17:41 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or