Pure BF/Implementation in Ocaml

This Ocaml program defines the types  and , then the function:

that corresponds to the Pure BF program given as command line argument.

However, the function f is never applied. This implementation is for that reason not very powerful.

Note that functions  and   actually modify their input world, rather than a copy.

type world = { inp : in_channel; out : out_channel } type tape = { back : char list; current : char; forth : char list }

let forwards (world, tape) = match tape.forth with | h :: t -> (world,              { back = tape.current :: tape.back;                 current = h;                 forth = t }) | [] -> (world,          { back = tape.current :: tape.back;             current = '\000';             forth = [] })

let backwards (world, tape) = match tape.back with | h :: t -> (world,              { back = t;                 current = h;                 forth = tape.current :: tape.forth }) | [] -> (world,          { back = [];             current = '\000';             forth = tape.current :: tape.forth })

let higher (world, tape) = let succ c = if c = '\255' then '\000' else Char.chr (succ (Char.code c)) in let x = succ tape.current in (world, { back = tape.back; current = x; forth = tape.forth })

let lower (world, tape) = let pred c = if c = '\000' then '\255' else Char.chr (pred (Char.code c)) in let x = pred tape.current in (world, { back = tape.back; current = x; forth = tape.forth })

let output (world, tape) = output_char world.out tape.current; (world, tape)

let input (world, tape) = let x = try input_char world.inp with | End_of_file -> '\000' in (world, { back = tape.back; current = x; forth = tape.forth })

let id (world, tape) = (world, tape)

let compose f g x = f (g x)

let rec loop f (world, tape) = if tape.current = '\000' then id (world, tape) else compose (loop f) f (world, tape)

let rec parse acc p = match p with | '[' :: p -> let (q, p) = parse id p in parse (compose (loop q) acc) p | ']' :: p -> (acc, p)  | [] -> (acc, []) | '>' :: p -> parse (compose forwards acc) p | '<' :: p -> parse (compose backwards acc) p  | '+' :: p -> parse (compose higher acc) p  | '-' :: p -> parse (compose lower acc) p  | '.' :: p -> parse (compose output acc) p  | ',' :: p -> parse (compose input acc) p  | _ :: p -> parse acc p

let str_to_list s = let l = ref [] in for k = String.length s - 1 downto 0 do    l := s.[k] :: !l done; !l

let (f, _) = parse id (str_to_list Sys.argv.(1))