diff --git a/lib/Logic/Statement/Laws.hs b/lib/Logic/Statement/Laws.hs index cd5ccf6..407b661 100644 --- a/lib/Logic/Statement/Laws.hs +++ b/lib/Logic/Statement/Laws.hs @@ -6,6 +6,9 @@ import Logic.Statement.Parse (stmt) import Logic.Statement.Serialize (serialize, SerializeFormat(Plain)) import Logic.Graph (bfs, verifyPath, VerifyPathError) +import Data.Map (Map) +import qualified Data.Map as Map (empty, insert, lookup) + import Data.Either (fromRight, rights) import Data.Maybe (fromJust, listToMaybe) @@ -72,15 +75,15 @@ match -- ^ pattern -> Statement -- ^ statement to search within - -> Maybe [(String, Statement)] + -> Maybe (Map String Statement) -- ^ mapping from pattern-statement atoms to search-statement parts -match = aux [] +match = aux Map.empty where aux - :: [(String, Statement)] + :: Map String Statement -> Statement -> Statement - -> Maybe [(String, Statement)] + -> Maybe (Map String Statement) aux mapping (Atom key) s = add mapping (key, s) aux mapping (Not p) (Not s) = aux mapping p s aux mapping (And p1 p2) (And s1 s2) = binary mapping (p1, s1) (p2, s2) @@ -90,21 +93,21 @@ match = aux [] aux mapping pattern s = Nothing add - :: [(String, Statement)] + :: Map String Statement -> (String, Statement) - -> Maybe [(String, Statement)] + -> Maybe (Map String Statement) add mapping entry@(key, s') = - case lookup key mapping of - Nothing -> Just (entry:mapping) + case Map.lookup key mapping of + Nothing -> Just $ Map.insert key s' mapping Just existing | existing == s' -> Just mapping | otherwise -> Nothing binary - :: [(String, Statement)] + :: Map String Statement -> (Statement, Statement) -> (Statement, Statement) - -> Maybe [(String, Statement)] + -> Maybe (Map String Statement) binary mapping (p1, s1) (p2, s2) = do mapping' <- aux mapping p1 s1 aux mapping' p2 s2 @@ -142,8 +145,8 @@ swap p1 p2 s = do mapping <- maybe (Left NonMatchingPattern) Right $ match p1 s maybe (Left IndeterminateSwap) Right $ aux mapping p2 where - aux :: [(String, Statement)] -> Statement -> Maybe Statement - aux mapping (Atom key) = lookup key mapping + aux :: Map String Statement -> Statement -> Maybe Statement + aux mapping (Atom key) = Map.lookup key mapping aux mapping (Not p) = Not <$> aux mapping p aux mapping (And p1 p2) = And <$> aux mapping p1 <*> aux mapping p2 aux mapping (Or p1 p2) = Or <$> aux mapping p1 <*> aux mapping p2 @@ -190,6 +193,7 @@ data ReplaceError = IndeterminateReplace deriving Show +-- Replace pattern p1 with pattern p2 at all possible depths replace :: Statement -> Statement -> Statement -> Either ReplaceError [Statement] replace p1 p2 = firstLeft . aux where