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