{
open StdLabels
open Printf

let deprecated_msg ~is_exn what =
  sprintf
    "[%sdeprecated \"\\\n\
     [2016-09] this element comes from the stdlib distributed with OCaml.\n\
     Referring to the stdlib directly is discouraged by Base. You should either\n\
     use the equivalent functionality offered by Base, or if you really want to\n\
     refer to the stdlib, use Stdlib.%s instead\"]"
    (if is_exn then "@" else "@@")
    what

let deprecated_msg_no_equivalent ~is_exn what =
  sprintf
    "[%sdeprecated \"\\\n\
     [2016-09] this element comes from the stdlib distributed with OCaml.\n\
     There is not equivalent functionality in Base or Stdio at the moment,\n\
     so you need to use [Stdlib.%s] instead\"]"
    (if is_exn then "@" else "@@")
    what

let deprecated_msg_with_repl_text ~is_exn text =
  sprintf
    "[%sdeprecated \"\\\n\
     [2016-09] this element comes from the stdlib distributed with OCaml.\n\
     %s.\"]"
    (if is_exn then "@" else "@@")
    text

let deprecated_msg_with_repl ~is_exn repl =
  deprecated_msg_with_repl_text ~is_exn (sprintf "Use [%s] instead" repl)

let deprecated_msg_with_approx_repl ~is_exn ~id repl =
  sprintf
    "[%sdeprecated \"\\\n\
     [2016-09] this element comes from the stdlib distributed with OCaml.\n\
     There is no equivalent functionality in Base or Stdio but you can use\n\
     [%s] instead.\n\
     Alternatively, if you really want to refer the stdlib you can use\n\
     [Stdlib.%s].\"]"
    (if is_exn then "@" else "@@")
    repl id

type replacement =
  | No_equivalent
  | Repl of string
  | Repl_text of string
  | Approx of string

let permissive = ref false

let val_replacement = function
  | "( ! )"               -> No_equivalent
  | "( != )"              -> Repl "not (phys_equal ...)"
  | "( & )"               -> No_equivalent
  | "( && )"              -> No_equivalent
  | "( * )"               -> No_equivalent
  | "( ** )"              -> Repl "**."
  | "( *. )"              -> No_equivalent
  | "( + )"               -> No_equivalent
  | "( +. )"              -> No_equivalent
  | "( - )"               -> No_equivalent
  | "( -. )"              -> No_equivalent
  | "( / )"               -> No_equivalent
  | "( /. )"              -> No_equivalent
  | "( := )"              -> No_equivalent
  | "( < )"               -> No_equivalent
  | "( <= )"              -> No_equivalent
  | "( <> )"              -> No_equivalent
  | "( = )"               -> No_equivalent
  | "( == )"              -> Repl "phys_equal"
  | "( > )"               -> No_equivalent
  | "( >= )"              -> No_equivalent
  | "( @ )"               -> No_equivalent
  | "( @@ )"              -> No_equivalent
  | "( ^ )"               -> No_equivalent
  | "( ^^ )"              -> No_equivalent
  | "( asr )"             -> No_equivalent
  | "( land )"            -> No_equivalent
  | "( lor )"             -> No_equivalent
  | "( lsl )"             -> No_equivalent
  | "( lsr )"             -> No_equivalent
  | "( lxor )"            -> No_equivalent
  | "( mod )"             -> Repl_text "Use (%), which has slightly different semantics, or Int.rem which is equivalent"
  | "( or )"              -> No_equivalent
  | "( |> )"              -> No_equivalent
  | "( || )"              -> No_equivalent
  | "( ~+ )"              -> No_equivalent
  | "( ~+. )"             -> No_equivalent
  | "( ~- )"              -> No_equivalent
  | "( ~-. )"             -> No_equivalent
  | "__FILE__"            -> No_equivalent
  | "__FUNCTION__"        -> No_equivalent
  | "__LINE__"            -> No_equivalent
  | "__LINE_OF__"         -> No_equivalent
  | "__LOC__"             -> No_equivalent
  | "__LOC_OF__"          -> No_equivalent
  | "__MODULE__"          -> No_equivalent
  | "__POS__"             -> No_equivalent
  | "__POS_OF__"          -> No_equivalent
  | "abs"                 -> No_equivalent
  | "abs_float"           -> No_equivalent
  | "acos"                -> Repl "Float.acos"
  | "acosh"               -> Repl "Float.acosh"
  | "asinh"               -> Repl "Float.asinh"
  | "atanh"               -> Repl "Float.atanh"
  | "asin"                -> Repl "Float.asin"
  | "at_exit"             -> No_equivalent
  | "atan"                -> Repl "Float.atan"
  | "atan2"               -> Repl "Float.atan2"
  | "bool_of_string"      -> Repl "Bool.of_string"
  | "bool_of_string_opt"  -> No_equivalent
  | "ceil"                -> Repl "Float.round_up"
  | "char_of_int"         -> Repl "Char.of_int_exn"
  | "classify_float"      -> Repl "Float.classify"
  | "close_in"            -> Repl "Stdio.In_channel.close"
  | "close_in_noerr"      -> Repl "Stdio.In_channel.close"
  | "close_out"           -> Repl "Stdio.Out_channel.close"
  | "close_out_noerr"     -> Repl "Stdio.Out_channel.close"
  | "compare"             -> No_equivalent
  | "copysign"            -> Repl "Float.copysign"
  | "cos"                 -> Repl "Float.cos"
  | "cosh"                -> Repl "Float.cosh"
  | "decr"                -> Repl "Int.decr"
  | "do_at_exit"          -> No_equivalent
  | "do_domain_local_at_exit" -> No_equivalent
  | "epsilon_float"       -> Repl "Float.epsilon_float"
  | "exit"                -> No_equivalent
  | "exp"                 -> Repl "Float.exp"
  | "expm1"               -> Repl "Float.expm1"
  | "failwith"            -> No_equivalent
  | "float"               -> Repl "Float.of_int"
  | "float_of_int"        -> Repl "Float.of_int"
  | "float_of_string"     -> Repl "Float.of_string"
  | "float_of_string_opt" -> No_equivalent
  | "floor"               -> Repl "Float.round_down"
  | "flush"               -> Repl "Stdio.Out_channel.flush"
  | "flush_all"           -> No_equivalent
  | "format_of_string"    -> No_equivalent
  | "frexp"               -> Repl "Float.frexp"
  | "fst"                 -> No_equivalent
  | "hypot"               -> Repl "Float.hypot"
  | "ignore"              -> No_equivalent
  | "in_channel_length"   -> Repl "Stdio.In_channel.length"
  | "incr"                -> Repl "Int.incr"
  | "infinity"            -> Repl "Float.infinity"
  | "input"               -> Repl "Stdio.In_channel.input"
  | "input_binary_int"    -> Repl "Stdio.In_channel.input_binary_int"
  | "input_byte"          -> Repl "Stdio.In_channel.input_byte"
  | "input_char"          -> Repl "Stdio.In_channel.input_char"
  | "input_line"          -> Repl "Stdio.In_channel.input_line"
  | "input_value"         -> Repl "Stdio.In_channel.unsafe_input_value"
  | "int_of_char"         -> Repl "Char.to_int"
  | "int_of_float"        -> Repl "Int.of_float"
  | "int_of_string"       -> Repl "Int.of_string"
  | "int_of_string_opt"   -> No_equivalent
  | "invalid_arg"         -> No_equivalent
  | "ldexp"               -> Repl "Float.ldexp"
  | "lnot"                -> No_equivalent
  | "log"                 -> Repl "Float.log"
  | "log10"               -> Repl "Float.log10"
  | "log1p"               -> Repl "Float.log1p"
  | "max"                 -> No_equivalent
  | "max_float"           -> Repl "Float.max_finite_value"
  | "max_int"             -> Repl "Int.max_value"
  | "min"                 -> No_equivalent
  | "min_float"           -> Repl "Float.min_positive_normal_value"
  | "min_int"             -> Repl "Int.min_value"
  | "mod_float"           -> Repl "Float.mod_float"
  | "modf"                -> Repl "Float.modf"
  | "nan"                 -> Repl "Float.nan"
  | "neg_infinity"        -> Repl "Float.neg_infinity"
  | "not"                 -> No_equivalent
  | "open_in"             -> Repl "Stdio.In_channel.create"
  | "open_in_bin"         -> Repl "Stdio.In_channel.create"
  | "open_in_gen"         -> No_equivalent
  | "open_out"            -> Repl "Stdio.Out_channel.create"
  | "open_out_bin"        -> Repl "Stdio.Out_channel.create"
  | "open_out_gen"        -> No_equivalent
  | "out_channel_length"  -> Repl "Stdio.Out_channel.length"
  | "output"              -> Repl "Stdio.Out_channel.output"
  | "output_binary_int"   -> Repl "Stdio.Out_channel.output_binary_int"
  | "output_byte"         -> Repl "Stdio.Out_channel.output_byte"
  | "output_bytes"        -> Repl "Stdio.Out_channel.output_bytes"
  | "output_char"         -> Repl "Stdio.Out_channel.output_char"
  | "output_string"       -> Repl "Stdio.Out_channel.output_string"
  | "output_substring"    -> Repl "Stdio.Out_channel.output"
  | "output_value"        -> Repl "Stdio.Out_channel.output_value"
  | "pos_in"              -> Repl "Stdio.In_channel.pos"
  | "pos_out"             -> Repl "Stdio.Out_channel.pos"
  | "pred"                -> Repl "Int.pred"
  | "prerr_bytes"         -> Repl "Stdio.Out_channel.output_bytes Stdio.stderr"
  | "prerr_char"          -> Repl "Stdio.Out_channel.output_char Stdio.stderr"
  | "prerr_endline"       -> Repl "Stdio.prerr_endline"
  | "prerr_float"         -> Repl "Stdio.eprintf \"%f\""
  | "prerr_int"           -> Repl "Stdio.eprintf \"%d\""
  | "prerr_newline"       -> Repl "Stdio.eprintf \"\n%!\""
  | "prerr_string"        -> Repl "Stdio.Out_channel.output_string Stdio.stderr"
  | "print_bytes"         -> Repl "Stdio.Out_channel.output_bytes Stdio.stdout"
  | "print_char"          -> Repl "Stdio.Out_channel.output_char Stdio.stdout"
  | "print_endline"       -> Repl "Stdio.print_endline"
  | "print_float"         -> Repl "Stdio.eprintf \"%f\""
  | "print_int"           -> Repl "Stdio.eprintf \"%d\""
  | "print_newline"       -> Repl "Stdio.eprintf \"\n%!\""
  | "print_string"        -> Repl "Stdio.Out_channel.output_string Stdio.stdout"
  | "raise"               -> No_equivalent
  | "raise_notrace"       -> No_equivalent
  | "read_float"          -> No_equivalent
  | "read_float_opt"      -> No_equivalent
  | "read_int"            -> No_equivalent
  | "read_int_opt"        -> No_equivalent
  | "read_line"           -> Repl "Stdio.In_channel.input_line"
  | "really_input"        -> Repl "Stdio.In_channel.really_input"
  | "really_input_string" -> Approx "Stdio.In_channel"
  | "ref"                 -> No_equivalent
  | "seek_in"             -> Repl "Stdio.In_channel.seek"
  | "seek_out"            -> Repl "Stdio.Out_channel.seek"
  | "set_binary_mode_in"  -> Repl "Stdio.In_channel.set_binary_mode"
  | "set_binary_mode_out" -> Repl "Stdio.Out_channel.set_binary_mode"
  | "sin"                 -> Repl "Float.sin"
  | "sinh"                -> Repl "Float.sinh"
  | "snd"                 -> No_equivalent
  | "sqrt"                -> Repl "Float.sqrt"
  | "stderr"              -> Repl "Stdio.stderr"
  | "stdin"               -> Repl "Stdio.stdin"
  | "stdout"              -> Repl "Stdio.stdout"
  | "string_of_bool"      -> Repl "Bool.to_string"
  | "string_of_float"     -> Repl "Float.to_string"
  | "string_of_format"    -> No_equivalent
  | "string_of_int"       -> Repl "Int.to_string"
  | "succ"                -> Repl "Int.succ"
  | "tan"                 -> Repl "Float.tan"
  | "tanh"                -> Repl "Float.tanh"
  | "truncate"            -> Repl "Int.of_float"
  | "unsafe_really_input" -> No_equivalent
  | "valid_float_lexem"   -> No_equivalent
  | symbol                ->
    if !permissive then No_equivalent
    else
      failwith
        (sprintf
           "Consider adding to [Base] an equivalent for symbol %S defined in stdlib"
           symbol)
;;

let exception_replacement = function
  | "Not_found" ->
    Some (Repl_text "\
Instead of raising [Not_found], consider using [raise_s] with an informative error\n\
message.  If code needs to distinguish [Not_found] from other exceptions, please change\n\
it to handle both [Not_found] and [Not_found_s].  Then, instead of raising [Not_found],\n\
raise [Not_found_s] with an informative error message")
  | _ -> None

let type_replacement = function
  | "in_channel"  -> Some (Repl "Stdio.In_channel.t")
  | "out_channel" -> Some (Repl "Stdio.Out_channel.t")
  | "result"      -> Some (Repl "Result.t")
  | _             -> None
;;

let module_replacement = function
  | "Format" ->
    let repl_text =
      "[Base] doesn't export a [Format] module, although the \n\
       [Stdlib.Format.formatter] type is available (as [Formatter.t])\n\
       for interaction with other libraries"
    in
    Some (Repl_text repl_text)
  | "Fun"      -> Some (Repl "Fn")
  | "Gc"       -> Some No_equivalent
  | "Printexc" -> Some (Repl_text "Use [Exn] or [Backtrace] instead")
  | "Seq"      -> Some (Approx "Sequence")
  | _          -> None

let replace ~is_exn id replacement =
  match replacement with
  | No_equivalent  -> deprecated_msg_no_equivalent ~is_exn id
  | Repl repl      -> deprecated_msg_with_repl ~is_exn repl
  | Repl_text text -> deprecated_msg_with_repl_text ~is_exn text
  | Approx repl    -> deprecated_msg_with_approx_repl ~is_exn repl ~id
;;

let is_alias = function
  | "format" | "format4" | "format6" -> true
  | _ -> false
}

let id_trail = ['a'-'z' 'A'-'Z' '_' '0'-'9']*
let id = ['a'-'z' 'A'-'Z' '_' '0'-'9'] id_trail
let val_id = id | '(' [^ ')']* ')'
let params = ('(' [^')']* ')' | ['+' '-']? '\'' id) " "

let val_ = "val " | "external "

rule line = parse
  | "module Camlinternal" _*
    { "" (* We can't deprecate these *) }
  | "module Bigarray" _* { "" (* Don't deprecate it yet *) }
  | "type " (params? as params) (id as id) (_* as def)
      { sprintf "type nonrec %s%s = %sStdlib.%s%s\n%s"
          params id
          params id
          (if is_alias id then "" else def)
          (match type_replacement id with
           | Some replacement -> replace ~is_exn:false id replacement
           | None -> deprecated_msg ~is_exn:false id) }

  | val_ (val_id as id) _* as line
    { sprintf "%s\n%s" line (replace ~is_exn:false id (val_replacement id)) }

  | "module " (id as id) " = Stdlib__" (id as id2) (_* as line)
      {
        Printf.sprintf "module %s = Stdlib.%s %s\n%s"
          id (String.capitalize_ascii id2) line
          (match module_replacement id with
           | Some replacement -> replace ~is_exn:false id replacement
           | None -> deprecated_msg ~is_exn:false id) }

  | "exception " (id as id) _* as line
    { match exception_replacement id with
      | Some replacement -> sprintf "%s\n%s" line (replace ~is_exn:true id replacement)
      | None ->
        let predefined_exceptions =
          [ "Out_of_memory"
          ; "Sys_error"
          ; "Failure"
          ; "Invalid_argument"
          ; "End_of_file"
          ; "Division_by_zero"
          ; "Not_found"
          ; "Match_failure"
          ; "Stack_overflow"
          ; "Sys_blocked_io"
          ; "Assert_failure"
          ; "Undefined_recursive_module" ]
        in
        if List.mem id ~set:predefined_exceptions
        then ""
        else sprintf "%s\n%s" line (deprecated_msg ~is_exn:true id)
    }
  | "module " (id as id) _*
    { sprintf "module %s = Stdlib.%s\n%s" id id
        (match module_replacement id with
         | Some replacement -> replace ~is_exn:false id replacement
         | None -> deprecated_msg ~is_exn:false id) }
  | _* as line
    { ksprintf failwith "cannot parse this: %s" line }