[Openmcl-cvs-notifications] r14297 - /trunk/source/compiler/nx0.lisp

[gb at clozure.com]

Author: gb
Date: Tue Sep 21 22:13:43 2010
New Revision: 14297

Log:
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.

Modified:
    trunk/source/compiler/nx0.lisp

Modified: trunk/source/compiler/nx0.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nx0.lisp (original)
+++ trunk/source/compiler/nx0.lisp Tue Sep 21 22:13:43 2010
@@ -439,7 +439,8 @@
                (if (acode-p form)
                  (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))
                        (and trust-decls
@@ -448,14 +449,14 @@
                                 (setq assert nil)
                                 (%cadr form))
                               (if (eq op (%nx1-operator typed-form))
-                                (progn
-                                  (when (and assert (null (nth 3 form)))
+                                (destructuring-bind (type subform &optiona=
l check) (%cdr form)                                  =

+                                  (when (and assert (null check))
                                     (setf (%car form) (%nx1-operator type-=
asserted-form)
+                                          (%cadr form)
+                                          (type-specifier
+                                           (specifier-type `(and ,type ,(a=
code-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-referenc=
e))
                                   (locally (declare (special *nx-in-fronte=
nd*))
                                     (unless *nx-in-frontend*
@@ -480,16 +481,19 @@
                                           (nx-binop-numeric-contagion (cad=
r form)
                                                                       (cad=
dr form)
                                                                       trus=
t-decls)
-                                        (if (and (acode-form-typep f1 'flo=
at trust-decls)
-                                                 (acode-form-typep f2 'flo=
at trust-decls))
+                                        (if (and (acode-form-typep f1 'rea=
l trust-decls)
+                                                 (acode-form-typep f2 'rea=
l trust-decls))
 =

                                           (if (or (acode-form-typep f1 'do=
uble-float trust-decls)
                                                   (acode-form-typep f2 'do=
uble-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-ty=
pes*)))))))))))))))))
+    (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)
               (%cdr form) new)))