Index: /trunk/ccl/compiler/optimizers.lisp
===================================================================
--- /trunk/ccl/compiler/optimizers.lisp	(revision 6176)
+++ /trunk/ccl/compiler/optimizers.lisp	(revision 6177)
@@ -616,5 +616,5 @@
           (setf (array-ctype-dimensions ctype)
                 '*))))
-    (let* ((element-type (specifier-type (if element-type-p element-type t))))
+    (let* ((element-type (specifier-type (if element-type-p (nx-unquote element-type) t))))
       (setf (array-ctype-element-type ctype) element-type)
       (if (typep element-type 'unknown-ctype)
@@ -1526,7 +1526,5 @@
     `(eql (lisptag ,arg) ,fixnum-tag)))
 
-(define-compiler-macro float (&whole w number &optional other)
-  (declare (ignore number other))
-  w)
+
 
 (define-compiler-macro double-float-p (n)
@@ -1788,5 +1786,6 @@
       call)))
 
-(define-compiler-macro float (&whole call number &optional other &environment env)
+(define-compiler-macro float (&whole call number &optional (other 0.0f0 other-p) &environment env)
+  
   (cond ((and (typep other 'single-float)
               (nx-form-typep number 'double-float env))
@@ -1795,4 +1794,9 @@
               (nx-form-typep number 'single-float env))
          `(the double-float (%single-to-double ,number)))
+        ((or (typep other 'single-float)
+             (null other-p))
+         `(the single-float (%short-float ,number)))
+        ((typep other 'double-float)
+         `(the double-float (%double-float ,number)))
         (t call)))