use Data.Map

This commit is contained in:
hi 2025-08-15 15:20:40 +00:00
parent 87adb51806
commit b0e98b0e51

View file

@ -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