Skip to content

Refactor -extension and -standard flags #398

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 17 commits into from
Dec 8, 2021
Merged
Show file tree
Hide file tree
Changes from 8 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions ocaml/driver/compenv.ml
Original file line number Diff line number Diff line change
Expand Up @@ -469,6 +469,10 @@ let read_one_param ppf position name v =
| Some pass -> set_save_ir_after pass true
end

| "extension" -> Clflags.Extension.enable v
| "no-extensions" ->
if check_bool ppf "standard" v then Clflags.Extension.disable_all ()

| _ ->
if !warnings_for_discarded_params &&
not (List.mem name !can_discard) then begin
Expand Down
23 changes: 15 additions & 8 deletions ocaml/driver/main_args.ml
Original file line number Diff line number Diff line change
Expand Up @@ -716,11 +716,18 @@ let mk_dump_into_file f =
;;

let mk_extension f =
"-extension", Arg.String f, "<extension> Enable the extension"
let available_extensions =
Clflags.Extension.(List.map to_string all)
in
"-extension", Arg.Symbol (available_extensions, f),
"<extension> Enable the extension (may be specified more than once)"
;;

let mk_standard f =
"-standard", Arg.Unit f, " Disable all default extensions"
let mk_no_extensions f =
"-no-extensions", Arg.Unit f,
" Disable all extensions, including extensions that are enabled by default,\n\
or specified in command line using -extension flags\n\
(before or after -no-extensions), or in OCAMLPARAM."
;;

let mk_dparsetree f =
Expand Down Expand Up @@ -1035,7 +1042,7 @@ module type Compiler_options = sig
val _match_context_rows : int -> unit
val _dtimings : unit -> unit
val _dprofile : unit -> unit
val _standard : unit -> unit
val _no_extensions : unit -> unit
val _dump_into_file : unit -> unit

val _args: string -> string array
Expand Down Expand Up @@ -1288,7 +1295,7 @@ struct
mk_dcamlprimc F._dcamlprimc;
mk_dtimings F._dtimings;
mk_dprofile F._dprofile;
mk_standard F._standard;
mk_no_extensions F._no_extensions;
mk_dump_into_file F._dump_into_file;
mk_extension F._extension;

Expand Down Expand Up @@ -1516,7 +1523,7 @@ struct
mk_dstartup F._dstartup;
mk_dtimings F._dtimings;
mk_dprofile F._dprofile;
mk_standard F._standard;
mk_no_extensions F._no_extensions;
mk_dump_into_file F._dump_into_file;
mk_dump_pass F._dump_pass;
mk_extension F._extension;
Expand Down Expand Up @@ -1776,7 +1783,7 @@ module Default = struct
let _unsafe = set unsafe
let _warn_error s = Warnings.parse_options true s
let _warn_help = Warnings.help_warnings
let _extension s = add_extension s
let _extension s = Extension.enable s
end

module Native = struct
Expand Down Expand Up @@ -1892,7 +1899,7 @@ module Default = struct
let _config_var = Misc.show_config_variable_and_exit
let _dprofile () = profile_columns := Profile.all_columns
let _dtimings () = profile_columns := [`Time]
let _standard = set_standard
let _no_extensions = Extension.disable_all
let _dump_into_file = set dump_into_file
let _for_pack s = for_package := (Some s)
let _g = set debug
Expand Down
2 changes: 1 addition & 1 deletion ocaml/driver/main_args.mli
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,7 @@ module type Compiler_options = sig
val _match_context_rows : int -> unit
val _dtimings : unit -> unit
val _dprofile : unit -> unit
val _standard : unit -> unit
val _no_extensions : unit -> unit
val _dump_into_file : unit -> unit

val _args: string -> string array
Expand Down
2 changes: 1 addition & 1 deletion ocaml/testsuite/tests/comprehensions/comprehensions.ml
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
(* TEST
flags = "-extension Comprehensions"
flags = "-extension comprehensions"
* expect
*)
(*Type checking tests.*)
Expand Down
8 changes: 4 additions & 4 deletions ocaml/typing/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,7 @@ type error =
| Probe_name_format of string
| Probe_name_undefined of string
| Probe_is_enabled_format
| Extension_not_enabled of Clflags.extension
| Extension_not_enabled of Clflags.Extension.t
| Literal_overflow of string
| Unknown_literal of string * char
| Illegal_letrec_pat
Expand Down Expand Up @@ -3776,12 +3776,12 @@ and type_expect_
| Pexp_extension (({ txt = ("extension.list_comprehension"
| "extension.arr_comprehension"); _ },
_ ) as extension) ->
if Clflags.is_extension_enabled Clflags.Comprehensions then
if Clflags.Extension.(is_enabled Comprehensions) then
let ext_expr = Extensions.extension_expr_of_payload ~loc extension in
type_extension ~loc ~env ~ty_expected ~sexp ext_expr
else
raise
(Error (loc, env, Extension_not_enabled(Clflags.Comprehensions)))
(Error (loc, env, Extension_not_enabled(Clflags.Extension.Comprehensions)))
| Pexp_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))

Expand Down Expand Up @@ -5740,7 +5740,7 @@ let report_error ~loc env = function
"%%probe_is_enabled points must specify a single probe name as a \
string literal"
| Extension_not_enabled(ext) ->
let name = Clflags.string_of_extension ext in
let name = Clflags.Extension.to_string ext in
Location.errorf ~loc
"Extension %s must be enabled to use this feature." name
| Literal_overflow ty ->
Expand Down
2 changes: 1 addition & 1 deletion ocaml/typing/typecore.mli
Original file line number Diff line number Diff line change
Expand Up @@ -185,7 +185,7 @@ type error =
| Probe_name_undefined of string
(* CR-soon mshinwell: Use an inlined record *)
| Probe_is_enabled_format
| Extension_not_enabled of Clflags.extension
| Extension_not_enabled of Clflags.Extension.t
| Literal_overflow of string
| Unknown_literal of string * char
| Illegal_letrec_pat
Expand Down
32 changes: 20 additions & 12 deletions ocaml/utils/clflags.ml
Original file line number Diff line number Diff line change
Expand Up @@ -376,23 +376,31 @@ let set_dumped_pass s enabled =
dumped_passes_list := dumped_passes
end

type extension = Comprehensions
module Extension = struct
type t = Comprehensions

let extensions = ref ([] : extension list) (* -extensions *)
let set_standard () = extensions := []
let all = [ Comprehensions ]

let string_of_extension = function
| Comprehensions -> "comprehensions"
let extensions = ref ([] : t list) (* -extension *)
let equal _t1 _t2 = true

let extension_of_string = function
| "comprehensions" -> Comprehensions
| extn -> raise (Arg.Bad(Printf.sprintf "Extension %s is not known" extn))
let disable_all_extensions = ref false (* -no-extensions *)
let disable_all () = disable_all_extensions := true

let add_extension extn =
let extension = extension_of_string (String.lowercase_ascii extn) in
extensions := extension::!extensions
let to_string = function
| Comprehensions -> "comprehensions"

let of_string = function
| "comprehensions" -> Comprehensions
| extn -> raise (Arg.Bad(Printf.sprintf "Extension %s is not known" extn))

let is_extension_enabled ext = List.mem ext !extensions
let enable extn =
let t = of_string (String.lowercase_ascii extn) in
if not (List.exists (equal t) !extensions) then
extensions := t::!extensions

let is_enabled ext = not !disable_all_extensions && List.mem ext !extensions
end

let dump_into_file = ref false (* -dump-into-file *)

Expand Down
14 changes: 8 additions & 6 deletions ocaml/utils/clflags.mli
Original file line number Diff line number Diff line change
Expand Up @@ -202,12 +202,14 @@ val set_dumped_pass : string -> bool -> unit

val dump_into_file : bool ref

type extension = Comprehensions
val extensions : extension list ref
val set_standard : unit -> unit
val add_extension: string -> unit
val is_extension_enabled: extension -> bool
val string_of_extension: extension -> string
module Extension : sig
type t = Comprehensions
val enable: string -> unit
val is_enabled : t -> bool
val to_string : t -> string
val all : t list
val disable_all : unit -> unit
end

(* Support for flags that can also be set from an environment variable *)
type 'a env_reader = {
Expand Down