Skip to content

Commit 03f9ac1

Browse files
cristianoccristianoc
committed
Test: hook up vendored gentype.
1 parent 2545891 commit 03f9ac1

11 files changed

+76
-97
lines changed

‎jscomp/core/js_implementation.ml

+3-11
Original file line numberDiff line numberDiff line change
@@ -43,17 +43,9 @@ let output_deps_set name set =
4343

4444
let process_with_gentype filename =
4545
match !Clflags.bs_gentype with
46-
| None -> ()
47-
| Some cmd ->
48-
let comm =
49-
cmd ^ " -bs-version " ^ Bs_version.version ^ " -cmt-add " ^ filename
50-
^ ":" ^ !Location.input_name
51-
in
52-
if !Clflags.verbose then (
53-
prerr_string "+ ";
54-
prerr_endline comm;
55-
prerr_newline ());
56-
ignore (Sys.command comm)
46+
| false -> ()
47+
| true ->
48+
GenType.executeCliCommand ~printUsageAndExit:(fun () -> ()) (Add filename)
5749

5850
let after_parsing_sig ppf outputprefix ast =
5951
Ast_config.iter_on_bs_config_sigi ast;

‎jscomp/dune

-2
Original file line numberDiff line numberDiff line change
@@ -54,8 +54,6 @@
5454
(library
5555
(name jscomp)
5656
(flags "-w" "+26+27+32+33+39-d")
57-
; Depends on:
58-
(libraries unix str)
5957
(modules_without_implementation
6058
Jscmj_main
6159
Lam_pass_unused_params

‎jscomp/gentype/GenType.ml

+56-61
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,61 @@ let version = Version.version
22

33
type cliCommand = Add of string | Clean | NoOp | Rm of string list
44

5+
let executeCliCommand ~printUsageAndExit cliCommand =
6+
match cliCommand with
7+
| Add s ->
8+
Log_.Color.forceColor := true;
9+
let splitColon = Str.split (Str.regexp ":") s in
10+
let cmt, mlast =
11+
match splitColon with
12+
| cmt :: rest ->
13+
let mlast = rest |> String.concat "" in
14+
(cmt, mlast)
15+
| _ -> assert false
16+
in
17+
let config = Paths.readConfig ~namespace:(cmt |> Paths.findNameSpace) in
18+
if !Debug.basic then Log_.item "Add %s %s\n" cmt mlast;
19+
cmt |> GenTypeMain.processCmtFile ~config;
20+
exit 0
21+
| Clean ->
22+
let config = Paths.readConfig ~namespace:None in
23+
let sourceDirs = ModuleResolver.readSourceDirs ~config in
24+
if !Debug.basic then
25+
Log_.item "Clean %d dirs\n" (sourceDirs.dirs |> List.length);
26+
let count = ref 0 in
27+
sourceDirs.dirs
28+
|> List.iter (fun dir ->
29+
let files = Sys.readdir dir in
30+
files
31+
|> Array.iter (fun file ->
32+
if
33+
Filename.check_suffix file ".re"
34+
|| Filename.check_suffix file ".res"
35+
then
36+
let extension = EmitType.outputFileSuffix ~config in
37+
let generated =
38+
Filename.concat dir
39+
((file |> Filename.chop_extension) ^ extension)
40+
in
41+
if Sys.file_exists generated then (
42+
Unix.unlink generated;
43+
incr count)));
44+
if !Debug.basic then Log_.item "Cleaned %d files\n" !count;
45+
exit 0
46+
| NoOp -> printUsageAndExit ()
47+
| Rm l ->
48+
let removeOne s =
49+
let cmtAbsolutePath = s in
50+
(* somehow the CMT hook is passing an absolute path here *)
51+
let cmt = cmtAbsolutePath |> Paths.relativePathFromBsLib in
52+
let config = Paths.readConfig ~namespace:(cmt |> Paths.findNameSpace) in
53+
let outputFile = cmt |> Paths.getOutputFile ~config in
54+
if !Debug.basic then Log_.item "Remove %s\n" cmt;
55+
if Sys.file_exists outputFile then Unix.unlink outputFile
56+
in
57+
l |> List.rev |> List.iter removeOne;
58+
exit 0
59+
560
let cli () =
661
let cliCommand = ref NoOp in
762
let usage = "genType version " ^ version in
@@ -29,70 +84,10 @@ let cli () =
2984
("--version", Arg.Unit versionAndExit, "show version information and exit");
3085
]
3186
in
32-
let executeCliCommand cliCommand =
33-
match cliCommand with
34-
| Add s ->
35-
Log_.Color.forceColor := true;
36-
let splitColon = Str.split (Str.regexp ":") s in
37-
let cmt, mlast =
38-
match splitColon with
39-
| cmt :: rest ->
40-
let mlast = rest |> String.concat "" in
41-
(cmt, mlast)
42-
| _ -> assert false
43-
in
44-
let config = Paths.readConfig ~namespace:(cmt |> Paths.findNameSpace) in
45-
if !Debug.basic then Log_.item "Add %s %s\n" cmt mlast;
46-
cmt |> GenTypeMain.processCmtFile ~config;
47-
exit 0
48-
| Clean ->
49-
let config = Paths.readConfig ~namespace:None in
50-
let sourceDirs = ModuleResolver.readSourceDirs ~config in
51-
if !Debug.basic then
52-
Log_.item "Clean %d dirs\n" (sourceDirs.dirs |> List.length);
53-
let count = ref 0 in
54-
sourceDirs.dirs
55-
|> List.iter (fun dir ->
56-
let files = Sys.readdir dir in
57-
files
58-
|> Array.iter (fun file ->
59-
if
60-
Filename.check_suffix file ".re"
61-
|| Filename.check_suffix file ".res"
62-
then
63-
let extension = EmitType.outputFileSuffix ~config in
64-
let generated =
65-
Filename.concat dir
66-
((file |> Filename.chop_extension) ^ extension)
67-
in
68-
if Sys.file_exists generated then (
69-
Unix.unlink generated;
70-
incr count)));
71-
if !Debug.basic then Log_.item "Cleaned %d files\n" !count;
72-
exit 0
73-
| NoOp -> printUsageAndExit ()
74-
| Rm l ->
75-
let removeOne s =
76-
let cmtAbsolutePath = s in
77-
(* somehow the CMT hook is passing an absolute path here *)
78-
let cmt = cmtAbsolutePath |> Paths.relativePathFromBsLib in
79-
let config =
80-
Paths.readConfig ~namespace:(cmt |> Paths.findNameSpace)
81-
in
82-
let outputFile = cmt |> Paths.getOutputFile ~config in
83-
if !Debug.basic then Log_.item "Remove %s\n" cmt;
84-
if Sys.file_exists outputFile then Unix.unlink outputFile
85-
in
86-
l |> List.rev |> List.iter removeOne;
87-
exit 0
88-
in
8987
let anonArg s =
9088
match !cliCommand with
9189
| Rm l -> cliCommand := Rm (s :: l)
9290
| _ -> print_endline s
9391
in
9492
Arg.parse speclist anonArg usage;
95-
executeCliCommand !cliCommand
96-
;;
97-
98-
cli ()
93+
executeCliCommand ~printUsageAndExit !cliCommand

‎jscomp/main/rescript_compiler_main.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -306,7 +306,7 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
306306
"-no-alias-deps", set Clflags.transparent_modules,
307307
"*internal*Do not record dependencies for module aliases";
308308

309-
"-bs-gentype", string_optional_set Clflags.bs_gentype ,
309+
"-bs-gentype", set Clflags.bs_gentype ,
310310
"*internal* Pass gentype command";
311311

312312
(******************************************************************************)

‎jscomp/ml/clflags.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,6 @@ let bs_vscode =
6666
we don't want to rebuild when flip on or off
6767
*)
6868
let dont_record_crc_unit : string option ref = ref None
69-
let bs_gentype = ref None
69+
let bs_gentype = ref false
7070
let no_assert_false = ref false
7171
let dump_location = ref true

‎jscomp/ml/clflags.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ type mli_status = Mli_exists | Mli_non_exists
3838
val assume_no_mli : mli_status ref
3939
val bs_vscode : bool
4040
val dont_record_crc_unit : string option ref
41-
val bs_gentype : string option ref
41+
val bs_gentype : bool ref
4242
val no_assert_false : bool ref
4343
val dump_location : bool ref
4444

‎lib/4.06.1/unstable/all_ounit_tests.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -9154,7 +9154,7 @@ type mli_status = Mli_exists | Mli_non_exists
91549154
val assume_no_mli : mli_status ref
91559155
val bs_vscode : bool
91569156
val dont_record_crc_unit : string option ref
9157-
val bs_gentype : string option ref
9157+
val bs_gentype : bool ref
91589158
val no_assert_false : bool ref
91599159
val dump_location : bool ref
91609160

@@ -9229,7 +9229,7 @@ let bs_vscode =
92299229
we don't want to rebuild when flip on or off
92309230
*)
92319231
let dont_record_crc_unit : string option ref = ref None
9232-
let bs_gentype = ref None
9232+
let bs_gentype = ref false
92339233
let no_assert_false = ref false
92349234
let dump_location = ref true
92359235

‎lib/4.06.1/unstable/js_compiler.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -1506,7 +1506,7 @@ type mli_status = Mli_exists | Mli_non_exists
15061506
val assume_no_mli : mli_status ref
15071507
val bs_vscode : bool
15081508
val dont_record_crc_unit : string option ref
1509-
val bs_gentype : string option ref
1509+
val bs_gentype : bool ref
15101510
val no_assert_false : bool ref
15111511
val dump_location : bool ref
15121512

@@ -1581,7 +1581,7 @@ let bs_vscode =
15811581
we don't want to rebuild when flip on or off
15821582
*)
15831583
let dont_record_crc_unit : string option ref = ref None
1584-
let bs_gentype = ref None
1584+
let bs_gentype = ref false
15851585
let no_assert_false = ref false
15861586
let dump_location = ref true
15871587

‎lib/4.06.1/unstable/js_playground_compiler.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -1149,7 +1149,7 @@ type mli_status = Mli_exists | Mli_non_exists
11491149
val assume_no_mli : mli_status ref
11501150
val bs_vscode : bool
11511151
val dont_record_crc_unit : string option ref
1152-
val bs_gentype : string option ref
1152+
val bs_gentype : bool ref
11531153
val no_assert_false : bool ref
11541154
val dump_location : bool ref
11551155

@@ -1224,7 +1224,7 @@ let bs_vscode =
12241224
we don't want to rebuild when flip on or off
12251225
*)
12261226
let dont_record_crc_unit : string option ref = ref None
1227-
let bs_gentype = ref None
1227+
let bs_gentype = ref false
12281228
let no_assert_false = ref false
12291229
let dump_location = ref true
12301230

‎lib/4.06.1/whole_compiler.ml

+6-14
Original file line numberDiff line numberDiff line change
@@ -1149,7 +1149,7 @@ type mli_status = Mli_exists | Mli_non_exists
11491149
val assume_no_mli : mli_status ref
11501150
val bs_vscode : bool
11511151
val dont_record_crc_unit : string option ref
1152-
val bs_gentype : string option ref
1152+
val bs_gentype : bool ref
11531153
val no_assert_false : bool ref
11541154
val dump_location : bool ref
11551155

@@ -1224,7 +1224,7 @@ let bs_vscode =
12241224
we don't want to rebuild when flip on or off
12251225
*)
12261226
let dont_record_crc_unit : string option ref = ref None
1227-
let bs_gentype = ref None
1227+
let bs_gentype = ref false
12281228
let no_assert_false = ref false
12291229
let dump_location = ref true
12301230

@@ -284055,17 +284055,9 @@ let output_deps_set name set =
284055284055

284056284056
let process_with_gentype filename =
284057284057
match !Clflags.bs_gentype with
284058-
| None -> ()
284059-
| Some cmd ->
284060-
let comm =
284061-
cmd ^ " -bs-version " ^ Bs_version.version ^ " -cmt-add " ^ filename
284062-
^ ":" ^ !Location.input_name
284063-
in
284064-
if !Clflags.verbose then (
284065-
prerr_string "+ ";
284066-
prerr_endline comm;
284067-
prerr_newline ());
284068-
ignore (Sys.command comm)
284058+
| false -> ()
284059+
| true ->
284060+
GenType.executeCliCommand ~printUsageAndExit:(fun () -> ()) (Add filename)
284069284061

284070284062
let after_parsing_sig ppf outputprefix ast =
284071284063
Ast_config.iter_on_bs_config_sigi ast;
@@ -296589,7 +296581,7 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
296589296581
"-no-alias-deps", set Clflags.transparent_modules,
296590296582
"*internal*Do not record dependencies for module aliases";
296591296583

296592-
"-bs-gentype", string_optional_set Clflags.bs_gentype ,
296584+
"-bs-gentype", set Clflags.bs_gentype ,
296593296585
"*internal* Pass gentype command";
296594296586

296595296587
(******************************************************************************)

‎scripts/ninja.js

+2
Original file line numberDiff line numberDiff line change
@@ -1617,6 +1617,7 @@ var bsc_libs = [
16171617
"common",
16181618
"frontend",
16191619
"depends",
1620+
"gentype",
16201621
"super_errors",
16211622
"outcome_printer",
16221623
"core",
@@ -1732,6 +1733,7 @@ o core/js_record_fold.ml: p4of core/j.ml
17321733
o ${my_target}/bsc.exe: link ${makeLibs(
17331734
bsc_libs
17341735
)} main/rescript_compiler_main.cmx
1736+
libs = unix.cmxa str.cmxa
17351737
o ${my_target}/rescript.exe: link ${makeLibs(
17361738
rescript_libs
17371739
)} main/rescript_main.cmx

0 commit comments

Comments
 (0)