open Driver

type backend = Config.typechecking

let to_filename str =
  let len = String.length str in
  let buf = Buffer.create len in
  let rec process i last_was_underscore =
    if i < len then
      let c = str.[i] in
      match c with
      | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' ->
          Buffer.add_char buf (Char.lowercase_ascii c);
          process (i + 1) false
      | ' ' | '\t' | '\n' ->
          if (not last_was_underscore) && Buffer.length buf > 0 then
            Buffer.add_char buf '_';
          process (i + 1) true
      | _ -> process (i + 1) last_was_underscore
    else ()
  in
  process 0 true;
  let result = Buffer.contents buf in
  let result_len = String.length result in
  if result_len > 0 && result.[result_len - 1] = '_' then
    String.sub result 0 (result_len - 1)
  else result

let run ?(output_dir = Filename.get_temp_dir_name ()) backend name input =
  let output_dir =
    Filename.concat output_dir (Config.show_typechecking backend)
  in
  if not (Sys.file_exists output_dir) then Sys.mkdir output_dir 0o755;
  let file_name = Format.sprintf "%s.ll" @@ to_filename name in
  let output_file = Filename.concat output_dir file_name in
  let target = None in
  let config =
    Config.
      {
        input = InputString input;
        output = OutputFile output_file;
        verbose = false;
        typechecking = backend;
        target;
        show_evidence = false;
      }
  in
  try
    Compile.compile config;
    let cflags = Config.cflags config @ [ "-g" ] in
    let stdlib_dir = Filename.concat Filename.current_dir_name "lib" in
    let stdlib_file = Config.runtime_file config in
    Run.link_and_run output_file stdlib_dir cflags stdlib_file target
  with
  | Common.Error.Error (loc, err) ->
      let error_str =
        Format.asprintf "%a%a" Common.Error.pp_loc (loc, err) Common.Error.pp
          err
      in
      Printf.sprintf "COMPILATION FAILED:\n%s" error_str
  | Exit -> Printf.sprintf "COMPILATION/LINKING FAILED: Exit called"
  | Failure msg -> Printf.sprintf "COMPILATION/LINKING FAILED: %s" msg
  | Sys_error msg ->
      Printf.sprintf "COMPILATION/LINKING FAILED: System error: %s" msg
  | exn ->
      let error_msg = Printexc.to_string exn in
      let backtrace = Printexc.get_backtrace () in
      Printf.sprintf "COMPILATION/LINKING FAILED: %s\n%s" error_msg backtrace

let to_alcotest_test_suite backends suite =
  backends
  |> List.map (fun backend ->
         let backend_name = Config.show_typechecking backend in
         suite
         |> List.map (fun (name, test_fns) ->
                let test_case_name =
                  Format.sprintf "%s (%s)" name backend_name
                in
                ( test_case_name,
                  test_fns
                  |> List.map (fun (name, test_fn) ->
                         (name, `Quick, fun () -> test_fn backend)) )))
  |> List.flatten

let test ~output_dir pos name source expected =
  ( name,
    fun backend ->
      run ~output_dir backend name source
      |> Alcotest.(check ~pos string) "same string" expected )
