From 045569769ababdeb82b684a860458e6f9fb0ffff Mon Sep 17 00:00:00 2001
From: Tim Daly <daly@axiom-developer.org>
Date: Sat, 11 Jul 2015 20:48:30 -0400
Subject: [PATCH] src/interp/i-coerce.lisp fix use of eqType assignment

Goal: Clean code

The eqType function disappears during compile so that
t := eqType t turns into t := t. The following code becomes a nop
and has been removed.
---
 changelog                         |    2 +
 patch                             |    7 ++-
 src/axiom-website/patches.html    |    2 +
 src/interp/i-coerce.lisp.pamphlet |   87 ++++---------------------------------
 4 files changed, 18 insertions(+), 80 deletions(-)

diff --git a/changelog b/changelog
index 4e12482..f706121 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,5 @@
+20150711 tpd src/axiom-website/patches.html 20150711.05.tpd.patch 
+20150711 tpd src/interp/i-coerce.lisp fix use of eqType assignment
 20150711 tpd src/axiom-website/patches.html 20150711.04.tpd.patch 
 20150711 tpd books/bookheader Add Laurent Thery to credits
 20150711 tpd books/bookvol5 Add Laurent Thery to credits
diff --git a/patch b/patch
index 1ab080a..26d21a0 100644
--- a/patch
+++ b/patch
@@ -1,4 +1,7 @@
-readme: Add Laurent Thery to credits (COQ Proof)
+src/interp/i-coerce.lisp fix use of eqType assignment
 
-Goal: Maintaining correct credit list
+Goal: Clean code
 
+The eqType function disappears during compile so that 
+t := eqType t turns into t := t. The following code becomes a nop
+and has been removed.
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 2433b89..d04593c 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -5098,6 +5098,8 @@ books/bookvol10.3, src/input/intlf,series minor test fixes<br/>
 books/bookvol5 merge functions used from i-coerce<br/>
 <a href="patches/20150711.04.tpd.patch">20150711.04.tpd.patch</a>
 readme Add Laurent Thery to credits<br/>
+<a href="patches/20150711.05.tpd.patch">20150711.05.tpd.patch</a>
+src/interp/i-coerce.lisp fix use of eqType assignment<br/>
  </body>
 </html>
 
diff --git a/src/interp/i-coerce.lisp.pamphlet b/src/interp/i-coerce.lisp.pamphlet
index c312134..6fc9972 100644
--- a/src/interp/i-coerce.lisp.pamphlet
+++ b/src/interp/i-coerce.lisp.pamphlet
@@ -1142,84 +1142,15 @@ Interpreter Coercion Query Functions
 ;        CAR(sig) isnt ['TypeEquivalence,:.]] and true
 ;  ans
 
-(DEFUN |canCoerceByFunction1| (|m1| |m2| |fun|)
-  (PROG (|$declaredMode| |$reportBottomUpFlag| |l1| |l2| |l| |sig|
-            |ISTMP#1| |ans|)
-    (DECLARE (SPECIAL |$declaredMode| |$reportBottomUpFlag|))
-    (RETURN
-      (SEQ (PROGN
-             (setq |$declaredMode| NIL)
-             (setq |$reportBottomUpFlag| NIL)
-             (setq |l1|
-                      (REMDUP (CONS |m1| (CONS |m1| NIL))))
-             (setq |l2|
-                      (REMDUP (CONS |m2| (CONS |m2| NIL))))
-             (setq |ans| NIL)
-             (DO ((G167106 |l1| (CDR G167106)) (|t1| NIL))
-                 ((OR (ATOM G167106)
-                      (PROGN (SETQ |t1| (CAR G167106)) NIL)
-                      (NULL (NULL |ans|)))
-                  NIL)
-               (SEQ (EXIT (DO ((G167123 |l2| (CDR G167123))
-                               (|t2| NIL))
-                              ((OR (ATOM G167123)
-                                   (PROGN
-                                     (SETQ |t2| (CAR G167123))
-                                     NIL)
-                                   (NULL (NULL |ans|)))
-                               NIL)
-                            (SEQ (EXIT (PROGN
-                                         (setq |l|
-                                          (|selectMms1| |fun| |t2|
-                                           (CONS |t1| NIL)
-                                           (CONS |t1| NIL) NIL))
-                                         (setq |ans|
-                                          (AND
-                                           (PROG (G167135)
-                                             (setq G167135 NIL)
-                                             (RETURN
-                                               (DO
-                                                ((G167141 |l|
-                                                  (CDR G167141))
-                                                 (|x| NIL))
-                                                ((OR (ATOM G167141)
-                                                  (PROGN
-                                                    (SETQ |x|
-                                                     (CAR G167141))
-                                                    NIL))
-                                                 (NREVERSE0 G167135))
-                                                 (SEQ
-                                                  (EXIT
-                                                   (COND
-                                                     ((AND (CONSP |x|)
-                                                       (PROGN
-                                                         (setq |sig|
-                                                          (QCAR |x|))
-                                                         'T)
-                                                       (BOOT-EQUAL
-                                                        (CADR |sig|)
-                                                        |t2|)
-                                                       (BOOT-EQUAL
-                                                        (CADDR |sig|)
-                                                        |t1|)
-                                                       (NULL
-                                                        (PROGN
-                                                          (setq
-                                                           |ISTMP#1|
-                                                           (CAR |sig|))
-                                                          (AND
-                                                           (CONSP
-                                                            |ISTMP#1|)
-                                                           (EQ
-                                                            (QCAR
-                                                             |ISTMP#1|)
-                                                        '|TypeEquivalence|)))))
-                                                      (SETQ G167135
-                                                       (CONS |x|
-                                                        G167135)))))))))
-                                           'T)))))))))
-             |ans|)))))
-
+(defun |canCoerceByFunction1| (m1 m2 fun)
+ (let (|$declaredMode| |$reportBottomUpFlag| l1 l2 l sig ans)
+  (declare (special |$declaredMode| |$reportBottomUpFlag|))
+  (setq |$declaredMode| nil)
+  (setq |$reportBottomUpFlag| nil)
+  (setq l (|selectMms1| fun m2 (list m1) (list m1) nil))
+  (loop for x in l 
+   when (and (equal (cadar x) m2) (equal (caddar x) m1))
+   collect x)))
 
 ;absolutelyCannotCoerce(t1,t2) ==
 ;  -- response of true means "definitely cannot coerce"
-- 
1.7.5.4