@@ -1611,10 +1611,13 @@ module Bsb_helper_arg : sig
1611
1611
1612
1612
1613
1613
1614
+ type string_action =
1615
+ | Call of (string -> unit )
1616
+ | Set of {mutable contents : string }
1617
+
1614
1618
type spec =
1615
- | Set of bool ref
1616
- | String of (string -> unit )
1617
- | Set_string of string ref
1619
+ | Bool of bool ref
1620
+ | String of string_action
1618
1621
1619
1622
type key = string
1620
1623
type doc = string
@@ -1638,10 +1641,14 @@ type key = string
1638
1641
type doc = string
1639
1642
type anon_fun = rev_args :string list -> unit
1640
1643
1644
+ type string_action =
1645
+ | Call of (string -> unit )
1646
+ | Set of {mutable contents : string }
1647
+
1641
1648
type spec =
1642
- | Set of bool ref
1643
- | String of ( string -> unit )
1644
- | Set_string of string ref
1649
+ | Bool of bool ref
1650
+ | String of string_action
1651
+
1645
1652
1646
1653
exception Bad of string
1647
1654
@@ -1650,10 +1657,6 @@ type error =
1650
1657
| Unknown of string
1651
1658
| Missing of string
1652
1659
1653
-
1654
-
1655
-
1656
-
1657
1660
type t = (string * spec * string ) list
1658
1661
1659
1662
let rec assoc3 (x : string ) (l : t ) =
@@ -1669,13 +1672,18 @@ let (+>) = Ext_buffer.add_string
1669
1672
let usage_b (buf : Ext_buffer.t ) progname speclist =
1670
1673
buf +> progname;
1671
1674
buf +> " options:\n " ;
1675
+ let max_col = ref 0 in
1676
+ Ext_list. iter speclist (fun (key ,_ ,_ ) ->
1677
+ if String. length key > ! max_col then
1678
+ max_col := String. length key
1679
+ );
1672
1680
Ext_list. iter speclist (fun (key ,_ ,doc ) ->
1673
1681
buf +> " " ;
1674
1682
buf +> key ;
1675
- buf +> " " ;
1683
+ buf +> ( String. make ( ! max_col - String. length key + 1 ) ' ' ) ;
1676
1684
buf +> doc;
1677
1685
buf +> " \n "
1678
- )
1686
+ )
1679
1687
;;
1680
1688
1681
1689
@@ -1713,17 +1721,17 @@ let parse_exn ~progname ~argv ~start (speclist : t) anonfun =
1713
1721
match assoc3 s speclist with
1714
1722
| Some action -> begin
1715
1723
begin match action with
1716
- | Set r -> r := true ;
1724
+ | Bool r -> r := true ;
1717
1725
| String f ->
1718
- if ! current < l then begin
1719
- f argv.( ! current);
1720
- incr current;
1721
- end else stop_raise ~progname ~error: ( Missing s) speclist
1722
- | Set_string r ->
1723
- if ! current < l then begin
1724
- r := argv.( ! current);
1725
- incr current;
1726
- end else stop_raise ~progname ~error: ( Missing s) speclist
1726
+ if ! current > = l then stop_raise ~progname ~error: ( Missing s) speclist
1727
+ else begin
1728
+ let arg = argv.( ! current) in
1729
+ incr current;
1730
+ match f with
1731
+ | Call f ->
1732
+ f arg
1733
+ | Set u -> u.contents < - arg
1734
+ end
1727
1735
end ;
1728
1736
end ;
1729
1737
| None -> stop_raise ~progname ~error: (Unknown s) speclist
@@ -4079,7 +4087,9 @@ end = struct
4079
4087
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
4080
4088
let compilation_kind = ref Bsb_helper_depfile_gen. Js
4081
4089
4082
- let hash : string ref = ref " "
4090
+ let hash : Bsb_helper_arg.string_action =
4091
+ Set {contents = " " }
4092
+
4083
4093
let dev_group = ref false
4084
4094
let namespace = ref None
4085
4095
@@ -4089,13 +4099,13 @@ let () =
4089
4099
~argv: Sys. argv
4090
4100
~start: 1
4091
4101
[
4092
- " -g" , Set dev_group ,
4093
- " Set the dev group (default to be 0)"
4102
+ " -g" , Bool dev_group ,
4103
+ " Set the dev group (default to be 0)"
4094
4104
;
4095
- " -bs-ns" , String (fun s -> namespace := Some s),
4096
- " Set namespace" ;
4097
- " -hash" , Set_string hash,
4098
- " Set hash(internal)" ;
4105
+ " -bs-ns" , String (Call ( fun s -> namespace := Some s) ),
4106
+ " Set namespace" ;
4107
+ " -hash" , String hash,
4108
+ " Set hash(internal)" ;
4099
4109
] (fun ~rev_args ->
4100
4110
match rev_args with
4101
4111
| [x]
0 commit comments