From 56a8dd2b30e462c28d15bae26551b42c2100d4e6 Mon Sep 17 00:00:00 2001
From: hi <hi>
Date: Tue, 12 Aug 2025 13:28:23 +0000
Subject: [PATCH 1/2] bfs: use a Set for visited nodes

---
 Logic/Graph.hs     | 8 +++++---
 Logic/Statement.hs | 2 +-
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/Logic/Graph.hs b/Logic/Graph.hs
index 0aa3be4..ba899ae 100644
--- a/Logic/Graph.hs
+++ b/Logic/Graph.hs
@@ -1,7 +1,9 @@
 module Logic.Graph where
 
-bfs :: Eq a => a -> a -> (a -> [(edge, a)]) -> Maybe [edge]
-bfs goal start getEdges = reverse <$> aux [([], start)] []
+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
   where
     aux [] _ = Nothing
     aux ((path, vertex):queue) visited
@@ -12,7 +14,7 @@ bfs goal start getEdges = reverse <$> aux [([], start)] []
           case filter (\(_, v) -> v == goal) new of
             [] ->
               let queue' = queue ++ map (\(edge, next) -> (edge:path, next)) new
-              in aux queue' (vertex:visited)
+              in aux queue' $ insert vertex visited
             ((edge, _):_) -> Just (edge:path)
 
     getUnvisitedAdjacent vertex visited =
diff --git a/Logic/Statement.hs b/Logic/Statement.hs
index f85fe26..6d7268b 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 (Show, Eq)
+  deriving (Eq, Ord, Show)
 
 atoms :: Statement -> [String]
 atoms = toAscList . mkSet

From 88c140fed5a113489eaa680309bbf36850131549 Mon Sep 17 00:00:00 2001
From: hi <hi>
Date: Tue, 12 Aug 2025 13:28:58 +0000
Subject: [PATCH 2/2] tidy: del unused Eq, add custom Show

---
 Logic/Language.hs            |  2 +-
 Logic/Language/Derivation.hs |  2 +-
 Logic/Language/Impl/MIU.hs   |  2 +-
 Logic/Parse.hs               |  2 +-
 Logic/Statement/Laws.hs      | 25 +++++++++++++++++++++++--
 Logic/Statement/Serialize.hs | 10 +++++-----
 6 files changed, 32 insertions(+), 11 deletions(-)

diff --git a/Logic/Language.hs b/Logic/Language.hs
index 78c6a40..3d472f4 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 (Eq symbol, Show symbol) => Language symbol where
+class 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 89ccbd4..c7d1b23 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 (Eq, Show)
+  deriving Show
 
 data DerivationError s
   = SelectIndexError (DerivationSelectIndexError s)
diff --git a/Logic/Language/Impl/MIU.hs b/Logic/Language/Impl/MIU.hs
index 24a4093..73f0c49 100644
--- a/Logic/Language/Impl/MIU.hs
+++ b/Logic/Language/Impl/MIU.hs
@@ -9,7 +9,7 @@ data AlphaMIU
   = M
   | I
   | U
-  deriving (Eq, Show)
+  deriving Show
 
 type StringMIU = [AlphaMIU]
 
diff --git a/Logic/Parse.hs b/Logic/Parse.hs
index 2b3ea90..f203fbe 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 (Eq, Show)
+  } deriving Show
 
 mkInput :: [symbol] -> Input symbol
 mkInput = Input 0
diff --git a/Logic/Statement/Laws.hs b/Logic/Statement/Laws.hs
index 7ac692a..d1d5224 100644
--- a/Logic/Statement/Laws.hs
+++ b/Logic/Statement/Laws.hs
@@ -3,6 +3,7 @@ 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)
@@ -12,7 +13,17 @@ data Law = Law
   { lawName :: String
   , lawLhs :: Statement
   , lawRhs :: Statement
-  } deriving (Eq, Show)
+  }
+
+instance Show Law where
+  show law =
+    "Law{"
+    <> lawName law
+    <> ": "
+    <> serialize Plain (lawLhs law)
+    <> " <=> "
+    <> serialize Plain (lawRhs law)
+    <> "}"
 
 mkLaw :: String -> String -> String -> Law
 mkLaw name lhs rhs = Law name (fromString lhs) (fromString rhs)
@@ -208,7 +219,16 @@ data LawsGraphEdge = LawsGraphEdge
   { lgeLaw :: Law
   , lgeReverse :: Bool
   , lgeIndex :: Integer
-  } deriving (Eq, Show)
+  }
+
+instance Show LawsGraphEdge where
+  show edge =
+    "LawsGraphEdge{"
+    <> (if lgeReverse edge then "< " else "> ")
+    <> lawName (lgeLaw edge)
+    <> " "
+    <> show (lgeIndex edge)
+    <> "}"
 
 bfsLaws :: Statement -> Statement -> Maybe [LawsGraphEdge]
 bfsLaws goal start = bfs goal start getLawsGraphEdges
@@ -284,6 +304,7 @@ 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 fa76f5b..5443495 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, Eq)
+  } deriving Show
 
 data CanEval
   = Filler
   | CanEval
-  deriving (Show, Eq)
+  deriving Show
 
 data TokenValue = TokenValue
   { tvLevel :: Int
   , tvValue :: Value
-  } deriving (Show, Eq)
+  } deriving Show
 
 data Value
   = NoValue
   | Value Bool
-  deriving (Show, Eq)
+  deriving Show
 
 data SerializeFormat
   = Plain
   | Latex
 --  | PrefixPlain
-  deriving (Show, Eq)
+  deriving Show
 
 serialize :: SerializeFormat -> Statement -> String
 serialize fmt s = concat $ map tsString $ serializeStrings fmt s