Commit 27e54c1e authored by Bastian Kauschke's avatar Bastian Kauschke

remove showSorts, rename sortAsScope

parent 0480c31a
......@@ -11,21 +11,13 @@ module Copar.FunctorExpression.Sorts
, annotateSorts
-- * Extracting a sort table
, sortTable
, sortAsScope
-- * Printing a sort table
-- $printing
, printSorts
, showSorts
, formatSortAsScope
) where
import Data.Foldable
import Data.List (intersperse)
import GHC.Generics
import Control.Monad.State
import Data.Text (Text)
import qualified Data.Text.Lazy as T (toStrict)
import qualified Data.Text.Lazy.IO as TIO
import Data.Text.Lazy.Builder as Build
import Data.Text.Lazy.Builder.Int as Build
import Data.Vector (Vector)
......@@ -34,7 +26,6 @@ import qualified Data.Vector.Mutable as VM
import Control.DeepSeq (NFData)
import Copar.FunctorExpression.Type
import Copar.FunctorExpression.Printable
import Copar.PrettyShow
-- | Sorts are basically unique integers for every sub-expression in a functor
......@@ -52,8 +43,8 @@ data Sorted a = Sorted
instance PrettyShow a => PrettyShow (Sorted a) where
prettyShow s = "(" <> prettyShow (sortedSort s) <> ", " <> prettyShow (sortedElem s) <> ")"
sortAsScope :: Sort -> Build.Builder
sortAsScope sort = "'" <> Build.decimal sort
formatSortAsScope :: Sort -> Build.Builder
formatSortAsScope sort = "'" <> Build.decimal sort
-- | Assigns each sub-expression a different sort, starting with 1.
annotateSorts :: Traversable f => FunctorExpression f a -> FunctorExpression f Sort
......@@ -87,34 +78,3 @@ sortTable expr = V.create $ do
populateVector v (Functor sort f) = do
VM.write v (fromIntegral sort - 1) (fmap (const ()) f)
traverse_ (populateVector v) f
-- $printing
-- The functions in this section are mostly for debugging purposes.
-- | Print a table of sorts to stdout.
--
-- See 'showSorts' for details on the format of this table.
printSorts ::
(Printable f, Foldable f, Functor f) => FunctorExpression f Sort -> IO ()
printSorts = mapM_ (TIO.putStrLn . Build.toLazyText) . printSortsHelper2
-- | Format all sorts of a sorted functor expression as a table.
--
-- Table format:
--
-- > 1: Func1 X
-- > 2: Func2 X X
-- > ...
showSorts :: (Printable f, Foldable f, Functor f) => FunctorExpression f Sort -> Text
showSorts expr =
T.toStrict
(Build.toLazyText (mconcat (intersperse "\n" (printSortsHelper2 expr))))
printSortsHelper2 ::
forall f. (Functor f, Foldable f, Printable f)
=> FunctorExpression f Sort
-> [Builder]
printSortsHelper2 = map print . zip [1..] . toList . sortTable
where
print :: (Int, f ()) -> Builder
print (i, f) = Build.decimal i <> ": " <> printMe defaultPrintConfig (fmap (const "X") f)
......@@ -5,7 +5,7 @@ import Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder as Build
import Copar.FunctorExpression.Printable
import Copar.FunctorExpression.Sorts (Sort, sortAsScope)
import Copar.FunctorExpression.Sorts (Sort, formatSortAsScope)
import Copar.FunctorExpression.Type (FunctorExpression (..))
printFunctor :: (Printable f, Foldable f, Functor f) => FunctorExpression f Sort -> T.Text
......@@ -21,10 +21,10 @@ inner f = (foldMap getChild f, print (fmap printChild f))
print = printMe PrintConfig { withName = \name -> name <> " " }
printChild Variable = "X"
printChild (Functor sort _) = sortAsScope sort
printChild (Functor sort _) = formatSortAsScope sort
getChild Variable = []
getChild (Functor sort f') = [(sortAsScope sort, f')]
getChild (Functor sort f') = [(formatSortAsScope sort, f')]
printParseableFunctor :: (Printable f, Foldable f, Functor f) => FunctorExpression f Sort -> T.Text
printParseableFunctor (Functor _ f') = Lazy.toStrict (Build.toLazyText (print (fmap (printInner (precedence f')) f')))
......
......@@ -22,7 +22,6 @@ spec :: Spec
spec = do
annotateSortsSpec
sortTableSpec
showSortsSpec
annotateSortsSpec :: Spec
annotateSortsSpec = describe "annotateSorts" $ do
......@@ -82,31 +81,6 @@ sortTableSpec = describe "sortTable" $ do
, SomeFunctor (Identity ())
]
showSortsSpec :: Spec
showSortsSpec = describe "showSorts" $ do
it "works for a single Variable" $
showSorts @Identity Variable `shouldBe` ""
it "works for a single functor" $ do
showSorts (Functor 1 (Identity Variable)) `shouldBe` "1: Identity X"
it "works for two functors" $ do
showSorts (Functor 1 (Identity (Functor 2 (Identity Variable)))) `shouldBe`
"1: Identity X\n2: Identity X"
it "works for functors with multiple arguments" $ do
showSorts
(Functor
1
(SomeFunctor
(Twice
(Functor 2 (SomeFunctor (Identity Variable)))
(Functor 3 (SomeFunctor (Identity Variable)))))) `shouldBe`
"1: Twice X X\n2: Identity X\n3: Identity X"
-- helpers
instance Printable Identity where
precedence _ = 0
printMe cfg (Identity x) = withName cfg "Identity" <> x
......
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