Skip to content

Commit 82a97a9

Browse files
bobzhangbobzhang
authored
Merge pull request #3141 from BuckleScript/fun2
remove caml_is_block, tweak getEnv, stdlib
2 parents 00851f0 + 28296c5 commit 82a97a9

21 files changed

+358
-189
lines changed

‎jscomp/bsb/bsb_templates.ml

Lines changed: 22 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -476,13 +476,13 @@ let root = OCamlRes.Res.([
476476
Dir ("react", [
477477
Dir ("src", [
478478
File ("Index.re",
479-
"ReactDOMRe.renderToElementWithId(<Component1 message=\"Hello!\" />, \"index1\");\n\
479+
"ReactDOMRe.renderToElementWithId(<Component1 message=\"Hello! Click this text.\" />, \"index1\");\n\
480480
\n\
481481
ReactDOMRe.renderToElementWithId(<Component2 greeting=\"Hello!\" />, \"index2\");\n\
482482
") ;
483483
File ("Component1.re",
484484
"/* This is the basic component. */\n\
485-
let component = ReasonReact.statelessComponent(\"Page\");\n\
485+
let component = ReasonReact.statelessComponent(\"Component1\");\n\
486486
\n\
487487
/* Your familiar handleClick from ReactJS. This mandatorily takes the payload,\n\
488488
\ then the `self` record, which contains state (none here), `handle`, `reduce`\n\
@@ -492,16 +492,16 @@ let root = OCamlRes.Res.([
492492
/* `make` is the function that mandatorily takes `children` (if you want to use\n\
493493
\ `JSX). `message` is a named argument, which simulates ReactJS props. Usage:\n\
494494
\n\
495-
\ `<Page message=\"hello\" />`\n\
495+
\ `<Component1 message=\"hello\" />`\n\
496496
\n\
497497
\ Which desugars to\n\
498498
\n\
499-
\ `ReasonReact.element(Page.make(~message=\"hello\", [||]))` */\n\
499+
\ `ReasonReact.element(Component1.make(~message=\"hello\", [||]))` */\n\
500500
let make = (~message, _children) => {\n\
501501
\ ...component,\n\
502502
\ render: self =>\n\
503-
\ <div onClick=(self.handle(handleClick))>\n\
504-
\ (ReasonReact.string(message))\n\
503+
\ <div onClick={self.handle(handleClick)}>\n\
504+
\ {ReasonReact.string(message)}\n\
505505
\ </div>,\n\
506506
};\n\
507507
") ;
@@ -540,13 +540,13 @@ let root = OCamlRes.Res.([
540540
\ let message =\n\
541541
\ \"You've clicked this \" ++ string_of_int(self.state.count) ++ \" times(s)\";\n\
542542
\ <div>\n\
543-
\ <button onClick=(_event => self.send(Click))>\n\
544-
\ (ReasonReact.string(message))\n\
543+
\ <button onClick={_event => self.send(Click)}>\n\
544+
\ {ReasonReact.string(message)}\n\
545545
\ </button>\n\
546-
\ <button onClick=(_event => self.send(Toggle))>\n\
547-
\ (ReasonReact.string(\"Toggle greeting\"))\n\
546+
\ <button onClick={_event => self.send(Toggle)}>\n\
547+
\ {ReasonReact.string(\"Toggle greeting\")}\n\
548548
\ </button>\n\
549-
\ (self.state.show ? ReasonReact.string(greeting) : ReasonReact.null)\n\
549+
\ {self.state.show ? ReasonReact.string(greeting) : ReasonReact.null}\n\
550550
\ </div>;\n\
551551
\ },\n\
552552
};\n\
@@ -561,6 +561,7 @@ let root = OCamlRes.Res.([
561561
<body>\n\
562562
\ Component 1:\n\
563563
\ <div id=\"index1\"></div>\n\
564+
\n\
564565
\ Component 2:\n\
565566
\ <div id=\"index2\"></div>\n\
566567
\n\
@@ -702,13 +703,13 @@ let root = OCamlRes.Res.([
702703
Dir ("react-lite", [
703704
Dir ("src", [
704705
File ("Index.re",
705-
"ReactDOMRe.renderToElementWithId(<Component1 message=\"Hello!\" />, \"index1\");\n\
706+
"ReactDOMRe.renderToElementWithId(<Component1 message=\"Hello! Click this text.\" />, \"index1\");\n\
706707
\n\
707708
ReactDOMRe.renderToElementWithId(<Component2 greeting=\"Hello!\" />, \"index2\");\n\
708709
") ;
709710
File ("Component1.re",
710711
"/* This is the basic component. */\n\
711-
let component = ReasonReact.statelessComponent(\"Page\");\n\
712+
let component = ReasonReact.statelessComponent(\"Component1\");\n\
712713
\n\
713714
/* Your familiar handleClick from ReactJS. This mandatorily takes the payload,\n\
714715
\ then the `self` record, which contains state (none here), `handle`, `reduce`\n\
@@ -718,16 +719,16 @@ let root = OCamlRes.Res.([
718719
/* `make` is the function that mandatorily takes `children` (if you want to use\n\
719720
\ `JSX). `message` is a named argument, which simulates ReactJS props. Usage:\n\
720721
\n\
721-
\ `<Page message=\"hello\" />`\n\
722+
\ `<Component1 message=\"hello\" />`\n\
722723
\n\
723724
\ Which desugars to\n\
724725
\n\
725-
\ `ReasonReact.element(Page.make(~message=\"hello\", [||]))` */\n\
726+
\ `ReasonReact.element(Component1.make(~message=\"hello\", [||]))` */\n\
726727
let make = (~message, _children) => {\n\
727728
\ ...component,\n\
728729
\ render: self =>\n\
729730
\ <div onClick=(self.handle(handleClick))>\n\
730-
\ (ReasonReact.string(message))\n\
731+
\ {ReasonReact.string(message)}\n\
731732
\ </div>,\n\
732733
};\n\
733734
") ;
@@ -766,13 +767,13 @@ let root = OCamlRes.Res.([
766767
\ let message =\n\
767768
\ \"You've clicked this \" ++ string_of_int(self.state.count) ++ \" times(s)\";\n\
768769
\ <div>\n\
769-
\ <button onClick=(_event => self.send(Click))>\n\
770-
\ (ReasonReact.string(message))\n\
770+
\ <button onClick={_event => self.send(Click)}>\n\
771+
\ {ReasonReact.string(message)}\n\
771772
\ </button>\n\
772-
\ <button onClick=(_event => self.send(Toggle))>\n\
773-
\ (ReasonReact.string(\"Toggle greeting\"))\n\
773+
\ <button onClick={_event => self.send(Toggle)}>\n\
774+
\ {ReasonReact.string(\"Toggle greeting\")}\n\
774775
\ </button>\n\
775-
\ (self.state.show ? ReasonReact.string(greeting) : ReasonReact.null)\n\
776+
\ {self.state.show ? ReasonReact.string(greeting) : ReasonReact.null}\n\
776777
\ </div>;\n\
777778
\ },\n\
778779
};\n\

‎jscomp/core/js_exp_make.ml

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -402,11 +402,6 @@ let dot ?comment (e0 : t) (e1 : string) : t =
402402

403403

404404

405-
(** coupled with the runtime *)
406-
let is_caml_block ?comment (e : t) : t =
407-
{expression_desc = Bin ( NotEqEq, dot e L.js_prop_length , undefined);
408-
comment}
409-
410405
(* This is a property access not external module *)
411406

412407
let array_length ?comment (e : t) : t =

‎jscomp/core/js_exp_make.mli

Lines changed: 0 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -289,18 +289,7 @@ val bool : bool -> t
289289
val unit : t
290290
(** [unit] in ocaml will be compiled into [0] in js *)
291291

292-
(** [math "abs"] --> Math["abs"] *)
293-
(* val math :
294-
?comment:string ->
295-
string ->
296-
t list ->
297-
t *)
298-
299-
300-
301292
val undefined : t
302-
val is_caml_block : ?comment:string -> t -> t
303-
304293

305294
val tag : ?comment:string -> J.expression -> t
306295

‎jscomp/core/lam_dispatch_primitive.ml

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -708,14 +708,6 @@ let translate loc (prim_name : string)
708708
call Js_runtime_modules.format
709709
(* "caml_alloc_dummy"; *)
710710
(* TODO: "caml_alloc_dummy_float"; *)
711-
| "caml_obj_is_block"
712-
->
713-
begin match args with
714-
| [e] -> E.is_caml_block e
715-
| _ -> assert false
716-
end
717-
718-
719711
| "caml_obj_dup"
720712
| "caml_update_dummy"
721713
| "caml_obj_truncate"

‎jscomp/runtime/caml_sys.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626

2727

2828

29-
external getEnv : 'a -> string -> string option = "" [@@bs.get_index] [@@bs.return undefined_to_opt]
29+
external getEnv : 'a -> string -> string option = "" [@@bs.get_index]
3030
let caml_sys_getenv s =
3131
match [%external process ] with
3232
| None -> raise Not_found

‎jscomp/stdlib-402/obj.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,9 @@ type t
1818
external repr : 'a -> t = "%identity"
1919
external obj : t -> 'a = "%identity"
2020
external magic : 'a -> 'b = "%identity"
21-
external is_block : t -> bool = "caml_obj_is_block"
21+
2222
external is_int : t -> bool = "%obj_is_int"
23+
let is_block a = not (is_int a)
2324
external tag : t -> int = "caml_obj_tag"
2425
external set_tag : t -> int -> unit = "caml_obj_set_tag"
2526
external size : t -> int = "%obj_size"

‎jscomp/stdlib-402/obj.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ type t
2121
external repr : 'a -> t = "%identity"
2222
external obj : t -> 'a = "%identity"
2323
external magic : 'a -> 'b = "%identity"
24-
external is_block : t -> bool = "caml_obj_is_block"
24+
val is_block : t -> bool
2525
external is_int : t -> bool = "%obj_is_int"
2626
external tag : t -> int = "caml_obj_tag"
2727
external set_tag : t -> int -> unit = "caml_obj_set_tag"

‎jscomp/stdlib-406/format.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1340,8 +1340,8 @@ let kfprintf k ppf (Format (fmt, _)) =
13401340
and ikfprintf k ppf (Format (fmt, _)) =
13411341
make_iprintf k ppf fmt
13421342

1343-
let fprintf ppf = kfprintf ignore ppf
1344-
let ifprintf ppf = ikfprintf ignore ppf
1343+
let fprintf ppf fmt = kfprintf ignore ppf fmt
1344+
let ifprintf ppf fmt = ikfprintf ignore ppf fmt
13451345
let printf fmt = fprintf std_formatter fmt
13461346
let eprintf fmt = fprintf err_formatter fmt
13471347

‎jscomp/stdlib-406/sys.ml

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -60,10 +60,18 @@ external remove: string -> unit = "caml_sys_remove"
6060
external rename : string -> string -> unit = "caml_sys_rename"
6161
external getenv: string -> string = "caml_sys_getenv"
6262

63+
#if BS then
64+
external getEnv : 'a -> string -> string option = "" [@@bs.get_index]
65+
let getenv_opt s =
66+
match [%external process ] with
67+
| None -> None
68+
| Some x -> getEnv x##env s
69+
#else
6370
let getenv_opt s =
6471
(* TODO: expose a non-raising primitive directly. *)
6572
try Some (getenv s)
6673
with Not_found -> None
74+
#end
6775

6876
external command: string -> int = "caml_sys_system_command"
6977
external time: unit -> (float [@unboxed]) =

‎jscomp/test/.depend

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -223,6 +223,7 @@ for_side_effect_test.cmj : mt.cmj
223223
format_regression.cmj :
224224
format_test.cmj : mt.cmj
225225
fs_test.cmj : ../others/node.cmj mt.cmj ../runtime/js.cmj
226+
fun_pattern_match.cmj : ../runtime/js.cmj
226227
functor_app_test.cmj : mt.cmj functor_inst.cmj functor_def.cmj
227228
functor_def.cmj : ../runtime/js.cmj
228229
functor_ffi.cmj : ../runtime/js.cmj

‎jscomp/test/Makefile

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -266,6 +266,7 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_
266266
large_record_duplication_test\
267267
unboxed_attribute_test\
268268
406_primitive_test\
269+
fun_pattern_match\
269270
ocaml_typedtree_test
270271
# ocaml_typedtree_test is not cross version due to camlinternalFormat
271272
# bs_uncurry_test

‎jscomp/test/fun_pattern_match.js

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
'use strict';
2+
3+
var Curry = require("../../lib/js/curry.js");
4+
var Caml_primitive = require("../../lib/js/caml_primitive.js");
5+
var Caml_builtin_exceptions = require("../../lib/js/caml_builtin_exceptions.js");
6+
7+
function f(param, v) {
8+
return ((((param[/* x0 */0] + param[/* x1 */1] | 0) + param[/* x2 */2] | 0) + param[/* x3 */3] | 0) + param[/* x4 */4] | 0) + v | 0;
9+
}
10+
11+
function f2(param, param$1) {
12+
return (((((param[/* x0 */0] + param[/* x1 */1] | 0) + param[/* x2 */2] | 0) + param[/* x3 */3] | 0) + param[/* x4 */4] | 0) + param$1[/* a */0] | 0) + param$1[/* b */1] | 0;
13+
}
14+
15+
function f3(param, param$1) {
16+
var lhs = param[/* rank */0];
17+
var rhs = param$1[/* rank */0];
18+
if (typeof lhs === "number") {
19+
throw [
20+
Caml_builtin_exceptions.assert_failure,
21+
/* tuple */[
22+
"fun_pattern_match.ml",
23+
43,
24+
9
25+
]
26+
];
27+
} else if (typeof rhs === "number") {
28+
throw [
29+
Caml_builtin_exceptions.assert_failure,
30+
/* tuple */[
31+
"fun_pattern_match.ml",
32+
43,
33+
9
34+
]
35+
];
36+
} else {
37+
return Caml_primitive.caml_int_compare(lhs[0], rhs[0]);
38+
}
39+
}
40+
41+
function f4(param, param$1) {
42+
var lhs = param[/* rank */0];
43+
var rhs = param$1[/* rank */0];
44+
if (typeof lhs === "number") {
45+
throw [
46+
Caml_builtin_exceptions.assert_failure,
47+
/* tuple */[
48+
"fun_pattern_match.ml",
49+
51,
50+
9
51+
]
52+
];
53+
} else if (typeof rhs === "number") {
54+
throw [
55+
Caml_builtin_exceptions.assert_failure,
56+
/* tuple */[
57+
"fun_pattern_match.ml",
58+
51,
59+
9
60+
]
61+
];
62+
} else {
63+
return Caml_primitive.caml_int_compare(lhs[0], rhs[0]);
64+
}
65+
}
66+
67+
var x = /* `A */[
68+
65,
69+
r
70+
];
71+
72+
function r(param) {
73+
return x;
74+
}
75+
76+
var match = r(/* () */0);
77+
78+
var v = Curry._1(match[1], /* () */0);
79+
80+
console.log(v);
81+
82+
exports.f = f;
83+
exports.f2 = f2;
84+
exports.f3 = f3;
85+
exports.f4 = f4;
86+
exports.r = r;
87+
exports.v = v;
88+
/* match Not a pure module */

‎jscomp/test/fun_pattern_match.ml

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
2+
3+
4+
type u = {x0 : int ; x1 : int ; x2 : int; x3 : int ; x4: int}
5+
6+
7+
let f {x0;x1;x2;x3;x4} v =
8+
x0 + x1 + x2 + x3 + x4 + v
9+
10+
11+
type b = {a : int; b: int }
12+
let f2 {x0;x1;x2;x3;x4} {a; b}=
13+
x0 + x1 + x2 + x3 + x4 + a + b
14+
15+
type binary_op =
16+
| PLUS
17+
| MINUS
18+
19+
type rank =
20+
| Uninitialized
21+
| Visited
22+
| Ranked of int
23+
24+
25+
type binary_op_ticker = {
26+
op : binary_op;
27+
rhs: ticker;
28+
lhs: ticker;
29+
}
30+
31+
and ticker_type =
32+
| Market
33+
| Binary_op of binary_op_ticker
34+
35+
and ticker = {
36+
mutable rank: rank;
37+
}
38+
39+
let f3 =
40+
(fun {rank = lhs; _} {rank = rhs} ->
41+
match lhs, rhs with
42+
| Ranked x , Ranked y -> Pervasives.compare x y
43+
| _ -> assert false
44+
)
45+
46+
47+
let f4
48+
{rank = lhs; _} {rank = rhs} =
49+
match lhs, rhs with
50+
| Ranked x , Ranked y -> Pervasives.compare x y
51+
| _ -> assert false
52+
53+
(* #995 test case *)
54+
let rec r = (let rec x = `A r and y = fun () -> x in y);;
55+
56+
let v = let (`A x) = r () in x ();;
57+
58+
Js.log v
59+

0 commit comments

Comments
 (0)