diff options
| -rw-r--r-- | parsing/parser.mly | 2 | ||||
| -rw-r--r-- | parsing/parsetree.mli | 1 | ||||
| -rw-r--r-- | toplevel/topdirs.ml | 12 | ||||
| -rw-r--r-- | toplevel/toploop.ml | 2 | ||||
| -rw-r--r-- | toplevel/toploop.mli | 1 |
5 files changed, 18 insertions, 0 deletions
diff --git a/parsing/parser.mly b/parsing/parser.mly index 6ba262ea6..863259eb8 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -1365,6 +1365,8 @@ toplevel_directive: | SHARP ident STRING { Ptop_dir($2, Pdir_string $3) } | SHARP ident INT { Ptop_dir($2, Pdir_int $3) } | SHARP ident val_longident { Ptop_dir($2, Pdir_ident $3) } + | SHARP ident FALSE { Ptop_dir($2, Pdir_bool false) } + | SHARP ident TRUE { Ptop_dir($2, Pdir_bool true) } ; /* Miscellaneous */ diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index b6cf4f73c..5681dded2 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -253,3 +253,4 @@ and directive_argument = | Pdir_string of string | Pdir_int of int | Pdir_ident of Longident.t + | Pdir_bool of bool diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index a9c08dcaa..68140e59a 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -248,3 +248,15 @@ let _ = Hashtbl.add directive_table "print_depth" (Directive_int(fun n -> max_printer_depth := n)) let _ = Hashtbl.add directive_table "print_length" (Directive_int(fun n -> max_printer_steps := n)) + +(* Set various compiler flags *) + +let _ = Hashtbl.add directive_table "modern" + (Directive_bool(fun b -> Clflags.classic := not b)) + +let parse_warnings s = + try Warnings.parse_options s + with Arg.Bad err -> printf "%s." err + +let _ = Hashtbl.add directive_table "warnings" + (Directive_string parse_warnings) diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index 9dbb82ddf..cd3682f02 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -28,6 +28,7 @@ type directive_fun = | Directive_string of (string -> unit) | Directive_int of (int -> unit) | Directive_ident of (Longident.t -> unit) + | Directive_bool of (bool -> unit) (* Hooks for parsing functions *) @@ -175,6 +176,7 @@ let execute_phrase print_outcome phr = | (Directive_string f, Pdir_string s) -> f s; true | (Directive_int f, Pdir_int n) -> f n; true | (Directive_ident f, Pdir_ident lid) -> f lid; true + | (Directive_bool f, Pdir_bool b) -> f b; true | (_, _) -> print_string "Wrong type of argument for directive `"; print_string dir_name; print_string "'"; print_newline(); diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli index e3400c125..e2ad52b5b 100644 --- a/toplevel/toploop.mli +++ b/toplevel/toploop.mli @@ -27,6 +27,7 @@ type directive_fun = | Directive_string of (string -> unit) | Directive_int of (int -> unit) | Directive_ident of (Longident.t -> unit) + | Directive_bool of (bool -> unit) val directive_table: (string, directive_fun) Hashtbl.t (* Table of known directives, with their execution function *) |