Merge pull request #2436 from BuckleScript/abstract_signature

deriving support in abstract language

jscomp/bsb/bsb_templates.ml

@@ -561,7 +561,9 @@ let root = OCamlRes.Res.([
       \  an issue! */\n\
        {\n\
       \  \"name\": \"react-template\",\n\
-      \  \"reason\": {\"react-jsx\" : 2},\n\
+      \  \"reason\": {\n\
+      \    \"react-jsx\": 2\n\
+      \  },\n\
       \  \"sources\": [\n\
       \    \"src\"\n\
       \  ],\n\

jscomp/others/.depend

@@ -17,8 +17,8 @@ js_console.cmj :
 js_result.cmj : js_result.cmi
 js_mapperRt.cmj : js_mapperRt.cmi
 bs_Array.cmj : js_math.cmj bs_Array.cmi
-bs_internalAVLset.cmj : bs_Array.cmj bs.cmj
-bs_internalAVLtree.cmj :
+bs_internalAVLset.cmj : bs_Array.cmj bs.cmj bs_internalAVLset.cmi
+bs_internalAVLtree.cmj : bs_internalAVLtree.cmi
 bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_SetIntM.cmi
 bs_Hash.cmj : bs_Hash.cmi
 bs_Queue.cmj : bs_Array.cmj bs_Queue.cmi
@@ -83,6 +83,8 @@ js_option.cmi :
 js_result.cmi :
 js_mapperRt.cmi :
 bs_Array.cmi :
+bs_internalAVLset.cmi :
+bs_internalAVLtree.cmi :
 bs_SetIntM.cmi :
 bs_Hash.cmi :
 bs_Queue.cmi :

jscomp/others/bs_Map.ml

@@ -14,7 +14,7 @@
 
 module N = Bs_internalAVLtree
 module B = Bs_Bag 
-type ('key, + 'a, 'id) t0 = ('key,'a,'id) N.t0 
+type ('key, + 'a, 'id) t0 = ('key,'a) N.t0 
 
 type ('k,'v,'id) t = 
   (('k,'id) Bs_Cmp.t,

jscomp/others/bs_MapInt.ml

@@ -4,9 +4,9 @@ type key = int
 # 9
 module N = Bs_internalAVLtree
 
-type ('key, 'a, 'id) t0 = ('key,'a,'id) N.t0 
+type ('key, 'a, 'id) t0 = ('key,'a) N.t0 
 
-type + 'a t = (key,'a, unit) N.t0 
+type + 'a t = (key,'a) N.t0 
 
 
 

jscomp/others/bs_MapString.ml

@@ -4,9 +4,9 @@ type key = string
 # 9
 module N = Bs_internalAVLtree
 
-type ('key, 'a, 'id) t0 = ('key,'a,'id) N.t0 
+type ('key, 'a, 'id) t0 = ('key,'a) N.t0 
 
-type + 'a t = (key,'a, unit) N.t0 
+type + 'a t = (key,'a) N.t0 
 
 
 

jscomp/others/bs_internalAVLset.ml

@@ -13,7 +13,7 @@ external toOpt : 'a Js.null -> 'a option = "#null_to_opt"
 external return : 'a -> 'a Js.null = "%identity"
 external empty : 'a Js.null = "#null"
 external unsafeCoerce : 'a Js.null -> 'a = "%identity"
-type ('elt, 'id) t0 =  'elt node Js.null
+type 'elt t0 =  'elt node Js.null
 (* Sets are represented by balanced binary trees (the heights of the
    children differ by at most 2 *)
 

jscomp/others/bs_internalAVLset.mli

@@ -0,0 +1,50 @@
+type 'elt t0 = 'elt node Js.null
+and 'elt node  = private {
+  mutable left : 'elt t0;
+   key : 'elt ; 
+  mutable right : 'elt t0;
+  h : int 
+} [@@bs.deriving abstract]
+(* TODO: node is used in [subset] *)
+external toOpt : 'a Js.null -> 'a option = "#null_to_opt"
+external return : 'a -> 'a Js.null = "%identity"
+external empty : 'a Js.null = "#null"
+
+
+
+val copy : 'a t0 -> 'a t0
+val create : 'a t0 -> 'a -> 'a t0 -> 'a t0
+val bal : 'a t0 -> 'a -> 'a t0 -> 'a t0
+val singleton0 : 'a -> 'a t0
+
+val min0Aux : 'a node -> 'a
+val minOpt0 : 'a t0 -> 'a option
+val minNull0 : 'a t0 -> 'a Js.null
+val max0Aux : 'a node -> 'a
+val maxOpt0 : 'a t0 -> 'a option
+val maxNull0 : 'a t0 -> 'a Js.null
+
+val removeMinAuxWithRef : 'a node -> 'a ref -> 'a t0
+
+val empty0 : 'a t0
+val isEmpty0 : 'a t0 -> bool
+val stackAllLeft : 'a t0 -> 'a node list -> 'a node list
+val iter0 : 'a t0 -> ('a -> 'b [@bs]) -> unit
+val fold0 : 'a t0 -> 'b -> ('b -> 'a -> 'b [@bs]) -> 'b
+val forAll0 : 'a t0 -> ('a -> bool [@bs]) -> bool
+val exists0 : 'a t0 -> ('a -> bool [@bs]) -> bool
+val join : 'a t0 -> 'a -> 'a t0 -> 'a t0
+val concat : 'a t0 -> 'a t0 -> 'a t0
+val filter0 : 'a t0 -> ('a -> bool [@bs]) -> 'a t0
+val partition0 :
+  'a t0 -> ('a -> bool [@bs]) -> 'a t0 * 'a t0
+val lengthAux : 'a node -> int
+val length0 : 'a t0 -> int
+
+val toList0 : 'a t0 -> 'a list
+val checkInvariant : _ t0 -> bool
+val toArray0 : 'a t0 -> 'a array
+val balMutate : 'a node -> 'a node
+val removeMinAuxMutateWithRoot : 'a node -> 'a node -> 'a t0
+val ofSortedArrayAux : 'a array -> int -> int -> 'a t0
+val ofSortedArrayUnsafe0 : 'a array -> 'a t0

jscomp/others/bs_internalAVLtree.ml

@@ -10,7 +10,7 @@
 (*  the special exception on linking described in file ../LICENSE.     *)
 (*                                                                     *)
 (***********************************************************************)
-(** Adapted by authors of BuckleScript without using functors          *)
+(** Almost rewritten  by authors of BuckleScript                       *)
 
 
 type ('k, + 'v) node  = {
@@ -25,7 +25,7 @@ external toOpt : 'a Js.null -> 'a option = "#null_to_opt"
 external return : 'a -> 'a Js.null = "%identity"
 external empty : 'a Js.null = "#null" 
 
-type ('key, 'a, 'id) t0 = ('key, 'a) node Js.null
+type ('key, 'a) t0 = ('key, 'a) node Js.null
 
 
 let height (n : _ t0) =

jscomp/others/bs_internalAVLtree.mli

@@ -0,0 +1,60 @@
+
+
+type ('key, 'a) t0 = ('key, 'a) node Js.null
+and ('k, + 'v) node  = {
+  left : ('k,'v) t0;
+  key : 'k; 
+  value : 'v; 
+  right : ('k,'v) t0;
+  h : int 
+} [@@bs.deriving abstract]
+
+external toOpt : 'a Js.null -> 'a option = "#null_to_opt"
+external return : 'a -> 'a Js.null = "%identity"
+external empty : 'a Js.null = "#null"
+
+
+val height : _ t0 -> int
+
+val create :
+  ('a,'b) t0 -> 'a -> 'b -> ('a,'b) t0 -> ('a,'b) t0
+val singleton0 : 'a -> 'b -> ('a,'b) t0
+
+val bal :
+  ('a,'b) t0 -> 'a -> 'b -> ('a,'b) t0 -> ('a,'b) t0
+
+val empty0 : _ t0
+
+val isEmpty0 : _ t0 -> bool
+
+val minBinding0 : ('a,'b) t0 -> ('a * 'b) option
+
+val maxBinding0 : ('a,'b) t0 -> ('a * 'b) option
+val removeMinAux : ('a, 'b) node -> ('a,'b) t0
+val merge : ('a,'b) t0 -> ('a,'b) t0 -> ('a,'b) t0
+val iter0 : ('a -> 'b -> 'c [@bs]) -> ('a,'b) t0 -> unit
+val map0 : ('a -> 'b [@bs]) -> ('c, 'a) t0 -> ('c, 'b) t0
+val mapi0 :
+  ('a -> 'b -> 'c [@bs]) -> ('a,'b) t0 -> ('a, 'c) t0
+val fold0 : ('a -> 'b -> 'c -> 'c [@bs]) -> ('a,'b) t0 -> 'c -> 'c
+val forAll0 : ('a -> 'b -> bool [@bs]) -> ('a,'b) t0 -> bool
+val exists0 : ('a -> 'b -> bool [@bs]) -> ('a,'b) t0 -> bool
+
+val join : ('a,'b) t0 -> 'a -> 'b -> ('a,'b) t0 -> ('a, 'b) t0
+
+val concat : ('a,'b) t0 -> ('a,'b) t0 -> ('a,'b) t0
+
+val concat_or_join :
+  ('a,'b) t0 -> 'a -> 'b option -> ('a,'b) t0 -> ('a, 'b) t0
+val filter0 : ('a -> 'b -> bool [@bs]) -> ('a,'b) t0 -> ('a,'b) t0
+val partition0 :
+  ('a -> 'b -> bool [@bs]) ->
+  ('a,'b) t0 -> ('a,'b) t0 * ('a,'b) t0
+
+val stackAllLeft :
+  ('a,'b) t0 -> ('a, 'b) node list -> ('a, 'b) node list
+val lengthAux : ('a, 'b) node -> int
+val length0 : ('a,'b) t0 -> int
+val bindings_aux : ('a * 'b) list -> ('a,'b) t0 -> ('a * 'b) list
+val bindings0 : ('a,'b) t0 -> ('a * 'b) list
+val checkInvariant : ('a,'b) t0 -> bool

jscomp/others/bs_internalSet.ml

@@ -2,7 +2,7 @@
 module N = Bs_internalAVLset
 module B =  Bs_Bag
 module A = Bs_Array
-type ('elt, 'id) t0 = ('elt, 'id) N.t0 
+type ('elt, 'id) t0 = 'elt N.t0 
 
 
 (* here we relies on reference transparence
@@ -11,7 +11,7 @@ type ('elt, 'id) t0 = ('elt, 'id) N.t0
 *)  
 let rec add0 ~cmp (t : _ t0) x  : _ t0 =
   match N.toOpt t with 
-    None -> N.(return @@ node ~left:empty ~right:empty ~key:x  ~h:1)
+    None -> N.singleton0 x 
   | Some nt ->
     let k = N.key nt in 
     let c = (Bs_Cmp.getCmp cmp) x k [@bs] in
@@ -215,10 +215,10 @@ let rec subset0 ~cmp (s1 : _ t0) (s2 : _ t0) =
     if c = 0 then
       subset0 ~cmp l1 l2 && subset0 ~cmp r1 r2
     else if c < 0 then
-      subset0 ~cmp N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && 
+      subset0 ~cmp N.(create l1 v1 empty) l2 && 
       subset0 ~cmp r1 s2
     else
-      subset0 ~cmp N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && 
+      subset0 ~cmp N.(create empty v1 r1 ) r2 && 
       subset0 ~cmp l1 s2
 (* and subsetAuxLeft s1 v s2 ~cmp = 
    mem0 ~cmp s2 v &&
@@ -247,7 +247,7 @@ let rec findNull0 ~cmp (n : _ t0) x =
 
 let rec addMutate ~cmp (t : _ t0) x =   
   match N.toOpt t with 
-  | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1)
+  | None -> N.singleton0 x 
   | Some nt -> 
     let k = N.key nt in 
     let  c = (Bs_Cmp.getCmp cmp) x k [@bs] in  
@@ -324,7 +324,7 @@ let rec addMutateCheckAux  (t : _ t0) x added ~cmp  =
   match N.toOpt t with 
   | None -> 
     added := true;
-    N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1)
+    N.singleton0 x 
   | Some nt -> 
     let k = N.key nt in 
     let  c = (Bs_Cmp.getCmp cmp) x k [@bs] in  

jscomp/others/bs_internalSetInt.ml

@@ -5,13 +5,13 @@ type elt = int
 # 10
 module N = Bs_internalAVLset
 module A = Bs_Array 
-type ('elt, 'id) t0 = ('elt, 'id) N.t0 
+type ('elt, 'id) t0 = 'elt N.t0 
 
 type t = (elt, unit) t0
 
 let rec add  (t : t) (x : elt) : t =
   match N.toOpt t with 
-    None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1)
+    None -> N.singleton0 x 
   | Some nt  ->
     let v = N.key nt in  
     if x = v then t else
@@ -192,9 +192,9 @@ let rec subset (s1 : t) (s2 : t) =
     if v1 = v2 then
       subset l1 l2 && subset r1 r2
     else if v1 < v2 then
-      subset N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && subset r1 s2
+      subset N.(create l1 v1 empty ) l2 && subset r1 s2
     else
-      subset N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && subset l1 s2
+      subset N.(create empty v1 r1 ) r2 && subset l1 s2
 
 
 let rec findOpt  (n :t) (x : elt) = 
@@ -219,7 +219,7 @@ let rec findNull (n :t) (x : elt)   =
 
 let rec addMutate  (t : _ t0) (x : elt)=   
   match N.toOpt t with 
-  | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1)
+  | None -> N.singleton0 x
   | Some nt -> 
     let k = N.key nt in 
     if x = k then t 

jscomp/others/bs_internalSetString.ml

@@ -5,13 +5,13 @@ type elt = string
 # 10
 module N = Bs_internalAVLset
 module A = Bs_Array 
-type ('elt, 'id) t0 = ('elt, 'id) N.t0 
+type ('elt, 'id) t0 = 'elt N.t0 
 
 type t = (elt, unit) t0
 
 let rec add  (t : t) (x : elt) : t =
   match N.toOpt t with 
-    None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1)
+    None -> N.singleton0 x 
   | Some nt  ->
     let v = N.key nt in  
     if x = v then t else
@@ -192,9 +192,9 @@ let rec subset (s1 : t) (s2 : t) =
     if v1 = v2 then
       subset l1 l2 && subset r1 r2
     else if v1 < v2 then
-      subset N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && subset r1 s2
+      subset N.(create l1 v1 empty ) l2 && subset r1 s2
     else
-      subset N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && subset l1 s2
+      subset N.(create empty v1 r1 ) r2 && subset l1 s2
 
 
 let rec findOpt  (n :t) (x : elt) = 
@@ -219,7 +219,7 @@ let rec findNull (n :t) (x : elt)   =
 
 let rec addMutate  (t : _ t0) (x : elt)=   
   match N.toOpt t with 
-  | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1)
+  | None -> N.singleton0 x
   | Some nt -> 
     let k = N.key nt in 
     if x = k then t 

jscomp/others/internal_set.cppo.ml

@@ -9,13 +9,13 @@ type elt = int
 
 module N = Bs_internalAVLset
 module A = Bs_Array 
-type ('elt, 'id) t0 = ('elt, 'id) N.t0 
+type ('elt, 'id) t0 = 'elt N.t0 
 
 type t = (elt, unit) t0
 
 let rec add  (t : t) (x : elt) : t =
   match N.toOpt t with 
-    None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1)
+    None -> N.singleton0 x 
   | Some nt  ->
     let v = N.key nt in  
     if x = v then t else
@@ -196,9 +196,9 @@ let rec subset (s1 : t) (s2 : t) =
     if v1 = v2 then
       subset l1 l2 && subset r1 r2
     else if v1 < v2 then
-      subset N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && subset r1 s2
+      subset N.(create l1 v1 empty ) l2 && subset r1 s2
     else
-      subset N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && subset l1 s2
+      subset N.(create empty v1 r1 ) r2 && subset l1 s2
 
 
 let rec findOpt  (n :t) (x : elt) = 
@@ -223,7 +223,7 @@ let rec findNull (n :t) (x : elt)   =
 
 let rec addMutate  (t : _ t0) (x : elt)=   
   match N.toOpt t with 
-  | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1)
+  | None -> N.singleton0 x
   | Some nt -> 
     let k = N.key nt in 
     if x = k then t 

jscomp/others/map.cppo.ml

@@ -1,16 +1,16 @@
 #ifdef TYPE_STRING
 type key = string
-           #elif defined TYPE_INT
+#elif defined TYPE_INT
 type key = int
-           #else 
+#else 
   [%error "unknown type"]
-  #endif 
+#endif 
 
 module N = Bs_internalAVLtree
 
-type ('key, 'a, 'id) t0 = ('key,'a,'id) N.t0 
+type ('key, 'a, 'id) t0 = ('key,'a) N.t0 
 
-type + 'a t = (key,'a, unit) N.t0 
+type + 'a t = (key,'a) N.t0 
 
 
 

jscomp/runtime/.depend

@@ -34,7 +34,7 @@ js_exn.cmj : caml_exceptions.cmj js_exn.cmi
 bs_obj.cmj : js.cmj
 js_nativeint.cmj :
 js_int.cmj :
-js_null.cmj : js.cmj js_null.cmi
+js_null.cmj : js_exn.cmj js.cmj js_null.cmi
 js_undefined.cmj : js.cmj js_undefined.cmi
 caml_array.cmi :
 caml_string.cmi :