Skip to content

Commit 8db06a1

Browse files
committed
change the semantics of annofun
1 parent f146f6b commit 8db06a1

File tree

4 files changed

+78
-85
lines changed

4 files changed

+78
-85
lines changed

jscomp/bsb_helper/bsb_helper_arg.ml

Lines changed: 18 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
type key = string
33
type doc = string
44
type usage_msg = string
5-
type anon_fun = (string -> unit)
5+
type anon_fun = rev_args:string list -> unit
66

77
type spec =
88
| Set of bool ref
@@ -15,7 +15,7 @@ exception Bad of string
1515
type error =
1616
| Unknown of string
1717
| Missing of string
18-
| Message of string
18+
1919

2020

2121

@@ -25,11 +25,12 @@ type t = (string * spec * string) list
2525
let rec assoc3 (x : string) (l : t) =
2626
match l with
2727
| [] -> None
28-
| (y1, y2, _y3) :: _t when y1 = x -> Some y2
28+
| (y1, y2, _) :: _ when y1 = x -> Some y2
2929
| _ :: t -> assoc3 x t
3030
;;
3131

3232

33+
let (+>) = Ext_buffer.add_string
3334

3435
let usage_b (buf : Ext_buffer.t) speclist errmsg =
3536
let print_spec buf (key, _spec, doc) =
@@ -52,22 +53,17 @@ let stop_raise ~progname ~(error : error) speclist errmsg =
5253
| Unknown ("-help" | "--help" | "-h") ->
5354
usage_b b speclist errmsg;
5455
output_string stdout (Ext_buffer.contents b);
55-
exit 0
56-
56+
exit 0
5757
| Unknown s ->
58-
Ext_buffer.add_string_char b progname ':';
59-
Ext_buffer.add_string b " unknown option '";
60-
Ext_buffer.add_string b s ;
61-
Ext_buffer.add_string b "'.\n"
58+
b +> progname ;
59+
b +> ": unknown option '";
60+
b +> s ;
61+
b +> "'.\n"
6262
| Missing s ->
63-
Ext_buffer.add_string_char b progname ':';
64-
Ext_buffer.add_string b " option '";
65-
Ext_buffer.add_string b s;
66-
Ext_buffer.add_string b "' needs an argument.\n"
67-
| Message s ->
68-
Ext_buffer.add_string_char b progname ':';
69-
Ext_buffer.add_char_string b ' ' s;
70-
Ext_buffer.add_string b ".\n"
63+
b +> progname ;
64+
b +> ": option '";
65+
b +> s;
66+
b +> "' needs an argument.\n"
7167
end;
7268
usage_b b speclist errmsg;
7369
raise (Bad (Ext_buffer.contents b))
@@ -76,12 +72,13 @@ let stop_raise ~progname ~(error : error) speclist errmsg =
7672
let parse_exn ~progname ~argv ~start (speclist : t) anonfun errmsg =
7773
let l = Array.length argv in
7874
let current = ref start in
75+
let rev_list = ref [] in
7976
while !current < l do
8077
let s = argv.(!current) in
78+
incr current;
8179
if s <> "" && s.[0] = '-' then begin
8280
match assoc3 s speclist with
83-
| Some action -> begin
84-
incr current;
81+
| Some action -> begin
8582
begin match action with
8683
| Set r -> r := true;
8784
| String f ->
@@ -98,10 +95,10 @@ let parse_exn ~progname ~argv ~start (speclist : t) anonfun errmsg =
9895
end;
9996
| None -> stop_raise ~progname ~error:(Unknown s) speclist errmsg
10097
end else begin
101-
(try anonfun s with Bad m -> stop_raise ~progname ~error:(Message m) speclist errmsg);
102-
incr current;
98+
rev_list := s :: !rev_list;
10399
end;
104100
done;
101+
anonfun ~rev_args:!rev_list
105102
;;
106103

107104

jscomp/bsb_helper/bsb_helper_arg.mli

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,13 +9,14 @@ type spec =
99
type key = string
1010
type doc = string
1111
type usage_msg = string
12-
type anon_fun = (string -> unit)
12+
type anon_fun = rev_args:string list -> unit
1313

1414
val parse_exn :
1515
progname:string ->
1616
argv:string array ->
1717
start:int ->
18-
(key * spec * doc) list -> anon_fun -> usage_msg -> unit
18+
(key * spec * doc) list ->
19+
anon_fun -> usage_msg -> unit
1920

2021

2122

jscomp/main/bsb_helper_main.ml

Lines changed: 18 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -24,17 +24,14 @@
2424
let compilation_kind = ref Bsb_helper_depfile_gen.Js
2525

2626
let hash : string ref = ref ""
27-
let batch_files = ref []
28-
let collect_file name =
29-
batch_files := name :: !batch_files
27+
3028

3129
(* let output_prefix = ref None *)
3230
let dev_group = ref false
3331
let namespace = ref None
3432

3533

36-
let anonymous filename =
37-
collect_file filename
34+
3835
let usage = "Usage: bsb_helper.exe [options] \nOptions are:"
3936

4037
let () =
@@ -50,19 +47,21 @@ let () =
5047
" Set namespace";
5148
"-hash", Set_string hash,
5249
" Set hash(internal)";
53-
] anonymous usage;
54-
(* arrange with mlast comes first *)
55-
match !batch_files with
56-
| [x]
57-
-> Bsb_helper_depfile_gen.emit_d
50+
] (fun ~rev_args ->
51+
match rev_args with
52+
| [x]
53+
-> Bsb_helper_depfile_gen.emit_d
54+
!compilation_kind
55+
!dev_group
56+
!namespace x ""
57+
| [y; x] (* reverse order *)
58+
->
59+
Bsb_helper_depfile_gen.emit_d
5860
!compilation_kind
5961
!dev_group
60-
!namespace x ""
61-
| [y; x] (* reverse order *)
62-
->
63-
Bsb_helper_depfile_gen.emit_d
64-
!compilation_kind
65-
!dev_group
66-
!namespace x y
67-
| _ ->
68-
()
62+
!namespace x y
63+
| _ ->
64+
()
65+
) usage;
66+
(* arrange with mlast comes first *)
67+

lib/4.06.1/bsb_helper.ml

Lines changed: 39 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -1619,13 +1619,14 @@ type spec =
16191619
type key = string
16201620
type doc = string
16211621
type usage_msg = string
1622-
type anon_fun = (string -> unit)
1622+
type anon_fun = rev_args:string list -> unit
16231623

16241624
val parse_exn :
16251625
progname:string ->
16261626
argv:string array ->
16271627
start:int ->
1628-
(key * spec * doc) list -> anon_fun -> usage_msg -> unit
1628+
(key * spec * doc) list ->
1629+
anon_fun -> usage_msg -> unit
16291630

16301631

16311632

@@ -1636,7 +1637,7 @@ end = struct
16361637
type key = string
16371638
type doc = string
16381639
type usage_msg = string
1639-
type anon_fun = (string -> unit)
1640+
type anon_fun = rev_args:string list -> unit
16401641

16411642
type spec =
16421643
| Set of bool ref
@@ -1649,7 +1650,7 @@ exception Bad of string
16491650
type error =
16501651
| Unknown of string
16511652
| Missing of string
1652-
| Message of string
1653+
16531654

16541655

16551656

@@ -1659,11 +1660,12 @@ type t = (string * spec * string) list
16591660
let rec assoc3 (x : string) (l : t) =
16601661
match l with
16611662
| [] -> None
1662-
| (y1, y2, _y3) :: _t when y1 = x -> Some y2
1663+
| (y1, y2, _) :: _ when y1 = x -> Some y2
16631664
| _ :: t -> assoc3 x t
16641665
;;
16651666

16661667

1668+
let (+>) = Ext_buffer.add_string
16671669

16681670
let usage_b (buf : Ext_buffer.t) speclist errmsg =
16691671
let print_spec buf (key, _spec, doc) =
@@ -1686,22 +1688,17 @@ let stop_raise ~progname ~(error : error) speclist errmsg =
16861688
| Unknown ("-help" | "--help" | "-h") ->
16871689
usage_b b speclist errmsg;
16881690
output_string stdout (Ext_buffer.contents b);
1689-
exit 0
1690-
1691+
exit 0
16911692
| Unknown s ->
1692-
Ext_buffer.add_string_char b progname ':';
1693-
Ext_buffer.add_string b " unknown option '";
1694-
Ext_buffer.add_string b s ;
1695-
Ext_buffer.add_string b "'.\n"
1693+
b +> progname ;
1694+
b +> ": unknown option '";
1695+
b +> s ;
1696+
b +> "'.\n"
16961697
| Missing s ->
1697-
Ext_buffer.add_string_char b progname ':';
1698-
Ext_buffer.add_string b " option '";
1699-
Ext_buffer.add_string b s;
1700-
Ext_buffer.add_string b "' needs an argument.\n"
1701-
| Message s ->
1702-
Ext_buffer.add_string_char b progname ':';
1703-
Ext_buffer.add_char_string b ' ' s;
1704-
Ext_buffer.add_string b ".\n"
1698+
b +> progname ;
1699+
b +> ": option '";
1700+
b +> s;
1701+
b +> "' needs an argument.\n"
17051702
end;
17061703
usage_b b speclist errmsg;
17071704
raise (Bad (Ext_buffer.contents b))
@@ -1710,12 +1707,13 @@ let stop_raise ~progname ~(error : error) speclist errmsg =
17101707
let parse_exn ~progname ~argv ~start (speclist : t) anonfun errmsg =
17111708
let l = Array.length argv in
17121709
let current = ref start in
1710+
let rev_list = ref [] in
17131711
while !current < l do
17141712
let s = argv.(!current) in
1713+
incr current;
17151714
if s <> "" && s.[0] = '-' then begin
17161715
match assoc3 s speclist with
1717-
| Some action -> begin
1718-
incr current;
1716+
| Some action -> begin
17191717
begin match action with
17201718
| Set r -> r := true;
17211719
| String f ->
@@ -1732,10 +1730,10 @@ let parse_exn ~progname ~argv ~start (speclist : t) anonfun errmsg =
17321730
end;
17331731
| None -> stop_raise ~progname ~error:(Unknown s) speclist errmsg
17341732
end else begin
1735-
(try anonfun s with Bad m -> stop_raise ~progname ~error:(Message m) speclist errmsg);
1736-
incr current;
1733+
rev_list := s :: !rev_list;
17371734
end;
17381735
done;
1736+
anonfun ~rev_args:!rev_list
17391737
;;
17401738

17411739

@@ -4084,17 +4082,14 @@ end = struct
40844082
let compilation_kind = ref Bsb_helper_depfile_gen.Js
40854083

40864084
let hash : string ref = ref ""
4087-
let batch_files = ref []
4088-
let collect_file name =
4089-
batch_files := name :: !batch_files
4085+
40904086

40914087
(* let output_prefix = ref None *)
40924088
let dev_group = ref false
40934089
let namespace = ref None
40944090

40954091

4096-
let anonymous filename =
4097-
collect_file filename
4092+
40984093
let usage = "Usage: bsb_helper.exe [options] \nOptions are:"
40994094

41004095
let () =
@@ -4110,21 +4105,22 @@ let () =
41104105
" Set namespace";
41114106
"-hash", Set_string hash,
41124107
" Set hash(internal)";
4113-
] anonymous usage;
4114-
(* arrange with mlast comes first *)
4115-
match !batch_files with
4116-
| [x]
4117-
-> Bsb_helper_depfile_gen.emit_d
4108+
] (fun ~rev_args ->
4109+
match rev_args with
4110+
| [x]
4111+
-> Bsb_helper_depfile_gen.emit_d
4112+
!compilation_kind
4113+
!dev_group
4114+
!namespace x ""
4115+
| [y; x] (* reverse order *)
4116+
->
4117+
Bsb_helper_depfile_gen.emit_d
41184118
!compilation_kind
41194119
!dev_group
4120-
!namespace x ""
4121-
| [y; x] (* reverse order *)
4122-
->
4123-
Bsb_helper_depfile_gen.emit_d
4124-
!compilation_kind
4125-
!dev_group
4126-
!namespace x y
4127-
| _ ->
4128-
()
4129-
4120+
!namespace x y
4121+
| _ ->
4122+
()
4123+
) usage;
4124+
(* arrange with mlast comes first *)
4125+
41304126
end

0 commit comments

Comments
 (0)