let blocks = [
  ('B', 'O');  ('X', 'K');  ('D', 'Q');  ('C', 'P');
  ('N', 'A');  ('G', 'T');  ('R', 'E');  ('T', 'G');
  ('Q', 'D');  ('F', 'S');  ('J', 'W');  ('H', 'U');
  ('V', 'I');  ('A', 'N');  ('O', 'B');  ('E', 'R');
  ('F', 'S');  ('L', 'Y');  ('P', 'C');  ('Z', 'M');

let find_letter blocks c =
  let found, remaining =
    List.partition (fun (c1, c2) -> c1 = c || c2 = c) blocks
  match found with
  | _ :: res -> Some (res @ remaining)
  | _ -> None

let can_make_word w =
  let n = String.length w in
  let rec aux i _blocks =
    if i >= n then true else
      match find_letter _blocks w.[i] with
      | None -> false
      | Some rem_blocks ->
          aux (succ i) rem_blocks
  aux 0 blocks

let test label f (word, should) =
  Printf.printf "- %s %S = %B  (should: %B)\n" label word (f word) should

let () =
  List.iter (test "can make word" can_make_word) [
    "A", true;
    "BARK", true;
    "BOOK", false;
    "TREAT", true;
    "COMMON", false;
    "SQUAD", true;
    "CONFUSE", true;