Index: /branches/working-0711/ccl/compiler/nx-basic.lisp
===================================================================
--- /branches/working-0711/ccl/compiler/nx-basic.lisp	(revision 13213)
+++ /branches/working-0711/ccl/compiler/nx-basic.lisp	(revision 13214)
@@ -352,8 +352,8 @@
     (if decl (%cdr decl) t)))
 
-(defun nx-declared-result-type (sym &optional (env *nx-lexical-environment*))
+(defun nx-declared-result-type (sym &optional (env *nx-lexical-environment*) args)
   (when (symbolp (setq sym (maybe-setf-function-name sym)))
-    (let* ((ftype (find-ftype-decl sym env))
-	   (ctype (if (typep ftype 'ctype) ftype (specifier-type-if-known ftype env))))
+    (let* ((ftype (find-ftype-decl sym env args))
+	   (ctype (and ftype (if (typep ftype 'ctype) ftype (specifier-type-if-known ftype env)))))
       (unless (or (null ctype)
 		  (not (function-ctype-p ctype))
Index: /branches/working-0711/ccl/compiler/nx0.lisp
===================================================================
--- /branches/working-0711/ccl/compiler/nx0.lisp	(revision 13213)
+++ /branches/working-0711/ccl/compiler/nx0.lisp	(revision 13214)
@@ -1985,5 +1985,5 @@
 	(ftype nil)
 	(def nil))
-    (setq ftype (find-ftype-decl sym env))
+    (setq ftype (find-ftype-decl sym env args spread-p))
     (setq def (nx1-find-call-def sym env global-only))
     (when ftype
@@ -2015,16 +2015,47 @@
     (values errors-p typed-args result-type)))
 
-(defun find-ftype-decl (sym &optional (env *nx-lexical-environment*))
+(defun known-ftype-for-call (sym args spread-p env)
+  ;; Find ftype based on actual arguments.
+  ;; This should be more general, but for now just pick off some special cases..
+  (when (and args (or (not spread-p) (cdr args)))
+    (cond ((or (eq sym 'aref) (eq sym 'uvref))
+           (let* ((atype (nx-form-type (car args) env))
+                  (a-ctype (specifier-type atype)))
+             (when (array-ctype-p a-ctype)
+               ;; No point declaring the type of an arg whose type we already know
+               `(function (t &rest integer) ,(type-specifier (array-ctype-specialized-element-type
+                                                                  a-ctype))))))
+          ((eq sym 'error)
+           (let ((condition (car args)))
+             (cond ((nx-form-typep condition 'condition env)
+                    '(function (t) *))
+                   ((nx-form-typep condition 'symbol env)
+                    ;; TODO: might be able to figure out actual initargs...
+                    `(function (t &key &allow-other-keys) *))
+                   (t nil))))
+          ((eq sym 'cerror)
+           (when (and (cdr args) (or (not spread-p) (cddr args)))
+             (let ((condition (cadr args)))
+               (cond ((nx-form-typep condition 'condition env)
+                      `(function (string t &rest t) *))
+                     ((nx-form-typep condition 'symbol env)
+                      `(function (string t &key &allow-other-keys) *))
+                     (t `(function (string t &rest t) *))))))
+          (t nil))))
+
+(defun find-ftype-decl (sym &optional (env *nx-lexical-environment*) (args :unknown) spread-p)
   (setq sym (maybe-setf-function-name sym))
   (loop
-    (when (listp env) (return  (proclaimed-ftype sym)))
-    (dolist (fdecl (lexenv.fdecls env))
-      (when (and (eq (car fdecl) sym)
-                 (eq (car (%cdr fdecl)) 'ftype))
-        (return-from find-ftype-decl (%cddr fdecl))))
-    (when (and (istruct-typep env 'lexical-environment)
-               (assq sym (lexenv.functions env)))
-      (return-from find-ftype-decl nil))
-    (setq env (lexenv.parent-env env))))
+    for lexenv = env then (lexenv.parent-env lexenv) until (listp lexenv)
+    do (dolist (fdecl (lexenv.fdecls lexenv))
+         (when (and (eq (car fdecl) sym)
+                    (eq (car (%cdr fdecl)) 'ftype))
+           (return-from find-ftype-decl (%cddr fdecl))))
+    do (when (and (istruct-typep lexenv 'lexical-environment)
+                  (assq sym (lexenv.functions lexenv)))
+         (return-from find-ftype-decl nil)))
+  (or (proclaimed-ftype sym)
+      (and (listp args)
+           (known-ftype-for-call sym args spread-p env))))
 
 (defun nx1-analyze-ftyped-call (ftype sym arglist spread-p env)
@@ -2634,14 +2665,5 @@
 		      #+no (and (memq (car form) *logical-ops*)
 			   (grovel-logical-form form env))
-		      (nx-declared-result-type (%car form) env)
-		      ;; Sort of the right idea, but this should be done
-		      ;; in a more general way.
-		      (when (or (eq (car form) 'aref)
-				(eq (car form) 'uvref))
-			(let* ((atype (nx-form-type (cadr form) env))
-			       (a-ctype (specifier-type atype)))
-			  (when (array-ctype-p a-ctype)
-			    (type-specifier (array-ctype-specialized-element-type
-					     a-ctype)))))
+		      (nx-declared-result-type (%car form) env (%cdr form))
 		      t))))
 	    t))