From 6aa44bff4c3479055a6e078f554cdc57b9a22a26 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Sun, 2 Feb 1992 23:05:17 +0000
Subject: [PATCH] Fixed (- x) to expand directly to (%negate x), rather than
 going by the intermediate of (- 0 x), since this is not a correct
 transformation.  (- 0 0.0) is 0.0, not -0.0.  Fixed the (- 0 x) transform to
 be restricted to rational args.

---
 compiler/srctran.lisp | 29 ++++++++++++++++-------------
 1 file changed, 16 insertions(+), 13 deletions(-)

diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index 001b56337..0ad53e07c 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.33 1992/02/02 22:43:56 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.34 1992/02/02 23:05:17 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1079,6 +1079,13 @@
     result))
 
 
+;;; This is restricted to rationals, because (- 0 0.0) is 0.0, not -0.0.
+;;;
+(deftransform - ((x y) ((member 0) rational))
+  "convert (- 0 x) to negate"
+  '(%negate y))
+
+
 ;;; NOT-MORE-CONTAGIOUS  --  Interface
 ;;;
 ;;;    Return T if in an arithmetic op including continuations X and Y, the
@@ -1092,7 +1099,6 @@
     (values (type= (numeric-contagion x y)
 		   (numeric-contagion y y)))))
 
-
 ;;; OK-ZERO-OR-LOSE  --  Interface
 ;;;
 ;;;    If y is not constant, not zerop, or is -0.0, or is contagious, then give
@@ -1108,10 +1114,6 @@
 		 (not-more-contagious y x))
 	(give-up))))
 
-(deftransform - ((x y))
-  "convert (- 0 x) to negate"
-  (ok-zero-or-lose y x)
-  '(%negate y))
 
 ;;; Fold (OP x 0).
 ;;;
@@ -1494,20 +1496,21 @@
 ;;; Source-Transform-Intransitive  --  Internal
 ;;;
 ;;;    Do source transformations for intransitive n-arg functions such as /.
-;;; With one arg, we form the inverse using the indentity, with two args we
-;;; pass, otherwise we associate into two-arg calls.
+;;; With one arg, we form the inverse.  With two args we pass.  Otherwise we
+;;; associate into two-arg calls.
 ;;;
 (proclaim '(function source-transform-intransitive (symbol list t) list))
-(defun source-transform-intransitive (function args identity)
+(defun source-transform-intransitive (function args inverse)
   (case (length args)
     ((0 2) (values nil t))
-    (1 `(,function ,identity ,(first args)))
+    (1 `(,@inverse ,(first args)))
     (t
      (associate-arguments function (first args) (rest args)))))
 
-(def-source-transform - (&rest args) (source-transform-intransitive '- args 0))
-(def-source-transform / (&rest args) (source-transform-intransitive '/ args 1))
-
+(def-source-transform - (&rest args)
+  (source-transform-intransitive '- args '(%negate)))
+(def-source-transform / (&rest args)
+  (source-transform-intransitive '/ args '(/ 1)))
 
 
 ;;;; Apply:
-- 
GitLab