day9.ml

module Int64 = Z
let i0 = Z.of_int 0
let i1 = Z.of_int 1
let i2 = Z.of_int 2
let i3 = Z.of_int 3
let i4 = Z.of_int 4

module Intcode = struct

  let (+) = Int64.add

  type t = {
    program: Int64.t array;
    mutable pos: Int64.t;
    mutable relative_base: Int64.t;
    inputs: Int64.t Queue.t;
    mutable outputs: Int64.t list;
    mutable last_op: op
  }
  and op = | Halt | Input | Output | Other

  let init ?(inputs=[]) ?(outputs=[]) program =
    let queue = Queue.create () in
    let memory = CCArray.make 100_000_000 (Int64.of_int 0) in
    let program = Array.of_list program in
    let () = CCArray.blit program 0 memory 0 (Array.length program) in
    List.iter (fun item -> Queue.push item queue) inputs;
    {
      program = memory;
      pos = i0;
      relative_base = i0;
      inputs = queue;
      outputs;
      last_op = Other;
    }

  let step (state: t) =
    let get p = Array.get state.program (Int64.to_int p) in
    let set ~pos = Array.set state.program (Int64.to_int pos) in
    let last_op op = state.last_op <- op in
    let move pos = state.pos <- pos in
    let update_base diff =
      state.relative_base <- Z.add state.relative_base  diff
    in
    let read () =
      Queue.pop state.inputs
    in
    let write value =
      state.outputs <- value :: state.outputs
    in
    let op = get state.pos |> Int64.to_string |> CCString.to_list |> List.rev in
    let with_modes modes =
      let modes =
        modes
        |> CCString.of_list
        |> CCString.pad ~side:`Right ~c:'0' 5
        |> CCString.to_list
      in
      let mode (param: Int64.t) =
        match CCList.drop (Int64.to_int param) modes with
        | [] | '0' :: _ -> `Pos
        | '1' :: _ -> `Value
        | '2' :: _ -> `Relative
        | _ -> assert false
      in
      fun (param: Int64.t) ->
        let value = get (state.pos + param) in
        match mode param with
        | `Value -> value
        | `Pos -> get value
        | `Relative -> get (Int64.add value state.relative_base)
    in
    Printf.printf "-: %s \n" (CCString.of_list op);
    match op with

    (* halt *)
    | ['9'; '9'] -> last_op Halt;

    | '9' :: modes ->
      let get_param = with_modes modes in
      let value = get_param i1 in
      update_base value;
      last_op Other;
      move (state.pos + i2)

    (* read *)
    | '3' :: modes ->
      let get_param = with_modes modes in
      let input_pos = get_param i1 in
      let value = read () in
      set ~pos:input_pos value;
      last_op Input;
      move (state.pos + i2)

    (* write *)
    | '4' :: modes ->
      let get_param = with_modes modes in
      write (get_param i1);
      last_op Output;
      move (state.pos + i2)

    (* jump-if-true / jump-if-false *)
    | op :: modes when op = '5' || op = '6' ->
      let get_param = with_modes modes in
      let f = if op = '5' then ( <> ) i0 else ( = ) i0 in
      let next = match get_param i1 |> f with
        | true -> get_param i2
        | false -> state.pos + i3
      in
      last_op Other;
      move next

    (* less-than / equals *)
    | op :: modes when op = '7' || op = '8' ->
      let get_param = with_modes modes in
      let f = if op = '7' then ( < ) else ( = ) in
      let value = match f (get_param i1) (get_param i2) with
        | true -> i1
        | false -> i0
      in
      set ~pos:(get (state.pos + i3)) value;
      last_op Other;
      move (state.pos + i4)

    (* add / mul *)
    | op :: modes when op = '1' || op = '2' ->
      let get_param = with_modes modes in
      let f = if op = '1' then ( + ) else Int64.mul in
      let res = f (get_param i1) (get_param i2) in
      let res_pos = get (state.pos + i3) in
      set ~pos:res_pos res;
      last_op Other;
      move (state.pos + i4)

    | op ->
      CCString.of_list op |> print_endline;
      assert false

  let rec run state =
    step state;
    match state.last_op with
    | Halt -> state.outputs
    | _ -> run state

  let rec run_till_output state =
    step state;
    match state.last_op with
    | Halt -> `Halted
    | Output -> `Output
    | _ -> run_till_output state

  let push_input state input =
    Queue.push input state.inputs

  let get_outputs state =
    state.outputs

end

let solve lines =
  let program =
    lines
    |> List.hd
    |> CCString.split_on_char ','
    |> List.map Int64.of_string
  in
  let state = Intcode.init ~inputs:[i1] program in
  let () = Intcode.run state |> List.map Int64.to_string |> List.iter print_endline in
  Printf.printf "Part1 = %Ld\n" 0L