From 1d0ca51b8e2877e9d4dca8fb95cec302466c972e Mon Sep 17 00:00:00 2001
From: Hans-Peter Deifel <hpd@hpdeifel.de>
Date: Fri, 19 Oct 2018 22:33:29 +0200
Subject: [PATCH] Remove monomorphic constructors from MonoidValued functors
The two constructors IntValued and RealValued were a historical
artifact and not at all needed. A general constructor `MonoidValued a`
is all it really takes to implement different parsers for Int and
ADouble.
---
src/MA/Functors/Distribution.hs | 2 +-
src/MA/Functors/MonoidValued.hs | 12 +++++-------
2 files changed, 6 insertions(+), 8 deletions(-)
diff --git a/src/MA/Functors/Distribution.hs b/src/MA/Functors/Distribution.hs
index 55f6244..b186a31 100644
--- a/src/MA/Functors/Distribution.hs
+++ b/src/MA/Functors/Distribution.hs
@@ -46,7 +46,7 @@ deriving instance Show (Distribution ())
instance ParseMorphism Distribution where
parseMorphismPoint (Distribution inner) = do
- (h1, succs) <- parseMorphismPoint (RealValued inner)
+ (h1, succs) <- parseMorphismPoint (MonoidValued @ADouble inner)
when (h1 /= 1) $
fail "distribution: Sum of outgoing labels is not 1"
diff --git a/src/MA/Functors/MonoidValued.hs b/src/MA/Functors/MonoidValued.hs
index 64ca17f..4d345b1 100644
--- a/src/MA/Functors/MonoidValued.hs
+++ b/src/MA/Functors/MonoidValued.hs
@@ -31,9 +31,7 @@ import qualified MA.Parser.Lexer as L
import MA.Parser.Types
import MA.FunctorDescription
-data MonoidValued m a where
- RealValued :: a -> MonoidValued ADouble a
- IntValued :: a -> MonoidValued Int a
+data MonoidValued m a = MonoidValued a
deriving instance Show (MonoidValued m ())
deriving instance Functor (MonoidValued m)
@@ -45,7 +43,7 @@ intValued = FunctorDescription
{ name = "Integer-valued"
, syntaxExample = "Z^X | ℤ^X"
, functorExprParser =
- prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure IntValued)
+ prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure MonoidValued)
}
realValued :: FunctorDescription (MonoidValued ADouble)
@@ -53,7 +51,7 @@ realValued = FunctorDescription
{ name = "Real-valued"
, syntaxExample = "R^X | ℝ^X"
, functorExprParser = prefix
- ((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure RealValued)
+ ((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure MonoidValued)
}
data MonoidWeight m = MonoidWeight !m !m
@@ -88,10 +86,10 @@ parseMorphismPointHelper inner weightParser = do
{-# SPECIALIZE parseMorphismPointHelper :: MorphParser l h1 Int -> MorphParser l h1 ADouble -> MorphParser l h1 (ADouble, Vector (Int, ADouble)) #-}
instance ParseMorphism (MonoidValued Int) where
- parseMorphismPoint (IntValued inner) = parseMorphismPointHelper inner L.decimal
+ parseMorphismPoint (MonoidValued inner) = parseMorphismPointHelper inner L.decimal
instance ParseMorphism (MonoidValued ADouble) where
- parseMorphismPoint (RealValued inner) = parseMorphismPointHelper inner L.adouble
+ parseMorphismPoint (MonoidValued inner) = parseMorphismPointHelper inner L.adouble
instance (Num m, Ord m) => RefinementInterface (MonoidValued m) where
init :: H1 (MonoidValued m) -> [Label (MonoidValued m)] -> Weight (MonoidValued m)
--
GitLab