# ekmett/semigroups

### Subversion checkout URL

You can clone with
or
.

Moved Numeric.Natural down from algebra. Added replicate1p to Semigroup

commit e96c5a29b6074f0929423236095293deff2f9e55 1 parent 169665b
authored
35 Data/Semigroup.hs
 @@ -41,6 +41,7 @@ import Data.Foldable import Data.Traversable import Data.List.NonEmpty +import Numeric.Natural.Internal import Data.Sequence (Seq, (><)) import Data.Set (Set) import Data.IntSet (IntSet) @@ -61,12 +62,29 @@ class Semigroup a where go b (c:cs) = b <> go c cs go b [] = b + -- replicate1p n r = replicate (1 + n) r + replicate1p :: Whole n => n -> a -> a + replicate1p y0 x0 = f x0 (1 Prelude.+ y0) + where + f x y + | even y = f (x <> x) (y `quot` 2) + | y == 1 = x + | otherwise = g (x <> x) (unsafePred y `quot` 2) x + g x y z + | even y = g (x <> x) (y `quot` 2) z + | y == 1 = x <> z + | otherwise = g (x <> x) (unsafePred y `quot` 2) (x <> z) + {-# INLINE replicate1p #-} + + instance Semigroup () where _ <> _ = () sconcat _ = () + replicate1p _ _ = () instance Semigroup b => Semigroup (a -> b) where f <> g = \a -> f a <> g a + replicate1p n f e = replicate1p n (f e) instance Semigroup [a] where (<>) = (++) @@ -82,27 +100,34 @@ instance Semigroup (Either a b) where instance (Semigroup a, Semigroup b) => Semigroup (a, b) where (a,b) <> (a',b') = (a<>a',b<>b') + replicate1p n (a,b) = (replicate1p n a, replicate1p n b) instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') + replicate1p n (a,b,c) = (replicate1p n a, replicate1p n b, replicate1p n c) instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) where (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') + replicate1p n (a,b,c,d) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d) instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') + replicate1p n (a,b,c,d,e) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d, replicate1p n e) instance Semigroup a => Semigroup (Dual a) where Dual a <> Dual b = Dual (b <> a) + replicate1p n (Dual a) = Dual (replicate1p n a) instance Semigroup (Endo a) where Endo f <> Endo g = Endo (f . g) instance Semigroup All where All a <> All b = All (a && b) + replicate1p _ a = a instance Semigroup Any where Any a <> Any b = Any (a || b) + replicate1p _ a = a instance Num a => Semigroup (Sum a) where Sum a <> Sum b = Sum (a + b) @@ -113,10 +138,12 @@ instance Num a => Semigroup (Product a) where instance Semigroup (Monoid.First a) where Monoid.First Nothing <> b = b a <> _ = a + replicate1p _ a = a instance Semigroup (Monoid.Last a) where a <> Monoid.Last Nothing = a _ <> b = b + replicate1p _ a = a instance Semigroup (NonEmpty a) where (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) @@ -130,6 +157,7 @@ newtype Min a = Min { getMin :: a } deriving instance Ord a => Semigroup (Min a) where Min a <> Min b = Min (a `min` b) + replicate1p _ a = a instance (Ord a, Bounded a) => Monoid (Min a) where mempty = maxBound @@ -144,6 +172,7 @@ newtype Max a = Max { getMax :: a } deriving instance Ord a => Semigroup (Max a) where Max a <> Max b = Max (a `max` b) + replicate1p _ a = a instance (Ord a, Bounded a) => Monoid (Max a) where mempty = minBound @@ -160,6 +189,7 @@ newtype First a = First { getFirst :: a } deriving instance Semigroup (First a) where a <> _ = a + replicate1p _ a = a -- | Use @'Option' ('Last' a)@ -- to get the behavior of 'Data.Monoid.Last' newtype Last a = Last { getLast :: a } deriving @@ -171,6 +201,7 @@ newtype Last a = Last { getLast :: a } deriving instance Semigroup (Last a) where _ <> b = b + replicate1p _ a = a -- (==)/XNOR on Bool forms a 'Semigroup', but has no good name @@ -255,12 +286,16 @@ instance Semigroup (Seq a) where instance Semigroup IntSet where (<>) = mappend + replicate1p _ a = a instance Ord a => Semigroup (Set a) where (<>) = mappend + replicate1p _ a = a instance Semigroup (IntMap v) where (<>) = mappend + replicate1p _ a = a instance Ord k => Semigroup (Map k v) where (<>) = mappend + replicate1p _ a = a
6 Numeric/Natural.hs
 @@ -0,0 +1,6 @@ +module Numeric.Natural + ( Natural + , Whole(toNatural) + ) where + +import Numeric.Natural.Internal
96 Numeric/Natural/Internal.hs
 @@ -0,0 +1,96 @@ +module Numeric.Natural.Internal + ( Natural(..) + , Whole(..) + ) where + +import Data.Word +import Data.Bits +import Text.Read +import Data.Ix + +newtype Natural = Natural { runNatural :: Integer } deriving (Eq,Ord,Ix) + +instance Show Natural where + showsPrec d (Natural n) = showsPrec d n + +instance Read Natural where + readPrec = fmap Natural \$ step readPrec + +instance Num Natural where + Natural n + Natural m = Natural (n + m) + Natural n * Natural m = Natural (n * m) + Natural n - Natural m | result < 0 = error "Natural.(-): negative result" + | otherwise = Natural result + where result = n - m + abs (Natural n) = Natural n + signum (Natural n) = Natural (signum n) + fromInteger n + | n >= 0 = Natural n + | otherwise = error "Natural.fromInteger: negative" + +instance Bits Natural where + Natural n .&. Natural m = Natural (n .&. m) + Natural n .|. Natural m = Natural (n .|. m) + xor (Natural n) (Natural m) = Natural (xor n m) + complement _ = error "Bits.complement: Natural complement undefined" + shift (Natural n) = Natural . shift n + rotate (Natural n) = Natural . rotate n + bit = Natural . bit + setBit (Natural n) = Natural . setBit n + clearBit (Natural n) = Natural . clearBit n + complementBit (Natural n) = Natural . complementBit n + testBit = testBit . runNatural + bitSize = bitSize . runNatural + isSigned _ = False + shiftL (Natural n) = Natural . shiftL n + shiftR (Natural n) = Natural . shiftR n + rotateL (Natural n) = Natural . rotateL n + rotateR (Natural n) = Natural . rotateR n + +instance Real Natural where + toRational (Natural a) = toRational a + +instance Enum Natural where + pred (Natural 0) = error "Natural.pred: 0" + pred (Natural n) = Natural (pred n) + succ (Natural n) = Natural (succ n) + fromEnum (Natural n) = fromEnum n + toEnum n | n < 0 = error "Natural.toEnum: negative" + | otherwise = Natural (toEnum n) + +instance Integral Natural where + quot (Natural a) (Natural b) = Natural (quot a b) + rem (Natural a) (Natural b) = Natural (rem a b) + div (Natural a) (Natural b) = Natural (div a b) + mod (Natural a) (Natural b) = Natural (mod a b) + divMod (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = divMod a b + quotRem (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = quotRem a b + toInteger = runNatural + +class Integral n => Whole n where + toNatural :: n -> Natural + unsafePred :: n -> n + +instance Whole Word where + toNatural = Natural . toInteger + unsafePred n = n - 1 + +instance Whole Word8 where + toNatural = Natural . toInteger + unsafePred n = n - 1 + +instance Whole Word16 where + toNatural = Natural . toInteger + unsafePred n = n - 1 + +instance Whole Word32 where + toNatural = Natural . toInteger + unsafePred n = n - 1 + +instance Whole Word64 where + toNatural = Natural . toInteger + unsafePred n = n - 1 + +instance Whole Natural where + toNatural = id + unsafePred (Natural n) = Natural (n - 1)
4 semigroups.cabal
 @@ -1,6 +1,6 @@ name: semigroups category: Algebra, Data, Data Structures, Math -version: 0.6.1 +version: 0.7.0 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE @@ -36,3 +36,5 @@ library exposed-modules: Data.Semigroup Data.List.NonEmpty + Numeric.Natural + Numeric.Natural.Internal