open Runeval
open Ocamliutil
open Tinyocaml

let version = "4.05.0"

let setdebug () =
  Runeval.debug := true;
  Eval.debug := true;
  Ocamlilib.debug := true;
  Pptinyocaml.debug := true;
  Ocamliprim.debug := true

let reverse_video = "\x1b[7m"
let code_end = "\x1b[0m"

let searchfor = ref (Str.regexp "") (* always matches *)
let searchuntil = ref (Str.regexp "$a") (* never matches *)
let searchafter = ref (Str.regexp "") (* always matches *)
let untilany = ref false
let afterany = ref false
let numresults = ref max_int
let invertsearch = ref false
let invertuntil = ref false
let invertafter = ref false
let stopaftersearch = ref false
let upto = ref 0
let repeat = ref false
let silenced = ref false
let highlight = ref false
let regexp = ref false
let showregexps = ref false
let noparens = ref false
let sidelets = ref false
let interactivesearch = ref false

let set_until_any s =
  untilany := true;
  searchuntil := Str.regexp s

let set_after_any s =
  afterany := true;
  searchafter := Str.regexp s

let make_regexp reference str =
  reference :=
    if !regexp
      then Str.regexp str
      else
        let r = Ocamlipat.regexp_of_lexbuf (Lexing.from_string str) in 
          if !showregexps then Printf.printf "Made search term %S\n" (Ocamlipat.regexp_of_string str);
          Str.regexp r

  In this mode , we stop after the first search and enter interactive mode then .
let set_interactive_search str =
  showall := true;
  interactivesearch := true;
  make_regexp searchfor str

let times = ref 1

let _ =
  Ocamliprim.exe := Bytes.of_string "-e"

let argv str =
  Ocamliprim.argv := Array.of_list (Array.to_list !Ocamliprim.argv @ [Bytes.of_string str])

let ename = ref ""

let setename s =
  ename := s

  For " Mod " check for Mod.cmi and mod.cmi . If neither exists , create Mod.cmi , Mod.cmo
let create_cmi_cmo (ename : string) (text : string) =
  if ename = "" then raise (Invalid_argument "create_cmi");
  let uncap =
    let chars = explode ename in
      implode (Char.lowercase_ascii (List.hd chars)::(List.tl chars))
  in
    if not (Sys.file_exists (ename ^ ".ml")) && not (Sys.file_exists (uncap ^ ".ml")) then
      begin
        let fh = open_out (ename ^ ".ml") in
          output_string fh text;
          close_out fh;
        ignore (Sys.command ("ocamlc " ^ ename ^ ".ml"))
      end

let settext s =
  Runeval.settext ~modname:!ename s;
  if !ename <> "" then create_cmi_cmo !ename s;
  ename := ""

let printversion () =
  print_string version;
  print_string "\n";
  exit 0

let set_notypecheck () =
  Ocamliutil.typecheck := false;
  Eval.runtime_typecheck := true

let argspec =
  [("-version", Arg.Unit printversion, " Print the version number of ocamli");
   ("-search", Arg.String (fun x -> make_regexp searchfor x; showall := true), " Show only matching evaluation steps");
   ("-regexp", Arg.Set regexp, " Search terms are regular expressions rather than the built-in system");
   ("-no-parens", Arg.Set noparens, "Ignore parentheses and begin and end when matching with classic search syntax");
   ("-invert-search", Arg.Set invertsearch, " Invert the search, showing non-matching steps");
   ("-highlight", Arg.Set highlight, "Highlight the matching part of each matched step.");
   ("-n", Arg.Set_int numresults, " Show only <x> results");
   ("-until", Arg.String (fun x -> make_regexp searchuntil x; showall := true), " show only until this matches a printed step");
   ("-after", Arg.String (fun x -> make_regexp searchafter x; showall := true), " show only after this matches a printed step");
   ("-until-any", Arg.String set_until_any, " show only until this matches any step");
   ("-after-any", Arg.String set_after_any, " show only after this matches any step");
   ("-invert-after", Arg.Set invertafter, " invert the after condition");
   ("-invert-until", Arg.Set invertuntil, " invert the until condition");
   ("-stop", Arg.Set stopaftersearch, " stop computation after final search results");
   ("-repeat", Arg.Set repeat, " allow the after...until result to be repeated.");
   ("-upto", Arg.Set_int upto, " show n lines up to each result line");
   ("-show", Arg.Set show, " Print the final result of the program");
   ("-show-all", Arg.Set showall, " Print steps of evaluation");
   ("-show-stdlib-init", Arg.Set Ocamlilib.showstdlibinit, " Show initialisation of standard library");
   ("-prompt", Arg.Set prompt, " Require enter after each step but last");
   ("-step", Arg.Set_float step, " Wait a number of seconds after each step but last");
   ("-pp", Arg.Set_string printer, " Set the prettyprinter");
   ("-width", Arg.Set_int width, " Set the output width");
   ("-e", Arg.String settext, " Evaluate the program text given");
   ("-e-name", Arg.String setename, " Set the module name for the next -e instance");
   ("-top", Arg.Set top, " Do nothing, exit cleanly (for top level)");
   ("-remove-rec", Arg.String add_remove_rec, " Do not print the given recursive function");
   ("-remove-rec-all", Arg.Set remove_rec_all, " Do not print any recursive functions");
   ("-show-pervasives", Arg.Set showpervasives, " Show more of pervasives");
   ("-real-ops", Arg.Set Tinyocamlrw.realops, " Don't treat :=, ref etc. as operators");
   ("-fast-curry", Arg.Set fastcurry, " Apply all curried arguments at once. ");
   ("-fast-for", Arg.Set Eval.fastfor, " Elide the evaluation of the inside of a FOR loop");
   ("-dtiny", Arg.Set debugtiny, " Show Tinyocaml representation");
   ("-dtinyall", Arg.Set debugtinyall, " Show Tinyocaml representation at each step");
   ("-dpp", Arg.Set debugpp, " Show the pretty-printed program");
   ("-debug", Arg.Unit setdebug, " Debug (for OCAMLRUNPARAM=b)");
   ("-debug-rules", Arg.Set Eval.debugrules, " Show each rule");
   ("-debug-show-regexps", Arg.Set showregexps, " Debug output of computed regular expressions");
   ("-no-arith", Arg.Clear show_simple_arithmetic, " Ellide simple arithmetic");
   ("-no-if-bool", Arg.Set noifbool, "Don't show if false, if true stage");
   ("-no-var-lookup", Arg.Set novarlookup, "Don't show stage immediately after variable lookup");
   ("-no-peek", Arg.Clear Eval.dopeek, " Avoid peeking for debug");
   ("-no-syntax", Arg.Clear Pptinyocaml.syntax, " Don't use syntax highlighting");
   ("-tex-syntax", Arg.Set Pptinyocaml.syntax_tex, " Output tex instead of ANSI control codes");
   ("-no-typecheck", Arg.Unit set_notypecheck, " Don't typecheck");
   ("-no-collect", Arg.Clear Eval.docollectunusedlets, " Don't collect unused lets");
   ("-no-stdlib", Arg.Clear Ocamlilib.load_stdlib, " Don't load the standard library");
   ("-side-lets", Arg.Set sidelets, "Show value-lets at the side");
   ("-otherlibs", Arg.Set_string Ocamlilib.otherlibs, " Location of OCaml otherlibs");
   ("-emulated-stdlib", Arg.Set Ocamliprim.emulated, " Use emulated Standard Library %externals");
   ("-times", Arg.Set_int times, " Do many times");
   ("-i-search", Arg.String set_interactive_search, "Set interactive mode with search");
   ("--", Arg.Rest argv, "")]

let linecount = ref 0

(* True if we are in printing range. i.e before or including 'until' and after or
including 'after' *)
let inrange = ref false

let take l n =
  if n < 0 then raise (Invalid_argument "take") else
  let rec take_inner r l n =
    if n = 0 then List.rev r else
      match l with
      | [] -> raise (Invalid_argument "take")
      | h::t -> take_inner (h::r) t (n - 1)
  in
    take_inner [] l n

let rec take_up_to l n =
  if n < 0 then raise (Invalid_argument "take_up_to") else
    try take l n with _ -> take_up_to l (n - 1)

let cache = ref []

let clean_cache () =
  cache := try take_up_to !cache !upto with _ -> []

let sls_width = ref 0

let print_sls_binding = function
  (PatVar v, e) ->
    let str = Pptinyocaml.to_string e in
    Printf.printf "%s = %s " v str;
| _ -> failwith "print_sls_binding"

let calculate_sls_width sls =
  List.fold_left ( + ) 0
    (List.map
      (function (PatVar v, e) ->
         String.length (Pptinyocaml.to_string e) + 4 + String.length v
       | _ -> failwith "set_sls_width")
      sls)

let set_sls_width sls =
  sls_width := max !sls_width (calculate_sls_width sls)

let print_sls ls =
  set_sls_width ls;
  List.iter print_sls_binding ls

  For now , remove any in remove_rec
let filter_sl : binding -> binding option = function
  (PatVar p, e) when List.mem p !remove_recs -> None
| x -> Some x

let filter_sls (sls : binding list) =
  option_map filter_sl sls

  Given a Tinyocaml.t , find all the bound names of all let bindings . Return a 
  * list of them , including all duplicates . We use Eval.bound_in_bindings
 * list of them, including all duplicates. We use Eval.bound_in_bindings *)
let bound_names e =
  let names = ref [] in
    Tinyocaml.iter
      (function x ->
        (*Printf.printf "iter:%s\n" (Tinyocaml.to_string x);*)
        match x with
        | Let (_, bindings, _) ->
            names := bound_in_bindings bindings @ !names
        | x -> ())
      e;
    !names

(* Given a Tinyocaml.t, remove any outer value-lets, and return the new
 * Tinyocaml.t and the list of value-lets *)
(* For now, just single binding, just PatVar. *)
let lets = ref []

let rec find_sidelets allowed_names x =
  match x with
  | (Let (recflag, [(PatVar v, e)], t)) when Tinyocamlutil.is_value e && List.mem v allowed_names ->
      if !remove_rec_all && recflag then () else lets := (PatVar v, e)::!lets;
      find_sidelets allowed_names t
  | x -> Tinyocaml.recurse (find_sidelets allowed_names) x

let find_sidelets allowed_names e =
  lets := [];
  let e' = find_sidelets allowed_names e in
    (e', List.rev !lets)

let rec remove_items_with_duplicates = function
  [] -> []
| h::t ->
    if List.mem h t
      then remove_items_with_duplicates (List.filter (fun x -> x <> h) t)
      else h::remove_items_with_duplicates t

(* To qualify for extraction, a name must be singly bound in the whole expression *)
let find_sidelets tiny =
  let bound = bound_names tiny in
    let singly_bound_names = remove_items_with_duplicates bound in
      let allowed = List.filter (fun x -> not (List.mem x !remove_recs)) singly_bound_names in
        find_sidelets allowed tiny

let really_print_line sls line =
  if !upto > 0 then print_string "\n";
  List.iter
    (fun x -> print_string x; print_string "\n")
    (take_up_to !cache !upto);
  for x = 0 to !sls_width - 1 - calculate_sls_width sls do print_string " " done; 
  print_sls sls;
  print_string line

  To highlight a string , we proceed through it , counting all non - escaped 
  * characters , to determine start and end points . 
  * a ) At position 's ' we add a highlight - start code . 
  * b ) At position ' e ' , we add and end - code and then re - emit any start codes 
  * occuring since the last end - code 
  * First we build three sections : before , during and after . Return also any 
  * start - codes in operation ( i.e not cancelled ) at ' e ' .
 * characters, to determine start and end points.
 * a) At position 's' we add a highlight-start code.
 * b) At position 'e', we add and end-code and then re-emit any start codes
 * occuring since the last end-code
 * First we build three sections: before, during and after. Return also any
 * start-codes in operation (i.e not cancelled) at 'e'. *)
let update count b e l before during after =
  if count >= e then (before, during, List.rev l @ after)
  else if count >= b then (before, List.rev l @ during, after)
  else (List.rev l @ before, during, after)

let rec sections b e codes count before during after = function
  '\x1b'::'['::'0'::'m'::t ->
    let l = ['\x1b'; '['; 'm'] in
    let before, during, after = update count b e l before during after in
      sections b e codes count before during after t
| '\x1b'::'['::x::'m'::t ->
   let l = ['\x1b'; '['; x; 'm'] in
    let before, during, after = update count b e l before during after in
      let codes' = if count > b then codes else l::codes in
      sections b e codes' count before during after t
| h::t ->
    let before, during, after = update count b e [h] before during after in
      sections b e codes (count + 1) before during after t
| [] ->
    (List.rev before, List.rev during, List.rev after, codes)

let debug_charlist chars =
  List.iter (Printf.printf "%C ") chars;
  print_newline ()

let highlight_charlist b e chars =
  Printf.printf "highlight_charlist: search result is at %i --> %i\n" b e;
  debug_charlist chars;
  let before, during, after, codes = sections b e [] 0 [] [] [] chars in
  print_endline "BEFORE:";
  debug_charlist before;
  print_endline "DURING:";
  debug_charlist during;
  print_endline "AFTER:";
  debug_charlist after;
  print_endline "CODES:";
  debug_charlist (List.flatten codes);
      before @ explode reverse_video @ during @ explode code_end
    @ (List.flatten codes) @ after @ explode code_end

let highlight_string b e s =
  implode (highlight_charlist b e (explode s))

let highlight_search regexp plainstr str =
  ignore (Str.search_forward regexp plainstr 0);
  let beginning = Str.match_beginning () + 4 in
  let theend = Str.match_end () + 4 in
    highlight_string beginning theend str

let last_s = ref ""

let print_line newline preamble tiny =
  let invert x = if x then not else (fun x -> x) in
  let s = string_of_tiny ~preamble:"" ~codes:false (Tinyocamlutil.strip_control tiny) in
  (* If it's the same as the last line, simply don't print it. *)
  if s <> !last_s then
    begin
      last_s := s;
      let matched =
        (invert !invertsearch)
        (try ignore (Str.search_forward !searchfor s 0); true with Not_found -> false)
      in
      let matched_until =
        (!untilany || matched) &&
        (invert !invertuntil)
        (try ignore (Str.search_forward !searchuntil s 0); true with Not_found -> false)
      in
      let matched_after =
        (!afterany || matched) &&
        (invert !invertafter)
        (try ignore (Str.search_forward !searchafter s 0); true with Not_found -> false)
      in
        (* Check if we are entering the range *)
        if not !inrange && matched_after then inrange := true;
        (* If it matches the search, and we are in the range, print the line *)
        if !inrange && matched then
          begin
            (* If interactive search, set prompt and unset the search term *)
            if !interactivesearch then
              begin
                prompt := true;
                searchfor := Str.regexp "" 
              end;
            let tiny, sls = if !sidelets then let t, sls = find_sidelets tiny in t, filter_sls sls else tiny, [] in
            let str = string_of_tiny ~preamble tiny in
            let str = if !highlight then highlight_search !searchfor s str else str in
            if not !silenced then really_print_line sls str;
            if newline && not !silenced then print_string "\n";
            flush stdout;
            incr linecount;
          end;
        (* Check if we are leaving the range. If so, set numresults = 0 to prevent
        more printing, but allow computation to continue (unless -stop is set). If
        'repeat' is set, we continue as normal, waiting for the next -after
        condition. If repeat, we output an extra newline to demarcate the results. *)
        if !inrange && matched_until then
          begin
            inrange := false;
            if !repeat then print_string "\n" else numresults := 0
          end;
      (* Update the cache *)
      cache := string_of_tiny ~preamble:"    " tiny :: !cache;
      clean_cache ();
    end

external reraise : exn -> 'a = "%reraise"

let mainfile = ref ""

let setfile x =
  if not (Sys.file_exists x) then
    begin
      Printf.printf "File %s not found\n" x;
      exit 1
    end
  else
    begin
      mainfile := x;
      setfile x
    end

let go () =
  Arg.parse argspec setfile
    "Syntax: eval <filename | -e program> [-- arg1 arg2 ...]\n";
  Ocamliprim.argv := Array.of_list (!Ocamliprim.exe::Array.to_list !Ocamliprim.argv);
  Eval.fastcurry := !fastcurry;
  Tinyocamlutil.fastcurry := !fastcurry;
  Pptinyocaml.fastcurry := !fastcurry;
  Ocamlilib.load_library ();
  (*Ocamlilib.showlib ();*)
if ! searchfor < > " " || ! searchuntil < > " " || !  < > " " then showall 
    * : = true ;
   * := true;*)
  let rec really_run first state =
    match if !prompt then wait_for_enter state else None with
      Some newcode ->
        Printf.printf "=>  %s%!" newcode;
        really_run false (Eval.init (snd (Tinyocamlrw.of_real_ocaml !Eval.lib (ast newcode))))
    | None ->
    Unix.sleepf !step;
    match Eval.next state with
      Next state' ->
         if !debugtinyall then
           begin
             print_string (Tinyocaml.to_string (Eval.tiny state));
             print_string "\n";
             flush stdout;
           end;
Printf.printf " Considering printing stage % s ... skipped last is % b\n " 
         ( string_of_tiny ~preamble : " " ( I.tiny state ' ) ) ! skipped ;
        (string_of_tiny ~preamble:"" (I.tiny state')) !skipped;*)
        begin if
          !showall &&  
          (!show_simple_arithmetic || show_this_stage (Eval.last ()) (Eval.peek state') (Eval.tiny state) (Eval.tiny state')) &&
          (!showpervasives || show_this_pervasive_stage (Eval.last ()))
        then
          begin
            let preamble = (*if !skipped then "=>* " else*) "=>  " in
            if Eval.newlines state then print_string "\n";
            print_line (not !prompt) preamble (Eval.tiny state');
            skipped := false;
            if !linecount >= !numresults && !stopaftersearch then raise Exit;
            if !linecount >= !numresults && not !stopaftersearch then silenced := true
          end
        else
          skipped := true
        end;
        really_run false state'
    | IsValue ->
        (* Only print if !quiet. On Silent we don't want it, on normal, we have already printed *)
        if !show && not !showall then print_line true "" (Eval.tiny state)
    | Malformed s ->
        print_string "Malformed AST node\n";
        print_string s;
        print_string "\n";
        if !debug then raise Exit
    | Unimplemented s ->
        print_string "Unimplemented AST node\n";
        print_string s;
        print_string "\n";
        if !debug then raise Exit
  in
   let run code =
    if !printer = "simple" then Pptinyocaml.simple := true;
    Pptinyocaml.width := !width;
    let state = Eval.init (snd (Tinyocamlrw.of_real_ocaml !Eval.lib (Ocamliutil.ast ~filename:!mainfile code))) in
       if !debugtiny then
         begin
           print_string (Tinyocaml.to_string (Eval.tiny state));
           print_string "\n";
           flush stdout;
           raise Exit
         end;
      if !showall then
        begin
          if !linecount >= !numresults && !stopaftersearch then raise Exit;
          print_line (not !prompt) "    " (Eval.tiny state);
          if !linecount >= !numresults && !stopaftersearch then raise Exit
        end;
      if !debugpp then raise Exit;
      for _ = 1 to !times do really_run true state done
   in
     try
       if not !top then
         match load_code () with
           None -> print_string "No source code provided.\n"; exit 1
         | Some x -> run x
     with
       Eval.ExceptionRaised(n, payload) ->
         let expstr =
           match payload with None -> "" | Some p -> Pptinyocaml.to_string p
         in
           prerr_string (Printf.sprintf "Exception: %s%s.\n" n (if expstr = "" then "" else " " ^ expstr))
     | Exit ->
         if !debug then reraise Exit;
         exit 0
     | e ->
         if !debug then raise e else Printf.eprintf "Error: [%s]\n" (Printexc.to_string e);
         exit 1

let () =
  if not !Sys.interactive then go ()


 always matches 
 never matches 
 always matches 
 True if we are in printing range. i.e before or including 'until' and after or
including 'after' 
Printf.printf "iter:%s\n" (Tinyocaml.to_string x);
 Given a Tinyocaml.t, remove any outer value-lets, and return the new
 * Tinyocaml.t and the list of value-lets 
 For now, just single binding, just PatVar. 
 To qualify for extraction, a name must be singly bound in the whole expression 
 If it's the same as the last line, simply don't print it. 
 Check if we are entering the range 
 If it matches the search, and we are in the range, print the line 
 If interactive search, set prompt and unset the search term 
 Check if we are leaving the range. If so, set numresults = 0 to prevent
        more printing, but allow computation to continue (unless -stop is set). If
        'repeat' is set, we continue as normal, waiting for the next -after
        condition. If repeat, we output an extra newline to demarcate the results. 
 Update the cache 
Ocamlilib.showlib ();
if !skipped then "=>* " else
 Only print if !quiet. On Silent we don't want it, on normal, we have already printed 
open Runeval
open Ocamliutil
open Tinyocaml

let version = "4.05.0"

let setdebug () =
  Runeval.debug := true;
  Eval.debug := true;
  Ocamlilib.debug := true;
  Pptinyocaml.debug := true;
  Ocamliprim.debug := true

let reverse_video = "\x1b[7m"
let code_end = "\x1b[0m"

let untilany = ref false
let afterany = ref false
let numresults = ref max_int
let invertsearch = ref false
let invertuntil = ref false
let invertafter = ref false
let stopaftersearch = ref false
let upto = ref 0
let repeat = ref false
let silenced = ref false
let highlight = ref false
let regexp = ref false
let showregexps = ref false
let noparens = ref false
let sidelets = ref false
let interactivesearch = ref false

let set_until_any s =
  untilany := true;
  searchuntil := Str.regexp s

let set_after_any s =
  afterany := true;
  searchafter := Str.regexp s

let make_regexp reference str =
  reference :=
    if !regexp
      then Str.regexp str
      else
        let r = Ocamlipat.regexp_of_lexbuf (Lexing.from_string str) in 
          if !showregexps then Printf.printf "Made search term %S\n" (Ocamlipat.regexp_of_string str);
          Str.regexp r

  In this mode , we stop after the first search and enter interactive mode then .
let set_interactive_search str =
  showall := true;
  interactivesearch := true;
  make_regexp searchfor str

let times = ref 1

let _ =
  Ocamliprim.exe := Bytes.of_string "-e"

let argv str =
  Ocamliprim.argv := Array.of_list (Array.to_list !Ocamliprim.argv @ [Bytes.of_string str])

let ename = ref ""

let setename s =
  ename := s

  For " Mod " check for Mod.cmi and mod.cmi . If neither exists , create Mod.cmi , Mod.cmo
let create_cmi_cmo (ename : string) (text : string) =
  if ename = "" then raise (Invalid_argument "create_cmi");
  let uncap =
    let chars = explode ename in
      implode (Char.lowercase_ascii (List.hd chars)::(List.tl chars))
  in
    if not (Sys.file_exists (ename ^ ".ml")) && not (Sys.file_exists (uncap ^ ".ml")) then
      begin
        let fh = open_out (ename ^ ".ml") in
          output_string fh text;
          close_out fh;
        ignore (Sys.command ("ocamlc " ^ ename ^ ".ml"))
      end

let settext s =
  Runeval.settext ~modname:!ename s;
  if !ename <> "" then create_cmi_cmo !ename s;
  ename := ""

let printversion () =
  print_string version;
  print_string "\n";
  exit 0

let set_notypecheck () =
  Ocamliutil.typecheck := false;
  Eval.runtime_typecheck := true

let argspec =
  [("-version", Arg.Unit printversion, " Print the version number of ocamli");
   ("-search", Arg.String (fun x -> make_regexp searchfor x; showall := true), " Show only matching evaluation steps");
   ("-regexp", Arg.Set regexp, " Search terms are regular expressions rather than the built-in system");
   ("-no-parens", Arg.Set noparens, "Ignore parentheses and begin and end when matching with classic search syntax");
   ("-invert-search", Arg.Set invertsearch, " Invert the search, showing non-matching steps");
   ("-highlight", Arg.Set highlight, "Highlight the matching part of each matched step.");
   ("-n", Arg.Set_int numresults, " Show only <x> results");
   ("-until", Arg.String (fun x -> make_regexp searchuntil x; showall := true), " show only until this matches a printed step");
   ("-after", Arg.String (fun x -> make_regexp searchafter x; showall := true), " show only after this matches a printed step");
   ("-until-any", Arg.String set_until_any, " show only until this matches any step");
   ("-after-any", Arg.String set_after_any, " show only after this matches any step");
   ("-invert-after", Arg.Set invertafter, " invert the after condition");
   ("-invert-until", Arg.Set invertuntil, " invert the until condition");
   ("-stop", Arg.Set stopaftersearch, " stop computation after final search results");
   ("-repeat", Arg.Set repeat, " allow the after...until result to be repeated.");
   ("-upto", Arg.Set_int upto, " show n lines up to each result line");
   ("-show", Arg.Set show, " Print the final result of the program");
   ("-show-all", Arg.Set showall, " Print steps of evaluation");
   ("-show-stdlib-init", Arg.Set Ocamlilib.showstdlibinit, " Show initialisation of standard library");
   ("-prompt", Arg.Set prompt, " Require enter after each step but last");
   ("-step", Arg.Set_float step, " Wait a number of seconds after each step but last");
   ("-pp", Arg.Set_string printer, " Set the prettyprinter");
   ("-width", Arg.Set_int width, " Set the output width");
   ("-e", Arg.String settext, " Evaluate the program text given");
   ("-e-name", Arg.String setename, " Set the module name for the next -e instance");
   ("-top", Arg.Set top, " Do nothing, exit cleanly (for top level)");
   ("-remove-rec", Arg.String add_remove_rec, " Do not print the given recursive function");
   ("-remove-rec-all", Arg.Set remove_rec_all, " Do not print any recursive functions");
   ("-show-pervasives", Arg.Set showpervasives, " Show more of pervasives");
   ("-real-ops", Arg.Set Tinyocamlrw.realops, " Don't treat :=, ref etc. as operators");
   ("-fast-curry", Arg.Set fastcurry, " Apply all curried arguments at once. ");
   ("-fast-for", Arg.Set Eval.fastfor, " Elide the evaluation of the inside of a FOR loop");
   ("-dtiny", Arg.Set debugtiny, " Show Tinyocaml representation");
   ("-dtinyall", Arg.Set debugtinyall, " Show Tinyocaml representation at each step");
   ("-dpp", Arg.Set debugpp, " Show the pretty-printed program");
   ("-debug", Arg.Unit setdebug, " Debug (for OCAMLRUNPARAM=b)");
   ("-debug-rules", Arg.Set Eval.debugrules, " Show each rule");
   ("-debug-show-regexps", Arg.Set showregexps, " Debug output of computed regular expressions");
   ("-no-arith", Arg.Clear show_simple_arithmetic, " Ellide simple arithmetic");
   ("-no-if-bool", Arg.Set noifbool, "Don't show if false, if true stage");
   ("-no-var-lookup", Arg.Set novarlookup, "Don't show stage immediately after variable lookup");
   ("-no-peek", Arg.Clear Eval.dopeek, " Avoid peeking for debug");
   ("-no-syntax", Arg.Clear Pptinyocaml.syntax, " Don't use syntax highlighting");
   ("-tex-syntax", Arg.Set Pptinyocaml.syntax_tex, " Output tex instead of ANSI control codes");
   ("-no-typecheck", Arg.Unit set_notypecheck, " Don't typecheck");
   ("-no-collect", Arg.Clear Eval.docollectunusedlets, " Don't collect unused lets");
   ("-no-stdlib", Arg.Clear Ocamlilib.load_stdlib, " Don't load the standard library");
   ("-side-lets", Arg.Set sidelets, "Show value-lets at the side");
   ("-otherlibs", Arg.Set_string Ocamlilib.otherlibs, " Location of OCaml otherlibs");
   ("-emulated-stdlib", Arg.Set Ocamliprim.emulated, " Use emulated Standard Library %externals");
   ("-times", Arg.Set_int times, " Do many times");
   ("-i-search", Arg.String set_interactive_search, "Set interactive mode with search");
   ("--", Arg.Rest argv, "")]

let linecount = ref 0

let inrange = ref false

let take l n =
  if n < 0 then raise (Invalid_argument "take") else
  let rec take_inner r l n =
    if n = 0 then List.rev r else
      match l with
      | [] -> raise (Invalid_argument "take")
      | h::t -> take_inner (h::r) t (n - 1)
  in
    take_inner [] l n

let rec take_up_to l n =
  if n < 0 then raise (Invalid_argument "take_up_to") else
    try take l n with _ -> take_up_to l (n - 1)

let cache = ref []

let clean_cache () =
  cache := try take_up_to !cache !upto with _ -> []

let sls_width = ref 0

let print_sls_binding = function
  (PatVar v, e) ->
    let str = Pptinyocaml.to_string e in
    Printf.printf "%s = %s " v str;
| _ -> failwith "print_sls_binding"

let calculate_sls_width sls =
  List.fold_left ( + ) 0
    (List.map
      (function (PatVar v, e) ->
         String.length (Pptinyocaml.to_string e) + 4 + String.length v
       | _ -> failwith "set_sls_width")
      sls)

let set_sls_width sls =
  sls_width := max !sls_width (calculate_sls_width sls)

let print_sls ls =
  set_sls_width ls;
  List.iter print_sls_binding ls

  For now , remove any in remove_rec
let filter_sl : binding -> binding option = function
  (PatVar p, e) when List.mem p !remove_recs -> None
| x -> Some x

let filter_sls (sls : binding list) =
  option_map filter_sl sls

  Given a Tinyocaml.t , find all the bound names of all let bindings . Return a 
  * list of them , including all duplicates . We use Eval.bound_in_bindings
 * list of them, including all duplicates. We use Eval.bound_in_bindings *)
let bound_names e =
  let names = ref [] in
    Tinyocaml.iter
      (function x ->
        match x with
        | Let (_, bindings, _) ->
            names := bound_in_bindings bindings @ !names
        | x -> ())
      e;
    !names

let lets = ref []

let rec find_sidelets allowed_names x =
  match x with
  | (Let (recflag, [(PatVar v, e)], t)) when Tinyocamlutil.is_value e && List.mem v allowed_names ->
      if !remove_rec_all && recflag then () else lets := (PatVar v, e)::!lets;
      find_sidelets allowed_names t
  | x -> Tinyocaml.recurse (find_sidelets allowed_names) x

let find_sidelets allowed_names e =
  lets := [];
  let e' = find_sidelets allowed_names e in
    (e', List.rev !lets)

let rec remove_items_with_duplicates = function
  [] -> []
| h::t ->
    if List.mem h t
      then remove_items_with_duplicates (List.filter (fun x -> x <> h) t)
      else h::remove_items_with_duplicates t

let find_sidelets tiny =
  let bound = bound_names tiny in
    let singly_bound_names = remove_items_with_duplicates bound in
      let allowed = List.filter (fun x -> not (List.mem x !remove_recs)) singly_bound_names in
        find_sidelets allowed tiny

let really_print_line sls line =
  if !upto > 0 then print_string "\n";
  List.iter
    (fun x -> print_string x; print_string "\n")
    (take_up_to !cache !upto);
  for x = 0 to !sls_width - 1 - calculate_sls_width sls do print_string " " done; 
  print_sls sls;
  print_string line

  To highlight a string , we proceed through it , counting all non - escaped 
  * characters , to determine start and end points . 
  * a ) At position 's ' we add a highlight - start code . 
  * b ) At position ' e ' , we add and end - code and then re - emit any start codes 
  * occuring since the last end - code 
  * First we build three sections : before , during and after . Return also any 
  * start - codes in operation ( i.e not cancelled ) at ' e ' .
 * characters, to determine start and end points.
 * a) At position 's' we add a highlight-start code.
 * b) At position 'e', we add and end-code and then re-emit any start codes
 * occuring since the last end-code
 * First we build three sections: before, during and after. Return also any
 * start-codes in operation (i.e not cancelled) at 'e'. *)
let update count b e l before during after =
  if count >= e then (before, during, List.rev l @ after)
  else if count >= b then (before, List.rev l @ during, after)
  else (List.rev l @ before, during, after)

let rec sections b e codes count before during after = function
  '\x1b'::'['::'0'::'m'::t ->
    let l = ['\x1b'; '['; 'm'] in
    let before, during, after = update count b e l before during after in
      sections b e codes count before during after t
| '\x1b'::'['::x::'m'::t ->
   let l = ['\x1b'; '['; x; 'm'] in
    let before, during, after = update count b e l before during after in
      let codes' = if count > b then codes else l::codes in
      sections b e codes' count before during after t
| h::t ->
    let before, during, after = update count b e [h] before during after in
      sections b e codes (count + 1) before during after t
| [] ->
    (List.rev before, List.rev during, List.rev after, codes)

let debug_charlist chars =
  List.iter (Printf.printf "%C ") chars;
  print_newline ()

let highlight_charlist b e chars =
  Printf.printf "highlight_charlist: search result is at %i --> %i\n" b e;
  debug_charlist chars;
  let before, during, after, codes = sections b e [] 0 [] [] [] chars in
  print_endline "BEFORE:";
  debug_charlist before;
  print_endline "DURING:";
  debug_charlist during;
  print_endline "AFTER:";
  debug_charlist after;
  print_endline "CODES:";
  debug_charlist (List.flatten codes);
      before @ explode reverse_video @ during @ explode code_end
    @ (List.flatten codes) @ after @ explode code_end

let highlight_string b e s =
  implode (highlight_charlist b e (explode s))

let highlight_search regexp plainstr str =
  ignore (Str.search_forward regexp plainstr 0);
  let beginning = Str.match_beginning () + 4 in
  let theend = Str.match_end () + 4 in
    highlight_string beginning theend str

let last_s = ref ""

let print_line newline preamble tiny =
  let invert x = if x then not else (fun x -> x) in
  let s = string_of_tiny ~preamble:"" ~codes:false (Tinyocamlutil.strip_control tiny) in
  if s <> !last_s then
    begin
      last_s := s;
      let matched =
        (invert !invertsearch)
        (try ignore (Str.search_forward !searchfor s 0); true with Not_found -> false)
      in
      let matched_until =
        (!untilany || matched) &&
        (invert !invertuntil)
        (try ignore (Str.search_forward !searchuntil s 0); true with Not_found -> false)
      in
      let matched_after =
        (!afterany || matched) &&
        (invert !invertafter)
        (try ignore (Str.search_forward !searchafter s 0); true with Not_found -> false)
      in
        if not !inrange && matched_after then inrange := true;
        if !inrange && matched then
          begin
            if !interactivesearch then
              begin
                prompt := true;
                searchfor := Str.regexp "" 
              end;
            let tiny, sls = if !sidelets then let t, sls = find_sidelets tiny in t, filter_sls sls else tiny, [] in
            let str = string_of_tiny ~preamble tiny in
            let str = if !highlight then highlight_search !searchfor s str else str in
            if not !silenced then really_print_line sls str;
            if newline && not !silenced then print_string "\n";
            flush stdout;
            incr linecount;
          end;
        if !inrange && matched_until then
          begin
            inrange := false;
            if !repeat then print_string "\n" else numresults := 0
          end;
      cache := string_of_tiny ~preamble:"    " tiny :: !cache;
      clean_cache ();
    end

external reraise : exn -> 'a = "%reraise"

let mainfile = ref ""

let setfile x =
  if not (Sys.file_exists x) then
    begin
      Printf.printf "File %s not found\n" x;
      exit 1
    end
  else
    begin
      mainfile := x;
      setfile x
    end

let go () =
  Arg.parse argspec setfile
    "Syntax: eval <filename | -e program> [-- arg1 arg2 ...]\n";
  Ocamliprim.argv := Array.of_list (!Ocamliprim.exe::Array.to_list !Ocamliprim.argv);
  Eval.fastcurry := !fastcurry;
  Tinyocamlutil.fastcurry := !fastcurry;
  Pptinyocaml.fastcurry := !fastcurry;
  Ocamlilib.load_library ();
if ! searchfor < > " " || ! searchuntil < > " " || !  < > " " then showall 
    * : = true ;
   * := true;*)
  let rec really_run first state =
    match if !prompt then wait_for_enter state else None with
      Some newcode ->
        Printf.printf "=>  %s%!" newcode;
        really_run false (Eval.init (snd (Tinyocamlrw.of_real_ocaml !Eval.lib (ast newcode))))
    | None ->
    Unix.sleepf !step;
    match Eval.next state with
      Next state' ->
         if !debugtinyall then
           begin
             print_string (Tinyocaml.to_string (Eval.tiny state));
             print_string "\n";
             flush stdout;
           end;
Printf.printf " Considering printing stage % s ... skipped last is % b\n " 
         ( string_of_tiny ~preamble : " " ( I.tiny state ' ) ) ! skipped ;
        (string_of_tiny ~preamble:"" (I.tiny state')) !skipped;*)
        begin if
          !showall &&  
          (!show_simple_arithmetic || show_this_stage (Eval.last ()) (Eval.peek state') (Eval.tiny state) (Eval.tiny state')) &&
          (!showpervasives || show_this_pervasive_stage (Eval.last ()))
        then
          begin
            if Eval.newlines state then print_string "\n";
            print_line (not !prompt) preamble (Eval.tiny state');
            skipped := false;
            if !linecount >= !numresults && !stopaftersearch then raise Exit;
            if !linecount >= !numresults && not !stopaftersearch then silenced := true
          end
        else
          skipped := true
        end;
        really_run false state'
    | IsValue ->
        if !show && not !showall then print_line true "" (Eval.tiny state)
    | Malformed s ->
        print_string "Malformed AST node\n";
        print_string s;
        print_string "\n";
        if !debug then raise Exit
    | Unimplemented s ->
        print_string "Unimplemented AST node\n";
        print_string s;
        print_string "\n";
        if !debug then raise Exit
  in
   let run code =
    if !printer = "simple" then Pptinyocaml.simple := true;
    Pptinyocaml.width := !width;
    let state = Eval.init (snd (Tinyocamlrw.of_real_ocaml !Eval.lib (Ocamliutil.ast ~filename:!mainfile code))) in
       if !debugtiny then
         begin
           print_string (Tinyocaml.to_string (Eval.tiny state));
           print_string "\n";
           flush stdout;
           raise Exit
         end;
      if !showall then
        begin
          if !linecount >= !numresults && !stopaftersearch then raise Exit;
          print_line (not !prompt) "    " (Eval.tiny state);
          if !linecount >= !numresults && !stopaftersearch then raise Exit
        end;
      if !debugpp then raise Exit;
      for _ = 1 to !times do really_run true state done
   in
     try
       if not !top then
         match load_code () with
           None -> print_string "No source code provided.\n"; exit 1
         | Some x -> run x
     with
       Eval.ExceptionRaised(n, payload) ->
         let expstr =
           match payload with None -> "" | Some p -> Pptinyocaml.to_string p
         in
           prerr_string (Printf.sprintf "Exception: %s%s.\n" n (if expstr = "" then "" else " " ^ expstr))
     | Exit ->
         if !debug then reraise Exit;
         exit 0
     | e ->
         if !debug then raise e else Printf.eprintf "Error: [%s]\n" (Printexc.to_string e);
         exit 1

let () =
  if not !Sys.interactive then go ()

