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

Remove even more unused code

parent 33e9f5c7
......@@ -43,6 +43,7 @@ import qualified Data.RefinablePartition as Partition
import Data.RefinementInterface (RefinementInterface)
import qualified Data.RefinementInterface as RI
import Data.Sort
import Data.Functors.SomeFunctor
data AlgoState s h = AlgoState
{ toSub :: MVector s [EdgeRef]
......@@ -204,15 +205,17 @@ processQueue queue states = whileM $ Queue.dequeue queue >>= \case
data SomeAlgoState s where
SomeAlgoState :: RefinementInterface h => AlgoState s h -> SomeAlgoState s
type Morphism = Encoding (RI.Label SomeFunctor) (RI.H1 SomeFunctor)
initializeAll :: Vector Morphism -> ST s (BlockQueue s, SortTable (SomeAlgoState s))
initializeAll encodings = do
let sizes = fmap (\(Morphism _ x) -> size x) encodings
let sizes = fmap size encodings
queue <- Queue.empty sizes
sorts <- iforM (V.zip encodings (rotateVectorLeft sizes)) $
\sort (Morphism (_ :: h ()) encoding, nextSize) -> do
(blocks, state) <- initialize @h sort encoding nextSize
\sort (encoding, nextSize) -> do
(blocks, state) <- initialize @SomeFunctor sort encoding nextSize
mapM_ (Queue.enqueue queue . (sort,)) blocks
return (SomeAlgoState state)
......
......@@ -3,7 +3,6 @@
{-# LANGUAGE RecordWildCards #-}
module Data.MorphismEncoding
( Encoding(..)
, SomeEncoding(..)
, EdgeRef(..)
, Edge(..)
, new
......@@ -32,12 +31,6 @@ data Encoding a h1 = Encoding
}
deriving (Show)
data SomeEncoding where
SomeEncoding :: (Show a, Show h1) => Encoding a h1 -> SomeEncoding
deriving instance Show SomeEncoding
new :: Vector h1 -> Vector (Edge a) -> Encoding a h1
new structure edges = Encoding {..}
......
......@@ -3,16 +3,11 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
module Data.Sort
( Morphism(..)
, Sort
( Sort
, Sorted
, SortTable
) where
import Data.Kind
import Data.RefinementInterface
import Data.MorphismEncoding
import Data.Vector (Vector)
......@@ -22,9 +17,3 @@ type Sorted a = (Sort, a)
-- | This type maps sorts to 'a'
type SortTable a = Vector a
-- TODO This should really be somewhere else
data Morphism :: Type where
Morphism :: RefinementInterface h => h () -> Encoding (Label h) (H1 h) -> Morphism
deriving instance Show Morphism
......@@ -16,9 +16,9 @@ import qualified Text.Megaparsec as Megaparsec
import Data.RefinementInterface
import Data.Functors (registeredFunctors)
import Data.Sort
import qualified MA.FunctorExpression.Parser as New
import qualified MA.FunctorExpression.Sorts as New
import Data.MorphismEncoding
import MA.FunctorExpression.Parser
import MA.FunctorExpression.Sorts
import Data.Functors.SomeFunctor
......@@ -28,20 +28,18 @@ instance Yaml.FromJSON RFIList where
parseJSON =
Yaml.withText "functor expression" $ \expr -> do
let res =
New.parseFunctorExpression
registeredFunctors
"functor expression"
expr
parseFunctorExpression registeredFunctors "functor expression" expr
case res of
Left err ->
fail $
"Invalid functor expression: " ++ Megaparsec.parseErrorPretty err
Right functorExpression ->
let sorts = New.sortTable (New.annotateSorts functorExpression)
let sorts = sortTable (annotateSorts functorExpression)
in return (RFIList sorts)
newtype CoalgebraSpecification = CoalgebraSpecification { fromCoalg :: Vector Morphism }
deriving (Show)
newtype CoalgebraSpecification = CoalgebraSpecification
{ fromCoalg :: Vector (Encoding (Label SomeFunctor) (H1 SomeFunctor))
} deriving (Show)
instance Yaml.FromJSON CoalgebraSpecification where
parseJSON = Yaml.withObject "coalgebra" $ \obj -> do
......@@ -50,10 +48,11 @@ instance Yaml.FromJSON CoalgebraSpecification where
-- TODO Ensure functors and morphisms are of equal length
encodings <- forM (V.zip functors morphisms) $
\(functor, yamlValue) ->
Morphism functor <$> parse functor yamlValue
\(functor, yamlValue) -> parse functor yamlValue
return (CoalgebraSpecification encodings)
decodeCoalgebra :: ByteString -> Either String (Vector Morphism)
decodeCoalgebra ::
ByteString
-> Either String (Vector (Encoding (Label SomeFunctor) (H1 SomeFunctor)))
decodeCoalgebra = fmap fromCoalg . Yaml.decodeEither
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