(* bfc.ml - Don Yang (uguu.org)

   Simple BF to C compiler.

   08/28/04
                                                                           *)

(* Maximum data for output program *)
let max_tape_size = Nativeint.of_int 0x10000;;

(* Open first argument for input if available, otherwise use stdin *)
let input () =
   if Array.length Sys.argv > 1
   then open_in_bin Sys.argv.(1)
   else stdin;;

(* Open second argument for input if available, otherwise use stdout *)
let output () =
   if Array.length Sys.argv > 2
   then open_out_bin Sys.argv.(2)
   else stdout;;

(* Extract BF operators from string *)
let rec parse_str x =
   if x = "" then [] else
   (
      match String.get x 0 with
        '[' -> ['[']  |  ']' -> [']']  |  '<' -> ['<']  |  '>' -> ['>']
      | '-' -> ['-']  |  '+' -> ['+']  |  ',' -> [',']  |  '.' -> ['.']
      | _ -> []
   ) @ (parse_str (String.sub x 1 ((String.length x) - 1)));;

(* Parse file line by line *)
let rec load_bf_recurse infile eof =
   if eof != 0 then []
   else
      let (x, y) = (try (input_line infile, 0) with End_of_file -> ("", 1)) in
      (parse_str x) @ (load_bf_recurse infile y);;
let load_bf infile =
   load_bf_recurse infile 0;;

(* Check for balanced [] brackets *)
let balance_brackets code =
   if
   (
      List.fold_left
         (
            fun level c ->
               let nlevel =
               (
                  match c with
                    '[' -> level + 1
                  | ']' -> level - 1
                  | _ -> level
               ) in if nlevel < 0 then -2 else nlevel
         )
         0
         code
   ) == 0
   then code
   else
   (
      prerr_string "[] unbalanced\n"; []
   );;

(* Convert each BF operator to C code *)
let write_opcode outfile c =
   (
      match c with
        '[' -> output_string outfile "\nwhile(*x){\n"
      | ']' -> output_string outfile "\n}\n"
      | '<' -> output_string outfile "--x;"
      | '>' -> output_string outfile "++x;"
      | '-' -> output_string outfile "--*x;"
      | '+' -> output_string outfile "++*x;"
      | ',' -> output_string outfile "\n*x=getchar();"
      | '.' -> output_string outfile "putchar(*x);\n"
      | _ -> ()
   ); outfile;;

(* C program header *)
let write_header outfile =
   output_string outfile
   (
      "#include<stdio.h>\n" ^
      "#include<string.h>\n" ^
      "static int Tape[" ^
         (Nativeint.to_string max_tape_size) ^
      "];\n" ^
      "int main(void)\n{\n" ^
      "int *x=&Tape[0];\n" ^
      "memset(x,0," ^
         (Nativeint.to_string max_tape_size) ^
      "*sizeof(int));\n"
   );;

(* C program footer *)
let write_footer outfile =
   output_string outfile "\nreturn 0;\n}\n";;


(* Program entry point *)
let infile = input() in
   let outfile = output() in
      let code = balance_brackets (load_bf infile) in
      (
         match code with
           [] -> ()
         | _ ->
         write_header outfile;
         write_footer (List.fold_left write_opcode outfile code)
      );
      close_out outfile;
      close_in infile;;