neko mimi Fu**♥のOCaml実装

使い方はHaskell版と一緒

type status = {
	mutable cptr : int;
	code : string;
	mutable mptr : int;
	mutable mem  : int array;
};;

type instruction = {
	pinc : string;
	pdec : string;
	dinc : string;
	ddec : string;
	out : string;
	inp : string;
	lps : string;
	lpe : string;
};;

let cmdfile = "command.list"
let instruction =
	let cmd_chnnl = open_in cmdfile in
	let tmp0 = input_line cmd_chnnl in
	let tmp1 = input_line cmd_chnnl in
	let tmp2 = input_line cmd_chnnl in
	let tmp3 = input_line cmd_chnnl in
	let tmp4 = input_line cmd_chnnl in
	let tmp5 = input_line cmd_chnnl in
	let tmp6 = input_line cmd_chnnl in
	let tmp7 = input_line cmd_chnnl in
	close_in cmd_chnnl;
	{
		pinc = tmp0;
		pdec = tmp1;
		dinc = tmp2;
		ddec = tmp3;
		out  = tmp4;
		inp  = tmp5;
		lps  = tmp6;
		lpe  = tmp7;
	};;

let input_all filename =
	let inchnnl = open_in filename in
	let rec iter inchnnl buf =
		try
			iter inchnnl (buf^(input_line inchnnl))
		with
			End_of_file ->
				close_in inchnnl;
				buf
	in iter inchnnl "";;

let status = {
	cptr = 0;
	code = input_all Sys.argv.(1);
	mptr = 0;
	mem  = Array.create 1024 0;
};;
let codelen = String.length status.code;;


let startWith src off tgt =
	let tgtlen = String.length tgt in
	let rec iter pos =
		if tgtlen <= pos
			then true
		else
			if (off+tgtlen) > codelen
			then false
			else if String.get src (off+pos) != String.get tgt pos
				then false
				else iter (pos+1)
	in iter 0;;

let pinc () =
	status.mptr <- status.mptr + 1;
	status.cptr <- String.length instruction.pinc + status.cptr;;

let pdec () =
	status.mptr <- status.mptr - 1;
	status.cptr <- String.length instruction.pdec + status.cptr;;

let dinc () =
	Array.set status.mem status.mptr (Array.get status.mem status.mptr + 1);
	status.cptr <- String.length instruction.dinc + status.cptr;;

let ddec () =
	Array.set status.mem status.mptr (Array.get status.mem status.mptr - 1);
	status.cptr <- String.length instruction.ddec + status.cptr;;

let out () =
	print_char (Char.chr (Array.get status.mem status.mptr));
	flush stdout;
	status.cptr <- String.length instruction.out + status.cptr;;

let inp () =
	Array.set status.mem status.mptr (Char.code (input_char stdin));
	status.cptr <- String.length instruction.inp + status.cptr;;

let lps () =
	if Array.get status.mem status.mptr == 0
	then
		let rec searchlpe pos=
			if startWith status.code (status.cptr+pos) instruction.lps
			then searchlpe (String.length instruction.lpe + searchlpe (String.length instruction.lps + pos))
			else if startWith status.code (status.cptr+pos) instruction.lpe
				then pos
				else searchlpe (pos+1)
		in status.cptr <- status.cptr + (searchlpe 1)
	else status.cptr <- String.length instruction.lps + status.cptr;;

let lpe () =
	if Array.get status.mem status.mptr == 0
	then status.cptr <- String.length instruction.lpe + status.cptr
	else 
		let rec searchlps pos=
			if startWith status.code (status.cptr-pos) instruction.lpe
			then searchlps (searchlps (pos+1)+1)
			else if startWith status.code (status.cptr-pos) instruction.lps
				then pos
				else searchlps (pos+1)
		in status.cptr <- status.cptr - (searchlps 1);;

let rec getAction () =
	if status.cptr > codelen then ()
	else if startWith status.code status.cptr instruction.pinc then pinc ()
	else if startWith status.code status.cptr instruction.pdec then pdec ()
	else if startWith status.code status.cptr instruction.dinc then dinc ()
	else if startWith status.code status.cptr instruction.ddec then ddec ()
	else if startWith status.code status.cptr instruction.out then out ()
	else if startWith status.code status.cptr instruction.inp then inp ()
	else if startWith status.code status.cptr instruction.lps then lps ()
	else if startWith status.code status.cptr instruction.lpe then lpe ()
	else (status.cptr <- 1 + status.cptr;getAction ());;

let rec main ()=
	if status.cptr > codelen then ()
	else
		(getAction();main ());;

main();;