open Printf

let iterations = 10;;

(*============================================================================*)

type 'a hufftree = Leaf of 'a | Node of 'a hufftree * 'a hufftree;; (*1*)

let get16bitint buf offset =                                        (*2*)
  ((int_of_char (buf.[offset])) lsl 8) lor                          (*3*)
  (int_of_char (buf.[offset+1]));;                                  (*4*)

let get32bitint buf offset =                                        (*5*)
  ((int_of_char (buf.[offset+0])) lsl 24) lor                       (*6*)
  ((int_of_char (buf.[offset+1])) lsl 16) lor                       (*7*)
  ((int_of_char (buf.[offset+2])) lsl 8) lor                        (*8*)
  (int_of_char (buf.[offset+3]));;                                  (*9*)

let list_rev_to_string list =                                       (*10*)
  let len = List.length list in                                     (*11*)
  let str = String.create len in                                    (*12*)
  let rec fill l n =                                                (*13*)
    match l with                                                    (*14*)
    | [] -> str                                                     (*15*)
    | hd :: tl -> str.[n] <- hd; fill tl (n - 1) in                 (*16*)
  fill list (len - 1);;                                             (*17*)

let huffdecode inbuf inoffset limit otree =                         (*18*)
  let rec decode byte inoff ptree acc =                             (*19*)
    match ptree with                                                (*20*)
      Leaf(pchar) ->                                                (*21*)
	if inoff >= (limit-1)                                       (*22*)
	then
	  pchar::acc                                                (*23*)
	else
	  decode byte inoff otree (pchar::acc)                      (*24*)
    | Node(left,right) ->                                           (*25*)
	let bitoffset = (7 - (inoff land 7))                        (*26*)
	in
	let newbyte =                                               (*27*)
	  if bitoffset = 7                                          (*28*)
	  then int_of_char(inbuf.[inoff lsr 3])                     (*29*)
	  else byte                                                 (*30*)
	in
	if ((newbyte lsr bitoffset) land 1) = 0                     (*31*)
	then decode newbyte (inoff+1) left acc                      (*32*)
	else decode newbyte (inoff+1) right acc                     (*33*)
  in
  list_rev_to_string (decode 0 (inoffset*8) otree []);;             (*34*)

let build_tree inbuf inoffset =                                     (*35*)
  let rec b_tree offset =                                           (*36*)
    let leftsize = get16bitint inbuf offset                         (*37*)
    in
    let rightsize = get16bitint inbuf (offset+2+leftsize)           (*38*)
    in
    let create_subtree size newoffset =                             (*39*)
      if size = 1                                                   (*40*)
      then
	Leaf(inbuf.[newoffset])                                     (*41*)
      else
	b_tree newoffset                                            (*42*)
    in
    let leftsubtree = create_subtree leftsize (offset+2)            (*43*)
    and rightsubtree = create_subtree rightsize (offset+4+leftsize) (*44*)
    in
    Node(leftsubtree,rightsubtree)                                  (*45*)
  in
  b_tree inoffset;;                                                 (*46*)

let do_all inbuf =                                                  (*47*)
  match String.sub inbuf 0 4 with                                   (*48*)
    "huff" ->                                                       (*49*)
      let treesize = get16bitint inbuf 4                            (*50*)
      in
      let limit = get32bitint inbuf (treesize+6)                    (*51*)
      and tree = (build_tree inbuf 6)                               (*52*)
      in
      huffdecode inbuf (treesize+10)                                (*53*)
	(limit+((treesize+10)*8)) tree                              (*54*)
	
  | x -> printf "Wrong start: %s\n" x ; ""(*Unnecessary error check*)

(*============================================================================*)

let get_file fname = 
  let handle = open_in fname in
  let len = in_channel_length handle in
  let s = String.create len in
  really_input handle s 0 len;
  s;;      

let rec iter n f =
  if n>1
  then
    (f(); iter (n-1) f)
  else
    f();;

let main inname outname =    
  let inbuf = get_file inname
  in
  let start = Sys.time() in
  let res = (iter iterations (function () -> do_all inbuf)) in  
  let stop = Sys.time () in
  let time = (stop -. start) in
  let outfile = open_out outname in
  (output outfile res 0 (String.length res);
   printf "%.3f" time;
   flush stdout;
   close_out outfile) ;; 

let () =
  let infile = (Array.get Sys.argv 1);
  in
  let outfile = infile ^ ".ocaml" 
  in
  main infile outfile;;