ghc/lib/hbc/Algebra.hs

   1 module Algebra where
   2 infixl 6 +. , -.
   3 infixl 7 *. , /.
   4
   5 --
   6 -- (x::A)->B is dependant functions
   7 -- (x = y) A is equality in type A
   8 --
   9
  10 -- For simplicity we may require decidable equality on the elements.
  11 class {-(Eq a) =>-} SemiGroup a where
  12     (+.) :: a->a->a
  13 --  assocAdd :: (x::a)->(y::a)->(z::a)->
  14 --              ((a+.b)+.c = a+.(b+.c)) a
  15
  16 class (SemiGroup a) => Monoid a where
  17     zero :: a
  18 --  leftZero :: (x::a) -> (zero +. x = x) a
  19
  20 class (Monoid a) => Group a where
  21     neg :: a->a
  22     (-.) :: a->a->a
  23     x -. y = x +. neg y
  24 --  leftNeg :: (x::a) -> (neg x +. x = zero) a
  25
  26 class (Group a) => AbelianGroup a
  27 --  commAdd :: (x::a)->(y::a)-> (x+.y = y+.x) a
  28
  29 class (AbelianGroup a) => Ring a where
  30     (*.) :: a->a->a
  31 --  assocMul  :: (x::a)->(y::a)->(z::a)->
  32 --               ((a*.b)*.c = a*.(b*.c)) a
  33 --  distrRingL :: (x::a)->(y::a)->(z::a)->
  34 --                (x*.(y+.z) = x*.y +. x*.z)
  35 --  distrRingR :: (x::a)->(y::a)->(z::a)->
  36 --                ((y+.z)*.x = y*.x +. z*.x)
  37
  38 class (Ring a) => UnityRing a where
  39     one :: a
  40 --  leftOne :: (x::a)->(one *. x = x) a
  41 --  rightOne :: (x::a)->(x *. one = x) a
  42
  43 class (Ring a) => CommutativeRing a
  44 --  commMul :: (x::a)->(y::a)-> (x*.y = y*.x) a
  45
  46 class (CommutativeRing a, UnityRing a) => IntegralDomain a
  47 --  noZeroDiv :: (x::a)->(y::a)-> (  (x*.y = zero) a  ->  Either ((x=zero) a) ((y=zero) a)  )
  48
  49 class (UnityRing a) => DivisionRing a where
  50     inv :: a->a
  51     (/.) :: a->a->a
  52     x /. y = x *. inv y
  53 --  leftinv :: (x::a) -> (inv x *. x = one) a
  54
  55 class (DivisionRing a, CommutativeRing a) => Field a
  56
  57 -- Every finite integral domain is a field.
  58
  59 -- Unique Factorization Domain
  60 class (IntegralDomain a) => UFD a
  61 --  every non-zero element has a unique factorization
  62
  63 -- Principal Ideal Domain
  64 class (IntegralDomain a) => PID a
  65 --  every ideal is a principal ideal
  66
  67 ---------------------------------------------------
  68
  69 -- [a] --
  70 instance SemiGroup [a] where
  71     (+.) = (++)
  72 instance Monoid [a] where
  73     zero = []
  74
  75 -- Bool --
  76 instance SemiGroup Bool where
  77     (+.) = (||)
  78 instance Monoid Bool where
  79     zero = False
  80 instance Group Bool where
  81     neg = not
  82 instance AbelianGroup Bool
  83 instance Ring Bool where
  84     (*.) = (&&)
  85 instance CommutativeRing Bool
  86 instance UnityRing Bool where
  87     one = True
  88 instance DivisionRing Bool where
  89     inv x = x
  90
  91 -- Int --
  92 instance SemiGroup Int where
  93     (+.) = (+)
  94 instance Monoid Int where
  95     zero = 0
  96 instance Group Int where
  97     neg = negate
  98 instance AbelianGroup Int
  99 instance Ring Int where
 100     (*.) = (*)
 101 instance CommutativeRing Int
 102 instance UnityRing Int where
 103     one = 1
 104
 105 -- Integer --
 106 instance SemiGroup Integer where
 107     (+.) = (+)
 108 instance Monoid Integer where
 109     zero = 0
 110 instance Group Integer where
 111     neg = negate
 112 instance AbelianGroup Integer
 113 instance Ring Integer where
 114     (*.) = (*)
 115 instance CommutativeRing Integer
 116 instance UnityRing Integer where
 117     one = 1
 118 instance IntegralDomain Integer
 119
 120 -- Q --
 121 -- A new data tupe is needed to do the instance declarations
 122 data Q = Q Rational {-#STRICT#-} deriving (Eq, Ord)
 123 instance Text Q where
 124 #if defined(__HBC__)
 125     -- not standard
 126     showsType _ = showString "Q"
 127 #endif
 128     showsPrec n (Q p) = showsPrec n p
 129 instance SemiGroup Q where
 130     Q a +. Q b = Q (a+b)
 131 instance Monoid Q where
 132     zero = Q 0
 133 instance Group Q where
 134     neg (Q a) = Q (-a)
 135 instance AbelianGroup Q
 136 instance Ring Q where
 137     Q a *. Q b = Q (a*b)
 138 instance CommutativeRing Q
 139 instance UnityRing Q where
 140     one = Q 1
 141 instance IntegralDomain Q
 142 instance DivisionRing Q where
 143     inv (Q x) = Q (recip x)
 144 instance Field Q
 145