Commit 22c05629 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢
Browse files

Merge branch 'print-functor' into 'master'

custom impl for `debug print-functor`

Closes #7

See merge request !20
parents 6ebd43f4 6e30c68a
......@@ -38,6 +38,7 @@ library
, Copar.RefinementInterface
, Copar.Functors
, Copar.FunctorDescription
, Copar.FunctorPrinter
, Copar.Functors.Powerset
, Copar.Functors.Bag
, Copar.Functors.GroupValued
......@@ -56,6 +57,7 @@ library
, Copar.FunctorExpression.Type
, Copar.FunctorExpression.Parser
, Copar.FunctorExpression.Pretty
, Copar.FunctorExpression.Printable
, Copar.FunctorExpression.Sorts
, Copar.FunctorExpression.Desorting
, Copar.FunctorExpression.Transform
......
......@@ -70,7 +70,7 @@ instance RefinementInterface Pair where
:: [Label Pair]
-- weight of the previous block
-> Weight Pair
-- weight of smaller section, (rhs target block, lhs target block), weight of bigger section
-- weight of smaller section, (lhs target block, rhs target block), weight of bigger section
-> (Weight Pair, F3 Pair, Weight Pair)
update [] weight = ((False, False), (if T.fst weight then Big else Other, if T.snd weight then Big else Other), weight)
update [True] weight = ((False, True), (Small, if T.snd weight then Big else Other), (fst weight, False))
......
module Copar.FunctorExpression.Printable
( Printable (..)
, printTree
, sortAsScope
) where
import Data.Text.Lazy.Builder as Build
import Data.Text.Lazy.Builder.Int as Build
import Copar.FunctorExpression.Sorts (Sort)
-- | Print the required skeleton for the current scope.
--
-- The current scope has already been popped of the stack.
printSkeleton :: [a] -> [[a]] -> Build.Builder
printSkeleton h xs =
foldl (\str e -> (if null e then " " else "│ ") <> str)
(if null h then "└ " else "├ ")
xs
sortAsScope :: Sort -> Build.Builder
sortAsScope sort = "'" <> Build.decimal sort
printTree :: (a -> ([(Build.Builder, a)], Build.Builder)) -> a -> Build.Builder
printTree f head =
let (children, functor) = f head
in functor <> printInner f [children]
printInner :: (a -> ([(Build.Builder, a)], Build.Builder)) -> [[(Build.Builder, a)]] -> Build.Builder
printInner f (((scope, v):h):rs) =
"\n" <> printSkeleton h rs <> scope <> ": "
<> functor <> (printInner f (children:h:rs))
where
(children, functor) = f v
printInner f ([]:rs) = printInner f rs
printInner _ [] = mempty
class Printable f where
printMe :: f Build.Builder -> Build.Builder
......@@ -13,4 +13,3 @@ transform
-> FunctorExpression g a
transform _ Variable = Variable
transform f (Functor a inner) = Functor a (f (fmap (transform f) inner))
module Copar.FunctorPrinter (printFunctor, Printable) where
import Data.Text as T
import Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder as Build
import Copar.FunctorExpression.Printable
import Copar.FunctorExpression.Sorts (Sort)
import Copar.FunctorExpression.Type (FunctorExpression (..))
printFunctor :: (Printable f, Foldable f, Functor f) => FunctorExpression f Sort -> T.Text
printFunctor (Functor _ f') = Lazy.toStrict (Build.toLazyText (printTree inner f'))
printFunctor Variable = "Variable X"
inner :: (Printable f, Foldable f, Functor f)
=> f (FunctorExpression f Sort)
-- ([('sort, subfunctor)], functor)
-> ([(Build.Builder, f (FunctorExpression f Sort))], Build.Builder)
inner f = (foldMap getChild f, printMe (fmap printChild f))
where
printChild Variable = "X"
printChild (Functor sort _) = sortAsScope sort
getChild Variable = []
getChild (Functor sort f') = [(sortAsScope sort, f')]
......@@ -48,6 +48,7 @@ import qualified Copar.Parser.Lexer as L
import Copar.RefinementInterface
import Copar.Functors.Polynomial hiding ( PolyF1(..) )
import Copar.FunctorExpression.Type
import Copar.FunctorExpression.Printable
import Copar.Parser.Types
import qualified Data.Vector.Utils as V
import Data.Primitive.SmallArray
......@@ -62,6 +63,13 @@ $(deriveShow1 ''Inner)
newtype AbsorbingPolynomial f a = AbsorbingPolynomial (Polynomial (Inner f a))
deriving (Functor, Foldable, Traversable)
instance (Printable f) => Printable (AbsorbingPolynomial f) where
printMe (AbsorbingPolynomial poly) = "AbsorbingPolynomial "
<> printPolynomial ((\case
Direct a -> a
Absorbed inner -> "(" <> printMe inner <> ")"
) <$> poly)
$(deriveShow1 ''AbsorbingPolynomial)
......
......@@ -27,6 +27,7 @@ import Data.Text.Prettyprint ((<+>))
import Copar.RefinementInterface
import qualified Copar.Parser.Lexer as L
import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.Coalgebra.Parser
import Copar.Functors.GroupValued
import Copar.FunctorDescription
......@@ -34,6 +35,9 @@ import Copar.FunctorDescription
newtype Bag a = Bag a
deriving (Functor,Foldable,Traversable)
instance Printable Bag where
printMe (Bag x) = "Bag B" <> x
bag :: FunctorDescription Bag
bag = FunctorDescription
{ name = "Bag"
......
......@@ -22,6 +22,7 @@ import Data.Float.Utils (EqDouble)
import Copar.Coalgebra.Parser
import Copar.FunctorDescription
import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.Functors.GroupValued
import qualified Copar.Parser.Lexer as L
import Copar.RefinementInterface
......@@ -30,6 +31,9 @@ import Copar.RefinementInterface
newtype Distribution x = Distribution x
deriving (Functor, Foldable, Traversable)
instance Printable Distribution where
printMe (Distribution x) ="Distribution D" <> x
distribution :: FunctorDescription Distribution
distribution = FunctorDescription
{ name = "Distribution"
......
......@@ -37,6 +37,7 @@ import qualified Data.Vector.Utils as V
import Copar.RefinementInterface
import Copar.Coalgebra.Parser
import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import qualified Copar.Parser.Lexer as L
import Copar.Parser.Types
import Copar.FunctorDescription
......@@ -53,6 +54,20 @@ deriving instance Traversable (GroupValued m)
$(deriveShow1 ''GroupValued)
instance Printable (GroupValued Int) where
printMe (GroupValued x) = "Integer-valued Z^" <> x
instance Printable (GroupValued EqDouble) where
printMe (GroupValued x) = "Real-valued R^" <> x
instance Printable (GroupValued (Ratio Int)) where
printMe (GroupValued x) = "Rational-valued Q^" <> x
instance Printable (GroupValued OrderedComplex) where
printMe (GroupValued x) = "Complex-valued C^" <> x
intValued :: FunctorDescription (GroupValued Int)
intValued = FunctorDescription
{ name = "Integer-valued"
......
......@@ -37,6 +37,7 @@ import Copar.RefinementInterface
import Copar.FunctorDescription
import qualified Copar.Parser.Lexer as L
import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.Coalgebra.Parser
import Data.Float.Utils ( MaxDouble(..)
, MinDouble(..)
......@@ -49,6 +50,26 @@ import Data.Bits.Monoid
newtype SlowMonoidValued m a = SlowMonoidValued a
-- TODO We may want to change MonoidValuedDiscription to a type class,
-- this would allow us to simplify these instances.
instance Printable (SlowMonoidValued (Max Int)) where
printMe (SlowMonoidValued x) = "Max-valued (Z, max)^" <> x
instance Printable (SlowMonoidValued (Min Int)) where
printMe (SlowMonoidValued x) = "Min-valued (Z, min)^" <> x
instance Printable (SlowMonoidValued MaxDouble) where
printMe (SlowMonoidValued x) = "Max-valued (R, max)^" <> x
instance Printable (SlowMonoidValued MinDouble) where
printMe (SlowMonoidValued x) = "Min-valued (R, min)^" <> x
instance Printable (SlowMonoidValued (BitAnd Word64)) where
printMe (SlowMonoidValued x) = "BitAnd-valued (Word, and)^" <> x
instance Printable (SlowMonoidValued (BitOr Word64)) where
printMe (SlowMonoidValued x) = "BitOr-valued (Word, or)^" <> x
instance Eq1 (SlowMonoidValued m) where
liftEq f (SlowMonoidValued a1) (SlowMonoidValued a2) = f a1 a2
......@@ -142,7 +163,7 @@ maxRealValued = makeMonoidValued $ MonoidValued
}
-- | The @(ℝ, max)^X@ functor
-- | The @(ℝ, min)^X@ functor
minRealValued :: FunctorDescription (SlowMonoidValued MinDouble)
minRealValued = makeMonoidValued $ MonoidValued
{ mvName = "Min"
......
......@@ -11,6 +11,7 @@
module Copar.Functors.Polynomial
( -- * Functor expression parser
polynomial
, printPolynomial
-- * Types exported for easier testing
, Polynomial(..)
, Sum(..)
......@@ -23,6 +24,7 @@ module Copar.Functors.Polynomial
import Control.Monad
import Data.Bifunctor
import Data.Foldable (fold)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Traversable
......@@ -45,6 +47,8 @@ import Data.Eq.Deriving (deriveEq1)
import Text.Show.Deriving (deriveShow1)
import Lens.Micro
import Control.DeepSeq
import Data.Text.Lazy.Builder as Build
import Data.Text.Lazy.Builder.Int as Build
import qualified Data.Text.Prettyprint as Doc
import Data.Text.Prettyprint ((<+>))
......@@ -53,8 +57,10 @@ import qualified Copar.Parser.Lexer as L
import Copar.Parser.Types
import Copar.RefinementInterface
import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.FunctorDescription
newtype Polynomial a = Polynomial (Sum a)
deriving (Functor, Foldable, Traversable)
......@@ -90,6 +96,34 @@ $(deriveEq1 ''Polynomial)
$(deriveShow1 ''Factor)
$(deriveShow1 ''Polynomial)
instance Printable Polynomial where
printMe poly = "Polynomial " <> printPolynomial poly
printPolynomial :: Polynomial Build.Builder -> Build.Builder
printPolynomial (Polynomial (Sum (prods))) = fold (NonEmpty.intersperse " + " (fmap printProduct prods))
printProduct :: Product Build.Builder -> Build.Builder
printProduct (Product (factors)) = fold (NonEmpty.intersperse "x" (fmap printFactor factors))
printFactor :: Factor Build.Builder -> Build.Builder
printFactor (Const IntSet) = "Z"
printFactor (Const NatSet) = "N"
printFactor (Const (FiniteNatSet v)) = Build.decimal v
printFactor (Const (ExplicitSet elems)) =
(V.foldl
(\s e -> s <> ", " <> Build.fromText e)
("{" <> Build.fromText (V.head elems)) (V.tail elems)
) <> "}"
printFactor (Identity a) = a
printFactor (Exponential a exp) = a <> "^" <> printExp exp
printExp :: Exponent -> Build.Builder
printExp (FiniteNatExp v) = Build.decimal v
printExp (ExplicitExp elems) =
(V.foldl (\s e -> s <> ", " <> Build.fromText e) ("{" <> Build.fromText (V.head elems)) (V.tail elems)) <> "}"
-- | Custom Show1 instance to show NonEmpty list like a normal list for easier
-- reading.
......
......@@ -25,6 +25,7 @@ import Data.Text.Prettyprint ((<+>))
import Copar.RefinementInterface
import qualified Copar.Parser.Lexer as L
import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.Coalgebra.Parser
import Copar.FunctorDescription
......@@ -33,6 +34,8 @@ newtype Powerset a = Powerset a
$(deriveShow1 ''Powerset)
instance Printable Powerset where
printMe (Powerset x) = "Powerset P" <> x
powerset :: FunctorDescription Powerset
powerset = FunctorDescription
......
......@@ -33,12 +33,13 @@ import qualified Data.Text as T
import Copar.Coalgebra.Parser.Class
import Copar.FunctorDescription
import Copar.FunctorExpression.Parser
import Copar.FunctorExpression.Printable
import Copar.PrettyShow
import Copar.RefinementInterface
type Suitable f
= ( RefinementInterface f
, Printable f
, Functor f
, Foldable f
, Traversable f
......@@ -63,6 +64,9 @@ instance Show1 SomeFunctor where
liftShowsPrec shows' showsList' pred (SomeFunctor f) =
liftShowsPrec shows' showsList' pred f
instance Printable SomeFunctor where
printMe (SomeFunctor x) = printMe x
-- | Apply a natural transformation under the 'SomeFunctor'.
--
......
......@@ -31,6 +31,7 @@ import Text.Show.Pretty (pPrint)
import Copar.Algorithm
import qualified Copar.Parser as P
import Copar.PartitionPrinter
import Copar.FunctorPrinter
import Copar.Functors
import Copar.FunctorDescription
import qualified Data.MorphismEncoding as Encoding
......@@ -510,8 +511,8 @@ main = do
Just file -> writeDot file config symbolTable encoding part
DebugCommand (DebugFunctor applyTrans f)
| applyTrans -> pPrint (applyFunctorRewrites f)
| otherwise -> pPrint f
| applyTrans -> T.putStrLn (printFunctor (applyFunctorRewrites f))
| otherwise -> T.putStrLn (printFunctor f)
helpOverview :: Text -> Doc AnsiStyle
helpOverview argv0 =
......
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