diff --git a/Logic/Graph.hs b/Logic/Graph.hs index ba899ae..0aa3be4 100644 --- a/Logic/Graph.hs +++ b/Logic/Graph.hs @@ -1,9 +1,7 @@ module Logic.Graph where -import Data.Set (Set, insert) - -bfs :: (Eq a, Ord a) => a -> a -> (a -> [(edge, a)]) -> Maybe [edge] -bfs goal start getEdges = reverse <$> aux [([], start)] mempty +bfs :: Eq a => a -> a -> (a -> [(edge, a)]) -> Maybe [edge] +bfs goal start getEdges = reverse <$> aux [([], start)] [] where aux [] _ = Nothing aux ((path, vertex):queue) visited @@ -14,7 +12,7 @@ bfs goal start getEdges = reverse <$> aux [([], start)] mempty case filter (\(_, v) -> v == goal) new of [] -> let queue' = queue ++ map (\(edge, next) -> (edge:path, next)) new - in aux queue' $ insert vertex visited + in aux queue' (vertex:visited) ((edge, _):_) -> Just (edge:path) getUnvisitedAdjacent vertex visited = diff --git a/Logic/Language.hs b/Logic/Language.hs index 3d472f4..78c6a40 100644 --- a/Logic/Language.hs +++ b/Logic/Language.hs @@ -7,7 +7,7 @@ instance Show a => Show (ConcatShowList a) where -- Formal language (/grammar/production system/whatever) -- https://en.wikipedia.org/wiki/Post_canonical_system -class Show symbol => Language symbol where +class (Eq symbol, Show symbol) => Language symbol where isWellFormed :: [symbol] -> Bool -- If Haskell had dependent types these could be generalized. diff --git a/Logic/Language/Derivation.hs b/Logic/Language/Derivation.hs index c7d1b23..89ccbd4 100644 --- a/Logic/Language/Derivation.hs +++ b/Logic/Language/Derivation.hs @@ -10,7 +10,7 @@ data Derivation symbol | Axiom3 Integer [symbol] [symbol] [symbol] | Infer1 Integer Integer (Derivation symbol) | Infer2 Integer Integer (Derivation symbol) (Derivation symbol) - deriving Show + deriving (Eq, Show) data DerivationError s = SelectIndexError (DerivationSelectIndexError s) diff --git a/Logic/Language/Impl/MIU.hs b/Logic/Language/Impl/MIU.hs index 73f0c49..24a4093 100644 --- a/Logic/Language/Impl/MIU.hs +++ b/Logic/Language/Impl/MIU.hs @@ -9,7 +9,7 @@ data AlphaMIU = M | I | U - deriving Show + deriving (Eq, Show) type StringMIU = [AlphaMIU] diff --git a/Logic/Parse.hs b/Logic/Parse.hs index f203fbe..2b3ea90 100644 --- a/Logic/Parse.hs +++ b/Logic/Parse.hs @@ -10,7 +10,7 @@ newtype Parser symbol output = Parser data Input symbol = Input { inputPos :: Int , inputSeq :: [symbol] - } deriving Show + } deriving (Eq, Show) mkInput :: [symbol] -> Input symbol mkInput = Input 0 diff --git a/Logic/Statement.hs b/Logic/Statement.hs index 6d7268b..f85fe26 100644 --- a/Logic/Statement.hs +++ b/Logic/Statement.hs @@ -9,7 +9,7 @@ data Statement | Or Statement Statement | Implies Statement Statement | Iff Statement Statement - deriving (Eq, Ord, Show) + deriving (Show, Eq) atoms :: Statement -> [String] atoms = toAscList . mkSet diff --git a/Logic/Statement/Laws.hs b/Logic/Statement/Laws.hs index d1d5224..7ac692a 100644 --- a/Logic/Statement/Laws.hs +++ b/Logic/Statement/Laws.hs @@ -3,7 +3,6 @@ module Logic.Statement.Laws where import Logic.Parse (eof, mkInput) import Logic.Statement (Statement(..)) import Logic.Statement.Parse (stmt) -import Logic.Statement.Serialize (serialize, SerializeFormat(Plain)) import Logic.Graph (bfs) import Data.Either (fromRight, rights) @@ -13,17 +12,7 @@ data Law = Law { lawName :: String , lawLhs :: Statement , lawRhs :: Statement - } - -instance Show Law where - show law = - "Law{" - <> lawName law - <> ": " - <> serialize Plain (lawLhs law) - <> " <=> " - <> serialize Plain (lawRhs law) - <> "}" + } deriving (Eq, Show) mkLaw :: String -> String -> String -> Law mkLaw name lhs rhs = Law name (fromString lhs) (fromString rhs) @@ -219,16 +208,7 @@ data LawsGraphEdge = LawsGraphEdge { lgeLaw :: Law , lgeReverse :: Bool , lgeIndex :: Integer - } - -instance Show LawsGraphEdge where - show edge = - "LawsGraphEdge{" - <> (if lgeReverse edge then "< " else "> ") - <> lawName (lgeLaw edge) - <> " " - <> show (lgeIndex edge) - <> "}" + } deriving (Eq, Show) bfsLaws :: Statement -> Statement -> Maybe [LawsGraphEdge] bfsLaws goal start = bfs goal start getLawsGraphEdges @@ -304,7 +284,6 @@ Just ["> dbl_neg 0","> dbl_neg 0","> dbl_neg 0","> dbl_neg 0"] ghci> time $ putStrLn $ show $ niceEdges <$> bfsLaws (fromString "!!!!!!!!!!p") (fromString "p") Just ["> dbl_neg 0","> dbl_neg 0","> dbl_neg 0","> dbl_neg 0","> dbl_neg 0"] 3.244101767s -ghci> time $ putStrLn $ show $ niceEdges <$> bfsLaws (fromString "!!!!!!!!!!!!p") (fromString "p") Just ["> dbl_neg 0","> dbl_neg 0","> dbl_neg 0","> dbl_neg 0","> dbl_neg 0","> dbl_neg 0"] 3066.211460539s -} diff --git a/Logic/Statement/Serialize.hs b/Logic/Statement/Serialize.hs index 5443495..fa76f5b 100644 --- a/Logic/Statement/Serialize.hs +++ b/Logic/Statement/Serialize.hs @@ -10,28 +10,28 @@ data TokenString = TokenString { tsCanEval :: CanEval , tsLevel :: Int , tsString :: String - } deriving Show + } deriving (Show, Eq) data CanEval = Filler | CanEval - deriving Show + deriving (Show, Eq) data TokenValue = TokenValue { tvLevel :: Int , tvValue :: Value - } deriving Show + } deriving (Show, Eq) data Value = NoValue | Value Bool - deriving Show + deriving (Show, Eq) data SerializeFormat = Plain | Latex -- | PrefixPlain - deriving Show + deriving (Show, Eq) serialize :: SerializeFormat -> Statement -> String serialize fmt s = concat $ map tsString $ serializeStrings fmt s