Skip to content

Commit 9462a6d

Browse files
bobzhangbobzhang
committed
alias Bad_arg as Arg.Bad to remain internal compatiblity
Bsb -- raise its own exception Bsb_helper -- does not raise exception, exit directly Bsc -- raise Arg.Bad to be consistent with ocaml internals
1 parent 16ff19e commit 9462a6d

28 files changed

+279
-10438
lines changed

‎jscomp/bsb/bsb_arg.ml

+8-5
Original file line numberDiff line numberDiff line change
@@ -46,11 +46,14 @@
4646
| Unknown of string
4747
| Missing of string
4848

49-
type t = spec Ext_arg.t
49+
type t = spec Ext_spec.t
5050

5151

52-
53-
let (+>) = Ext_buffer.add_string
52+
exception Bad of string
53+
54+
let bad_arg s = raise_notrace (Bad s)
55+
56+
let (+>) = Ext_buffer.add_string
5457

5558
let usage_b (buf : Ext_buffer.t) ~usage (speclist : t) =
5659
buf +> usage;
@@ -108,7 +111,7 @@ type t = spec Ext_arg.t
108111
b +> "' needs an argument.\n"
109112
end;
110113
usage_b b ~usage speclist ;
111-
Ext_arg.bad_arg (Ext_buffer.contents b)
114+
bad_arg (Ext_buffer.contents b)
112115

113116

114117
let parse_exn ~usage ~argv ?(start=1) ?(finish=Array.length argv) (speclist : t) anonfun =
@@ -118,7 +121,7 @@ type t = spec Ext_arg.t
118121
let s = argv.(!current) in
119122
incr current;
120123
if s <> "" && s.[0] = '-' then begin
121-
match Ext_arg.assoc3 speclist s with
124+
match Ext_spec.assoc3 speclist s with
122125
| Some action -> begin
123126
begin match action with
124127
| Unit r ->

‎jscomp/bsb/bsb_arg.mli

+5-1
Original file line numberDiff line numberDiff line change
@@ -40,10 +40,14 @@ type spec =
4040

4141
type anon_fun = rev_args:string list -> unit
4242

43+
exception Bad of string
44+
4345
val parse_exn :
4446
usage:string ->
4547
argv:string array ->
4648
?start:int ->
4749
?finish:int ->
4850
(string * spec * string) array ->
49-
anon_fun -> unit
51+
anon_fun -> unit
52+
53+
val bad_arg : string -> 'a

‎jscomp/bsb/bsb_theme_init.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -96,7 +96,7 @@ let process_themes env theme proj_dir (themes : OCamlRes.Res.node list ) =
9696
) with
9797
| None ->
9898
list_themes ();
99-
Ext_arg.bad_arg ( "theme " ^ theme ^ " not found")
99+
Bsb_arg.bad_arg ( "theme " ^ theme ^ " not found")
100100
| Some (Dir(_theme, nodes )) ->
101101
List.iter (fun node -> process_theme_aux env proj_dir node ) nodes
102102
| Some _ -> assert false

‎jscomp/bsb_helper/bsb_helper_arg.ml

+4-3
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ type error =
1414
| Unknown of string
1515
| Missing of string
1616

17-
type t = spec Ext_arg.t
17+
type t = spec Ext_spec.t
1818

1919

2020

@@ -58,7 +58,8 @@ let stop_raise ~progname ~(error : error) (speclist : t) =
5858
b +> "' needs an argument.\n"
5959
end;
6060
usage_b b progname speclist ;
61-
Ext_arg.bad_arg (Ext_buffer.contents b)
61+
prerr_endline (Ext_buffer.contents b);
62+
exit 2
6263

6364

6465
let parse_exn ~progname ~argv ~start (speclist : t) anonfun =
@@ -69,7 +70,7 @@ let parse_exn ~progname ~argv ~start (speclist : t) anonfun =
6970
let s = argv.(!current) in
7071
incr current;
7172
if s <> "" && s.[0] = '-' then begin
72-
match Ext_arg.assoc3 speclist s with
73+
match Ext_spec.assoc3 speclist s with
7374
| Some action -> begin
7475
begin match action with
7576
| Bool r -> r := true;

‎jscomp/core/js_packages_info.ml

+4-4
Original file line numberDiff line numberDiff line change
@@ -235,23 +235,23 @@ let get_output_dir
235235

236236
let add_npm_package_path (packages_info : t) (s : string) : t =
237237
if is_empty packages_info then
238-
Ext_arg.bad_arg "please set package name first using -bs-package-name "
238+
Bsc_args.bad_arg "please set package name first using -bs-package-name "
239239
else
240240
let module_system, path =
241241
match Ext_string.split ~keep_empty:false s ':' with
242242
| [ module_system; path] ->
243243
(match module_system_of_string module_system with
244244
| Some x -> x
245245
| None ->
246-
Ext_arg.bad_arg ("invalid module system " ^ module_system)), path
246+
Bsc_args.bad_arg ("invalid module system " ^ module_system)), path
247247
| [path] ->
248248
NodeJS, path
249249
| module_system :: path ->
250250
(match module_system_of_string module_system with
251251
| Some x -> x
252-
| None -> Ext_arg.bad_arg @@ "invalid module system " ^ module_system), (String.concat ":" path)
252+
| None -> Bsc_args.bad_arg @@ "invalid module system " ^ module_system), (String.concat ":" path)
253253
| _ ->
254-
Ext_arg.bad_arg @@ "invalid npm package path: " ^ s
254+
Bsc_args.bad_arg @@ "invalid npm package path: " ^ s
255255
in
256256
{ packages_info with module_systems = {module_system; path}::packages_info.module_systems}
257257

‎jscomp/core/js_packages_state.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ let set_package_name name =
3131
if Js_packages_info.is_empty !packages_info then
3232
packages_info := Js_packages_info.from_name name
3333
else
34-
Ext_arg.bad_arg "duplicated flag for -bs-package-name"
34+
Bsc_args.bad_arg "duplicated flag for -bs-package-name"
3535

3636
let set_package_map module_name =
3737
(* set_package_name name ;

‎jscomp/depends/ast_extract.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,7 @@ let check_suffix name =
141141
else if Ext_path.check_suffix_case name !Config.interface_suffix then
142142
`Mli, Ext_filename.chop_extension_maybe name
143143
else
144-
Ext_arg.bad_arg ("don't know what to do with " ^ name)
144+
Bsc_args.bad_arg ("don't know what to do with " ^ name)
145145

146146

147147
let collect_ast_map ppf files parse_implementation parse_interface =

‎jscomp/core/bsc_args.ml ‎jscomp/ext/bsc_args.ml

+6-5
Original file line numberDiff line numberDiff line change
@@ -45,14 +45,15 @@
4545
| String of string_action
4646

4747

48+
exception Bad = Arg.Bad
4849

49-
50-
50+
let bad_arg s = raise_notrace (Bad s)
51+
5152
type error =
5253
| Unknown of string
5354
| Missing of string
5455

55-
type t = spec Ext_arg.t
56+
type t = spec Ext_spec.t
5657

5758

5859
let (+>) = Ext_buffer.add_string
@@ -113,7 +114,7 @@ let stop_raise ~usage ~(error : error) (speclist : t ) =
113114
b +> "' needs an argument.\n"
114115
end;
115116
usage_b b ~usage speclist ;
116-
Ext_arg.bad_arg (Ext_buffer.contents b)
117+
bad_arg (Ext_buffer.contents b)
117118

118119

119120
let parse_exn ~usage ~argv ?(start=1) ?(finish=Array.length argv) (speclist : t)
@@ -124,7 +125,7 @@ let parse_exn ~usage ~argv ?(start=1) ?(finish=Array.length argv) (speclist : t
124125
let s = argv.(!current) in
125126
incr current;
126127
if s <> "" && s.[0] = '-' then begin
127-
match Ext_arg.assoc3 speclist s with
128+
match Ext_spec.assoc3 speclist s with
128129
| Some action -> begin
129130
begin match action with
130131
| Unit r ->

‎jscomp/core/bsc_args.mli ‎jscomp/ext/bsc_args.mli

+3-2
Original file line numberDiff line numberDiff line change
@@ -39,8 +39,9 @@ type spec = Unit of unit_action | String of string_action
3939

4040
type t = (string * spec * string) array
4141

42-
43-
42+
exception Bad of string
43+
val bad_arg :
44+
string -> 'a
4445

4546

4647
val parse_exn :

‎jscomp/ext/ext_arg.mli

-40
This file was deleted.

‎jscomp/ext/ext_arg.ml ‎jscomp/ext/ext_spec.ml

+1-8
Original file line numberDiff line numberDiff line change
@@ -35,11 +35,4 @@ let rec unsafe_loop i (l : 'a t) n x =
3535

3636
let assoc3 (l : 'a t) (x : string) : 'a option =
3737
let n = Array.length l in
38-
unsafe_loop 0 l n x
39-
40-
41-
exception Bad_arg of string
42-
43-
44-
let bad_arg s =
45-
raise_notrace (Bad_arg s)
38+
unsafe_loop 0 l n x

‎jscomp/ext/ext_spec.mli

+6
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
type 'a t = (string * 'a * string) array
2+
3+
val assoc3 :
4+
'a t ->
5+
string ->
6+
'a option

‎jscomp/main/bsb_main.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -151,7 +151,7 @@ let handle_anonymous_arg ~rev_args =
151151
match rev_args with
152152
| [] -> ()
153153
| arg:: _ ->
154-
Ext_arg.bad_arg ("Unknown arg \"" ^ arg ^ "\"")
154+
Bsc_args.bad_arg ("Unknown arg \"" ^ arg ^ "\"")
155155

156156

157157
let program_exit () =
@@ -273,7 +273,7 @@ let () =
273273
start.pos_fname start.pos_lnum
274274
Ext_json_parse.report_error e ;
275275
exit 2
276-
| Ext_arg.Bad_arg s
276+
| Bsb_arg.Bad s
277277
| Sys_error s ->
278278
Format.fprintf Format.err_formatter
279279
"@{<error>Error:@} %s@."

‎jscomp/main/js_main.ml

+9-9
Original file line numberDiff line numberDiff line change
@@ -168,7 +168,7 @@ let process_file ppf sourcefile =
168168
Printtyp.signature Format.std_formatter cmi_sign ;
169169
Format.pp_print_newline Format.std_formatter ()
170170
| Unknown ->
171-
Ext_arg.bad_arg ("don't know what to do with " ^ sourcefile)
171+
Bsc_args.bad_arg ("don't know what to do with " ^ sourcefile)
172172
let usage = "Usage: bsc <options> <files>\nOptions are:"
173173

174174
let ppf = Format.err_formatter
@@ -184,7 +184,7 @@ let anonymous ~(rev_args : string list) =
184184
~target:output
185185
Ppx_entry.rewrite_implementation
186186
Ppx_entry.rewrite_signature
187-
| _ -> Ext_arg.bad_arg "Wrong format when use -as-ppx"
187+
| _ -> Bsc_args.bad_arg "Wrong format when use -as-ppx"
188188
else
189189
begin
190190
match rev_args with
@@ -194,7 +194,7 @@ let anonymous ~(rev_args : string list) =
194194
process_file ppf filename
195195
| [] -> ()
196196
| _ ->
197-
Ext_arg.bad_arg "can not handle multiple files"
197+
Bsc_args.bad_arg "can not handle multiple files"
198198
end
199199

200200
(** used by -impl -intf *)
@@ -217,7 +217,7 @@ let fmt_file input =
217217
| Ml | Mli -> `ml
218218
| Res | Resi -> `res
219219
| Re | Rei -> `refmt (Filename.concat (Filename.dirname Sys.executable_name) "refmt.exe")
220-
| _ -> Ext_arg.bad_arg ("don't know what to do with " ^ input) in
220+
| _ -> Bsc_args.bad_arg ("don't know what to do with " ^ input) in
221221
output_string stdout (Napkin_multi_printer.print syntax ~input)
222222

223223
let set_color_option option =
@@ -242,8 +242,8 @@ let define_variable s =
242242
match Ext_string.split ~keep_empty:true s '=' with
243243
| [key; v] ->
244244
if not (Lexer.define_key_value key v) then
245-
Ext_arg.bad_arg ("illegal definition: " ^ s)
246-
| _ -> Ext_arg.bad_arg ("illegal definition: " ^ s)
245+
Bsc_args.bad_arg ("illegal definition: " ^ s)
246+
| _ -> Bsc_args.bad_arg ("illegal definition: " ^ s)
247247

248248
let print_standard_library () =
249249
let (//) = Filename.concat in
@@ -322,7 +322,7 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
322322
"<module> Opens the module <module> before typing";
323323

324324
"-bs-jsx", string_call (fun i ->
325-
(if i <> "3" then Ext_arg.bad_arg (" Not supported jsx version : " ^ i));
325+
(if i <> "3" then Bsc_args.bad_arg (" Not supported jsx version : " ^ i));
326326
Js_config.jsx_version := 3),
327327
"*internal* Set jsx version";
328328

@@ -532,8 +532,8 @@ let _ : unit =
532532
~argv:Sys.argv
533533
buckle_script_flags anonymous ~usage;
534534
with
535-
| Ext_arg.Bad_arg msg ->
536-
Format.eprintf "%s" msg ;
535+
| Bsc_args.Bad msg ->
536+
Format.eprintf "%s@." msg ;
537537
exit 2
538538
| x ->
539539
begin

‎jscomp/snapshot.ninja

+6-6
Original file line numberDiff line numberDiff line change
@@ -15,10 +15,10 @@ OCAML_SRC_TOOLS=$native_ocaml_path/tools
1515
includes = -I js_parser -I stubs -I ext -I common -I syntax -I depends -I core -I super_errors -I outcome_printer -I bsb -I ounit -I ounit_tests -I napkin -I main
1616
SNAP=../lib/$snapshot_path
1717

18-
build snapshot: phony $SNAP/whole_compiler.ml $SNAP/bsb_helper.ml $SNAP/bsb.ml $SNAP/bspp.ml $SNAP/unstable/all_ounit_tests.ml
19-
18+
build snapshot: phony $SNAP/whole_compiler.ml $SNAP/bsb_helper.ml $SNAP/bsb.ml $SNAP/unstable/all_ounit_tests.ml
19+
# $SNAP/bspp.ml
2020
build $SNAP/whole_compiler.ml: bspack | ./bin/bspack.exe $LTO
21-
flags = ${releaseMode} -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER ${includes}
21+
flags = ${releaseMode} -D BS_ONLY=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER ${includes}
2222
main = Js_main
2323
post_process = && node $LTO $SNAP/whole_compiler.ml
2424

@@ -30,9 +30,9 @@ build $SNAP/bsb.ml: bspack | ./bin/bspack.exe $LTO
3030
flags = -D BS_MIN_LEX_DEPS=true -bs-MD ${releaseMode} -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I stubs -I common -I ext -I syntax -I depends -I bsb -I ext -I main
3131
main = Bsb_main
3232

33-
build $SNAP/bspp.ml: bspack | ./bin/bspack.exe $LTO
34-
flags = -D BS_MIN_LEX_DEPS=true ${releaseMode} -bs-MD -module-alias Config=Config_whole_compiler -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING?parser -I common -I ext -I syntax -I depends -I bspp -I core -I main
35-
main = Bspp_main
33+
# build $SNAP/bspp.ml: bspack | ./bin/bspack.exe $LTO
34+
# flags = -D BS_MIN_LEX_DEPS=true ${releaseMode} -bs-MD -module-alias Config=Config_whole_compiler -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING?parser -I common -I ext -I syntax -I depends -I bspp -I core -I main
35+
# main = Bspp_main
3636

3737
build $SNAP/unstable/bsb_native.ml: bspack | ./bin/bspack.exe $LTO
3838
flags = -D BS_MIN_LEX_DEPS=true -D BS_NATIVE=true -bs-MD ${releaseMode} -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I stubs -I common -I ext -I syntax -I depends -I bsb -I ext -I main

0 commit comments

Comments
 (0)