2024 day3, fix bug in prelude

aoc2024/Day3.newt

@@ -0,0 +1,126 @@
+module Day3
+
+import Prelude
+import Node
+import Aoc
+
+uncurry : ∀ a b c. (a -> b -> c) -> (a × b) -> c
+uncurry f (a,b) = f a b
+
+Parser : U → U
+Parser a = List Char → Maybe (a × List Char)
+
+instance Monad Parser where
+  pure a = \ cs => Just (a, cs)
+  bind ma mab = \ cs => case ma cs of
+    Nothing =>  Nothing
+    Just (a,cs) => mab a cs
+
+instance Alternative Parser where
+  pa <|> pb = \ cs => case pa cs of
+    Nothing => pb cs
+    res => res
+
+fail : ∀ a. Parser a
+fail = \ cs => Nothing
+
+satisfy : (Char → Bool) → Parser Char
+satisfy pred = λ cs => case cs of
+  Nil => Nothing
+  (c :: cs) => if pred c then Just (c, cs) else Nothing
+
+match : Char → Parser Char
+match d = satisfy (_==_ d)
+
+any : Parser Char
+any = satisfy (λ _ => True)
+
+some many : ∀ a. Parser a → Parser (List a)
+many p = some p <|> pure Nil
+some p = do
+  v <- p
+  vs <- many p
+  pure (v :: vs)
+
+pnum : Parser Int
+pnum = do
+  chars <- many (satisfy isDigit)
+  if S (S (S Z)) < length chars then fail
+    else pure $ stringToInt $ pack chars
+
+data Inst : U where
+  Mult : Int → Int → Inst
+  Do : Inst
+  Dont : Inst
+
+mul : Parser Inst
+mul = do
+  match 'm'
+  match 'u'
+  match 'l'
+  match '('
+  x <- pnum
+  match ','
+  y <- pnum
+  match ')'
+  pure $ Mult x y
+
+pdo : Parser Inst
+pdo = do
+  match 'd'
+  match 'o'
+  match '('
+  match ')'
+  pure Do
+
+pdont : Parser Inst
+pdont = do
+  match 'd'
+  match 'o'
+  match 'n'
+  match '\''
+  match 't'
+  match '('
+  match ')'
+  pure Dont
+
+some' many' : ∀ a. Parser a → Parser (List a)
+many' p = do
+  pure MkUnit
+  some' p <|> (any >> many' p) <|> pure Nil
+
+some' p = do
+  v <- p
+  vs <- many' p
+  pure (v :: vs)
+
+inst : Parser Inst
+inst = mul <|> pdo <|> pdont
+
+pfile : Parser (List Inst)
+pfile = many' inst
+
+value : Inst → Int
+value (Mult x y) = x * y
+value _ = 0
+
+part2 : List Inst → Bool → Int → Int
+part2 Nil _ acc = acc
+part2 (Do :: insts) _ acc = part2 insts True acc
+part2 (Dont :: insts) _ acc = part2 insts False acc
+part2 (_ :: insts) False acc = part2 insts False acc
+part2 (Mult x y :: insts) True acc = part2 insts True (acc + x * y)
+
+run : String → IO Unit
+run fn = do
+  putStrLn fn
+  text <- trim <$> readFile fn
+  let (Just (insts, Nil)) = pfile (unpack text) | _ => putStrLn "parse failed"
+  let part1 = foldl _+_ 0 $ map value insts
+  putStrLn $ "part1 " ++ show part1
+  putStrLn $ "part2 " ++ show (part2 insts True 0)
+
+main : IO Unit
+main = do
+  run "aoc2024/day3/eg.txt"
+  run "aoc2024/day3/input.txt"