Changeset 14297

Timestamp:

Sep 21, 2010, 8:13:43 PM (14 years ago)

Author:

Gary Byers

Message:

Some small changes to ACODE-FORM-TYPE: try to intersect, don't return
the NIL type as often, more careful with FLOAT subtypes. Still needs
lots of work, but this is a start.

File:

• trunk/source/compiler/nx0.lisp (modified) (3 diffs)

trunk/source/compiler/nx0.lisp

@@ -440 +440 @@
                  (let* ((op (acode-operator form)))
                    (if (eq op (%nx1-operator fixnum))
-                     'fixnum
+                     (let* ((val (cadr form)))
+                       `(integer ,val ,val))
                      (if (eq op (%nx1-operator immediate))
                        (type-of (%cadr form))
@@ -449 +450 @@
                                 (%cadr form))
                               (if (eq op (%nx1-operator typed-form))
-                                (progn
-                                  (when (and assert (null (nth 3 form)))
+                                (destructuring-bind (type subform &optional check) (%cdr form)                                  
+                                  (when (and assert (null check))
                                     (setf (%car form) (%nx1-operator type-asserted-form)
+                                          (%cadr form)
+                                          (type-specifier
+                                           (specifier-type `(and ,type ,(acode-form-type subform trust-decls assert))))
                                           assert nil))
-                                  (if (eq (%cadr form) 'number)
-                                    (or (acode-form-type (nx-untyped-form form) trust-decls)
-                                        'number)
-                                    (%cadr form)))
+                                  (%cadr form))
                                 (if (eq op (%nx1-operator lexical-reference))
                                   (locally (declare (special *nx-in-frontend*))
@@ -481 +482 @@
                                                                       (caddr form)
                                                                       trust-decls)
-                                        (if (and (acode-form-typep f1 'float trust-decls)
-                                                 (acode-form-typep f2 'float trust-decls))
+                                        (if (and (acode-form-typep f1 'real trust-decls)
+                                                 (acode-form-typep f2 'real trust-decls))
 
                                           (if (or (acode-form-typep f1 'double-float trust-decls)
                                                   (acode-form-typep f2 'double-float trust-decls))
                                             'double-float
-                                            'single-float)))
+                                            (if (or (acode-form-typep f1 'single-float trust-decls)
+                                                    (acode-form-typep f2 'single-float trust-decls))
+                                              'single-float
+                                              'float))))
                                       (cdr (assq op *nx-operator-result-types*)))))))))))))))))
+    (if (or (null typespec) (eq typespec '*)) (setq typespec t))
     (when (and (acode-p form) (typep (acode-operator form) 'fixnum) assert)
-      (unless typespec (setq typespec t))
       (let* ((new (cons typespec (cons (cons (%car form) (%cdr form)) nil))))
         (setf (%car form) (%nx1-operator type-asserted-form)