(* brainf*ck interpreter with byte compile *)

(*
  11xxxxxx => + (x+2) times 41 = 00101001
  10xxxxxx => - (x+2) times 43 = 00101011
  000xxxxx => > (x+2) times 62 = 00111110
  011xxxxx => < (x+2) times 60 = 00111100
  01011011 => [             91 = 01011011
  01011101 => ]             93 = 01011101
  00110000 => .             46 = 00110000
  00101100 => ,             44 = 00101100
  01011111 => [-] (_)
  01000010 => NOP (B)
  01000110 => NOP (F)
  01000011 => NOP (C)
  others   => NOP
*)

let rec input_all filename =
  let i = open_in filename in
  let size = in_channel_length i in
  let buffer = String.make size '\000' in
  begin
    ignore (really_input i buffer 0 size);
    close_in i;
    buffer
  end

let bf_run c compiled =
  let vm = Array.init 65535 (fun i -> 0) in
  let ip = 0 in
  let rp = 0 in
  let rec run ip rp =
    let v = c.[ip] in
    let (nip, nrp) =
      match v with
          '+' ->
            vm.(rp) <- (vm.(rp) + 1) land 255;
            (ip+1, rp)
        | '-' ->
            vm.(rp) <- (vm.(rp) - 1) land 255;
            (ip+1, rp)
        | '>' -> (ip+1, rp+1)
        | '<' -> (ip+1, rp-1)
        | '.' ->
            let ch = char_of_int vm.(rp) in
              print_char ch;
              if ch = '\n' then flush stdout;
              (ip+1, rp)
        | ',' ->
            vm.(rp) <- begin
              try int_of_char (input_char stdin)
              with End_of_file -> -1
            end;
            (ip+1, rp)
        | '[' ->
            if (vm.(rp) <> 0) then
              (ip+1, rp)
            else
              let rec search ip l =
                match c.[ip] with
                  | ']' ->
                      if l = 0 then ip+1
                      else search (ip+1) (l-1)
                  | '[' -> search (ip+1) (l+1)
                  | _ -> search (ip+1) l
              in
                (search (ip+1) 0, rp)
        | ']' ->
            let rec search ip l =
              match c.[ip] with
                | '[' ->
                    if l = 0 then ip
                    else search (ip-1) (l-1)
                | ']' -> search (ip-1) (l+1)
                | _ -> search (ip-1) l
            in
              (search (ip-1) 0, rp)
        | '_' when compiled ->
            vm.(rp) <- 0;
            (ip+1, rp)
        | _ when compiled ->
            let x = int_of_char v in
              if (x lsr 6) = 3 then
                let sz = 2 + (x land 0b111111) in
                  vm.(rp) <- (vm.(rp) + sz) land 255;
                  (ip+1, rp)
              else if (x lsr 6) = 2 then
                let sz = 2 + (x land 0b111111) in
                  vm.(rp) <- (vm.(rp) - sz) land 255;
                  (ip+1, rp)
              else if (x lsr 5) = 0 then
                let sz = 2 + (x land 0b11111) in
                  (ip+1, rp+sz)
              else if (x lsr 5) = 3 then
                let sz = 2 + (x land 0b11111) in
                  (ip+1, rp-sz)
              else
                (ip+1, rp)
        | _ -> (ip+1, rp)
    in
      if (nip < String.length c) then
        run nip nrp
      else
        ()
  in
    run ip rp

let bf_compile c =
  let rec compile ip =
    let rle ch opc shift =
      let op = opc lsl shift in
      let max = (1 lsl shift) - 1 in
      if c.[ip+1] = ch then
        let rec get_size ip =
          if c.[ip] = ch then 1 + get_size (ip+1)
          else 0
        in
        let sz = get_size (ip+2) in
        let s = if sz > max then max else sz in
          (String.make 1 (char_of_int (op lor s)), ip+s+1)
      else
        (String.make 1 ch, ip)
    in
    let v = c.[ip] in
    let (o, nip) =
      match v with
        | '+' -> rle '+' 3 6
        | '-' -> rle '-' 2 6 
        | '>' -> rle '>' 0 5
        | '<' -> rle '<' 3 5
        | '.' -> (".", ip)
        | ',' -> (",", ip)
        | '[' ->
            if c.[ip+1] = '-' && c.[ip+2] = ']' then ("_", ip+2)
            else ("[", ip)
        | ']' -> ("]", ip)
        | _ -> ("", ip)
    in
      if (nip+1 < String.length c) then
        o ^ compile (nip+1)
      else
        ""
  in
    compile 0

let _ =
  let filename = Sys.argv.(1) in
  let all = input_all filename in
  let code =
    if all.[0] == 'B' && all.[1] == 'F' && all.[2] == 'C' then
      all
    else
      bf_compile all
  in
    if Array.length Sys.argv > 2 then
      let o = open_out Sys.argv.(2) in
        output o ("BFC"^code) 0 (3 + String.length code)
    else
      bf_run code true