src/real/ring/cl_R_ring.cc

   1 // Ring of real numbers.
   2
   3 // General includes.
   4 #include "cl_sysdep.h"
   5
   6 CL_PROVIDE(cl_R_ring)
   7
   8 // Specification.
   9 #include "cln/real_ring.h"
  10
  11
  12 // Implementation.
  13
  14 #include "cln/real.h"
  15 #include "cl_R.h"
  16 #include "cln/io.h"
  17 #include "cln/real_io.h"
  18
  19 namespace cln {
  20
  21 static void R_fprint (cl_heap_ring* R, cl_ostream stream, const _cl_ring_element& x)
  22 {
  23         unused R;
  24         fprint(stream,The(cl_R)(x));
  25 }
  26
  27 static cl_boolean R_equal (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  28 {
  29         unused R;
  30         return equal(The(cl_R)(x),The(cl_R)(y));
  31 }
  32
  33 static const _cl_ring_element R_zero (cl_heap_ring* R)
  34 {
  35         return _cl_ring_element(R, (cl_R)0);
  36 }
  37
  38 static cl_boolean R_zerop (cl_heap_ring* R, const _cl_ring_element& x)
  39 {
  40         unused R;
  41         // Here we return true only if x is the *exact* zero. Because we
  42         // don't want the degree of polynomials to depend on rounding errors.
  43         // For all ring theoretic purposes, we treat 0.0 as if it were a
  44         // zero divisor.
  45         return exact_zerop(The(cl_R)(x));
  46 }
  47
  48 static const _cl_ring_element R_plus (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  49 {
  50         return _cl_ring_element(R, The(cl_R)(x) + The(cl_R)(y));
  51 }
  52
  53 static const _cl_ring_element R_minus (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  54 {
  55         return _cl_ring_element(R, The(cl_R)(x) - The(cl_R)(y));
  56 }
  57
  58 static const _cl_ring_element R_uminus (cl_heap_ring* R, const _cl_ring_element& x)
  59 {
  60         return _cl_ring_element(R, - The(cl_R)(x));
  61 }
  62
  63 static const _cl_ring_element R_one (cl_heap_ring* R)
  64 {
  65         return _cl_ring_element(R, (cl_R)1);
  66 }
  67
  68 static const _cl_ring_element R_canonhom (cl_heap_ring* R, const cl_I& x)
  69 {
  70         return _cl_ring_element(R, (cl_R)x);
  71 }
  72
  73 static const _cl_ring_element R_mul (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  74 {
  75         return _cl_ring_element(R, The(cl_R)(x) * The(cl_R)(y));
  76 }
  77
  78 static const _cl_ring_element R_square (cl_heap_ring* R, const _cl_ring_element& x)
  79 {
  80         return _cl_ring_element(R, square(The(cl_R)(x)));
  81 }
  82
  83 static const _cl_ring_element R_expt_pos (cl_heap_ring* R, const _cl_ring_element& x, const cl_I& y)
  84 {
  85         return _cl_ring_element(R, expt(The(cl_R)(x),y));
  86 }
  87
  88 static cl_boolean cl_R_p (const cl_number& x)
  89 {
  90         return (cl_boolean)
  91                (!x.pointer_p()
  92                 || (x.pointer_type()->flags & cl_class_flags_subclass_real) != 0
  93                );
  94 }
  95
  96 static cl_ring_setops R_setops = {
  97         R_fprint,
  98         R_equal
  99 };
 100 static cl_ring_addops R_addops = {
 101         R_zero,
 102         R_zerop,
 103         R_plus,
 104         R_minus,
 105         R_uminus
 106 };
 107 static cl_ring_mulops R_mulops = {
 108         R_one,
 109         R_canonhom,
 110         R_mul,
 111         R_square,
 112         R_expt_pos
 113 };
 114
 115 static cl_number_ring_ops<cl_R> R_ops = {
 116         cl_R_p,
 117         equal,
 118         exact_zerop,
 119         operator+,
 120         operator-,
 121         operator-,
 122         operator*,
 123         square,
 124         expt
 125 };
 126
 127 class cl_heap_real_ring : public cl_heap_number_ring {
 128         SUBCLASS_cl_heap_ring()
 129 public:
 130         // Constructor.
 131         cl_heap_real_ring ()
 132                 : cl_heap_number_ring (&R_setops,&R_addops,&R_mulops,
 133                                        (cl_number_ring_ops<cl_number>*) &R_ops)
 134                 { type = &cl_class_real_ring; }
 135         // Destructor.
 136         ~cl_heap_real_ring () {}
 137 };
 138
 139 static void cl_real_ring_destructor (cl_heap* pointer)
 140 {
 141         (*(cl_heap_real_ring*)pointer).~cl_heap_real_ring();
 142 }
 143
 144 static void cl_real_ring_dprint (cl_heap* pointer)
 145 {
 146         unused pointer;
 147         fprint(cl_debugout, "(cl_real_ring) cl_R_ring");
 148 }
 149
 150 cl_class cl_class_real_ring = {
 151         cl_real_ring_destructor,
 152         cl_class_flags_number_ring,
 153         cl_real_ring_dprint
 154 };
 155
 156 // Constructor.
 157 inline cl_real_ring::cl_specialized_number_ring ()
 158         : cl_number_ring (new cl_heap_real_ring()) {}
 159
 160 const cl_real_ring cl_R_ring;
 161
 162 }  // namespace cln
 163
 164 CL_PROVIDE_END(cl_R_ring)