type instruction =
	| NOOP (* no operation, IP := IP + 1 *)
	| PUSH of int (* push integer constant onto stack, IP := IP + 1 *)
	| ADD (* push sum of top two elements of stack, IP := IP + 1 *)
	| SUB (* push difference of top two elements of stack, IP := IP + 1 *)
	| EQ (* push 1 if top two elements of stack are equal otherwise push 0, IP := IP + 1 *)
	| LT (* push 1 if top top element of stack is less than the second element otherwise push 0, IP := IP + 1 *)
	| JMP of int (* relative jump IP := IP + rel *)
	| JMPZ of int (* jump if zero on the stack IP := IP + rel, otherwise IP := IP + 1 *)
	| EXIT (* stop execution, returning the top element of the stack *)
	| READ (* push read integer, IP := IP + 1 *)
	| DUP (* duplicate top element on the stack, IP := IP + 1 *)
type machine_state = {
	input : int list;
	rom : int -> instruction;
	stack : int list;
	instruction_pointer : int;
}
let pop state =
	match state.stack with
	| x :: stack -> (x, { state with stack })
	| [] -> failwith "empty stack"
let read state =
	match state.input with
	| x :: input -> (x, { state with input })
	| [] -> failwith "empty input"
let double_pop state =
	let x1, state = pop state in
	let x2, state = pop state in
	(x1, x2, state)
let push x state = { state with stack = x :: state.stack }
let increment_instruction_pointer i state =
	{ state with instruction_pointer = state.instruction_pointer + i }
let string_of_instruction = function
	| NOOP -> "NOOP" | ADD -> "ADD" | SUB -> "SUB" | EQ -> "EQ"
	| LT -> "LT" | EXIT -> "EXIT" | READ -> "READ" | DUP -> "DUP"
	| PUSH i -> "PUSH " ^ string_of_int i
	| JMP i -> "JMP " ^ string_of_int i
	| JMPZ i -> "JMPZ " ^ string_of_int i
let print_debug_info { input; rom; stack; instruction_pointer } =
	Printf.printf "INFO: IP = %i (%s), stack = [%s], input = [%s]\n"
	instruction_pointer
	(string_of_instruction @@ rom instruction_pointer)
	(String.concat ", " @@ List.map string_of_int stack)
	(String.concat ", " @@ List.map string_of_int input)
let rec run (state : machine_state) =
	print_debug_info state;
	let incr = increment_instruction_pointer 1 in
	match state.rom state.instruction_pointer with
	| NOOP -> run (incr state)
	| _ -> failwith "not implemented"
let romA i = [| PUSH 0; READ; DUP; JMPZ 3; ADD; JMP (-4); JMPZ 1; EXIT |].(i)
let computerA input =
	run { rom = romA; stack = []; input; instruction_pointer = 0 }