brainf_ck_interpleter.ml

module List = struct
  include Stdlib.List

  let hd_opt xs = try Some (hd xs) with Failure _ -> None
end


let char_list_of_string string =
  let rec aux acc idx =
    if idx >= 0 then
      aux (string.[idx] :: acc) (idx - 1)
    else
      acc
  in
  aux [] (String.length string - 1)

let memory_size = 30000

let interplet code =
  let user_memory = Array.make memory_size 0 in
  let char_list = char_list_of_string code |> Array.of_list in

  let rec impl ptr idx ps =
    let next = idx + 1 in

    try
      match char_list.(idx) with
      | '>' -> let ptr = ptr + 1 in (if ptr >= memory_size then impl 0 else impl ptr) next ps
      | '<' -> let ptr = ptr - 1 in (if ptr < 0 then impl memory_size else impl ptr) next ps
      | '+' -> user_memory.(ptr) <- user_memory.(ptr) + 1; impl ptr next ps
      | '-' -> user_memory.(ptr) <- user_memory.(ptr) - 1; impl ptr next ps
      | '.' -> output_binary_int stdout user_memory.(ptr); impl ptr next ps
      | ',' -> user_memory.(ptr) <- input_binary_int stdin; impl ptr next ps
      | '[' ->
          if user_memory.(ptr) = 0 then
            let rec get_next_index idx' depth =
              match char_list.(idx') with
              | '[' -> get_next_index (idx' + 1) (depth + 1)
              | ']' ->
                  if depth > 0 then
                    get_next_index (idx' + 1) (depth - 1)
                  else
                    idx' + 1
              | _ -> get_next_index (idx' + 1) depth
            in
            impl ptr (get_next_index next 0) ps
          else
            impl ptr next (idx :: ps)
      | ']' ->
          begin
            match ps with
            | [] -> failwith "pair is not found: ']'"
            | x :: xs -> impl ptr x xs
          end
      | _ -> impl ptr next ps

    with Invalid_argument msg as e ->
      if msg = "index out of bounds" then
        match List.hd_opt ps with
        | None -> ()
        | Some idx -> Printf.eprintf "pair is not found: '[' %d\n" idx
      else
        raise e
  in
  impl 0 0 []