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