Changeset 266

Timestamp:

Jan 11, 2004, 11:31:27 PM (21 years ago)

Author:

Gary Byers

Message:

Too-few args to generic-function -> PROGRAM-ERROR, not just ERROR.

File:

• trunk/ccl/level-1/l1-dcode.lisp (modified) (8 diffs)

trunk/ccl/level-1/l1-dcode.lisp

@@ -746 +746 @@
         (let ((method (%find-1st-arg-combined-method dt (%lexpr-ref args args-len 0))))
           (%apply-lexpr-tail-wise method args))
-        (error "0 args to ~s" (%gf-dispatch-table-gf dt))))
+        (signal-program-error "0 args to ~s" (%gf-dispatch-table-gf dt))))
     (let* ()  ; happens if traced
-      (when (null args) (error "0 args to ~s" (%gf-dispatch-table-gf dt)))
+      (when (null args) (signal-program-error "0 args to ~s" (%gf-dispatch-table-gf dt)))
       (let ((method (%find-1st-arg-combined-method dt (%car args))))
         (apply method args)))))
@@ -779 +779 @@
     (let* ((args-len (list-length args))
            (argnum (%gf-dispatch-table-argnum dt)))
-      (when (< args-len argnum) (error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
+      (when (< args-len argnum) (signal-program-error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
       (let ((method (%find-nth-arg-combined-method dt (nth argnum args) args)))
         (apply method args)))
     (let* ((args-len (%lexpr-count args))
            (argnum (%gf-dispatch-table-argnum dt)))
-      (when (< args-len argnum) (error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
+      (when (< args-len argnum) (signal-program-error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
       (let ((method (%find-nth-arg-combined-method dt (%lexpr-ref args args-len argnum) args)))
         (%apply-lexpr-tail-wise method args)))))
@@ -1198 +1198 @@
 
 (defun nth-arg-dcode-too-few-args (gf-or-cm)
-  (error "Too few args to: ~s" (combined-method-gf gf-or-cm)))
+  (signal-program-error "Too few args to: ~s" (combined-method-gf gf-or-cm)))
 
 (defun nth-arg-combined-method-trap-0 (gf-or-cm table wrapper args)
@@ -1393 +1393 @@
     (let* ((args-len (list-length args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error  "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (nth argnum args))
              (thing (assq arg (cadr stuff)))) ; are these things methods or method-functions? - fns    
@@ -1401 +1401 @@
     (let* ((args-len (%lexpr-count args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (%lexpr-ref args args-len argnum))
              (thing (assq arg (cadr stuff)))) ; are these things methods or method-functions? - fns    
@@ -1415 +1415 @@
     (let* ((args-len (list-length args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (nth argnum args))
              (thing (assoc arg (cadr stuff)))) ; are these things methods or method-functions?    
@@ -1423 +1423 @@
     (let* ((args-len (%lexpr-count args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (%lexpr-ref args args-len argnum))
              (thing (assoc arg (cadr stuff)))) ; are these things methods or method-functions?    
@@ -1619 +1619 @@
                    ; oh screw it - old-args may be lexpr too
                    (let ((old-args (cddr magic)))
-                     (when (< args-len numreq) (error "Too few args to ~S" gf))
+                     (when (< args-len numreq) (signal-program-error "Too few args to ~S" gf))
                      (when (null (cmp-args-old-args args old-args numreq))
                        ; required args not eq - usually true, we expect