This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
350
unikernel/duniverse/base/shadow-stdlib/gen/mapper.mll
Normal file
350
unikernel/duniverse/base/shadow-stdlib/gen/mapper.mll
Normal file
|
|
@ -0,0 +1,350 @@
|
|||
{
|
||||
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 }
|
||||
Loading…
Add table
Add a link
Reference in a new issue