Commit 6192a5a7 authored by Bastian Kauschke's avatar Bastian Kauschke
Browse files

dedup MonoidValued PrintMorphism implementation

parent 5c50b8fb
......@@ -75,6 +75,7 @@ class (Suitable (SlowMonoidValued m)) => MonoidValuedDescription m where
mvOperation :: Text
mvTerm :: Text
mvPrecedence :: Int
mvPrinter :: m -> Build.Builder
instance MonoidValuedDescription m => FunctorDescription (SlowMonoidValued m) where
name = mvName @m <> "-valued"
......@@ -130,6 +131,7 @@ instance MonoidValuedDescription (Max Int) where
mvDescription = "the monoid (Z, max)"
mvPrecedence = 50
mvTerm = "int"
mvPrinter (Max value) = Build.decimal value
-- | The @(ℤ, min)^X@ functor
type MinIntValued = SlowMonoidValued (Min Int)
......@@ -140,6 +142,7 @@ instance MonoidValuedDescription (Min Int) where
mvDescription = "the monoid (Z, min)"
mvPrecedence = 40
mvTerm = "int"
mvPrinter (Min value) = Build.decimal value
-- | The @(ℝ, max)^X@ functor
type MaxDoubleValued = SlowMonoidValued (MaxDouble)
......@@ -150,6 +153,7 @@ instance MonoidValuedDescription MaxDouble where
mvDescription = "the monoid (R, max)"
mvPrecedence = 30
mvTerm = "real"
mvPrinter (MaxDouble value) = printFloat value
-- | The @(ℝ, min)^X@ functor
type MinDoubleValued = SlowMonoidValued (MinDouble)
......@@ -160,6 +164,7 @@ instance MonoidValuedDescription MinDouble where
mvDescription = "the monoid (R, min)"
mvPrecedence = 20
mvTerm = "real"
mvPrinter (MinDouble value) = printFloat value
-- | The @(Word, and)^X@ functor
type BitAndValued = SlowMonoidValued (BitAnd Word64)
......@@ -170,6 +175,7 @@ instance MonoidValuedDescription (BitAnd Word64) where
mvDescription = "bitvectors and bitwise 'and' as monoid weight"
mvPrecedence = 10
mvTerm = "0xCAFE"
mvPrinter value = "0x" <> Build.hexadecimal value
-- | The @(Word, or)^X@ functor
type BitOrValued = SlowMonoidValued (BitOr Word64)
......@@ -180,6 +186,7 @@ instance MonoidValuedDescription (BitOr Word64) where
mvDescription = "bitvectors and bitwise 'or' as monoid weight"
mvPrecedence = 0
mvTerm = "0xCAFE"
mvPrinter value = "0x" <> Build.hexadecimal value
type instance Label (SlowMonoidValued m) = m
......@@ -215,45 +222,25 @@ instance (Monoid m, Ord m) => RefinementInterface (SlowMonoidValued m) where
instance (Monoid m, Ord m) => MinimizationInterface (SlowMonoidValued m) where
merge _ lbls = filter (/=mempty) [fold lbls]
instance PrintMorphism (SlowMonoidValued (Max Int)) where
instance (MonoidValuedDescription m) => PrintMorphism (SlowMonoidValued m) where
printMorphismPoint _ _ edges = "{" <> sepFold ", " printEdge edges <> "}"
where printEdge ((Max value), state) = state <> ": " <> Build.decimal value
where printEdge (value, state) = state <> ": " <> mvPrinter value
instance ParseMorphism (SlowMonoidValued (Max Int)) where
parseMorphismPoint = parseMorphismPointHelper (Max <$> (L.signed L.decimal))
instance PrintMorphism (SlowMonoidValued (Min Int)) where
printMorphismPoint _ _ edges = "{" <> sepFold ", " printEdge edges <> "}"
where printEdge ((Min value), state) = state <> ": " <> Build.decimal value
instance ParseMorphism (SlowMonoidValued (Min Int)) where
parseMorphismPoint = parseMorphismPointHelper (Min <$> (L.signed L.decimal))
instance PrintMorphism (SlowMonoidValued MaxDouble) where
printMorphismPoint _ _ edges = "{" <> sepFold ", " printEdge edges <> "}"
where printEdge ((MaxDouble value), state) = state <> ": " <> printFloat value
instance ParseMorphism (SlowMonoidValued MaxDouble) where
parseMorphismPoint = parseMorphismPointHelper (MaxDouble <$> L.signed L.float)
instance PrintMorphism (SlowMonoidValued MinDouble) where
printMorphismPoint _ _ edges = "{" <> sepFold ", " printEdge edges <> "}"
where printEdge ((MinDouble value), state) = state <> ": " <> printFloat value
instance ParseMorphism (SlowMonoidValued MinDouble) where
parseMorphismPoint = parseMorphismPointHelper (MinDouble <$> L.signed L.float)
instance PrintMorphism (SlowMonoidValued (BitAnd Word64)) where
printMorphismPoint _ _ edges = "{" <> sepFold ", " printEdge edges <> "}"
where printEdge (value, state) = state <> ": 0x" <> Build.hexadecimal value
instance ParseMorphism (SlowMonoidValued (BitAnd Word64)) where
parseMorphismPoint = parseMorphismPointHelper L.hex
instance PrintMorphism (SlowMonoidValued (BitOr Word64)) where
printMorphismPoint _ _ edges = "{" <> sepFold ", " printEdge edges <> "}"
where printEdge (value, state) = state <> ": 0x" <> Build.hexadecimal value
instance ParseMorphism (SlowMonoidValued (BitOr Word64)) where
parseMorphismPoint = parseMorphismPointHelper L.hex
......
Supports Markdown
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