Skip to content

Commit c7409f4

Browse files
bobzhangbobzhang
authored
Merge pull request #3869 from BuckleScript/snapshot_changes
snapshot changes and get back build_sorted.ml
2 parents 03fa503 + bbb1275 commit c7409f4

File tree

10 files changed

+410
-296
lines changed

10 files changed

+410
-296
lines changed

‎lib/4.02.3/bsb_helper.ml

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -4156,13 +4156,14 @@ type kind = Js | Bytecode | Native
41564156
val deps_of_channel : in_channel -> string list
41574157

41584158

4159-
4160-
val emit_d:
4159+
val emit_d:
4160+
kind ->
41614161
Bsb_dir_index.t ->
41624162
string option ->
41634163
string ->
41644164
string -> (* empty string means no mliast *)
41654165
unit
4166+
41664167
end = struct
41674168
#1 "bsb_helper_depfile_gen.ml"
41684169
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -4410,6 +4411,7 @@ let oc_intf
44104411

44114412

44124413
let emit_d
4414+
compilation_kind
44134415
(index : Bsb_dir_index.t)
44144416
(namespace : string option) (mlast : string) (mliast : string) =
44154417
let data =
@@ -4418,9 +4420,12 @@ let emit_d
44184420
let buf = Ext_buffer.create 2048 in
44194421
let filename =
44204422
Ext_filename.new_extension mlast Literals.suffix_d in
4421-
let lhs_suffix = Literals.suffix_cmj in
4422-
let rhs_suffix = Literals.suffix_cmj in
4423-
4423+
let lhs_suffix, rhs_suffix =
4424+
match compilation_kind with
4425+
| Js -> Literals.suffix_cmj, Literals.suffix_cmj
4426+
| Bytecode -> Literals.suffix_cmo, Literals.suffix_cmo
4427+
| Native -> Literals.suffix_cmx, Literals.suffix_cmx
4428+
in
44244429
oc_impl
44254430
mlast
44264431
index
@@ -4439,12 +4444,6 @@ let emit_d
44394444
end;
44404445
write_file filename buf
44414446

4442-
4443-
4444-
4445-
4446-
4447-
44484447
end
44494448
module Bsb_helper_main : sig
44504449
#1 "bsb_helper_main.mli"
@@ -4510,6 +4509,8 @@ end = struct
45104509
* along with this program; if not, write to the Free Software
45114510
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
45124511

4512+
let compilation_kind = ref Bsb_helper_depfile_gen.Js
4513+
45134514
let hash : string ref = ref ""
45144515
let batch_files = ref []
45154516
let collect_file name =
@@ -4539,11 +4540,13 @@ let () =
45394540
match !batch_files with
45404541
| [x]
45414542
-> Bsb_helper_depfile_gen.emit_d
4543+
!compilation_kind
45424544
(Bsb_dir_index.of_int !dev_group )
45434545
!namespace x ""
45444546
| [y; x] (* reverse order *)
45454547
->
45464548
Bsb_helper_depfile_gen.emit_d
4549+
!compilation_kind
45474550
(Bsb_dir_index.of_int !dev_group)
45484551
!namespace x y
45494552
| _ ->

‎lib/4.02.3/bsdep.ml

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -39095,7 +39095,13 @@ let app_exp_mapper
3909539095
|
3909639096
{pexp_desc =
3909739097
(Pexp_ident {txt = Lident name;_ }
39098-
| Pexp_constant (Const_string(name,None)))
39098+
39099+
| Pexp_constant (
39100+
39101+
Const_string
39102+
39103+
(name,None))
39104+
)
3909939105
;
3910039106
pexp_loc}
3910139107
(* f##paint *)
@@ -39125,7 +39131,11 @@ let app_exp_mapper
3912539131
| Some { args = [obj; {
3912639132
pexp_desc =
3912739133
Pexp_ident {txt = Lident name}
39128-
| Pexp_constant (Const_string (name, None)); pexp_loc
39134+
| Pexp_constant (
39135+
39136+
Const_string
39137+
39138+
(name, None)); pexp_loc
3912939139
}
3913039140
]
3913139141
}

‎lib/4.02.3/bsppx.ml

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21201,7 +21201,13 @@ let app_exp_mapper
2120121201
|
2120221202
{pexp_desc =
2120321203
(Pexp_ident {txt = Lident name;_ }
21204-
| Pexp_constant (Const_string(name,None)))
21204+
21205+
| Pexp_constant (
21206+
21207+
Const_string
21208+
21209+
(name,None))
21210+
)
2120521211
;
2120621212
pexp_loc}
2120721213
(* f##paint *)
@@ -21231,7 +21237,11 @@ let app_exp_mapper
2123121237
| Some { args = [obj; {
2123221238
pexp_desc =
2123321239
Pexp_ident {txt = Lident name}
21234-
| Pexp_constant (Const_string (name, None)); pexp_loc
21240+
| Pexp_constant (
21241+
21242+
Const_string
21243+
21244+
(name, None)); pexp_loc
2123521245
}
2123621246
]
2123721247
}

‎lib/4.02.3/unstable/bsb_native.ml

Lines changed: 73 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -8548,26 +8548,82 @@ let cache : string Coll.t = Coll.create 0
85488548
let to_list cb =
85498549
Coll.to_list cache cb
85508550

8551+
(* Some package managers will implement "postinstall" caches, that do not
8552+
* keep their build artifacts in the local node_modules. Similar to
8553+
* npm_config_prefix, bs_custom_resolution allows these to specify the
8554+
* exact location of build cache, but on a per-package basis. Implemented as
8555+
* environment lookup to avoid invasive changes to bsconfig and mandates. *)
8556+
let custom_resolution = lazy
8557+
(match Sys.getenv "bs_custom_resolution" with
8558+
| exception Not_found -> false
8559+
| "true" -> true
8560+
| _ -> false)
8561+
8562+
let pkg_name_as_variable package =
8563+
Bsb_pkg_types.to_string package
8564+
|> fun s -> Ext_string.split s '@'
8565+
|> String.concat ""
8566+
|> fun s -> Ext_string.split s '_'
8567+
|> String.concat "__"
8568+
|> fun s -> Ext_string.split s '/'
8569+
|> String.concat "__slash__"
8570+
|> fun s -> Ext_string.split s '.'
8571+
|> String.concat "__dot__"
8572+
|> fun s -> Ext_string.split s '-'
8573+
|> String.concat "_"
8574+
85518575
(** TODO: collect all warnings and print later *)
85528576
let resolve_bs_package ~cwd (package : t) =
8553-
match Coll.find_opt cache package with
8554-
| None ->
8555-
let result = resolve_bs_package_aux ~cwd package in
8556-
Bsb_log.info "@{<info>Package@} %a -> %s@." Bsb_pkg_types.print package result ;
8557-
Coll.add cache package result ;
8558-
result
8559-
| Some x
8560-
->
8561-
let result = resolve_bs_package_aux ~cwd package in
8562-
if result <> x then
8577+
if Lazy.force custom_resolution then
8578+
begin
8579+
Bsb_log.info "@{<info>Using Custom Resolution@}@.";
8580+
let custom_pkg_loc = pkg_name_as_variable package ^ "__install" in
8581+
let custom_pkg_location = lazy (Sys.getenv custom_pkg_loc) in
8582+
match Lazy.force custom_pkg_location with
8583+
| exception Not_found ->
8584+
begin
8585+
Bsb_log.error
8586+
"@{<error>Custom resolution of package %s does not exist in var %s @}@."
8587+
(Bsb_pkg_types.to_string package)
8588+
custom_pkg_loc;
8589+
Bsb_exception.package_not_found ~pkg:package ~json:None
8590+
end
8591+
| path when not (Sys.file_exists path) ->
8592+
begin
8593+
Bsb_log.error
8594+
"@{<error>Custom resolution of package %s does not exist on disk: %s=%s @}@."
8595+
(Bsb_pkg_types.to_string package)
8596+
custom_pkg_loc
8597+
path;
8598+
Bsb_exception.package_not_found ~pkg:package ~json:None
8599+
end
8600+
| path ->
85638601
begin
8564-
Bsb_log.warn
8565-
"@{<warning>Duplicated package:@} %a %s (chosen) vs %s in %s @."
8566-
Bsb_pkg_types.print package x result cwd;
8567-
end;
8568-
x
8569-
8570-
8602+
Bsb_log.info
8603+
"@{<info>Custom Resolution of package %s in var %s found at %s@}@."
8604+
(Bsb_pkg_types.to_string package)
8605+
custom_pkg_loc
8606+
path;
8607+
path
8608+
end
8609+
end
8610+
else
8611+
match Coll.find_opt cache package with
8612+
| None ->
8613+
let result = resolve_bs_package_aux ~cwd package in
8614+
Bsb_log.info "@{<info>Package@} %a -> %s@." Bsb_pkg_types.print package result ;
8615+
Coll.add cache package result ;
8616+
result
8617+
| Some x
8618+
->
8619+
let result = resolve_bs_package_aux ~cwd package in
8620+
if result <> x then
8621+
begin
8622+
Bsb_log.warn
8623+
"@{<warning>Duplicated package:@} %a %s (chosen) vs %s in %s @."
8624+
Bsb_pkg_types.print package x result cwd;
8625+
end;
8626+
x
85718627

85728628

85738629
(** The package does not need to be a bspackage

‎lib/4.02.3/unstable/js_compiler.ml

Lines changed: 21 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21082,7 +21082,13 @@ let app_exp_mapper
2108221082
|
2108321083
{pexp_desc =
2108421084
(Pexp_ident {txt = Lident name;_ }
21085-
| Pexp_constant (Const_string(name,None)))
21085+
21086+
| Pexp_constant (
21087+
21088+
Const_string
21089+
21090+
(name,None))
21091+
)
2108621092
;
2108721093
pexp_loc}
2108821094
(* f##paint *)
@@ -21112,7 +21118,11 @@ let app_exp_mapper
2111221118
| Some { args = [obj; {
2111321119
pexp_desc =
2111421120
Pexp_ident {txt = Lident name}
21115-
| Pexp_constant (Const_string (name, None)); pexp_loc
21121+
| Pexp_constant (
21122+
21123+
Const_string
21124+
21125+
(name, None)); pexp_loc
2111621126
}
2111721127
]
2111821128
}
@@ -75490,7 +75500,7 @@ let primitive ppf (prim : Lam_primitive.t) = match prim with
7549075500
| Pmakeblock(tag, _, Mutable) -> fprintf ppf "makemutable %i" tag
7549175501
| Pfield (n, (Fld_module s | Fld_record s))
7549275502
-> fprintf ppf "field %s/%i" s n
75493-
| Pfield (n, Fld_na)
75503+
| Pfield (n, _)
7549475504
-> fprintf ppf "field %i" n
7549575505
| Pfield_computed ->
7549675506
fprintf ppf "field_computed"
@@ -110495,11 +110505,18 @@ type default_case =
110495110505
let no_effects_const = lazy true
110496110506
let has_effects_const = lazy false
110497110507

110508+
let is_nullary_variant x =
110509+
match x with
110510+
110511+
| [] -> true
110512+
110513+
| _ -> false
110514+
110498110515
let names_from_construct_pattern (pat: Typedtree.pattern) =
110499110516
let names_from_type_variant cstrs =
110500110517
let (consts, blocks) = List.fold_left
110501110518
(fun (consts, blocks) cstr ->
110502-
if cstr.Types.cd_args = []
110519+
if is_nullary_variant cstr.Types.cd_args
110503110520
then (Ident.name cstr.Types.cd_id :: consts, blocks)
110504110521
else (consts, Ident.name cstr.Types.cd_id :: blocks))
110505110522
([], []) cstrs in

0 commit comments

Comments
 (0)