(*  Copyright (C) 2006, 2007  Florent Monnier
    This little script is a brainfuck interpreter written in OCaml

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA  *)

(* utils *)

let printc c = print_char(char_of_int c)

let dump buf acc =
  print_newline();
  List.iter (fun d -> Printf.printf " %3d\n" d) (List.rev_append acc buf);
  print_newline()

let get_char() = int_of_char(input_char stdin)

let slide_left ~buf ~acc = match acc with
  | [] -> (0::buf, [])
  | h::t -> (h::buf, t)

let slide_right ~buf ~acc = match buf with
  | [] -> ([0], acc)
  | h::[] -> ([0], h::acc)
  | h::t -> (t, h::acc)

(* interpreter *)
let parse_brainfuck ~code =
  let rec rewind i n =
    if i < 0 then failwith "open bracket missing" else
    match code.[i] with
    | ']' -> rewind (pred i) (succ n)
    | '[' -> if n = 0 then succ i else rewind (pred i) (pred n)
    | _ -> rewind (pred i) n
  in
  let len = String.length code in
  let rec parse i ~buf ~acc =
    if i < len then
    match code.[i], buf with
    | _, [] -> failwith "Empty buffer"
    | '+', h::t -> parse (succ i) ~buf:(succ h::t) ~acc
    | '-', h::t -> parse (succ i) ~buf:(pred h::t) ~acc
    | ',', h::t -> parse (succ i) ~buf:(get_char()::t) ~acc
    | ']', h::t ->
        if h = 0 then parse (succ i) ~buf ~acc
        else parse (rewind (pred i) 0) ~buf ~acc
    | '.', h::t -> printc h;  parse (succ i) ~buf ~acc
    | '#', _ -> dump buf acc; parse (succ i) ~buf ~acc
    | '>', _ -> let (buf, acc) = slide_right ~buf ~acc in parse (succ i) ~buf ~acc
    | '<', _ -> let (buf, acc) = slide_left  ~buf ~acc in parse (succ i) ~buf ~acc
    | _,_ -> parse (succ i) ~buf ~acc
  in
  parse 0 ~buf:[0] ~acc:[]

(* main *)
let () =
  let code = "           >+++++++
     [<++++++++++++>-]   <+++.>+++
     [<++++++>-]         <.+++..-.++++.--..--------.+++++++++.>++++++
     [<------------->-]  <.>++++++++
     [<+++++++++>-]      <+.+++++.>++++++
     [<------------->-]  <.>++++++
     [<+++++++++++>-]    <++.+.+++++++++++++.>+++++++++
     [<--------->-]      <-.>+++++++
     [<++++++++++++>-]   <+++.--.-------.----------.+.+++++++++++++.>++++
     [<---->-]           <.-.>++++
     [<++++>-]           <+.-------------.+++++++++.>++++++
     [<------------->-]  <.>+++++
     [<+++++++++++>-]    <.++++++++++++++.+++++++.++++++++.>+++++++
     [<------------>-]   <.>++++++
     [<+++++++++++>-]    <++.+.+++++++++++++.>+++++++++
     [<--------->-]      <-.>++++++
     [<++++++++>-]       <.>++++
     [<++++++++>-]       <++.---.--------.+++++++++++.>++++
     [<---->-]           <-.++++++++++++..----.----.+++++++++++++.+.---.++.>++++
     [<---->-]           <-.++.+++++.---.>++++++
     [<----------->-]    <---.>++++
     [<++++++++>-]       <++.>++++++
     [<++++++++>-]       <.>++++
     [<---->-]           <-.++++++++.+++++.--------.+++++++++++++++.>+++
     [<------>-]         <.++++++++.>++++++++
     [<------------>-]   <-. "
  in
  let code = "
      ++++++++++[>+++++++>++++++++++>+++>+<<<<-]
      >++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>. "
  in
  parse_brainfuck ~code