Changeset 4300
- Timestamp:
- 2016-06-04T22:13:59-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/integer-ring.lisp
r4267 r4300 21 21 22 22 (defpackage "INTEGER-RING" 23 (:use :cl :copy :ring )23 (:use :cl :copy :ring :rational-field) 24 24 (:export "INTEGER-RING" 25 25 "INTEGER-RING-VALUE" … … 39 39 (in-package "INTEGER-RING") 40 40 41 (defclass integer-ring (r ing)41 (defclass integer-ring (rational-field) 42 42 ((value :initarg :value :initform 0 :accessor integer-ring-value :type integer)) 43 43 (:documentation "An object representing an integer.") … … 50 50 (format stream "VALUE=~A" value)))) 51 51 52 (defmethod multiply-by ((self integer-ring) (other integer-ring))53 (with-slots (value)54 self55 (with-slots ((other-value value))56 other57 (setf value (* value other-value))))58 self)59 60 (defmethod divide-by ((self integer-ring) (other integer-ring))61 (with-slots (value)62 self63 (with-slots ((other-value value))64 other65 (assert (zerop (mod value other-value)))66 (setf value (/ value other-value))))67 self)68 69 (defmethod add-to ((self integer-ring) (other integer-ring))70 (with-slots (value)71 self72 (with-slots ((other-value value))73 other74 (setf value (+ value other-value))))75 self)76 77 (defmethod subtract-from ((self integer-ring) (other integer-ring))78 (with-slots (value)79 self80 (with-slots ((other-value value))81 other82 (setf value (- value other-value))))83 self)84 85 (defmethod unary-minus ((self integer-ring))86 (with-slots (value)87 self88 (setf value (- value)))89 self)90 91 52 (defmethod unary-inverse ((self integer-ring)) 92 53 (with-slots (value) … … 96 57 (-1 self) 97 58 (otherwise (error "Non-invertible ring element: ~S" self))))) 98 99 (defmethod universal-zerop ((self integer-ring))100 (with-slots (value)101 self102 (zerop value)))103 59 104 60 (defmethod universal-gcd ((self integer-ring) (other integer-ring)) … … 118 74 (make-instance 'integer-ring :value (/ value c)) 119 75 (make-instance 'integer-ring :value (/ other-value c))))))) 120 121 (defmethod universal-equalp ((self integer-ring) (other integer-ring))122 (with-slots (value)123 self124 (with-slots ((other-value value))125 other126 (= value other-value))))127 128 (defmethod ->sexp ((self integer-ring) &optional vars)129 (declare (ignore vars))130 (integer-ring-value self))
Note:
See TracChangeset
for help on using the changeset viewer.