5 files changed, 126 insertions(+), 13 deletions(-)

M .gitignore
M 2023/08.hs
A 2023/08b.example
M lib/Qulude.hs
M run/run-hs

@@ 1,2 1,6 @@
 *.so
 .event
+
+*.exe
+*.hi
+*.o

@@ 18,6 18,10 @@ import qualified Data.Maybe as Maybe
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 
+import System.IO
+import System.IO.Temp
+import System.Process
+
 type Instructions = String
 type Node = String
 type DesertMap = Map.Map Node (Node, Node)


@@ 27,7 31,7 @@ parser :: Parser Parse
 parser = do
   is <- upper `manyTill` newline
   newline
-  let node = many upper
+  let node = many alphaNum
   map <- many $ do
     n <- node
     string " = ("


@@ 39,18 43,103 @@ parser = do
     return (n, (l, r))
   return (is, Map.fromList map)
 
+--step :: DesertMap -> Node -> Char -> Node
+--step map n 'L' = fst $ map ! n
+--step map n 'R' = snd $ map ! n
+
 walk :: DesertMap -> Node -> Instructions -> [Node]
 walk map n ('L':is) = n:(walk map (fst $ map ! n) is)
 walk map n ('R':is) = n:(walk map (snd $ map ! n) is)
 
 partA (is, map) = length $ takeWhile ((/=) "ZZZ") $ walk map "AAA" $ List.cycle is
 
---partB :: Parse -> Parse
---partB = id
+--walk' :: DesertMap -> [Node] -> Instructions -> [[Node]]
+--walk' map ns (i:is) = let ns' = fmap (\n -> step map n i) ns in ns':(walk' map ns' is)
+
+partB' (is, map) = walk' 0 starts
+  where starts = filter isStart $ Map.keys map
+        isStart (_:_:'A':[]) = True
+        isStart _ = False
+        isEnd (_:_:'Z':[]) = True
+        isEnd _ = False
+        endOfTheLine = and . fmap isEnd
+        l = length is
+        walk' !acc !ns | endOfTheLine ns = acc
+        walk' !acc !ns | otherwise =
+          let i = (is !! (acc `mod` l)) in
+          --let ns' = fmap (\n -> step n i) ns in
+          --(traceShowId ns') `seq` walk' (succ acc) ns'
+          walk' (succ acc) $! fmap (\n -> step n $! i) $! ns
+        step n 'L' = fst $ map ! n
+        step n 'R' = snd $ map ! n
+
+fmap' f xs = foldl' (\acc x -> f x:acc) [] xs
+
+walk' map (ns, i:is) = ns `seq` (fmap' (\n -> step n i) ns, is)
+  where step n 'L' = fst $ map ! n
+        step n 'R' = snd $ map ! n
+
+partB'' (is, map) = List.findIndex (endOfTheLine . fst) $ iterate (walk' map) (starts, List.cycle is)
+  where starts = filter isStart $ Map.keys map
+        endOfTheLine ns = and $ fmap' isEnd ns
+
+isStart (_:_:'A':[]) = True
+isStart _ = False
+
+isEnd (_:_:'Z':[]) = True
+isEnd _ = False
+
+emit :: Handle -> Parse -> IO ()
+emit h (is, map) = do
+  let putLn = hPutStrLn h
+      put = hPutStr h
+
+  let ns = Map.keys map
+      n = length ns
+  putLn $ "enum node {"
+  flip traverse_ (zip [0..] ns) $ \(i :: Int, n) -> do
+    putLn $ printf "    n_%s = %d," n i
+  putLn $ "};"
+  putLn $ ""
+
+  putLn $ "int lefts[] = {"
+  flip traverse_ ns $ \n -> do
+    putLn $ printf "    n_%s," (fst $ map ! n)
+  putLn $ "};"
+  putLn $ ""
+
+  putLn $ "int rights[] = {"
+  flip traverse_ ns $ \n -> do
+    putLn $ printf "    n_%s," (snd $ map ! n)
+  putLn $ "};"
+  putLn $ ""
+
+  let starts = filter isStart ns
+      s = length starts
+  put $ "int starts[] = {"
+  flip traverse_ starts $ \n -> do
+    put $ printf "n_%s, " n
+  putLn $ "};"
+  putLn ""
+
+  putLn "#include <stdio.h>"
+  putLn "int main() {"
+  putLn "    printf(\"hello\\n\");"
+  putLn "    return 0;"
+  putLn "}"
+
+partB :: Parse -> IO ()
+partB p = do
+  withSystemTempFile "08.c" $ \fp -> \h -> do
+    emit h p 
+    hFlush h
+
+    callProcess "cat" [ "-n", fp ]
+    callProcess "tcc" [ "-run", fp ]
 
 main :: IO ()
 main = with parser $ do
   run "08.example" "a example" partA -- 2
   run "08.input" "a input" partA -- 19631
-  --run "08.example" "b example" partB
+  runIO "08b.example" "b example" partB -- 6
   --run "08.input" "b input" partB

@@ 0,0 1,10 @@
+LR
+
+11A = (11B, XXX)
+11B = (XXX, 11Z)
+11Z = (11B, XXX)
+22A = (22B, XXX)
+22B = (22C, 22C)
+22C = (22Z, 22Z)
+22Z = (22B, 22B)
+XXX = (XXX, XXX)

@@ 10,6 10,7 @@ module Qulude ( module Prelude
               , module Data.Functor.Identity
               , module Data.Word
               , module Data.Either
+              , module Data.Foldable
 
               , module Debug.Trace
 


@@ 39,6 40,7 @@ module Qulude ( module Prelude
 
               , with
               , run, run'
+              , runIO
               , render
 
               , (\\), (&)


@@ 54,8 56,6 @@ module Qulude ( module Prelude
 
               , fromRight', fromLeft', fromEither
 
-              , foldl'
-
               , unsafePerformIO
 
               , Array, UArray


@@ 67,12 67,13 @@ module Qulude ( module Prelude
 
 import Prelude hiding ( lines, cycle )
 
-import Data.List ( (\\), foldl' )
+import Data.List ( (\\) )
 import Data.Sequence ( (><), (<|), (|>), Seq ( (:<|), (:|>) ) )
 import Data.Maybe ( fromJust, fromMaybe, catMaybes, mapMaybe, listToMaybe )
 import Data.Tuple ( swap )
 import Data.Function ( (&) )
 import Data.Either
+import Data.Foldable
 
 import Data.Bits
 import Data.Char


@@ 179,15 180,18 @@ with :: Parser a -> ReaderT (Parser a) m b -> m b
 with p ma = runReaderT ma p
 
 run :: (Show b, Eq b) => String -> String -> (a -> b) -> ReaderT (Parser a) IO ()
-run fn t f = run_ fn t Nothing f
+run fn t f = run_ fn t Nothing (return . f)
+
+runIO :: (Show b, Eq b) => String -> String -> (a -> IO b) -> ReaderT (Parser a) IO ()
+runIO fn t f = run_ fn t Nothing f
 
 run' :: (Show b, Eq b) => String -> String -> (a -> b) -> b -> ReaderT (Parser a) IO ()
-run' fn t f b = run_ fn t (Just b) f
+run' fn t f b = run_ fn t (Just b) (return . f)
 
-run_ :: (Show b, Eq b) => String -> String -> Maybe b -> (a -> b) -> ReaderT (Parser a) IO ()
+run_ :: (Show b, Eq b) => String -> String -> Maybe b -> (a -> IO b) -> ReaderT (Parser a) IO ()
 run_ fn t mb f = ask >>= \p -> lift (parseFile p fn) >>= \case
-  Just x ->
-    let b = f x in
+  Just x -> do
+    b <- liftIO $ f x
     case mb of
       Nothing -> lift $ printf "%s: %s\n" t (show b)
       Just b' | b == b' -> lift $ printf "%s: %s\n" t (show b)

@@ 5,4 5,10 @@ set -o nounset -o pipefail -o errexit
 SCRIPT_DIR=$(readlink -f "$0" | xargs dirname)
 LIB=${LIB-$SCRIPT_DIR/../lib}
 
-exec stack runghc -- -i"$LIB" "$1"
+if [ -n "${GHC_OPT-}" ]; then
+    EXE=$(dirname "$1")/$(basename --suffix=.hs "$1").exe
+    stack ghc -- -O"$GHC_OPT" -o "$EXE" -i"$LIB" "$1"
+    exec "$EXE"
+else
+    stack runghc -- -i"$LIB" "$1"
+fi