readme.rst

Switch to 4.07.0

$ opam switch create 4.07.0
$ opam install js_of_ocaml js_of_ocaml-ppx

$ ocamlbuild -use-ocamlfind -pkg js_of_ocaml-ppx -pkg js_of_ocaml library.byte && js_of_ocaml --opt=3 -o bf.js library.byte

Switch to 4.04.0

$ opam switch create 4.04.0
$ opam install js_of_ocaml=3.0 js_of_ocaml-ppx=3.0

Switch to 4.02.1

$ opam switch create 4.02.1
$ opam install js_of_ocaml=2.5 menhir=20151103

$ ocamlbuild -pp "camlp4o -I ~/.opam/4.02.1/lib js_of_ocaml/pa_js.cmo" -pkg js_of_ocaml library_402.byte && js_of_ocaml --opt=3 -o bf.js library_402.byte

Result

ocaml	js_of_ocaml	size
4.14.0	4.0.0	76k
4.07	4.0.0	75k
4.07	3.5.0	28k
4.04	3.0	16K
4.02.1	2.5	12.2k

brainfuck.ml

type operands =
  | Incr_PTR
  | Decr_PTR
  | Incr_value
  | Decr_value
  | Output
  | Input
  | While'
  | End

type instructions = IntCst of int

let get_correction base previous ch =
  let factor, delta =
    let factor = ch / base in
    let delta = ch - (factor * base) in
    if delta > base / 2 then
      let corr = ch - ((factor + 1) * base) in
      (factor + 1, corr)
    else (factor, delta)
  in
  let adelta = abs delta and delta_previous = ch - previous in
  if adelta + 3 + factor < abs delta_previous then (factor, delta)
  else (0, delta_previous)

(* Count the instruction number for represent the character ch inside a loop *)
let get_loop_size base (previous_char, current_base) ch =
  let factor, delta = get_correction base previous_char ch in
  let count_letter = if factor = 0 then 0 else 3 in
  (ch, current_base + factor + abs delta + count_letter)

(* Extract the min and max values from the different values *)
let get_extrema (mini, maxi) chr = (min mini chr, max maxi chr)

let choose_base str =
  let min_base, max_base =
    Common.fold_string get_extrema (max_int, min_int) str
  in
  let rec _choose_base (current, value) base =
    if base > max_base then current
    else
      let base_value =
        Common.fold_string (get_loop_size base) (0, base) str |> snd
      in
      let new_val =
        if base_value < value then (base, base_value) else (current, value)
      in
      _choose_base new_val (base + 1)
  in

  let init_base = float_of_int min_base |> sqrt |> int_of_float in
  _choose_base (init_base, max_int) 1

let rec to_instruction = function
  | IntCst i ->
      let op = if i > 0 then Incr_value else Decr_value in
      Common.make_list (abs i) op

and print str =
  let base = choose_base str in

  let build_char factor _delta = to_instruction (IntCst factor)
  and print_char _factor delta = to_instruction (IntCst delta) @ [ Output ] in

  let build_str (previous, coef_acc, printer_acc) ch =
    let factor, delta = get_correction base previous ch in
    let prev = match factor with 0 -> [] | _ -> [ Incr_PTR ] in
    ( ch,
      coef_acc @ prev @ build_char factor delta,
      printer_acc @ prev @ print_char factor delta )
  in

  let _, coef, printer = Common.fold_string build_str (0, [], []) str in
  let count_letter = Common.count_list Incr_PTR coef in

  to_instruction (IntCst base)
  @ (While' :: coef)
  @ Common.make_list count_letter Decr_PTR
  @ (Decr_value :: End :: printer)

let to_brainfuck = function
  | Incr_PTR -> ">"
  | Decr_PTR -> "<"
  | Incr_value -> "+"
  | Decr_value -> "-"
  | Output -> "."
  | Input -> "+"
  | While' -> "["
  | End -> "]"

let to_ook = function
  | Incr_PTR -> "Ook. Ook? "
  | Decr_PTR -> "Ook? Ook. "
  | Incr_value -> "Ook. Ook. "
  | Decr_value -> "Ook! Ook! "
  | Output -> "Ook! Ook. "
  | Input -> "Ook. Ook! "
  | While' -> "Ook! Ook? "
  | End -> "Ook? Ook! "

(*
let _ =
  let str = "Hello_ World!" in
  print str
  |> List.iter (fun x -> print_string (to_brainfuck x))


  ; print_endline "Ook? Ook?"


*)

common.ml

let make_list length value =
  let rec _make_list acc = function
    | 0 -> acc
    | x -> _make_list (value :: acc) (x - 1)
  in
  _make_list [] length

let count_list elem l =
  let rec _count_list acc = function
    | [] -> acc
    | hd :: tl ->
        let count = if hd = elem then acc + 1 else acc in
        _count_list count tl
  in
  _count_list 0 l

let fold_string (func : 'a -> int -> 'a) init str =
  let max_idx = String.length str in
  let rec _fold_str acc idx str =
    if idx = max_idx then acc
    else
      let ch = String.get str idx |> int_of_char |> func acc in
      _fold_str ch (idx + 1) str
  in

  _fold_str init 0 str

library.ml

open Js_of_ocaml

let convert_bf printer str =
  str |> Js.to_string |> Brainfuck.print |> List.map printer
  |> List.fold_left ( ^ ) ""

let _ =
  let convert_bf = Js.wrap_callback (convert_bf Brainfuck.to_brainfuck)
  and convert_ook = Js.wrap_callback (convert_bf Brainfuck.to_ook) in
  let open Js.Unsafe in
  global##.converter :=
    obj [| ("to_bf", inject convert_bf); ("to_ook", inject convert_ook) |]

library_402.ml

let convert_bf printer str =
  str |> Js.to_string |> Brainfuck.print |> List.map printer
  |> List.fold_left ( ^ ) ""

let _ =
  let convert_bf = Js.wrap_callback (convert_bf Brainfuck.to_brainfuck)
  and convert_ook = Js.wrap_callback (convert_bf Brainfuck.to_ook) in
  let open Js.Unsafe in
  global##converter<- 
    obj [| ("to_bf", inject convert_bf); ("to_ook", inject convert_ook) |]