Lower eqv? and equal? to new instructions.

* libguile/numbers.h:
* libguile/eq.c (scm_i_heap_numbers_equal_p): New helper, factored out
  of scm_eqv_p.
  (scm_eqv_p): Use new helper.
* libguile/vm-engine.c (heap-numbers-equal?): New op.
* module/language/cps/compile-bytecode.scm (compile-function): Add
  support for heap-number? and heap-numbers-equal?.  Remove case for
  eqv?.
* module/language/cps/effects-analysis.scm: Add heap-numbers-equal?.
* module/language/cps/primitives.scm (*comparisons*): Add
  heap-numbers-equal?.
* module/language/cps/type-fold.scm (heap-numbers-equal?): Update.
* module/language/cps/types.scm (heap-numbers-equal?): Update.
* module/language/tree-il/compile-cps.scm (canonicalize): Completely
  inline eqv?, and partially inline equal?.
* module/system/vm/assembler.scm (system): Export emit-heap-numbers-equal?.

1 files changed, 21 insertions, 12 deletions

diff --git a/libguile/eq.c b/libguile/eq.c
index 4680de7d8..daee4c02e 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1998,2000-2001,2003-2004,2006,2009-2011,2017 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -156,6 +156,25 @@ scm_i_fraction_equalp (SCM x, SCM y)
 				  SCM_FRACTION_DENOMINATOR (y))));
 }
 
+SCM
+scm_i_heap_numbers_equal_p (SCM x, SCM y)
+{
+  if (SCM_IMP (x)) abort();
+  switch (SCM_TYP16 (x))
+    {
+    case scm_tc16_big:
+      return scm_bigequal (x, y);
+    case scm_tc16_real:
+      return scm_real_equalp (x, y);
+    case scm_tc16_complex:
+      return scm_complex_equalp (x, y);
+    case scm_tc16_fraction:
+      return scm_i_fraction_equalp (x, y);
+    default:
+      abort ();
+    }
+}
+
 static SCM scm_i_eqv_p (SCM x, SCM y, SCM rest);
 #include <stdio.h>
 SCM_DEFINE (scm_i_eqv_p, "eqv?", 0, 2, 1,
@@ -210,17 +229,7 @@ SCM scm_eqv_p (SCM x, SCM y)
     default:
       break;
     case scm_tc7_number:
-      switch SCM_TYP16 (x)
-        {
-        case scm_tc16_big:
-          return scm_bigequal (x, y);
-        case scm_tc16_real:
-          return scm_real_equalp (x, y);
-        case scm_tc16_complex:
-          return scm_complex_equalp (x, y);
-	case scm_tc16_fraction:
-          return scm_i_fraction_equalp (x, y);
-        }
+      return scm_i_heap_numbers_equal_p (x, y);
     }
   return SCM_BOOL_F;
 }