Improve fixnum case of abs in cptypes

Add a special case for `abs`, in particular because
(abs (most-negative-fixnum)) is not a fixnum.

mats/cptypes.ms

@@ -933,11 +933,24 @@
                         (fixnum? (abs x))))
          '(lambda (x) (when (fixnum? x)
                         #t))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (fixnum? x)
+                   (abs x)))
+    '(lambda (x) (when (fixnum? x)
+                   (let ([t x])
+                     (if (#3%fx= t (most-negative-fixnum))
+                         (pariah (- (most-negative-fixnum)))
+                         (#3%fxabs t))))))
   (cptypes-equivalent-expansion? ; unexpected, but correct
     '(lambda (x) (when (bignum? x)
                    (bignum? (abs x))))
     '(lambda (x) (when (bignum? x)
                    #t)))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (flonum? x)
+                   (abs x)))
+    '(lambda (x) (when (flonum? x)
+                   (#3%flabs x))))
   (test-closed1 '(add1 1+ sub1 1- -1+ abs)
                 '(flonum? real? (lambda (x) (and (integer? x) (exact? x)))))
 )

release_notes/release_notes.stex

@@ -116,6 +116,10 @@ Online versions of both books can be found at
 %-----------------------------------------------------------------------------
 \section{Functionality Changes}\label{section:functionality}
 
+\subsection{Improved support abs in type recovery (10.2.0)}
+
+The type recovery pass has improved support for abs when the argument is a fixnum.
+
 \subsection{Add support for 1+, 1- and -1+ in type recovery (10.2.0)}
 
 The type recovery pass has support for 1+, 1- and -1+.

s/cptypes.ss

@@ -298,10 +298,38 @@ Notes:
                (ensure-single-value e1 #f)
                (make-seq ctxt (ensure-single-value e1 #f)
                               (loop (car e*) (cdr e*)))))]))
-        (define (build-let var* e* body)
-          (if (null? var*)
-              body
-              `(call ,(make-preinfo-call) ,(build-lambda var* body) ,e* ...)))
+
+    (define (prepare-let e* r*) ; ==> (before* var* e* ref*)
+      ; The arguments e* and r* must have the same length.
+      ; In the results:
+      ;   before*, var* and e* may be shorter than the arguments.
+      ;   var* and e* have the same length.
+      ;   ref* has the same lenght than the arguments.
+      ;        It may be a mix of: references to the new variables
+      ;                            references to variables in the context
+      ;                            propagated constants
+      (let loop ([rev-rbefore* '()] [rev-rvar* '()] [rev-re* '()] [rev-rref* '()]
+                 [e* e*] [r* r*])
+        (cond
+          [(and (null? e*) (null? r*))
+           (values (reverse rev-rbefore*) (reverse rev-rvar*) (reverse rev-re*) (reverse rev-rref*))]
+          [(check-constant-is? (car r*))
+           (loop (cons (car e*) rev-rbefore*) rev-rvar* rev-re* (cons (car r*) rev-rref*)
+                 (cdr e*) (cdr r*))]
+          [(try-ref->prelex/not-assigned (car e*))
+           => (lambda (v)
+                (set-prelex-multiply-referenced! v #t) ; just in case it was sinlge referenced
+                (loop rev-rbefore* rev-rvar* rev-re* (cons (car e*) rev-rref*)
+                      (cdr e*) (cdr r*)))]
+          [else
+           (let ([v (make-temp-prelex #t)])
+             (loop rev-rbefore* (cons v rev-rvar*) (cons (car e*) rev-re*) (cons (build-ref v) rev-rref*)
+                   (cdr e*) (cdr r*)))])))
+
+    (define (build-let var* e* body)
+      (if (null? var*)
+          body
+          `(call ,(make-preinfo-call) ,(build-lambda var* body) ,e* ...)))
 
     (define build-lambda
       (case-lambda
@@ -318,10 +346,10 @@ Notes:
     (define (build-ref x)
       `(ref #f ,x))
 
-    (define (try-ref->prelex v)
+    (define (try-ref->prelex/not-assigned v)
       (and (Lsrc? v)
            (nanopass-case (Lsrc Expr) v
-             [(ref ,maybe-src ,x) x]
+             [(ref ,maybe-src ,x) (and (not (prelex-assigned x) x))]
              [else #f])))
   )
 
@@ -978,33 +1006,6 @@ Notes:
       )
 
       (let ()
-        (define (prepare-let e* r*) ; ==> (before* var* e* ref*)
-          ; All the arguments must have the same length.
-          ; In the results:
-          ;   before*, var* and e* may be shorter than the arguments.
-          ;   var* and e* have the same length.
-          ;   ref* has the same lenght than the arguments.
-          ;        It may be a mix of: references to the new variables
-          ;                            references to variables in the context
-          ;                            propagated constants
-          (let loop ([rev-rbefore* '()] [rev-rvar* '()] [rev-re* '()] [rev-rref* '()]
-                     [e* e*] [r* r*])
-            (cond
-              [(null? e*)
-               (values (reverse rev-rbefore*) (reverse rev-rvar*) (reverse rev-re*) (reverse rev-rref*))]
-              [(check-constant-is? (car r*))
-               (loop (cons (car e*) rev-rbefore*) rev-rvar* rev-re* (cons (car r*) rev-rref*)
-                     (cdr e*) (cdr r*))]
-              [(try-ref->prelex (car e*))
-               => (lambda (v)
-                    (set-prelex-multiply-referenced! v #t) ; just in case it was sinlge referenced
-                    (loop rev-rbefore* rev-rvar* rev-re* (cons (car e*) rev-rref*)
-                          (cdr e*) (cdr r*)))]
-              [else
-               (let ([v (make-temp-prelex #t)])
-                 (loop rev-rbefore* (cons v rev-rvar*) (cons (car e*) rev-re*) (cons (build-ref v) rev-rref*)
-                       (cdr e*) (cdr r*)))])))
-
         (define (countmap f l*)
           (fold-left (lambda (x l) (if (f l) (+ 1 x) x)) 0 l*))
 
@@ -1166,7 +1167,14 @@ Notes:
       (define-specialize 2 abs
         [(n) (let ([r (get-type n)])
                (cond
-                 ; not closed for fixnums
+                 [(predicate-implies? r 'fixnum)
+                  (let-values ([(before* var* n* ref*) (prepare-let (list n) (list r))])
+                    (values (make-seq ctxt (make-1seq* 'effect before*)
+                                           (build-let var* n*
+                                                      `(if (call ,(make-preinfo-call) ,(lookup-primref 3 'fx=)  ,(car ref*) (quote ,(constant most-negative-fixnum)))
+                                                           ,(make-seq ctxt `(pariah) `(quote ,(- (constant most-negative-fixnum))))
+                                                           (call ,preinfo ,(lookup-primref 3 'fxabs) ,(car ref*)))))
+                           'exact-integer ntypes #f #f))]
                  [(predicate-implies? r 'bignum)
                   (values `(call ,preinfo ,pr ,n)
                           'bignum ntypes #f #f)]