diff --git a/bin/day2404.ml b/bin/day2404.ml
new file mode 100644
index 0000000..a329b9b
--- /dev/null
+++ b/bin/day2404.ml
@@ -0,0 +1,47 @@
+let search_string big little =
+  let re = Str.regexp_string little in
+  let rec impl acc pos =
+    try
+      let _ = Str.search_forward re big pos in
+      impl (acc + 1) (Str.match_end ())
+    with Not_found -> acc
+  in
+  impl 0 0
+
+let is_inbounds sa (x, y) =
+  y >= 0 && y < Array.length sa && x >= 0 && x < String.length sa.(y)
+
+let gen_string sa (x, y) (dx, dy) =
+  let rec impl acc x y =
+    if is_inbounds sa (x, y) then
+      impl (String.cat acc (String.make 1 sa.(y).[x])) (x + dx) (y + dy)
+    else acc
+  in
+  impl "" x y
+
+let gen_strings sa (x, y) (dx, dy) (dx2, d2y) =
+  let rec impl acc x y =
+    if is_inbounds sa (x, y) then
+      let s = gen_string sa (x, y) (dx, dy) in
+      impl (s :: acc) (x + dx2) (y + d2y)
+    else acc
+  in
+  List.rev (impl [] x y)
+
+let gen_search_strings sa =
+  let right = String.length sa.(0) - 1 in
+  gen_strings sa (0, 0) (1, 0) (0, 1)
+  @ gen_strings sa (0, 0) (0, 1) (1, 0)
+  @ gen_strings sa (0, 0) (1, 1) (1, 0)
+  @ gen_strings sa (0, 1) (1, 1) (0, 1)
+  @ gen_strings sa (right, 0) (-1, 1) (-1, 0)
+  @ gen_strings sa (right, 1) (-1, 1) (0, 1)
+  @ []
+
+let find_xmas sa =
+  let search_strings = gen_search_strings sa in
+  List.fold_left (fun acc x -> acc + search_string x "XMAS") 0 search_strings
+  + List.fold_left (fun acc x -> acc + search_string x "SAMX") 0 search_strings
+
+let sa_of_file fname = Aoc.strings_of_file fname |> Array.of_list
+let _ = Aoc.main sa_of_file [ (string_of_int, find_xmas) ]
diff --git a/bin/dune b/bin/dune
index 4865e91..c0cbb18 100644
--- a/bin/dune
+++ b/bin/dune
@@ -1,4 +1,4 @@
 (executables
- (public_names day2401 day2402 day2403)
- (names day2401 day2402 day2403)
+ (public_names day2401 day2402 day2403 day2404)
+ (names day2401 day2402 day2403 day2404)
  (libraries str aoc))