Skip to content

Make playground work with curry/uncurry/extensible record again! #394

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
May 22, 2016
Merged

Make playground work with curry/uncurry/extensible record again! #394

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
90 changes: 67 additions & 23 deletions jscomp/ppx_entry.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,9 +66,15 @@ let predef_val_unit =
let prim = "js_pure_expr"
let prim_stmt = "js_pure_stmt"
let prim_debugger = "js_debugger"
let curry_type_id = Longident.Ldot (Lident "Js", "fn")

(* TODO should be renamed in to {!Js.fn} *)
let curry_type_id = Longident.Ldot (Lident "Pervasives", "uncurry")
let ignore_id = Longident.Ldot (Lident "Pervasives", "ignore")
let js_unsafe_downgrade_id = Longident.Ldot (Ldot (Lident "Js", "Unsafe"), "!")

(* TODO should be moved into {!Js.t} Later *)
let js_obj_type_id = Longident.Ldot (Lident "Pervasives", "js_obj")

(* note we first declare its type is [unit],
then [ignore] it, [ignore] is necessary since
the js value maybe not be of type [unit] and
Expand Down Expand Up @@ -161,7 +167,7 @@ let handle_record_as_js_object

let result_type =
{Parsetree.ptyp_desc =
Ptyp_constr ({txt = Ldot(Lident "Js", "t"); loc},
Ptyp_constr ({txt = js_obj_type_id ; loc},
[{ Parsetree.ptyp_desc =
Ptyp_object (List.map2 (fun x y -> x ,[], y) labels tyvars, Closed);
ptyp_attributes = [];
Expand Down Expand Up @@ -358,16 +364,31 @@ let handle_typ
uncurry_fn_type loc ty ptyp_attributes args body
else {ty with ptyp_desc = Ptyp_arrow("", args, body)}
end
| {ptyp_desc = Ptyp_object ( methods, closed_flag) } ->
| {
ptyp_desc = Ptyp_object ( methods, closed_flag) ;
ptyp_attributes ;
ptyp_loc = loc
} ->
let methods = List.map (fun (label, ptyp_attrs, core_type ) ->
match find_uncurry_attrs_and_remove ptyp_attrs with
| None, _ -> label, ptyp_attrs , self.typ self core_type
| Some v, ptyp_attrs ->
label , ptyp_attrs, self.typ self
{ core_type with ptyp_attributes = v :: core_type.ptyp_attributes}
) methods in
{ty with ptyp_desc = Ptyp_object (methods, closed_flag)}

begin match Ext_list.exclude_with_fact (function
| {Location.txt = "bs.obj" ; _}, _ -> true
| _ -> false ) ptyp_attributes with
| None, _ ->
{ty with ptyp_desc = Ptyp_object (methods, closed_flag)}
| Some _, ptyp_attributes ->
{ptyp_desc =
Ptyp_constr ({ txt = js_obj_type_id ; loc},
[{ ty with ptyp_desc = Ptyp_object(methods, closed_flag);
ptyp_attributes }]);
ptyp_attributes = [];
ptyp_loc = loc }
end
| _ -> super.typ self ty

let handle_debugger loc payload =
Expand Down Expand Up @@ -455,16 +476,29 @@ let handle_obj_property loc obj name e
(mapper : Ast_mapper.mapper) : Parsetree.expression =
(* ./dumpast -e ' (Js.Unsafe.(!) obj) # property ' *)
let obj = mapper.expr mapper obj in

let down = create_local_external loc
~pval_prim:"js_unsafe_downgrade"
~pval_type:({ptyp_desc =
Ptyp_arrow ("",
{ptyp_desc =
Ptyp_constr ({txt = js_obj_type_id ; loc},
[{ptyp_desc = Ptyp_var "a" ;
ptyp_loc = loc;
ptyp_attributes = [] }]);
ptyp_attributes = [];
ptyp_loc = loc},
{ptyp_desc = Ptyp_var "a";
ptyp_loc = loc;
ptyp_attributes = []});
ptyp_loc = loc;
ptyp_attributes = []})
~pval_attributes:[]
"Tmp"
"cast" ["", obj] in
{ e with pexp_desc =
Pexp_send
({pexp_desc =
Pexp_apply
({pexp_desc =
Pexp_ident {txt = js_unsafe_downgrade_id;
loc};
pexp_loc = loc;
pexp_attributes = []},
[("", obj)]);
({pexp_desc = down ;
pexp_loc = loc;
pexp_attributes = []},
name);
Expand Down Expand Up @@ -506,20 +540,30 @@ let handle_obj_method loc (obj : Parsetree.expression)
let len = List.length args in
let obj = mapper.expr mapper obj in
let args = List.map (mapper.expr mapper ) args in

let down = create_local_external loc
~pval_prim:"js_unsafe_downgrade"
~pval_type:({ptyp_desc =
Ptyp_arrow ("",
{ptyp_desc =
Ptyp_constr ({txt = js_obj_type_id ; loc},
[{ptyp_desc = Ptyp_var "a" ;
ptyp_loc = loc;
ptyp_attributes = [] }]);
ptyp_attributes = [];
ptyp_loc = loc},
{ptyp_desc = Ptyp_var "a";
ptyp_loc = loc;
ptyp_attributes = []});
ptyp_loc = loc;
ptyp_attributes = []})
~pval_attributes:[]
"Tmp"
"cast" ["", obj] in
{e with pexp_desc = gen_fn_run loc len
(("",
{pexp_desc =
Pexp_send
({pexp_desc =
Pexp_apply
({pexp_desc =
Pexp_ident {
txt = js_unsafe_downgrade_id;
loc };
pexp_loc = loc ;
pexp_attributes = []},
[("", obj)]);
({pexp_desc = down ;
pexp_loc = loc ;
pexp_attributes = []},
name);
Expand Down
4 changes: 2 additions & 2 deletions jscomp/runtime/js.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,8 +24,8 @@



type +'a t (** Js object type *)
type +'a fn (** Js uncurried function *)
type +'a t = 'a Pervasives.js_obj(** Js object type *)
type +'a fn = 'a Pervasives.uncurry (** Js uncurried function *)

module Unsafe = struct
external (!) : 'a t -> 'a = "js_unsafe_downgrade"
Expand Down
2 changes: 1 addition & 1 deletion lib/js/test/demo.js
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,9 @@
'use strict';

var Runtime = require("@runtime");
var BUI = require("@blp/ui");
var UI = require("@ui");
var Curry = require("../curry");
var BUI = require("@blp/ui");

var data = /* array */[
/* record */[
Expand Down
2 changes: 1 addition & 1 deletion lib/js/test/test_react.js
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
// GENERATED CODE BY BUCKLESCRIPT VERSION 0.4.2 , PLEASE EDIT WITH CARE
'use strict';

var ReactDom = require("react-dom");
var React = require("react");
var ReactDom = require("react-dom");

console.log("hey");

Expand Down