type internal = Left | Right | Plus | Minus | Read | Write | Loop of internal list;; let ( >> ) x f = f x;; let addel el (x, l) = (x, el::l);; let make_internal code = let len = String.length code in let rec cmp pos n = if pos < len then ( match code.[pos] with '<' -> addel Left (cmp (pos + 1) n) |'>' -> addel Right (cmp (pos + 1) n) |'+' -> addel Plus (cmp (pos + 1) n) |'-' -> addel Minus (cmp (pos + 1) n) |',' -> addel Read (cmp (pos + 1) n) |'.' -> addel Write (cmp (pos + 1) n) |'[' -> let (inrespos, inres) = (cmp (pos + 1) (n + 1)) in addel (Loop inres) (cmp inrespos n) |']' -> if n = 0 then failwith "unmatched closing bracket detected" else (pos + 1, []) |_ -> cmp (pos + 1) n ) else if n > 0 then failwith "unmatched opening bracket detected" else (pos + 1, []) in snd (cmp 0 0);; let rec string_of_internal expr = match expr with Left::ls -> "<" ^ (string_of_internal ls) |Right::ls -> ">" ^ (string_of_internal ls) |Plus::ls -> "+" ^ (string_of_internal ls) |Minus::ls -> "-" ^ (string_of_internal ls) |Read::ls -> "," ^ (string_of_internal ls) |Write::ls -> "." ^ (string_of_internal ls) |(Loop s)::ls -> "[" ^ (string_of_internal s) ^ "]" ^ (string_of_internal ls) |[] -> "";; let compile expr = let rec comp code offset = match code with |Left::ls -> ((String.make offset ' ') ^ "if (dp == memsize) dp = 0; else dp++;") :: (comp ls offset) |Right::ls -> ((String.make offset ' ') ^ "if (dp == 0) dp = memsize; else dp--;") :: (comp ls offset) |Plus::ls -> ((String.make offset ' ') ^ "(mem [dp])++;") :: (comp ls offset) |Minus::ls -> ((String.make offset ' ') ^ "(mem [dp])--;") :: (comp ls offset) |Read::ls -> ((String.make offset ' ') ^ "scanf (\"%c\", mem + dp);") :: (comp ls offset) |Write::ls -> ((String.make offset ' ') ^ "printf (\"%c\", mem [dp]);") :: (comp ls offset) |(Loop s)::ls -> let off' = (String.make offset ' ') in (off' ^ "while (mem [dp])") :: (off' ^ "{") :: (comp s (offset + 2)) @ ((off' ^ "}")::(comp ls offset)) |[] -> [] in "#include ":: "":: "int main ()":: " {":: " int dp = 0;":: " const int memsize = 32768;":: " char mem [memsize];":: " memset (mem, sizeof mem, 0);":: ((comp expr 2) @ [" return 0;"; "}"]);; let rec read_input f = try let u = (input_line f) ^ "\n" in u ^ (read_input f) with End_of_file -> "";; let main () = let file = (open_in "code.bf") in let input = read_input file in close_in file; Printf.printf "[Brainf*ck -> C++] v0.1 (c) Dmitry Nikulin aka freidom, 24.10.2009, lcme.ucoz.ru Compiling Brainf*ck code: %s " input; let output = (open_out "code.c") in List.iter (fun x -> output_string output (x ^ "\n")) (compile (make_internal input)); close_out output; Sys.;; main ();;