Pure BF/Implementation in Ocaml

← Back to Pure BF

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

f : world * tape -> world * tape

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))