Skip to content

Commit e8f2190

Browse files
bobzhangbobzhang
authored
Merge pull request #4459 from BuckleScript/customized_command_line_parsing
customized command line parsing
2 parents 9fcb1bd + 1deb31b commit e8f2190

File tree

17 files changed

+6518
-5929
lines changed

17 files changed

+6518
-5929
lines changed

‎jscomp/bsb/bsb_arg.ml‎

Lines changed: 159 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,159 @@
1+
(* Copyright (C) 2020- Authors of BuckleScript
2+
*
3+
* This program is free software: you can redistribute it and/or modify
4+
* it under the terms of the GNU Lesser General Public License as published by
5+
* the Free Software Foundation, either version 3 of the License, or
6+
* (at your option) any later version.
7+
*
8+
* In addition to the permissions granted to you by the LGPL, you may combine
9+
* or link a "work that uses the Library" with a publicly distributed version
10+
* of this file to produce a combined library or application, then distribute
11+
* that combined work under the terms of your choosing, with no requirement
12+
* to comply with the obligations normally placed on you by section 4 of the
13+
* LGPL version 3 (or the corresponding section of a later version of the LGPL
14+
* should you choose to use a later version).
15+
*
16+
* This program is distributed in the hope that it will be useful,
17+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
* GNU Lesser General Public License for more details.
20+
*
21+
* You should have received a copy of the GNU Lesser General Public License
22+
* along with this program; if not, write to the Free Software
23+
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
24+
25+
26+
27+
28+
type key = string
29+
type doc = string
30+
type anon_fun = rev_args:string list -> unit
31+
32+
type string_action =
33+
| String_call of (string -> unit)
34+
| String_set of string ref
35+
36+
type unit_action =
37+
| Unit_call of (unit -> unit)
38+
| Unit_set of bool ref
39+
40+
type spec =
41+
| Unit of unit_action
42+
| String of string_action
43+
44+
45+
exception Bad of string
46+
47+
48+
type error =
49+
| Unknown of string
50+
| Missing of string
51+
52+
type t = (string * spec * string) list
53+
54+
let rec assoc3 (x : string) (l : t) =
55+
match l with
56+
| [] -> None
57+
| (y1, y2, _) :: _ when y1 = x -> Some y2
58+
| _ :: t -> assoc3 x t
59+
;;
60+
61+
62+
let (+>) = Ext_buffer.add_string
63+
64+
let usage_b (buf : Ext_buffer.t) ~usage speclist =
65+
buf +> usage;
66+
buf +> "\nOptions:\n";
67+
let max_col = ref 0 in
68+
Ext_list.iter speclist (fun (key,_,_) ->
69+
if String.length key > !max_col then
70+
max_col := String.length key
71+
);
72+
Ext_list.iter speclist (fun (key,_,doc) ->
73+
if not (Ext_string.starts_with doc "*internal*") then begin
74+
buf +> " ";
75+
buf +> key ;
76+
buf +> (String.make (!max_col - String.length key + 2 ) ' ');
77+
let cur = ref 0 in
78+
let doc_length = String.length doc in
79+
while !cur < doc_length do
80+
match String.index_from_opt doc !cur '\n' with
81+
| None ->
82+
if !cur <> 0 then begin
83+
buf +> "\n";
84+
buf +> String.make (!max_col + 4) ' ' ;
85+
end;
86+
buf +> String.sub doc !cur (String.length doc - !cur );
87+
cur := doc_length
88+
| Some new_line_pos ->
89+
if !cur <> 0 then begin
90+
buf +> "\n";
91+
buf +> String.make (!max_col + 4) ' ' ;
92+
end;
93+
buf +> String.sub doc !cur (new_line_pos - !cur );
94+
cur := new_line_pos + 1
95+
done ;
96+
buf +> "\n"
97+
end
98+
)
99+
;;
100+
101+
102+
103+
let stop_raise ~usage ~(error : error) speclist =
104+
let b = Ext_buffer.create 200 in
105+
begin match error with
106+
| Unknown ("-help" | "--help" | "-h") ->
107+
usage_b b ~usage speclist ;
108+
Ext_buffer.output_buffer stdout b;
109+
exit 0
110+
| Unknown s ->
111+
b +> "unknown option: '";
112+
b +> s ;
113+
b +> "'.\n"
114+
| Missing s ->
115+
b +> "option '";
116+
b +> s;
117+
b +> "' needs an argument.\n"
118+
end;
119+
usage_b b ~usage speclist ;
120+
raise (Bad (Ext_buffer.contents b))
121+
122+
123+
let parse_exn ~usage ~argv ?(start=1) ?(finish=Array.length argv) (speclist : t) anonfun =
124+
let current = ref start in
125+
let rev_list = ref [] in
126+
while !current < finish do
127+
let s = argv.(!current) in
128+
incr current;
129+
if s <> "" && s.[0] = '-' then begin
130+
match assoc3 s speclist with
131+
| Some action -> begin
132+
begin match action with
133+
| Unit r ->
134+
begin match r with
135+
| Unit_set r -> r.contents <- true
136+
| Unit_call f -> f ()
137+
end
138+
| String f ->
139+
if !current >= finish then stop_raise ~usage ~error:(Missing s) speclist
140+
else begin
141+
let arg = argv.(!current) in
142+
incr current;
143+
match f with
144+
| String_call f ->
145+
f arg
146+
| String_set u -> u.contents <- arg
147+
end
148+
end;
149+
end;
150+
| None -> stop_raise ~usage ~error:(Unknown s) speclist
151+
end else begin
152+
rev_list := s :: !rev_list;
153+
end;
154+
done;
155+
anonfun ~rev_args:!rev_list
156+
;;
157+
158+
159+

‎jscomp/bsb/bsb_arg.mli‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
(* Copyright (C) 2020- Authors of BuckleScript
2+
*
3+
* This program is free software: you can redistribute it and/or modify
4+
* it under the terms of the GNU Lesser General Public License as published by
5+
* the Free Software Foundation, either version 3 of the License, or
6+
* (at your option) any later version.
7+
*
8+
* In addition to the permissions granted to you by the LGPL, you may combine
9+
* or link a "work that uses the Library" with a publicly distributed version
10+
* of this file to produce a combined library or application, then distribute
11+
* that combined work under the terms of your choosing, with no requirement
12+
* to comply with the obligations normally placed on you by section 4 of the
13+
* LGPL version 3 (or the corresponding section of a later version of the LGPL
14+
* should you choose to use a later version).
15+
*
16+
* This program is distributed in the hope that it will be useful,
17+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
* GNU Lesser General Public License for more details.
20+
*
21+
* You should have received a copy of the GNU Lesser General Public License
22+
* along with this program; if not, write to the Free Software
23+
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
24+
25+
type string_action =
26+
| String_call of (string -> unit)
27+
| String_set of string ref
28+
29+
type unit_action =
30+
| Unit_call of (unit -> unit)
31+
| Unit_set of bool ref
32+
33+
exception Bad of string
34+
35+
type spec =
36+
| Unit of unit_action
37+
| String of string_action
38+
39+
type key = string
40+
type doc = string
41+
42+
type anon_fun = rev_args:string list -> unit
43+
44+
val parse_exn :
45+
usage:string ->
46+
argv:string array ->
47+
?start:int ->
48+
?finish:int ->
49+
(key * spec * doc) list ->
50+
anon_fun -> unit

‎jscomp/bsb/bsb_parse_sources.ml‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -112,23 +112,23 @@ let extract_input_output (edge : Ext_json_types.t) : string list * string list =
112112
(match Ext_array.find_and_split content
113113
(fun x () -> match x with Str { str =":"} -> true | _ -> false )
114114
() with
115-
| `No_split -> error ()
116-
| `Split ( output, input) ->
117-
(Ext_array.to_list_map (fun (x : Ext_json_types.t) ->
115+
| No_split -> error ()
116+
| Split ( output, input) ->
117+
(Ext_array.to_list_map output (fun x ->
118118
match x with
119119
| Str {str = ":"} ->
120120
error ()
121121
| Str {str } ->
122122
Some str
123-
| _ -> None) output
123+
| _ -> None)
124124
,
125-
Ext_array.to_list_map (fun (x : Ext_json_types.t) ->
125+
Ext_array.to_list_map input (fun x ->
126126
match x with
127127
| Str {str = ":"} ->
128128
error ()
129129
| Str {str} ->
130130
Some str (* More rigirous error checking: It would trigger a ninja syntax error *)
131-
| _ -> None) input))
131+
| _ -> None) ))
132132
| _ -> error ()
133133
type json_map = Ext_json_types.t Map_string.t
134134

‎jscomp/ext/ext_array.ml‎

Lines changed: 4 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ let rec tolist_aux a f i res =
112112
| Some v -> v :: res
113113
| None -> res)
114114

115-
let to_list_map f a =
115+
let to_list_map a f =
116116
tolist_aux a f (Array.length a - 1) []
117117

118118
let to_list_map_acc a acc f =
@@ -187,13 +187,7 @@ let rfind_with_index arr cmp v =
187187
else aux (i - 1) in
188188
aux (len - 1)
189189

190-
type 'a split = [ `No_split | `Split of 'a array * 'a array ]
191-
let rfind_and_split arr cmp v : _ split =
192-
let i = rfind_with_index arr cmp v in
193-
if i < 0 then
194-
`No_split
195-
else
196-
`Split (Array.sub arr 0 i , Array.sub arr (i + 1 ) (Array.length arr - i - 1 ))
190+
type 'a split = No_split | Split of 'a array * 'a array
197191

198192

199193
let find_with_index arr cmp v =
@@ -207,9 +201,9 @@ let find_with_index arr cmp v =
207201
let find_and_split arr cmp v : _ split =
208202
let i = find_with_index arr cmp v in
209203
if i < 0 then
210-
`No_split
204+
No_split
211205
else
212-
`Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1))
206+
Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1))
213207

214208
(** TODO: available since 4.03, use {!Array.exists} *)
215209

‎jscomp/ext/ext_array.mli‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,8 @@ val to_list_f :
4949
('a -> 'b) ->
5050
'b list
5151

52-
val to_list_map : ('a -> 'b option) -> 'a array -> 'b list
52+
val to_list_map :
53+
'a array -> ('a -> 'b option) -> 'b list
5354

5455
val to_list_map_acc :
5556
'a array ->
@@ -65,12 +66,9 @@ val of_list_map :
6566
val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int
6667

6768

68-
type 'a split = [ `No_split | `Split of 'a array * 'a array ]
6969

70-
val rfind_and_split :
71-
'a array ->
72-
('a -> 'b -> bool) ->
73-
'b -> 'a split
70+
type 'a split = No_split | Split of 'a array * 'a array
71+
7472

7573
val find_and_split :
7674
'a array ->

0 commit comments

Comments
 (0)