ref: b48af5db45a3131c01198c52c1c87d94eeb5ea17
parent: 8a9c333f2ebefdce03f17c8d16fa63423580e830
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Sep 12 12:14:04 EDT 2024
Flesh out semigroup
--- a/lib/Data/Monoid.hs
+++ b/lib/Data/Monoid.hs
@@ -2,10 +2,13 @@
import Prelude() -- do not import Prelude
import Primitives
import Control.Applicative
+import Control.Error
import Data.Bool
import Data.Bounded
+import Data.Eq
import Data.Function
import Data.Functor
+import Data.Integral
import Data.List_Type
import Data.Ord
import Data.Maybe_Type
@@ -158,3 +161,26 @@
instance Monoid Ordering where
mempty = EQ
+
+----------------------
+
+stimesIdempotentMonoid :: (Ord b, Integral b, Monoid a) => b -> a -> a
+stimesIdempotentMonoid n x = case compare n 0 of
+ LT -> error "stimesIdempotentMonoid: negative multiplier"
+ EQ -> mempty
+ GT -> x
+
+stimesMonoid :: (Ord b, Integral b, Monoid a) => b -> a -> a
+stimesMonoid n x0 = case compare n 0 of
+ LT -> error "stimesMonoid: negative multiplier"
+ EQ -> mempty
+ GT -> f x0 n
+ where
+ f x y
+ | even y = f (x `mappend` x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x `mappend` x) (y `quot` 2) x
+ g x y z
+ | even y = g (x `mappend` x) (y `quot` 2) z
+ | y == 1 = x `mappend` z
+ | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z)
--- a/lib/Data/Semigroup.hs
+++ b/lib/Data/Semigroup.hs
@@ -1,7 +1,39 @@
module Data.Semigroup(module Data.Semigroup) where
import Prelude() -- do not import Prelude
import Primitives
+import Control.Error
+import Data.Bool
+import Data.Eq
+import Data.Integral
+import Data.List_Type
+import Data.List.NonEmpty_Type
+import Data.Num
+import Data.Ord
infixr 6 <>
class Semigroup a where
- (<>) :: a -> a -> a
+ (<>) :: a -> a -> a
+ sconcat :: NonEmpty a -> a
+ stimes :: (Integral b, Ord b) => b -> a -> a
+
+ sconcat (a :| as) = go a as
+ where go b (c:cs) = b <> go c cs
+ go b [] = b
+
+ stimes y0 x0
+ | y0 <= 0 = error "stimes: positive multiplier expected"
+ | otherwise = f x0 y0
+ where
+ f x y
+ | y `rem` 2 == 0 = f (x <> x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x <> x) (y `quot` 2) x
+ g x y z
+ | y `rem` 2 == 0 = g (x <> x) (y `quot` 2) z
+ | y == 1 = x <> z
+ | otherwise = g (x <> x) (y `quot` 2) (x <> z)
+
+stimesIdempotent :: (Integral b, Ord b) => b -> a -> a
+stimesIdempotent n x =
+ if n <= 0 then error "stimesIdempotent: positive multiplier expected"
+ else x
--
⑨