Commit 8182aa5a authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

Remove product functor

This was long obsoleted by the polynomial functor
parent 0f631281
......@@ -35,7 +35,6 @@ library
, MA.Functors.Bag
, MA.Functors.MonoidValued
, MA.Functors.Distribution
, MA.Functors.Product
, MA.Functors.Polynomial
, MA.Functors.SomeFunctor
, MA.Parser
......
module MA.Functors.Product
( product
, Product(..)
) where
import Control.Monad (void)
import Prelude hiding (product)
import Data.Tuple.Extra (both)
import MA.RefinementInterface
import qualified MA.Parser.Lexer as L
import MA.FunctorExpression.Parser
import MA.Coalgebra.RefinementTypes
import MA.Coalgebra.Parser
data Product a = Product a a
deriving (Show, Functor, Foldable, Traversable)
product :: FunctorParser Product
product = infixR $ do
void $ L.symbol "×"
return Product
data Side = L | R
deriving (Eq)
data Three = ToRest | ToCompound | ToSub
deriving (Show, Eq, Ord, Enum)
type instance H1 Product = ()
type instance H3 Product = (Three, Three)
type instance Label Product = Side
type instance Weight Product = (Bool, Bool)
instance ParseMorphism Product where
parseMorphismPoint (Product parseLeft parseRight) = L.parens $ do
left <- parseLeft
void L.comma
right <- parseRight
return ((), [(left, L), (right, R)])
instance RefinementInterface Product where
init :: H1 Product -> [Label Product] -> Weight Product
init _ _ = (True, True)
update :: [Label Product] -> Weight Product -> (Weight Product, H3 Product, Weight Product)
update labels (left, right) = val up
where
val h3 = (both (==ToSub) h3, h3, both (==ToCompound) h3)
up = (left +? (L `elem` labels), right +? (R `elem` labels))
(+?) :: Bool -> Bool -> Three
a +? b = toEnum (fromEnum a + fromEnum b)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment