Skip to content

Instantly share code, notes, and snippets.

@petermarks
Created April 29, 2012 10:17
Show Gist options
  • Save petermarks/2549171 to your computer and use it in GitHub Desktop.
Save petermarks/2549171 to your computer and use it in GitHub Desktop.
Coded
module Main where
import Control.Monad
import Control.Monad.Logic
import Control.Monad.State.Strict
import qualified Data.Map as M
type BindingT k v = StateT (M.Map k v)
bind :: (Ord k, Eq v, Monad m) => k -> v -> BindingT k v m ()
bind k v = do
m <- bindings
let (mv, m') = M.insertLookupWithKey (\_ _ v -> v) k v m
case mv of
(Just v') | v /= v' -> fail $ "Cannot bind to a different value"
| otherwise -> return ()
Nothing -> put m'
bindings :: (Monad m) => BindingT k v m (M.Map k v)
bindings = get
runBindingT :: (Monad m) => BindingT k v m a -> m (M.Map k v)
runBindingT a = execStateT a M.empty
type Solver = BindingT Char Char Logic
main :: IO ()
main = print $ solve ["funk", "nuts", "stun"] ["6348", "8342", "8436", "2481"]
solve :: [String] -> [String] -> [(Char, Char)]
solve ws cs = M.toList . observe . runBindingT $ solveAll ws cs
solveAll :: [String] -> [String] -> Solver ()
solveAll ws cs = mapM_ (solveWord cs) ws
solveWord :: [String] -> String -> Solver ()
solveWord cs w = do
c <- member cs
sequence_ $ zipWith bind w c
member :: (MonadLogic m) => [a] -> m a
member = msum . map return
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment