19-1: this should be faster but

still doesn't go fast enough but it's too late to debug now. byeee

1 files changed, 18 insertions, 13 deletions

diff --git a/19-1.hs b/19-1.hs
index 7bda88c..9a602f8 100644
--- a/19-1.hs
+++ b/19-1.hs
@@ -1,12 +1,12 @@
-import Control.Monad.Trans.State
+import Control.Monad.ST
 import Data.Foldable (foldrM)
-import Data.HashMap.Lazy as HM hiding (filter, mapMaybe, map, null)
+import Data.HashTable.ST.Basic as H
 import Data.List (nub)
 import Data.Maybe (mapMaybe)
 
 import Debug.Trace
 
-type S = HashMap String [String]
+type S s = H.HashTable s String [String]
 
 -- Return Nothing if no match; unmatched remainder (can be []) if
 -- match.
@@ -16,20 +16,20 @@ match (x:xs) (y:ys) | x == y    = match xs ys
                     | otherwise = Nothing
 match [] _ = Nothing
 
-matchAny :: [String] -> String -> State S [String]
-matchAny yss xs = do
-  s <- get
-  case HM.lookup xs s of
+matchAny :: S s -> [String] -> String -> ST s [String]
+matchAny s yss xs = do
+  t <- H.lookup s xs
+  case t of
     Nothing -> let r = mapMaybe (match xs) yss
-               in put (HM.insert xs r s) >> return r
+               in H.insert s xs r >> return r
     Just x -> return x
 
-check :: [String] -> String -> State S Bool
-check yss xs = do
-  zss <- nub <$> matchAny yss xs
+check :: S s -> [String] -> String -> ST s Bool
+check s yss xs = do
+  zss <- nub <$> matchAny s yss xs
   if [] `elem` zss
     then return True
-    else anyM (check yss) zss
+    else anyM (check s yss) zss
 
 anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 anyM p = foldrM f False
@@ -44,8 +44,13 @@ parse s = let yss = filter (not . null) . drop 2 $ lines s
               xss = parseTowels . head $ lines s
           in (xss, yss)
 
+run :: [String] -> [String] -> ST s Int
+run xss yss = do
+  ht <- H.new :: ST s (S s)
+  length . filter id <$> traverse (check ht yss) xss
+
 main :: IO ()
 main = do
   input <- getContents
   let (xss, yss) = parse input
-  print . length . filter id $ evalState (mapM (check xss) yss) HM.empty
+  print $ runST $ run yss xss