systemqfw

system Q F omega elaborator
git clone git://git.rr3.xyz/systemqfw
Log | Files | Refs | Submodules | README | LICENSE

Algebra.hs (1410B)

      1 module Algebra where
      2 import Data.Functor ((<&>))
      3 
      4 -- Type classes for quantity algebras and ledgers
      5 
      6 infix 4 ?<, ?<=, ?>=, ?>
      7 
      8 class Eq a => PartialOrd a where
      9     pcompare :: a -> a -> Maybe Ordering
     10     x `pcompare` y =
     11         if x ?< y then
     12             Just LT
     13         else if x == y then
     14             Just EQ
     15         else if y ?< x then
     16             Just GT
     17         else
     18             Nothing
     19 
     20     (?<) :: a -> a -> Bool
     21     x ?< y = x `pcompare` y == Just LT
     22 
     23     (?<=) :: a -> a -> Bool
     24     x ?<= y = x == y || x ?< y
     25 
     26     (?>=) :: a -> a -> Bool
     27     x ?>= y = x == y || x ?> y
     28 
     29     (?>) :: a -> a -> Bool
     30     x ?> y = x `pcompare` y == Just GT
     31 
     32     pmin :: a -> a -> Maybe a
     33     x `pmin` y = x `pcompare` y <&> \case
     34         LT -> x
     35         EQ -> x
     36         GT -> y
     37 
     38     pmax :: a -> a -> Maybe a
     39     x `pmax` y = x `pcompare` y <&> \case
     40         LT -> y
     41         EQ -> x
     42         GT -> x
     43 
     44     {-# MINIMAL pcompare | (?<) #-}
     45 
     46 {-
     47 class LubMonoid a where
     48     bot :: a
     49     (<^>) :: a -> a -> a
     50 -}
     51 
     52 class AddMonoid a where
     53     zero :: a
     54     (<+>) :: a -> a -> a
     55 
     56 class MulScalar a where
     57     one :: a
     58 class MulScalar (MulActionScalar a) => MulAction a where
     59     type MulActionScalar a
     60     (<⋅>) :: MulActionScalar a -> a -> a
     61 
     62 class (
     63         PartialOrd a,
     64         -- LubMonoid a,
     65         AddMonoid a,
     66         MulAction a,
     67         MulActionScalar a ~ a
     68     ) => QuantityAlgebra a where
     69     defaultQuantity :: a