src/rational/ring/cl_RA_ring.cc

   1 // Ring of rational numbers.
   2
   3 // General includes.
   4 #include "cl_sysdep.h"
   5
   6 CL_PROVIDE(cl_RA_ring)
   7
   8 // Specification.
   9 #include "cl_rational_ring.h"
  10
  11
  12 // Implementation.
  13
  14 #include "cl_rational.h"
  15 #include "cl_rational_io.h"
  16 #include "cl_RA.h"
  17
  18 static void RA_fprint (cl_heap_ring* R, cl_ostream stream, const _cl_ring_element& x)
  19 {
  20         unused R;
  21         fprint(stream,The(cl_RA)(x));
  22 }
  23
  24 static cl_boolean RA_equal (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  25 {
  26         unused R;
  27         return cl_equal(The(cl_RA)(x),The(cl_RA)(y));
  28 }
  29
  30 static const _cl_ring_element RA_zero (cl_heap_ring* R)
  31 {
  32         return _cl_ring_element(R, (cl_RA)0);
  33 }
  34
  35 static cl_boolean RA_zerop (cl_heap_ring* R, const _cl_ring_element& x)
  36 {
  37         unused R;
  38         return zerop(The(cl_RA)(x));
  39 }
  40
  41 static const _cl_ring_element RA_plus (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  42 {
  43         return _cl_ring_element(R, The(cl_RA)(x) + The(cl_RA)(y));
  44 }
  45
  46 static const _cl_ring_element RA_minus (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  47 {
  48         return _cl_ring_element(R, The(cl_RA)(x) - The(cl_RA)(y));
  49 }
  50
  51 static const _cl_ring_element RA_uminus (cl_heap_ring* R, const _cl_ring_element& x)
  52 {
  53         return _cl_ring_element(R, - The(cl_RA)(x));
  54 }
  55
  56 static const _cl_ring_element RA_one (cl_heap_ring* R)
  57 {
  58         return _cl_ring_element(R, (cl_RA)1);
  59 }
  60
  61 static const _cl_ring_element RA_canonhom (cl_heap_ring* R, const cl_I& x)
  62 {
  63         return _cl_ring_element(R, (cl_RA)x);
  64 }
  65
  66 static const _cl_ring_element RA_mul (cl_heap_ring* R, const _cl_ring_element& x, const _cl_ring_element& y)
  67 {
  68         return _cl_ring_element(R, The(cl_RA)(x) * The(cl_RA)(y));
  69 }
  70
  71 static const _cl_ring_element RA_square (cl_heap_ring* R, const _cl_ring_element& x)
  72 {
  73         return _cl_ring_element(R, square(The(cl_RA)(x)));
  74 }
  75
  76 static const _cl_ring_element RA_expt_pos (cl_heap_ring* R, const _cl_ring_element& x, const cl_I& y)
  77 {
  78         return _cl_ring_element(R, expt_pos(The(cl_RA)(x),y));
  79 }
  80
  81 static cl_boolean cl_RA_p (const cl_number& x)
  82 {
  83         return (cl_boolean)
  84                (!x.pointer_p()
  85                 ? x.nonpointer_tag() == cl_FN_tag
  86                 : (x.pointer_type()->flags & cl_class_flags_subclass_rational) != 0
  87                );
  88 }
  89
  90 static cl_ring_setops RA_setops = {
  91         RA_fprint,
  92         RA_equal
  93 };
  94 static cl_ring_addops RA_addops = {
  95         RA_zero,
  96         RA_zerop,
  97         RA_plus,
  98         RA_minus,
  99         RA_uminus
 100 };
 101 static cl_ring_mulops RA_mulops = {
 102         RA_one,
 103         RA_canonhom,
 104         RA_mul,
 105         RA_square,
 106         RA_expt_pos
 107 };
 108
 109 static cl_number_ring_ops<cl_RA> RA_ops = {
 110         cl_RA_p,
 111         cl_equal,
 112         zerop,
 113         operator+,
 114         operator-,
 115         operator-,
 116         operator*,
 117         square,
 118         expt_pos
 119 };
 120
 121 class cl_heap_rational_ring : public cl_heap_number_ring {
 122         SUBCLASS_cl_heap_ring()
 123 public:
 124         // Constructor.
 125         cl_heap_rational_ring ()
 126                 : cl_heap_number_ring (&RA_setops,&RA_addops,&RA_mulops,
 127                                        (cl_number_ring_ops<cl_number>*) &RA_ops)
 128                 { type = &cl_class_rational_ring; }
 129         // Destructor.
 130         ~cl_heap_rational_ring () {}
 131 };
 132
 133 static void cl_rational_ring_destructor (cl_heap* pointer)
 134 {
 135         (*(cl_heap_rational_ring*)pointer).~cl_heap_rational_ring();
 136 }
 137
 138 static void cl_rational_ring_dprint (cl_heap* pointer)
 139 {
 140         unused pointer;
 141         fprint(cl_debugout, "(cl_rational_ring) cl_RA_ring");
 142 }
 143
 144 cl_class cl_class_rational_ring = {
 145         cl_rational_ring_destructor,
 146         cl_class_flags_number_ring,
 147         cl_rational_ring_dprint
 148 };
 149
 150 // Constructor.
 151 inline cl_rational_ring::cl_specialized_number_ring ()
 152         : cl_number_ring (new cl_heap_rational_ring()) {}
 153
 154 const cl_rational_ring cl_RA_ring;
 155
 156 CL_PROVIDE_END(cl_RA_ring)