diff --git a/jscomp/others/build.ninja b/jscomp/others/build.ninja index 9474bed2b5..64c00c986d 100644 --- a/jscomp/others/build.ninja +++ b/jscomp/others/build.ninja @@ -106,7 +106,8 @@ build others/js_null_undefined.cmi : cc others/js_null_undefined.mli | runtime build others/js_obj.cmi others/js_obj.cmj : cc others/js_obj.ml | runtime build others/js_option.cmj : cc others/js_option.ml | others/js_exn.cmj others/js_option.cmi runtime build others/js_option.cmi : cc others/js_option.mli | runtime -build others/js_promise.cmi others/js_promise.cmj : cc others/js_promise.ml | runtime +build others/js_promise.cmi others/js_promise.cmj : cc others/js_promise.ml | others/js_promise2.cmj runtime +build others/js_promise2.cmi others/js_promise2.cmj : cc others/js_promise2.ml | runtime build others/js_re.cmi : cc others/js_re.mli | others/js_re2.cmi runtime build others/js_re2.cmi : cc others/js_re2.mli | runtime build others/js_result.cmj : cc others/js_result.ml | others/js_result.cmi runtime @@ -121,7 +122,7 @@ build others/js_undefined.cmj : cc others/js_undefined.ml | others/js_exn.cmj ot build others/js_undefined.cmi : cc others/js_undefined.mli | runtime build others/js_vector.cmj : cc others/js_vector.ml | others/js_vector.cmi runtime build others/js_vector.cmi : cc others/js_vector.mli | runtime -build js_pkg : phony others/js_array.cmi others/js_array.cmj others/js_array2.cmi others/js_array2.cmj others/js_cast.cmi others/js_cast.cmj others/js_console.cmi others/js_console.cmj others/js_date.cmi others/js_date.cmj others/js_dict.cmi others/js_dict.cmj others/js_exn.cmi others/js_exn.cmj others/js_float.cmi others/js_float.cmj others/js_global.cmi others/js_global.cmj others/js_int.cmi others/js_int.cmj others/js_json.cmi others/js_json.cmj others/js_list.cmi others/js_list.cmj others/js_mapperRt.cmi others/js_mapperRt.cmj others/js_math.cmi others/js_math.cmj others/js_null.cmi others/js_null.cmj others/js_null_undefined.cmi others/js_null_undefined.cmj others/js_obj.cmi others/js_obj.cmj others/js_option.cmi others/js_option.cmj others/js_promise.cmi others/js_promise.cmj others/js_re.cmi others/js_re2.cmi others/js_result.cmi others/js_result.cmj others/js_string.cmi others/js_string.cmj others/js_string2.cmi others/js_string2.cmj others/js_typed_array.cmi others/js_typed_array.cmj others/js_typed_array2.cmi others/js_typed_array2.cmj others/js_types.cmi others/js_types.cmj others/js_undefined.cmi others/js_undefined.cmj others/js_vector.cmi others/js_vector.cmj +build js_pkg : phony others/js_array.cmi others/js_array.cmj others/js_array2.cmi others/js_array2.cmj others/js_cast.cmi others/js_cast.cmj others/js_console.cmi others/js_console.cmj others/js_date.cmi others/js_date.cmj others/js_dict.cmi others/js_dict.cmj others/js_exn.cmi others/js_exn.cmj others/js_float.cmi others/js_float.cmj others/js_global.cmi others/js_global.cmj others/js_int.cmi others/js_int.cmj others/js_json.cmi others/js_json.cmj others/js_list.cmi others/js_list.cmj others/js_mapperRt.cmi others/js_mapperRt.cmj others/js_math.cmi others/js_math.cmj others/js_null.cmi others/js_null.cmj others/js_null_undefined.cmi others/js_null_undefined.cmj others/js_obj.cmi others/js_obj.cmj others/js_option.cmi others/js_option.cmj others/js_promise.cmi others/js_promise.cmj others/js_promise2.cmi others/js_promise2.cmj others/js_re.cmi others/js_re2.cmi others/js_result.cmi others/js_result.cmj others/js_string.cmi others/js_string.cmj others/js_string2.cmi others/js_string2.cmj others/js_typed_array.cmi others/js_typed_array.cmj others/js_typed_array2.cmi others/js_typed_array2.cmj others/js_types.cmi others/js_types.cmj others/js_undefined.cmi others/js_undefined.cmj others/js_vector.cmi others/js_vector.cmj build others/belt_Array.cmj : cc others/belt_Array.ml | others/belt.cmi others/belt_Array.cmi others/js_math.cmj js_pkg runtime build others/belt_Array.cmi : cc others/belt_Array.mli | runtime build others/belt_Debug.cmi others/belt_Debug.cmj : cc others/belt_Debug.ml | runtime diff --git a/jscomp/others/js_promise.ml b/jscomp/others/js_promise.ml index 8c4c33de21..a17bea37dc 100644 --- a/jscomp/others/js_promise.ml +++ b/jscomp/others/js_promise.ml @@ -29,8 +29,8 @@ ]} *) -type + 'a t -type error (* abstract error type *) +type + 'a t = 'a Js_promise2.t +type error = Js_promise2.error external make : (resolve:('a -> unit [@bs]) -> @@ -53,17 +53,17 @@ external then_ : ('a -> 'b t [@bs.uncurry]) -> 'b t = "then" [@@bs.send.pipe: 'a external catch : (error -> 'a t [@bs.uncurry]) -> 'a t = "catch" [@@bs.send.pipe: 'a t] (* [ p|> catch handler] - Note in JS the returned promise type is actually runtime dependent, - if promise is rejected, it will pick the [handler] otherwise the original promise, + Note in JS the returned promise type is actually runtime dependent, + if promise is rejected, it will pick the [handler] otherwise the original promise, to make it strict we enforce reject handler https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Promise/catch *) (* -let errorAsExn (x : error) (e : (exn ->'a option))= - if Caml_exceptions.isCamlExceptionOrOpenVariant (Obj.magic x ) then - e (Obj.magic x) +let errorAsExn (x : error) (e : (exn ->'a option))= + if Caml_exceptions.isCamlExceptionOrOpenVariant (Obj.magic x ) then + e (Obj.magic x) else None [%bs.error? ] *) diff --git a/jscomp/others/js_promise2.ml b/jscomp/others/js_promise2.ml new file mode 100644 index 0000000000..cadc81aaa2 --- /dev/null +++ b/jscomp/others/js_promise2.ml @@ -0,0 +1,69 @@ +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +(** Specialized bindings to Promise. Note: For simplicity, + this binding does not track the error type, it treat it as an opaque type + {[ + + ]} +*) + +type + 'a t +type error (* abstract error type *) + + +external make : (resolve:('a -> unit [@bs]) -> + reject:(exn -> unit [@bs]) -> unit [@bs.uncurry]) -> 'a t = "Promise" [@@bs.new] +(* [make (fun resolve reject -> .. )] *) +external resolve : 'a -> 'a t = "resolve" [@@bs.val] [@@bs.scope "Promise"] +external reject : exn -> 'a t = "reject" [@@bs.val] [@@bs.scope "Promise"] +external all : 'a t array -> 'a array t = "all" [@@bs.val] [@@bs.scope "Promise"] +external all2 : 'a0 t * 'a1 t -> ('a0 * 'a1) t = "all" [@@bs.val] [@@bs.scope "Promise"] +external all3 : 'a0 t * 'a1 t * 'a2 t -> ('a0 * 'a1 * 'a2 ) t = "all" [@@bs.val] [@@bs.scope "Promise"] +external all4 : 'a0 t * 'a1 t * 'a2 t * 'a3 t -> ('a0 * 'a1 * 'a2 * 'a3 ) t = "all" [@@bs.val] [@@bs.scope "Promise"] +external all5 : 'a0 t * 'a1 t * 'a2 t * 'a3 t * 'a4 t -> ('a0 * 'a1 * 'a2 * 'a3 * 'a4 ) t = "all" [@@bs.val] [@@bs.scope "Promise"] +external all6 : 'a0 t * 'a1 t * 'a2 t * 'a3 t * 'a4 t * 'a5 t -> ('a0 * 'a1 * 'a2 * 'a3 * 'a4 * 'a5 ) t = "all" [@@bs.val] [@@bs.scope "Promise"] + +external race : 'a t array -> 'a t = "race" [@@bs.val] [@@bs.scope "Promise"] + +external then_ : 'a t -> ('a -> 'b t [@bs.uncurry]) -> 'b t = "then" [@@bs.send] + + + +external catch : 'a t -> (error -> 'a t [@bs.uncurry]) -> 'a t = "catch" [@@bs.send] +(* [ p |. catch handler] + Note in JS the returned promise type is actually runtime dependent, + if promise is rejected, it will pick the [handler] otherwise the original promise, + to make it strict we enforce reject handler + https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Promise/catch + *) + + +(* +let errorAsExn (x : error) (e : (exn ->'a option))= + if Caml_exceptions.isCamlExceptionOrOpenVariant (Obj.magic x ) then + e (Obj.magic x) + else None +[%bs.error? ] +*) diff --git a/jscomp/others/release.ninja b/jscomp/others/release.ninja index f83664c09f..0a2e72e993 100644 --- a/jscomp/others/release.ninja +++ b/jscomp/others/release.ninja @@ -36,7 +36,8 @@ build others/js_null_undefined.cmi : cc others/js_null_undefined.mli | runtime build others/js_obj.cmi others/js_obj.cmj : cc others/js_obj.ml | runtime build others/js_option.cmj : cc others/js_option.ml | others/js_exn.cmj others/js_option.cmi runtime build others/js_option.cmi : cc others/js_option.mli | runtime -build others/js_promise.cmi others/js_promise.cmj : cc others/js_promise.ml | runtime +build others/js_promise.cmi others/js_promise.cmj : cc others/js_promise.ml | others/js_promise2.cmj runtime +build others/js_promise2.cmi others/js_promise2.cmj : cc others/js_promise2.ml | runtime build others/js_re.cmi : cc others/js_re.mli | others/js_re2.cmi runtime build others/js_re2.cmi : cc others/js_re2.mli | runtime build others/js_result.cmj : cc others/js_result.ml | others/js_result.cmi runtime @@ -51,7 +52,7 @@ build others/js_undefined.cmj : cc others/js_undefined.ml | others/js_exn.cmj ot build others/js_undefined.cmi : cc others/js_undefined.mli | runtime build others/js_vector.cmj : cc others/js_vector.ml | others/js_vector.cmi runtime build others/js_vector.cmi : cc others/js_vector.mli | runtime -build js_pkg : phony others/js_array.cmi others/js_array.cmj others/js_array2.cmi others/js_array2.cmj others/js_cast.cmi others/js_cast.cmj others/js_console.cmi others/js_console.cmj others/js_date.cmi others/js_date.cmj others/js_dict.cmi others/js_dict.cmj others/js_exn.cmi others/js_exn.cmj others/js_float.cmi others/js_float.cmj others/js_global.cmi others/js_global.cmj others/js_int.cmi others/js_int.cmj others/js_json.cmi others/js_json.cmj others/js_list.cmi others/js_list.cmj others/js_mapperRt.cmi others/js_mapperRt.cmj others/js_math.cmi others/js_math.cmj others/js_null.cmi others/js_null.cmj others/js_null_undefined.cmi others/js_null_undefined.cmj others/js_obj.cmi others/js_obj.cmj others/js_option.cmi others/js_option.cmj others/js_promise.cmi others/js_promise.cmj others/js_re.cmi others/js_re2.cmi others/js_result.cmi others/js_result.cmj others/js_string.cmi others/js_string.cmj others/js_string2.cmi others/js_string2.cmj others/js_typed_array.cmi others/js_typed_array.cmj others/js_typed_array2.cmi others/js_typed_array2.cmj others/js_types.cmi others/js_types.cmj others/js_undefined.cmi others/js_undefined.cmj others/js_vector.cmi others/js_vector.cmj +build js_pkg : phony others/js_array.cmi others/js_array.cmj others/js_array2.cmi others/js_array2.cmj others/js_cast.cmi others/js_cast.cmj others/js_console.cmi others/js_console.cmj others/js_date.cmi others/js_date.cmj others/js_dict.cmi others/js_dict.cmj others/js_exn.cmi others/js_exn.cmj others/js_float.cmi others/js_float.cmj others/js_global.cmi others/js_global.cmj others/js_int.cmi others/js_int.cmj others/js_json.cmi others/js_json.cmj others/js_list.cmi others/js_list.cmj others/js_mapperRt.cmi others/js_mapperRt.cmj others/js_math.cmi others/js_math.cmj others/js_null.cmi others/js_null.cmj others/js_null_undefined.cmi others/js_null_undefined.cmj others/js_obj.cmi others/js_obj.cmj others/js_option.cmi others/js_option.cmj others/js_promise.cmi others/js_promise.cmj others/js_promise2.cmi others/js_promise2.cmj others/js_re.cmi others/js_re2.cmi others/js_result.cmi others/js_result.cmj others/js_string.cmi others/js_string.cmj others/js_string2.cmi others/js_string2.cmj others/js_typed_array.cmi others/js_typed_array.cmj others/js_typed_array2.cmi others/js_typed_array2.cmj others/js_types.cmi others/js_types.cmj others/js_undefined.cmi others/js_undefined.cmj others/js_vector.cmi others/js_vector.cmj build others/belt_Array.cmj : cc others/belt_Array.ml | others/belt.cmi others/belt_Array.cmi others/js_math.cmj js_pkg runtime build others/belt_Array.cmi : cc others/belt_Array.mli | runtime build others/belt_Debug.cmi others/belt_Debug.cmj : cc others/belt_Debug.ml | runtime diff --git a/jscomp/runtime/js.ml b/jscomp/runtime/js.ml index f57d4cd870..87c61165ba 100644 --- a/jscomp/runtime/js.ml +++ b/jscomp/runtime/js.ml @@ -238,6 +238,9 @@ module Re2 = Js_re2 module Promise = Js_promise (** Provide bindings to JS promise *) +module Promise2 = Js_promise2 +(** Provide bindings to JS promise *) + module Date = Js_date (** Provide bindings for JS Date *) diff --git a/jscomp/test/js.js b/jscomp/test/js.js new file mode 100644 index 0000000000..d608fd87b2 --- /dev/null +++ b/jscomp/test/js.js @@ -0,0 +1,97 @@ +'use strict'; + + +var Internal = /* module */[]; + +var MapperRt = 0; + +var Null = 0; + +var Undefined = 0; + +var Nullable = 0; + +var Null_undefined = 0; + +var Exn = 0; + +var $$Array = 0; + +var Array2 = 0; + +var $$String = 0; + +var String2 = 0; + +var Re = 0; + +var Re2 = 0; + +var $$Promise = 0; + +var Promise2 = 0; + +var $$Date = 0; + +var Dict = 0; + +var Global = 0; + +var Json = 0; + +var $$Math = 0; + +var Obj = 0; + +var Typed_array = 0; + +var TypedArray2 = 0; + +var Types = 0; + +var Float = 0; + +var Int = 0; + +var $$Option = 0; + +var Result = 0; + +var List = 0; + +var Vector = 0; + +var Console = 0; + +exports.MapperRt = MapperRt; +exports.Internal = Internal; +exports.Null = Null; +exports.Undefined = Undefined; +exports.Nullable = Nullable; +exports.Null_undefined = Null_undefined; +exports.Exn = Exn; +exports.$$Array = $$Array; +exports.Array2 = Array2; +exports.$$String = $$String; +exports.String2 = String2; +exports.Re = Re; +exports.Re2 = Re2; +exports.$$Promise = $$Promise; +exports.Promise2 = Promise2; +exports.$$Date = $$Date; +exports.Dict = Dict; +exports.Global = Global; +exports.Json = Json; +exports.$$Math = $$Math; +exports.Obj = Obj; +exports.Typed_array = Typed_array; +exports.TypedArray2 = TypedArray2; +exports.Types = Types; +exports.Float = Float; +exports.Int = Int; +exports.$$Option = $$Option; +exports.Result = Result; +exports.List = List; +exports.Vector = Vector; +exports.Console = Console; +/* No side effect */ diff --git a/jscomp/test/js_promise_basic_test.js b/jscomp/test/js_promise_basic_test.js index 08840f2600..6a79469ba8 100644 --- a/jscomp/test/js_promise_basic_test.js +++ b/jscomp/test/js_promise_basic_test.js @@ -288,7 +288,7 @@ Mt.from_pair_suites("Js_promise_basic_test", suites[0]); var twop = Promise.resolve(2); function then_(prim, prim$1) { - return prim$1.then(Curry.__1(prim)); + return prim.then(Curry.__1(prim$1)); } function re(prim) { diff --git a/jscomp/test/js_promise_basic_test.ml b/jscomp/test/js_promise_basic_test.ml index 5474cfb872..c09ba7f25a 100644 --- a/jscomp/test/js_promise_basic_test.ml +++ b/jscomp/test/js_promise_basic_test.ml @@ -1,13 +1,13 @@ let suites : Mt.pair_suites ref = ref [] let test_id = ref 0 -let eq loc x y = - incr test_id ; - suites := +let eq loc x y = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites -open Js_promise +open Js_promise2 let assert_bool b = if b then () @@ -16,74 +16,74 @@ let assert_bool b = let fail _ = (* assert_bool false *) - assert false + assert false let thenTest () = let p = resolve 4 in - p |> then_ (fun x -> resolve @@ assert_bool (x = 4)) + p |. then_ (fun x -> resolve @@ assert_bool (x = 4)) let andThenTest () = let p = resolve 6 in - p |> then_ (fun _ -> resolve (12)) - |> then_ (fun y -> resolve @@ assert_bool (y = 12)) + p |. then_ (fun _ -> resolve (12)) + |. then_ (fun y -> resolve @@ assert_bool (y = 12)) let h = resolve () -let assertIsNotFound (x : Js_promise.error) = +let assertIsNotFound (x : Js_promise.error) = match (function [@bs.open] - | Not_found -> 0) x with + | Not_found -> 0) x with | Some _ -> h - | _ -> assert false + | _ -> assert false (** would be nice to have [%bs.open? Stack_overflow]*) let catchTest () = let p = reject Not_found in - p |> then_ fail - |> catch (fun error -> + p |. then_ fail + |. catch (fun error -> assertIsNotFound error ) let orResolvedTest () = let p = resolve 42 in - p |> catch (fun _ -> resolve 22) - |> then_ (fun value -> resolve @@ assert_bool (value = 42)) - |> catch fail + p |. catch (fun _ -> resolve 22) + |. then_ (fun value -> resolve @@ assert_bool (value = 42)) + |. catch fail let orRejectedTest () = let p = reject Not_found in - p |> catch (fun _ -> resolve 22) - |> then_ (fun value -> resolve @@ assert_bool (value = 22)) - |> catch fail + p |. catch (fun _ -> resolve 22) + |. then_ (fun value -> resolve @@ assert_bool (value = 22)) + |. catch fail let orElseResolvedTest () = let p = resolve 42 in - p |> catch (fun _ -> resolve 22) - |> then_ (fun value -> resolve @@ assert_bool (value = 42)) - |> catch fail + p |. catch (fun _ -> resolve 22) + |. then_ (fun value -> resolve @@ assert_bool (value = 42)) + |. catch fail let orElseRejectedResolveTest () = let p = reject Not_found in - p |> catch (fun _ -> resolve 22) - |> then_ (fun value -> resolve @@ assert_bool (value = 22)) - |> catch fail + p |. catch (fun _ -> resolve 22) + |. then_ (fun value -> resolve @@ assert_bool (value = 22)) + |. catch fail let orElseRejectedRejectTest () = let p = reject Not_found in - p |> catch (fun _ -> reject Stack_overflow) - |> then_ fail - |> catch (fun error -> - match (function [@bs.open] Stack_overflow -> 0) error with - | Some _ -> h - | None -> assert false + p |. catch (fun _ -> reject Stack_overflow) + |. then_ fail + |. catch (fun error -> + match (function [@bs.open] Stack_overflow -> 0) error with + | Some _ -> h + | None -> assert false (* resolve @@ assert_bool (Obj.magic error == Stack_overflow) *)) let resolveTest () = let p1 = resolve 10 in - p1 |> then_ (fun x -> resolve @@ assert_bool (x = 10)) + p1 |. then_ (fun x -> resolve @@ assert_bool (x = 10)) let rejectTest () = let p = reject Not_found in - p |> catch + p |. catch (fun error -> assertIsNotFound error (* resolve @@ assert_bool (Obj.magic error == Not_found) *) @@ -91,13 +91,13 @@ let rejectTest () = let thenCatchChainResolvedTest () = let p = resolve 20 in - p |> then_ (fun value -> resolve @@ assert_bool (value = 20) ) - |> catch fail + p |. then_ (fun value -> resolve @@ assert_bool (value = 20) ) + |. catch fail let thenCatchChainRejectedTest () = let p = reject Not_found in - p |> then_ fail - |> catch (fun error -> + p |. then_ fail + |. catch (fun error -> assertIsNotFound error (* resolve @@ assert_bool (Obj.magic error == Not_found) *)) @@ -108,14 +108,14 @@ let allResolvedTest () = let p3 = resolve 3 in let promises = [| p1; p2; p3 |] in all promises - |> then_ + |. then_ (fun resolved -> assert_bool (resolved.(0) = 1) ; assert_bool (resolved.(1) = 2) ; assert_bool (resolved.(2) = 3) ; h ) - + let allRejectTest () = let p1 = resolve 1 in @@ -123,8 +123,8 @@ let allRejectTest () = let p3 = reject Not_found in let promises = [| p1; p2; p3 |] in all promises - |> then_ fail - |> catch (fun error -> assert_bool (Obj.magic error == Not_found) ; h) + |. then_ fail + |. catch (fun error -> assert_bool (Obj.magic error == Not_found) ; h) let raceTest () = let p1 = resolve "first" in @@ -132,17 +132,17 @@ let raceTest () = let p3 = resolve "third" in let promises = [| p1; p2; p3 |] in race promises - |> then_ (fun resolved -> h) - |> catch fail + |. then_ (fun resolved -> h) + |. catch fail let createPromiseRejectTest () = make (fun ~resolve ~reject -> reject Not_found [@bs]) - |> catch (fun error -> assert_bool (Obj.magic error == Not_found); h) + |. catch (fun error -> assert_bool (Obj.magic error == Not_found); h) let createPromiseFulfillTest () = make (fun ~resolve ~reject:_ -> resolve "success" [@bs]) - |> then_ (fun resolved -> assert_bool (Obj.magic resolved = "success"); h) - |> catch fail + |. then_ (fun resolved -> assert_bool (Obj.magic resolved = "success"); h) + |. catch fail let () = ignore @@ thenTest (); @@ -163,31 +163,31 @@ let () = (** TODO: async tests? *) -let () = - (Js.Promise.all2 (Js.Promise.resolve 2, Js.Promise.resolve 3)) - |> Js.Promise.then_ (fun (a,b) -> - eq __LOC__ (a,b) (2,3); - - Js.Promise.resolve () +let () = + (Js.Promise2.all2 (Js.Promise2.resolve 2, Js.Promise2.resolve 3)) + |. Js.Promise2.then_ (fun (a,b) -> + eq __LOC__ (a,b) (2,3); + + Js.Promise2.resolve () ) - |> ignore + |. ignore + +;; Js.log (List.length !suites) -;; Js.log (List.length !suites) - ;; Js.log "hey" ;; Mt.from_pair_suites __MODULE__ !suites -let twop = Js.Promise.resolve 2 -let then_ = Js.Promise.then_ -let re = Js.Promise.resolve +let twop = Js.Promise2.resolve 2 +let then_ = Js.Promise2.then_ +let re = Js.Promise2.resolve ;; Mt.from_promise_suites __MODULE__ [ - __LOC__, + __LOC__, twop - |> then_ (fun x -> re @@ Mt.Eq(x,2)); - __LOC__, + |. then_ (fun x -> re @@ Mt.Eq(x,2)); + __LOC__, twop - |> then_ (fun x -> re @@ Mt.Neq(x,3)) + |. then_ (fun x -> re @@ Mt.Neq(x,3)) ] \ No newline at end of file diff --git a/jscomp/test/mt.ml b/jscomp/test/mt.ml index 1e05a7c7cb..fbe2173773 100644 --- a/jscomp/test/mt.ml +++ b/jscomp/test/mt.ml @@ -7,7 +7,7 @@ external describe : string -> (unit -> unit[@bs]) -> unit = "describe" external it : string -> (unit -> unit[@bs.uncurry]) -> unit = "it" [@@bs.val] -external it_promise : string -> (unit -> _ Js.Promise.t [@bs.uncurry]) -> unit = "it" +external it_promise : string -> (unit -> _ Js.Promise2.t [@bs.uncurry]) -> unit = "it" [@@bs.val] external eq : 'a -> 'a -> unit = "deepEqual" @@ -84,7 +84,7 @@ type eq = (* TODO: | Exception : exn -> (unit -> unit) -> _ eq *) type pair_suites = (string * (unit -> eq)) list -type promise_suites = (string * eq Js.Promise.t) list +type promise_suites = (string * eq Js.Promise2.t) list let close_enough ?(threshold=0.0000001 (* epsilon_float *)) a b = abs_float (a -. b) < threshold @@ -104,7 +104,7 @@ let node_from_pair_suites (name : string) (suites : pair_suites) = | Ok a -> Js.log (name, a, "ok?") ) suites -let handleCode spec = +let handleCode spec = match spec with | Eq(a,b) -> assert_equal a b @@ -134,8 +134,8 @@ let from_pair_suites name (suites : pair_suites) = ) else node_from_pair_suites name suites | _ -> () -let val_unit = Js.Promise.resolve () -let from_promise_suites name (suites : (string * _ Js.Promise.t ) list) = +let val_unit = Js.Promise2.resolve () +let from_promise_suites name (suites : (string * _ Js.Promise2.t ) list) = match Array.to_list Node.Process.process##argv with | cmd :: _ -> if is_mocha () then @@ -143,7 +143,7 @@ let from_promise_suites name (suites : (string * _ Js.Promise.t ) list) = suites |> List.iter (fun (name, code) -> it_promise name (fun _ -> - code |> Js.Promise.then_ (fun x -> handleCode x; val_unit) + code |. Js.Promise2.then_ (fun x -> handleCode x; val_unit) ) ) @@ -172,17 +172,17 @@ let from_pair_suites_non_top name suites = from_pair_suites name suites *) -let eq_suites ~test_id ~suites loc x y = - incr test_id ; - suites := +let eq_suites ~test_id ~suites loc x y = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Eq(x,y))) :: !suites -let bool_suites ~test_id ~suites loc x = - incr test_id ; - suites := - (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Ok(x))) :: !suites +let bool_suites ~test_id ~suites loc x = + incr test_id ; + suites := + (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Ok(x))) :: !suites -let throw_suites ~test_id ~suites loc x = - incr test_id ; - suites := +let throw_suites ~test_id ~suites loc x = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> ThrowAny(x))) :: !suites \ No newline at end of file diff --git a/jscomp/test/mt.mli b/jscomp/test/mt.mli index cffd8770f4..df20ac97fc 100644 --- a/jscomp/test/mt.mli +++ b/jscomp/test/mt.mli @@ -14,21 +14,21 @@ type pair_suites = (string * (unit -> eq)) list val from_suites : string -> (string * (unit -> unit)) list -> unit val from_pair_suites : string -> pair_suites -> unit -type promise_suites = (string * eq Js.Promise.t) list +type promise_suites = (string * eq Js.Promise2.t) list -val from_promise_suites : +val from_promise_suites : string -> - promise_suites -> + promise_suites -> unit -val eq_suites : +val eq_suites : test_id:int ref -> suites:pair_suites ref -> string -> 'b -> 'b -> unit - + val bool_suites : test_id:int ref -> suites: pair_suites ref -> string -> bool -> unit -val throw_suites : +val throw_suites : test_id:int ref -> suites: pair_suites ref -> string -> (unit -> unit) -> unit \ No newline at end of file diff --git a/jscomp/test/node.js b/jscomp/test/node.js new file mode 100644 index 0000000000..d2c4781d39 --- /dev/null +++ b/jscomp/test/node.js @@ -0,0 +1,40 @@ +'use strict'; + + +function test(x) { + if (typeof x === "string") { + return /* tuple */[ + /* String */0, + x + ]; + } else { + return /* tuple */[ + /* Buffer */1, + x + ]; + } +} + +var Path = 0; + +var Fs = 0; + +var Fs2 = 0; + +var Process = 0; + +var Module = 0; + +var $$Buffer = 0; + +var Child_process = 0; + +exports.Path = Path; +exports.Fs = Fs; +exports.Fs2 = Fs2; +exports.Process = Process; +exports.Module = Module; +exports.$$Buffer = $$Buffer; +exports.Child_process = Child_process; +exports.test = test; +/* No side effect */ diff --git a/jscomp/test/ocaml_parsetree_test.js b/jscomp/test/ocaml_parsetree_test.js index 3001356b66..5cc0394231 100644 --- a/jscomp/test/ocaml_parsetree_test.js +++ b/jscomp/test/ocaml_parsetree_test.js @@ -9885,16 +9885,11 @@ function directive_parse(token_with_comments, lexbuf) { ]; }), /* Dir_float */Block.__(1, [Caml_format.caml_float_of_string(curr_token[0])])); case 7 : + var v$1 = curr_token[0]; return token_op(calc, (function (e) { - throw [ - $$Error$2, - /* Conditional_expr_expected_type */Block.__(7, [ - /* Dir_type_bool */0, - /* Dir_type_int */2 - ]), - curr_loc - ]; - }), /* Dir_int */Block.__(2, [curr_token[0]])); + push(e); + return v$1 !== 0; + }), /* Dir_int */Block.__(2, [v$1])); case 11 : var r = curr_token[0]; var exit = 0; @@ -11291,7 +11286,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 989, + 992, 16 ] ]; @@ -11328,7 +11323,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 1003, + 1006, 18 ] ]; @@ -11379,7 +11374,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 1023, + 1026, 18 ] ]; @@ -11418,7 +11413,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 1053, + 1056, 16 ] ]; @@ -11924,7 +11919,7 @@ if (match) { var match$4 = match$3[/* pvb_pat */0]; var match$5 = match$4[/* ppat_desc */0]; if (typeof match$5 === "number" || match$5.tag) { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { var match$6 = match$5[0]; if (match$6[/* txt */0] === "v") { @@ -11944,7 +11939,7 @@ if (match) { var match$15 = match$14[2]; var match$16 = match$15[/* ppat_desc */0]; if (typeof match$16 === "number" || match$16.tag) { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { var match$17 = match$16[0]; if (match$17[/* txt */0] === "str") { @@ -11964,7 +11959,7 @@ if (match) { var match$26 = match$25[0]; var match$27 = match$26[/* pexp_desc */0]; if (match$27.tag) { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { var match$28 = match$27[0]; var match$29 = match$28[/* txt */0]; @@ -11991,7 +11986,7 @@ if (match) { var match$40 = match$39[0]; var match$41 = match$40[/* pexp_desc */0]; if (match$41.tag) { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { var match$42 = match$41[0]; var match$43 = match$42[/* txt */0]; @@ -12015,7 +12010,7 @@ if (match) { var match$52 = match$51[1]; var match$53 = match$52[/* pexp_desc */0]; if (match$53.tag) { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { var match$54 = match$53[0]; var match$55 = match$54[/* txt */0]; @@ -12039,7 +12034,7 @@ if (match) { var match$64 = match$63[1]; var match$65 = match$64[/* pexp_desc */0]; if (match$65.tag) { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { var match$66 = match$65[0]; var match$67 = match$66[/* txt */0]; @@ -12071,7 +12066,7 @@ if (match) { var match$80 = match$79[1]; var match$81 = match$80[/* pexp_desc */0]; if (match$81.tag) { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { var match$82 = match$81[0]; var match$83 = match$82[/* txt */0]; @@ -12106,233 +12101,233 @@ if (match) { if (match$98[/* pos_fname */0] === "" && !(match$98[/* pos_lnum */1] !== 1 || match$98[/* pos_bol */2] !== 0 || match$98[/* pos_cnum */3] !== 0)) { var match$99 = match$97[/* loc_end */1]; if (match$99[/* pos_fname */0] === "" && !(match$99[/* pos_lnum */1] !== 4 || match$99[/* pos_bol */2] !== 46 || match$99[/* pos_cnum */3] !== 71 || match$97[/* loc_ghost */2] || match$2[1])) { - eq("File \"ocaml_parsetree_main.ml\", line 215, characters 10-17", true, true); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 215, characters 10-17", true, true); } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } break; case 1 : case 2 : - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); break; } break; case 0 : case 2 : - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); break; } } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } break; case 1 : case 2 : - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); break; } break; case 0 : case 2 : - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); break; } } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } break; case 1 : case 2 : - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); break; } } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } break; case 1 : case 2 : - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); break; } } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } break; case 1 : case 2 : - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); break; } } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } } else { - eq("File \"ocaml_parsetree_main.ml\", line 216, characters 12-19", true, false); + eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } from_pair_suites("Ocaml_parsetree_test", suites[0]); diff --git a/jscomp/test/ocaml_parsetree_test.ml b/jscomp/test/ocaml_parsetree_test.ml index ed9e24484f..fbebcd2d1e 100644 --- a/jscomp/test/ocaml_parsetree_test.ml +++ b/jscomp/test/ocaml_parsetree_test.ml @@ -157,7 +157,7 @@ end = struct (* The main OCaml version string has moved to ../VERSION *) let version = Sys.ocaml_version -let standard_library_default = "/Users/hongbozhang/git/bucklescript/vendor/ocaml/lib/ocaml" +let standard_library_default = "/Users/chenglou/Github/bucklescript/vendor/ocaml/lib/ocaml" let standard_library = @@ -167,7 +167,7 @@ let standard_library = standard_library_default -let standard_runtime = "/Users/hongbozhang/git/bucklescript/vendor/ocaml/bin/ocamlrun" +let standard_runtime = "/Users/chenglou/Github/bucklescript/vendor/ocaml/bin/ocamlrun" let ccomp_type = "cc" let bytecomp_c_compiler = "gcc -O -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -O " let bytecomp_c_libraries = "-lcurses -lpthread" @@ -218,8 +218,8 @@ let ext_asm = ".s" let ext_lib = ".a" let ext_dll = ".so" -let host = "x86_64-apple-darwin17.7.0" -let target = "x86_64-apple-darwin17.7.0" +let host = "x86_64-apple-darwin18.2.0" +let target = "x86_64-apple-darwin18.2.0" let default_executable_name = match Sys.os_type with @@ -2676,22 +2676,22 @@ type pair_suites = (string * (unit -> eq)) list val from_suites : string -> (string * (unit -> unit)) list -> unit val from_pair_suites : string -> pair_suites -> unit -type promise_suites = (string * eq Js.Promise.t) list +type promise_suites = (string * eq Js.Promise2.t) list -val from_promise_suites : +val from_promise_suites : string -> - promise_suites -> + promise_suites -> unit -val eq_suites : +val eq_suites : test_id:int ref -> suites:pair_suites ref -> string -> 'b -> 'b -> unit - + val bool_suites : test_id:int ref -> suites: pair_suites ref -> string -> bool -> unit -val throw_suites : +val throw_suites : test_id:int ref -> suites: pair_suites ref -> string -> (unit -> unit) -> unit end = struct @@ -2705,7 +2705,7 @@ external describe : string -> (unit -> unit[@bs]) -> unit = "describe" external it : string -> (unit -> unit[@bs.uncurry]) -> unit = "it" [@@bs.val] -external it_promise : string -> (unit -> _ Js.Promise.t [@bs.uncurry]) -> unit = "it" +external it_promise : string -> (unit -> _ Js.Promise2.t [@bs.uncurry]) -> unit = "it" [@@bs.val] external eq : 'a -> 'a -> unit = "deepEqual" @@ -2782,7 +2782,7 @@ type eq = (* TODO: | Exception : exn -> (unit -> unit) -> _ eq *) type pair_suites = (string * (unit -> eq)) list -type promise_suites = (string * eq Js.Promise.t) list +type promise_suites = (string * eq Js.Promise2.t) list let close_enough ?(threshold=0.0000001 (* epsilon_float *)) a b = abs_float (a -. b) < threshold @@ -2802,7 +2802,7 @@ let node_from_pair_suites (name : string) (suites : pair_suites) = | Ok a -> Js.log (name, a, "ok?") ) suites -let handleCode spec = +let handleCode spec = match spec with | Eq(a,b) -> assert_equal a b @@ -2832,8 +2832,8 @@ let from_pair_suites name (suites : pair_suites) = ) else node_from_pair_suites name suites | _ -> () -let val_unit = Js.Promise.resolve () -let from_promise_suites name (suites : (string * _ Js.Promise.t ) list) = +let val_unit = Js.Promise2.resolve () +let from_promise_suites name (suites : (string * _ Js.Promise2.t ) list) = match Array.to_list Node.Process.process##argv with | cmd :: _ -> if is_mocha () then @@ -2841,7 +2841,7 @@ let from_promise_suites name (suites : (string * _ Js.Promise.t ) list) = suites |> List.iter (fun (name, code) -> it_promise name (fun _ -> - code |> Js.Promise.then_ (fun x -> handleCode x; val_unit) + code |. Js.Promise2.then_ (fun x -> handleCode x; val_unit) ) ) @@ -2870,19 +2870,19 @@ let from_pair_suites_non_top name suites = from_pair_suites name suites *) -let eq_suites ~test_id ~suites loc x y = - incr test_id ; - suites := +let eq_suites ~test_id ~suites loc x y = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Eq(x,y))) :: !suites -let bool_suites ~test_id ~suites loc x = - incr test_id ; - suites := - (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Ok(x))) :: !suites +let bool_suites ~test_id ~suites loc x = + incr test_id ; + suites := + (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Ok(x))) :: !suites -let throw_suites ~test_id ~suites loc x = - incr test_id ; - suites := +let throw_suites ~test_id ~suites loc x = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> ThrowAny(x))) :: !suites end (** Interface as module *) @@ -17990,8 +17990,11 @@ let directive_parse token_with_comments lexbuf = | INT v -> token_op calc ~no:(fun e -> - raise(Error(Conditional_expr_expected_type(Dir_type_bool,Dir_type_int), - curr_loc))) + push e ; + v <> 0 + + + ) (Dir_int v) | FLOAT v -> token_op calc @@ -18326,7 +18329,7 @@ let () = ) -# 727 "parsing/lexer.ml" +# 730 "parsing/lexer.ml" let __ocaml_lex_tables = { Lexing.lex_base = "\000\000\164\255\165\255\224\000\003\001\038\001\073\001\108\001\ @@ -19569,123 +19572,123 @@ let rec token lexbuf = and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 767 "parsing/lexer.mll" +# 770 "parsing/lexer.mll" ( if not !escaped_newlines then raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0), Location.curr lexbuf)); update_loc lexbuf None 1 false 0; token lexbuf ) -# 1977 "parsing/lexer.ml" +# 1980 "parsing/lexer.ml" | 1 -> -# 774 "parsing/lexer.mll" +# 777 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0; EOL ) -# 1983 "parsing/lexer.ml" +# 1986 "parsing/lexer.ml" | 2 -> -# 777 "parsing/lexer.mll" +# 780 "parsing/lexer.mll" ( token lexbuf ) -# 1988 "parsing/lexer.ml" +# 1991 "parsing/lexer.ml" | 3 -> -# 779 "parsing/lexer.mll" +# 782 "parsing/lexer.mll" ( UNDERSCORE ) -# 1993 "parsing/lexer.ml" +# 1996 "parsing/lexer.ml" | 4 -> -# 781 "parsing/lexer.mll" +# 784 "parsing/lexer.mll" ( TILDE ) -# 1998 "parsing/lexer.ml" +# 2001 "parsing/lexer.ml" | 5 -> -# 783 "parsing/lexer.mll" +# 786 "parsing/lexer.mll" ( LABEL (get_label_name lexbuf) ) -# 2003 "parsing/lexer.ml" +# 2006 "parsing/lexer.ml" | 6 -> -# 785 "parsing/lexer.mll" +# 788 "parsing/lexer.mll" ( warn_latin1 lexbuf; LABEL (get_label_name lexbuf) ) -# 2008 "parsing/lexer.ml" +# 2011 "parsing/lexer.ml" | 7 -> -# 787 "parsing/lexer.mll" +# 790 "parsing/lexer.mll" ( QUESTION ) -# 2013 "parsing/lexer.ml" +# 2016 "parsing/lexer.ml" | 8 -> -# 789 "parsing/lexer.mll" +# 792 "parsing/lexer.mll" ( OPTLABEL (get_label_name lexbuf) ) -# 2018 "parsing/lexer.ml" +# 2021 "parsing/lexer.ml" | 9 -> -# 791 "parsing/lexer.mll" +# 794 "parsing/lexer.mll" ( warn_latin1 lexbuf; OPTLABEL (get_label_name lexbuf) ) -# 2023 "parsing/lexer.ml" +# 2026 "parsing/lexer.ml" | 10 -> -# 793 "parsing/lexer.mll" +# 796 "parsing/lexer.mll" ( let s = Lexing.lexeme lexbuf in try Hashtbl.find keyword_table s with Not_found -> LIDENT s ) -# 2030 "parsing/lexer.ml" +# 2033 "parsing/lexer.ml" | 11 -> -# 797 "parsing/lexer.mll" +# 800 "parsing/lexer.mll" ( warn_latin1 lexbuf; LIDENT (Lexing.lexeme lexbuf) ) -# 2035 "parsing/lexer.ml" +# 2038 "parsing/lexer.ml" | 12 -> -# 799 "parsing/lexer.mll" +# 802 "parsing/lexer.mll" ( UIDENT(Lexing.lexeme lexbuf) ) -# 2040 "parsing/lexer.ml" +# 2043 "parsing/lexer.ml" | 13 -> -# 801 "parsing/lexer.mll" +# 804 "parsing/lexer.mll" ( warn_latin1 lexbuf; UIDENT(Lexing.lexeme lexbuf) ) -# 2045 "parsing/lexer.ml" +# 2048 "parsing/lexer.ml" | 14 -> -# 803 "parsing/lexer.mll" +# 806 "parsing/lexer.mll" ( try INT (cvt_int_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int", Location.curr lexbuf)) ) -# 2054 "parsing/lexer.ml" +# 2057 "parsing/lexer.ml" | 15 -> -# 809 "parsing/lexer.mll" +# 812 "parsing/lexer.mll" ( FLOAT (remove_underscores(Lexing.lexeme lexbuf)) ) -# 2059 "parsing/lexer.ml" +# 2062 "parsing/lexer.ml" | 16 -> -# 811 "parsing/lexer.mll" +# 814 "parsing/lexer.mll" ( try INT32 (cvt_int32_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int32", Location.curr lexbuf)) ) -# 2067 "parsing/lexer.ml" +# 2070 "parsing/lexer.ml" | 17 -> -# 816 "parsing/lexer.mll" +# 819 "parsing/lexer.mll" ( try INT64 (cvt_int64_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int64", Location.curr lexbuf)) ) -# 2075 "parsing/lexer.ml" +# 2078 "parsing/lexer.ml" | 18 -> -# 821 "parsing/lexer.mll" +# 824 "parsing/lexer.mll" ( try NATIVEINT (cvt_nativeint_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "nativeint", Location.curr lexbuf)) ) -# 2083 "parsing/lexer.ml" +# 2086 "parsing/lexer.ml" | 19 -> -# 826 "parsing/lexer.mll" +# 829 "parsing/lexer.mll" ( reset_string_buffer(); is_in_string := true; let string_start = lexbuf.lex_start_p in @@ -19694,10 +19697,10 @@ and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = is_in_string := false; lexbuf.lex_start_p <- string_start; STRING (get_stored_string(), None) ) -# 2095 "parsing/lexer.ml" +# 2098 "parsing/lexer.ml" | 20 -> -# 835 "parsing/lexer.mll" +# 838 "parsing/lexer.mll" ( reset_string_buffer(); let delim = Lexing.lexeme lexbuf in let delim = String.sub delim 1 (String.length delim - 2) in @@ -19708,64 +19711,64 @@ and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = is_in_string := false; lexbuf.lex_start_p <- string_start; STRING (get_stored_string(), Some delim) ) -# 2109 "parsing/lexer.ml" +# 2112 "parsing/lexer.ml" | 21 -> -# 846 "parsing/lexer.mll" +# 849 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 1; CHAR (Lexing.lexeme_char lexbuf 1) ) -# 2115 "parsing/lexer.ml" +# 2118 "parsing/lexer.ml" | 22 -> -# 849 "parsing/lexer.mll" +# 852 "parsing/lexer.mll" ( CHAR(Lexing.lexeme_char lexbuf 1) ) -# 2120 "parsing/lexer.ml" +# 2123 "parsing/lexer.ml" | 23 -> -# 851 "parsing/lexer.mll" +# 854 "parsing/lexer.mll" ( CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) ) -# 2125 "parsing/lexer.ml" +# 2128 "parsing/lexer.ml" | 24 -> -# 853 "parsing/lexer.mll" +# 856 "parsing/lexer.mll" ( CHAR(char_for_decimal_code lexbuf 2) ) -# 2130 "parsing/lexer.ml" +# 2133 "parsing/lexer.ml" | 25 -> -# 855 "parsing/lexer.mll" +# 858 "parsing/lexer.mll" ( CHAR(char_for_hexadecimal_code lexbuf 3) ) -# 2135 "parsing/lexer.ml" +# 2138 "parsing/lexer.ml" | 26 -> -# 857 "parsing/lexer.mll" +# 860 "parsing/lexer.mll" ( let l = Lexing.lexeme lexbuf in let esc = String.sub l 1 (String.length l - 1) in raise (Error(Illegal_escape esc, Location.curr lexbuf)) ) -# 2143 "parsing/lexer.ml" +# 2146 "parsing/lexer.ml" | 27 -> -# 862 "parsing/lexer.mll" +# 865 "parsing/lexer.mll" ( let s, loc = with_comment_buffer comment lexbuf in COMMENT (s, loc) ) -# 2149 "parsing/lexer.ml" +# 2152 "parsing/lexer.ml" | 28 -> -# 865 "parsing/lexer.mll" +# 868 "parsing/lexer.mll" ( let s, loc = with_comment_buffer comment lexbuf in DOCSTRING (Docstrings.docstring s loc) ) -# 2160 "parsing/lexer.ml" +# 2163 "parsing/lexer.ml" | 29 -> let -# 872 "parsing/lexer.mll" +# 875 "parsing/lexer.mll" stars -# 2166 "parsing/lexer.ml" +# 2169 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_curr_pos in -# 873 "parsing/lexer.mll" +# 876 "parsing/lexer.mll" ( let s, loc = with_comment_buffer (fun lexbuf -> @@ -19774,28 +19777,28 @@ let lexbuf in COMMENT (s, loc) ) -# 2177 "parsing/lexer.ml" +# 2180 "parsing/lexer.ml" | 30 -> -# 882 "parsing/lexer.mll" +# 885 "parsing/lexer.mll" ( if !print_warnings then Location.prerr_warning (Location.curr lexbuf) Warnings.Comment_start; let s, loc = with_comment_buffer comment lexbuf in COMMENT (s, loc) ) -# 2185 "parsing/lexer.ml" +# 2188 "parsing/lexer.ml" | 31 -> let -# 886 "parsing/lexer.mll" +# 889 "parsing/lexer.mll" stars -# 2191 "parsing/lexer.ml" +# 2194 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_curr_pos + -2) in -# 887 "parsing/lexer.mll" +# 890 "parsing/lexer.mll" ( COMMENT (stars, Location.curr lexbuf) ) -# 2195 "parsing/lexer.ml" +# 2198 "parsing/lexer.ml" | 32 -> -# 889 "parsing/lexer.mll" +# 892 "parsing/lexer.mll" ( let loc = Location.curr lexbuf in Location.prerr_warning loc Warnings.Comment_not_end; lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; @@ -19803,307 +19806,307 @@ let lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 }; STAR ) -# 2206 "parsing/lexer.ml" +# 2209 "parsing/lexer.ml" | 33 -> let -# 896 "parsing/lexer.mll" +# 899 "parsing/lexer.mll" num -# 2212 "parsing/lexer.ml" +# 2215 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_mem.(1) and -# 897 "parsing/lexer.mll" +# 900 "parsing/lexer.mll" name -# 2217 "parsing/lexer.ml" +# 2220 "parsing/lexer.ml" = Lexing.sub_lexeme_opt lexbuf lexbuf.Lexing.lex_mem.(3) lexbuf.Lexing.lex_mem.(2) in -# 899 "parsing/lexer.mll" +# 902 "parsing/lexer.mll" ( update_loc lexbuf name (int_of_string num) true 0; token lexbuf ) -# 2223 "parsing/lexer.ml" +# 2226 "parsing/lexer.ml" | 34 -> -# 902 "parsing/lexer.mll" +# 905 "parsing/lexer.mll" ( SHARP ) -# 2228 "parsing/lexer.ml" +# 2231 "parsing/lexer.ml" | 35 -> -# 903 "parsing/lexer.mll" +# 906 "parsing/lexer.mll" ( AMPERSAND ) -# 2233 "parsing/lexer.ml" +# 2236 "parsing/lexer.ml" | 36 -> -# 904 "parsing/lexer.mll" +# 907 "parsing/lexer.mll" ( AMPERAMPER ) -# 2238 "parsing/lexer.ml" +# 2241 "parsing/lexer.ml" | 37 -> -# 905 "parsing/lexer.mll" +# 908 "parsing/lexer.mll" ( BACKQUOTE ) -# 2243 "parsing/lexer.ml" +# 2246 "parsing/lexer.ml" | 38 -> -# 906 "parsing/lexer.mll" +# 909 "parsing/lexer.mll" ( QUOTE ) -# 2248 "parsing/lexer.ml" +# 2251 "parsing/lexer.ml" | 39 -> -# 907 "parsing/lexer.mll" +# 910 "parsing/lexer.mll" ( LPAREN ) -# 2253 "parsing/lexer.ml" +# 2256 "parsing/lexer.ml" | 40 -> -# 908 "parsing/lexer.mll" +# 911 "parsing/lexer.mll" ( RPAREN ) -# 2258 "parsing/lexer.ml" +# 2261 "parsing/lexer.ml" | 41 -> -# 909 "parsing/lexer.mll" +# 912 "parsing/lexer.mll" ( STAR ) -# 2263 "parsing/lexer.ml" +# 2266 "parsing/lexer.ml" | 42 -> -# 910 "parsing/lexer.mll" +# 913 "parsing/lexer.mll" ( COMMA ) -# 2268 "parsing/lexer.ml" +# 2271 "parsing/lexer.ml" | 43 -> -# 911 "parsing/lexer.mll" +# 914 "parsing/lexer.mll" ( MINUSGREATER ) -# 2273 "parsing/lexer.ml" +# 2276 "parsing/lexer.ml" | 44 -> -# 912 "parsing/lexer.mll" +# 915 "parsing/lexer.mll" ( DOT ) -# 2278 "parsing/lexer.ml" +# 2281 "parsing/lexer.ml" | 45 -> -# 913 "parsing/lexer.mll" +# 916 "parsing/lexer.mll" ( DOTDOT ) -# 2283 "parsing/lexer.ml" +# 2286 "parsing/lexer.ml" | 46 -> -# 914 "parsing/lexer.mll" +# 917 "parsing/lexer.mll" ( COLON ) -# 2288 "parsing/lexer.ml" +# 2291 "parsing/lexer.ml" | 47 -> -# 915 "parsing/lexer.mll" +# 918 "parsing/lexer.mll" ( COLONCOLON ) -# 2293 "parsing/lexer.ml" +# 2296 "parsing/lexer.ml" | 48 -> -# 916 "parsing/lexer.mll" +# 919 "parsing/lexer.mll" ( COLONEQUAL ) -# 2298 "parsing/lexer.ml" +# 2301 "parsing/lexer.ml" | 49 -> -# 917 "parsing/lexer.mll" +# 920 "parsing/lexer.mll" ( COLONGREATER ) -# 2303 "parsing/lexer.ml" +# 2306 "parsing/lexer.ml" | 50 -> -# 918 "parsing/lexer.mll" +# 921 "parsing/lexer.mll" ( SEMI ) -# 2308 "parsing/lexer.ml" +# 2311 "parsing/lexer.ml" | 51 -> -# 919 "parsing/lexer.mll" +# 922 "parsing/lexer.mll" ( SEMISEMI ) -# 2313 "parsing/lexer.ml" +# 2316 "parsing/lexer.ml" | 52 -> -# 920 "parsing/lexer.mll" +# 923 "parsing/lexer.mll" ( LESS ) -# 2318 "parsing/lexer.ml" +# 2321 "parsing/lexer.ml" | 53 -> -# 921 "parsing/lexer.mll" +# 924 "parsing/lexer.mll" ( LESSMINUS ) -# 2323 "parsing/lexer.ml" +# 2326 "parsing/lexer.ml" | 54 -> -# 922 "parsing/lexer.mll" +# 925 "parsing/lexer.mll" ( EQUAL ) -# 2328 "parsing/lexer.ml" +# 2331 "parsing/lexer.ml" | 55 -> -# 923 "parsing/lexer.mll" +# 926 "parsing/lexer.mll" ( LBRACKET ) -# 2333 "parsing/lexer.ml" +# 2336 "parsing/lexer.ml" | 56 -> -# 924 "parsing/lexer.mll" +# 927 "parsing/lexer.mll" ( LBRACKETBAR ) -# 2338 "parsing/lexer.ml" +# 2341 "parsing/lexer.ml" | 57 -> -# 925 "parsing/lexer.mll" +# 928 "parsing/lexer.mll" ( LBRACKETLESS ) -# 2343 "parsing/lexer.ml" +# 2346 "parsing/lexer.ml" | 58 -> -# 926 "parsing/lexer.mll" +# 929 "parsing/lexer.mll" ( LBRACKETGREATER ) -# 2348 "parsing/lexer.ml" +# 2351 "parsing/lexer.ml" | 59 -> -# 927 "parsing/lexer.mll" +# 930 "parsing/lexer.mll" ( RBRACKET ) -# 2353 "parsing/lexer.ml" +# 2356 "parsing/lexer.ml" | 60 -> -# 928 "parsing/lexer.mll" +# 931 "parsing/lexer.mll" ( LBRACE ) -# 2358 "parsing/lexer.ml" +# 2361 "parsing/lexer.ml" | 61 -> -# 929 "parsing/lexer.mll" +# 932 "parsing/lexer.mll" ( LBRACELESS ) -# 2363 "parsing/lexer.ml" +# 2366 "parsing/lexer.ml" | 62 -> -# 930 "parsing/lexer.mll" +# 933 "parsing/lexer.mll" ( BAR ) -# 2368 "parsing/lexer.ml" +# 2371 "parsing/lexer.ml" | 63 -> -# 931 "parsing/lexer.mll" +# 934 "parsing/lexer.mll" ( BARBAR ) -# 2373 "parsing/lexer.ml" +# 2376 "parsing/lexer.ml" | 64 -> -# 932 "parsing/lexer.mll" +# 935 "parsing/lexer.mll" ( BARRBRACKET ) -# 2378 "parsing/lexer.ml" +# 2381 "parsing/lexer.ml" | 65 -> -# 933 "parsing/lexer.mll" +# 936 "parsing/lexer.mll" ( GREATER ) -# 2383 "parsing/lexer.ml" +# 2386 "parsing/lexer.ml" | 66 -> -# 934 "parsing/lexer.mll" +# 937 "parsing/lexer.mll" ( GREATERRBRACKET ) -# 2388 "parsing/lexer.ml" +# 2391 "parsing/lexer.ml" | 67 -> -# 935 "parsing/lexer.mll" +# 938 "parsing/lexer.mll" ( RBRACE ) -# 2393 "parsing/lexer.ml" +# 2396 "parsing/lexer.ml" | 68 -> -# 936 "parsing/lexer.mll" +# 939 "parsing/lexer.mll" ( GREATERRBRACE ) -# 2398 "parsing/lexer.ml" +# 2401 "parsing/lexer.ml" | 69 -> -# 937 "parsing/lexer.mll" +# 940 "parsing/lexer.mll" ( LBRACKETAT ) -# 2403 "parsing/lexer.ml" +# 2406 "parsing/lexer.ml" | 70 -> -# 938 "parsing/lexer.mll" +# 941 "parsing/lexer.mll" ( LBRACKETPERCENT ) -# 2408 "parsing/lexer.ml" +# 2411 "parsing/lexer.ml" | 71 -> -# 939 "parsing/lexer.mll" +# 942 "parsing/lexer.mll" ( LBRACKETPERCENTPERCENT ) -# 2413 "parsing/lexer.ml" +# 2416 "parsing/lexer.ml" | 72 -> -# 940 "parsing/lexer.mll" +# 943 "parsing/lexer.mll" ( LBRACKETATAT ) -# 2418 "parsing/lexer.ml" +# 2421 "parsing/lexer.ml" | 73 -> -# 941 "parsing/lexer.mll" +# 944 "parsing/lexer.mll" ( LBRACKETATATAT ) -# 2423 "parsing/lexer.ml" +# 2426 "parsing/lexer.ml" | 74 -> -# 942 "parsing/lexer.mll" +# 945 "parsing/lexer.mll" ( BANG ) -# 2428 "parsing/lexer.ml" +# 2431 "parsing/lexer.ml" | 75 -> -# 943 "parsing/lexer.mll" +# 946 "parsing/lexer.mll" ( INFIXOP0 "!=" ) -# 2433 "parsing/lexer.ml" +# 2436 "parsing/lexer.ml" | 76 -> -# 944 "parsing/lexer.mll" +# 947 "parsing/lexer.mll" ( PLUS ) -# 2438 "parsing/lexer.ml" +# 2441 "parsing/lexer.ml" | 77 -> -# 945 "parsing/lexer.mll" +# 948 "parsing/lexer.mll" ( PLUSDOT ) -# 2443 "parsing/lexer.ml" +# 2446 "parsing/lexer.ml" | 78 -> -# 946 "parsing/lexer.mll" +# 949 "parsing/lexer.mll" ( PLUSEQ ) -# 2448 "parsing/lexer.ml" +# 2451 "parsing/lexer.ml" | 79 -> -# 947 "parsing/lexer.mll" +# 950 "parsing/lexer.mll" ( MINUS ) -# 2453 "parsing/lexer.ml" +# 2456 "parsing/lexer.ml" | 80 -> -# 948 "parsing/lexer.mll" +# 951 "parsing/lexer.mll" ( MINUSDOT ) -# 2458 "parsing/lexer.ml" +# 2461 "parsing/lexer.ml" | 81 -> -# 951 "parsing/lexer.mll" +# 954 "parsing/lexer.mll" ( PREFIXOP(Lexing.lexeme lexbuf) ) -# 2463 "parsing/lexer.ml" +# 2466 "parsing/lexer.ml" | 82 -> -# 953 "parsing/lexer.mll" +# 956 "parsing/lexer.mll" ( PREFIXOP(Lexing.lexeme lexbuf) ) -# 2468 "parsing/lexer.ml" +# 2471 "parsing/lexer.ml" | 83 -> -# 955 "parsing/lexer.mll" +# 958 "parsing/lexer.mll" ( INFIXOP0(Lexing.lexeme lexbuf) ) -# 2473 "parsing/lexer.ml" +# 2476 "parsing/lexer.ml" | 84 -> -# 957 "parsing/lexer.mll" +# 960 "parsing/lexer.mll" ( INFIXOP1(Lexing.lexeme lexbuf) ) -# 2478 "parsing/lexer.ml" +# 2481 "parsing/lexer.ml" | 85 -> -# 959 "parsing/lexer.mll" +# 962 "parsing/lexer.mll" ( INFIXOP2(Lexing.lexeme lexbuf) ) -# 2483 "parsing/lexer.ml" +# 2486 "parsing/lexer.ml" | 86 -> -# 961 "parsing/lexer.mll" +# 964 "parsing/lexer.mll" ( INFIXOP4(Lexing.lexeme lexbuf) ) -# 2488 "parsing/lexer.ml" +# 2491 "parsing/lexer.ml" | 87 -> -# 962 "parsing/lexer.mll" +# 965 "parsing/lexer.mll" ( PERCENT ) -# 2493 "parsing/lexer.ml" +# 2496 "parsing/lexer.ml" | 88 -> -# 964 "parsing/lexer.mll" +# 967 "parsing/lexer.mll" ( INFIXOP3(Lexing.lexeme lexbuf) ) -# 2498 "parsing/lexer.ml" +# 2501 "parsing/lexer.ml" | 89 -> -# 966 "parsing/lexer.mll" +# 969 "parsing/lexer.mll" ( SHARPOP(Lexing.lexeme lexbuf) ) -# 2503 "parsing/lexer.ml" +# 2506 "parsing/lexer.ml" | 90 -> -# 967 "parsing/lexer.mll" +# 970 "parsing/lexer.mll" ( if !if_then_else <> Dir_out then if !if_then_else = Dir_if_true then @@ -20113,14 +20116,14 @@ and EOF ) -# 2516 "parsing/lexer.ml" +# 2519 "parsing/lexer.ml" | 91 -> -# 977 "parsing/lexer.mll" +# 980 "parsing/lexer.mll" ( raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0), Location.curr lexbuf)) ) -# 2523 "parsing/lexer.ml" +# 2526 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_token_rec lexbuf __ocaml_lex_state @@ -20130,15 +20133,15 @@ and comment lexbuf = and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 983 "parsing/lexer.mll" +# 986 "parsing/lexer.mll" ( comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc; store_lexeme lexbuf; comment lexbuf; ) -# 2538 "parsing/lexer.ml" +# 2541 "parsing/lexer.ml" | 1 -> -# 988 "parsing/lexer.mll" +# 991 "parsing/lexer.mll" ( match !comment_start_loc with | [] -> assert false | [_] -> comment_start_loc := []; Location.curr lexbuf @@ -20146,10 +20149,10 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = store_lexeme lexbuf; comment lexbuf; ) -# 2549 "parsing/lexer.ml" +# 2552 "parsing/lexer.ml" | 2 -> -# 996 "parsing/lexer.mll" +# 999 "parsing/lexer.mll" ( string_start_loc := Location.curr lexbuf; store_string_char '"'; @@ -20167,10 +20170,10 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = is_in_string := false; store_string_char '"'; comment lexbuf ) -# 2570 "parsing/lexer.ml" +# 2573 "parsing/lexer.ml" | 3 -> -# 1014 "parsing/lexer.mll" +# 1017 "parsing/lexer.mll" ( let delim = Lexing.lexeme lexbuf in let delim = String.sub delim 1 (String.length delim - 2) in @@ -20192,43 +20195,43 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = store_string delim; store_string_char '}'; comment lexbuf ) -# 2595 "parsing/lexer.ml" +# 2598 "parsing/lexer.ml" | 4 -> -# 1037 "parsing/lexer.mll" +# 1040 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2600 "parsing/lexer.ml" +# 2603 "parsing/lexer.ml" | 5 -> -# 1039 "parsing/lexer.mll" +# 1042 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 1; store_lexeme lexbuf; comment lexbuf ) -# 2608 "parsing/lexer.ml" +# 2611 "parsing/lexer.ml" | 6 -> -# 1044 "parsing/lexer.mll" +# 1047 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2613 "parsing/lexer.ml" +# 2616 "parsing/lexer.ml" | 7 -> -# 1046 "parsing/lexer.mll" +# 1049 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2618 "parsing/lexer.ml" +# 2621 "parsing/lexer.ml" | 8 -> -# 1048 "parsing/lexer.mll" +# 1051 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2623 "parsing/lexer.ml" +# 2626 "parsing/lexer.ml" | 9 -> -# 1050 "parsing/lexer.mll" +# 1053 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2628 "parsing/lexer.ml" +# 2631 "parsing/lexer.ml" | 10 -> -# 1052 "parsing/lexer.mll" +# 1055 "parsing/lexer.mll" ( match !comment_start_loc with | [] -> assert false | loc :: _ -> @@ -20236,20 +20239,20 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = comment_start_loc := []; raise (Error (Unterminated_comment start, loc)) ) -# 2639 "parsing/lexer.ml" +# 2642 "parsing/lexer.ml" | 11 -> -# 1060 "parsing/lexer.mll" +# 1063 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0; store_lexeme lexbuf; comment lexbuf ) -# 2647 "parsing/lexer.ml" +# 2650 "parsing/lexer.ml" | 12 -> -# 1065 "parsing/lexer.mll" +# 1068 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2652 "parsing/lexer.ml" +# 2655 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_comment_rec lexbuf __ocaml_lex_state @@ -20259,42 +20262,42 @@ and string lexbuf = and __ocaml_lex_string_rec lexbuf __ocaml_lex_state = match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 1069 "parsing/lexer.mll" +# 1072 "parsing/lexer.mll" ( () ) -# 2664 "parsing/lexer.ml" +# 2667 "parsing/lexer.ml" | 1 -> let -# 1070 "parsing/lexer.mll" +# 1073 "parsing/lexer.mll" space -# 2670 "parsing/lexer.ml" +# 2673 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_curr_pos in -# 1071 "parsing/lexer.mll" +# 1074 "parsing/lexer.mll" ( update_loc lexbuf None 1 false (String.length space); string lexbuf ) -# 2676 "parsing/lexer.ml" +# 2679 "parsing/lexer.ml" | 2 -> -# 1075 "parsing/lexer.mll" +# 1078 "parsing/lexer.mll" ( store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); string lexbuf ) -# 2682 "parsing/lexer.ml" +# 2685 "parsing/lexer.ml" | 3 -> -# 1078 "parsing/lexer.mll" +# 1081 "parsing/lexer.mll" ( store_string_char(char_for_decimal_code lexbuf 1); string lexbuf ) -# 2688 "parsing/lexer.ml" +# 2691 "parsing/lexer.ml" | 4 -> -# 1081 "parsing/lexer.mll" +# 1084 "parsing/lexer.mll" ( store_string_char(char_for_hexadecimal_code lexbuf 2); string lexbuf ) -# 2694 "parsing/lexer.ml" +# 2697 "parsing/lexer.ml" | 5 -> -# 1084 "parsing/lexer.mll" +# 1087 "parsing/lexer.mll" ( if in_comment () then string lexbuf else begin @@ -20309,29 +20312,29 @@ let string lexbuf end ) -# 2712 "parsing/lexer.ml" +# 2715 "parsing/lexer.ml" | 6 -> -# 1099 "parsing/lexer.mll" +# 1102 "parsing/lexer.mll" ( if not (in_comment ()) then Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string; update_loc lexbuf None 1 false 0; store_lexeme lexbuf; string lexbuf ) -# 2722 "parsing/lexer.ml" +# 2725 "parsing/lexer.ml" | 7 -> -# 1106 "parsing/lexer.mll" +# 1109 "parsing/lexer.mll" ( is_in_string := false; raise (Error (Unterminated_string, !string_start_loc)) ) -# 2728 "parsing/lexer.ml" +# 2731 "parsing/lexer.ml" | 8 -> -# 1109 "parsing/lexer.mll" +# 1112 "parsing/lexer.mll" ( store_string_char(Lexing.lexeme_char lexbuf 0); string lexbuf ) -# 2734 "parsing/lexer.ml" +# 2737 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_string_rec lexbuf __ocaml_lex_state @@ -20341,34 +20344,34 @@ and quoted_string delim lexbuf = and __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 1114 "parsing/lexer.mll" +# 1117 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0; store_lexeme lexbuf; quoted_string delim lexbuf ) -# 2749 "parsing/lexer.ml" +# 2752 "parsing/lexer.ml" | 1 -> -# 1119 "parsing/lexer.mll" +# 1122 "parsing/lexer.mll" ( is_in_string := false; raise (Error (Unterminated_string, !string_start_loc)) ) -# 2755 "parsing/lexer.ml" +# 2758 "parsing/lexer.ml" | 2 -> -# 1122 "parsing/lexer.mll" +# 1125 "parsing/lexer.mll" ( let edelim = Lexing.lexeme lexbuf in let edelim = String.sub edelim 1 (String.length edelim - 2) in if delim = edelim then () else (store_lexeme lexbuf; quoted_string delim lexbuf) ) -# 2765 "parsing/lexer.ml" +# 2768 "parsing/lexer.ml" | 3 -> -# 1129 "parsing/lexer.mll" +# 1132 "parsing/lexer.mll" ( store_string_char(Lexing.lexeme_char lexbuf 0); quoted_string delim lexbuf ) -# 2771 "parsing/lexer.ml" +# 2774 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state @@ -20378,26 +20381,26 @@ and skip_sharp_bang lexbuf = and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 1134 "parsing/lexer.mll" +# 1137 "parsing/lexer.mll" ( update_loc lexbuf None 3 false 0 ) -# 2783 "parsing/lexer.ml" +# 2786 "parsing/lexer.ml" | 1 -> -# 1136 "parsing/lexer.mll" +# 1139 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0 ) -# 2788 "parsing/lexer.ml" +# 2791 "parsing/lexer.ml" | 2 -> -# 1137 "parsing/lexer.mll" +# 1140 "parsing/lexer.mll" ( () ) -# 2793 "parsing/lexer.ml" +# 2796 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state ;; -# 1139 "parsing/lexer.mll" +# 1142 "parsing/lexer.mll" let at_bol lexbuf = @@ -20632,7 +20635,7 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = preprocessor := Some (init, preprocess) -# 3035 "parsing/lexer.ml" +# 3038 "parsing/lexer.ml" end module Parse : sig @@ -20727,9 +20730,9 @@ and expression = wrap Parser.parse_expression and pattern = wrap Parser.parse_pattern end -module Ocaml_parsetree_main +module Ocaml_parsetree_main_bspack = struct -#1 "ocaml_parsetree_main.ml" +#1 "ocaml_parsetree_main_bspack.ml" let suites : Mt.pair_suites ref = ref [] let test_id = ref 0 let eq loc x y = diff --git a/jscomp/test/ocaml_parsetree_test.ml.d b/jscomp/test/ocaml_parsetree_test.ml.d new file mode 100644 index 0000000000..2cfdd77657 --- /dev/null +++ b/jscomp/test/ocaml_parsetree_test.ml.d @@ -0,0 +1,32 @@ +ocaml_parsetree_test.ml: +../../vendor/ocaml/parsing/ast_helper.ml +../../vendor/ocaml/parsing/ast_helper.mli +../../vendor/ocaml/parsing/asttypes.mli +../../vendor/ocaml/parsing/docstrings.ml +../../vendor/ocaml/parsing/docstrings.mli +../../vendor/ocaml/parsing/lexer.ml +../../vendor/ocaml/parsing/lexer.mli +../../vendor/ocaml/parsing/location.ml +../../vendor/ocaml/parsing/location.mli +../../vendor/ocaml/parsing/longident.ml +../../vendor/ocaml/parsing/longident.mli +../../vendor/ocaml/parsing/parse.ml +../../vendor/ocaml/parsing/parse.mli +../../vendor/ocaml/parsing/parser.ml +../../vendor/ocaml/parsing/parser.mli +../../vendor/ocaml/parsing/parsetree.mli +../../vendor/ocaml/parsing/syntaxerr.ml +../../vendor/ocaml/parsing/syntaxerr.mli +../../vendor/ocaml/utils/clflags.ml +../../vendor/ocaml/utils/clflags.mli +../../vendor/ocaml/utils/config.ml +../../vendor/ocaml/utils/config.mli +../../vendor/ocaml/utils/misc.ml +../../vendor/ocaml/utils/misc.mli +../../vendor/ocaml/utils/terminfo.ml +../../vendor/ocaml/utils/terminfo.mli +../../vendor/ocaml/utils/warnings.ml +../../vendor/ocaml/utils/warnings.mli +./mt.ml +./mt.mli +./ocaml_parsetree_main_bspack.ml diff --git a/jscomp/test/ocaml_typedtree_test.js b/jscomp/test/ocaml_typedtree_test.js index 191a2a3197..6dc2d099fd 100644 --- a/jscomp/test/ocaml_typedtree_test.js +++ b/jscomp/test/ocaml_typedtree_test.js @@ -22701,151 +22701,55 @@ function TypedtreeMap_000(funarg) { /* ctyp_attributes */ct$1[/* ctyp_attributes */4] ]); }; - var map_type_declaration = function (decl) { - var decl$1 = Curry._1(funarg[/* enter_type_declaration */2], decl); - var typ_params = List.map(map_type_parameter, decl$1[/* typ_params */2]); - var typ_cstrs = List.map((function (param) { - return /* tuple */[ - map_core_type(param[0]), - map_core_type(param[1]), - param[2] - ]; - }), decl$1[/* typ_cstrs */4]); - var match = decl$1[/* typ_kind */5]; - var typ_kind; - if (typeof match === "number") { - typ_kind = match === 0 ? /* Ttype_abstract */0 : /* Ttype_open */1; - } else if (match.tag) { - var list = List.map((function (ld) { - return /* record */[ - /* ld_id */ld[/* ld_id */0], - /* ld_name */ld[/* ld_name */1], - /* ld_mutable */ld[/* ld_mutable */2], - /* ld_type */map_core_type(ld[/* ld_type */3]), - /* ld_loc */ld[/* ld_loc */4], - /* ld_attributes */ld[/* ld_attributes */5] - ]; - }), match[0]); - typ_kind = /* Ttype_record */Block.__(1, [list]); - } else { - var list$1 = List.map(map_constructor_declaration, match[0]); - typ_kind = /* Ttype_variant */Block.__(0, [list$1]); - } - var typ_manifest = may_map(map_core_type, decl$1[/* typ_manifest */7]); - return Curry._1(funarg[/* leave_type_declaration */27], /* record */[ - /* typ_id */decl$1[/* typ_id */0], - /* typ_name */decl$1[/* typ_name */1], - /* typ_params */typ_params, - /* typ_type */decl$1[/* typ_type */3], - /* typ_cstrs */typ_cstrs, - /* typ_kind */typ_kind, - /* typ_private */decl$1[/* typ_private */6], - /* typ_manifest */typ_manifest, - /* typ_loc */decl$1[/* typ_loc */8], - /* typ_attributes */decl$1[/* typ_attributes */9] + var map_class_structure = function (cs) { + var cs$1 = Curry._1(funarg[/* enter_class_structure */22], cs); + var cstr_self = map_pattern(cs$1[/* cstr_self */0]); + var cstr_fields = List.map(map_class_field, cs$1[/* cstr_fields */1]); + return Curry._1(funarg[/* leave_class_structure */47], /* record */[ + /* cstr_self */cstr_self, + /* cstr_fields */cstr_fields, + /* cstr_type */cs$1[/* cstr_type */2], + /* cstr_meths */cs$1[/* cstr_meths */3] ]); }; - var map_module_expr = function (mexpr) { - var mexpr$1 = Curry._1(funarg[/* enter_module_expr */12], mexpr); - var match = mexpr$1[/* mod_desc */0]; - var mod_desc; + var map_binding = function (vb) { + return /* record */[ + /* vb_pat */map_pattern(vb[/* vb_pat */0]), + /* vb_expr */map_expression(vb[/* vb_expr */1]), + /* vb_attributes */vb[/* vb_attributes */2], + /* vb_loc */vb[/* vb_loc */3] + ]; + }; + var map_class_type = function (ct) { + var ct$1 = Curry._1(funarg[/* enter_class_type */19], ct); + var match = ct$1[/* cltyp_desc */0]; + var cltyp_desc; switch (match.tag | 0) { case 0 : - mod_desc = mexpr$1[/* mod_desc */0]; - break; - case 1 : - mod_desc = /* Tmod_structure */Block.__(1, [map_structure(match[0])]); - break; - case 2 : - mod_desc = /* Tmod_functor */Block.__(2, [ + cltyp_desc = /* Tcty_constr */Block.__(0, [ match[0], match[1], - may_map(map_module_type, match[2]), - map_module_expr(match[3]) - ]); - break; - case 3 : - mod_desc = /* Tmod_apply */Block.__(3, [ - map_module_expr(match[0]), - map_module_expr(match[1]), - match[2] - ]); - break; - case 4 : - var match$1 = match[2]; - var mod_type = match[1]; - var mexpr$2 = match[0]; - mod_desc = match$1 ? /* Tmod_constraint */Block.__(4, [ - map_module_expr(mexpr$2), - mod_type, - /* Tmodtype_explicit */[map_module_type(match$1[0])], - match[3] - ]) : /* Tmod_constraint */Block.__(4, [ - map_module_expr(mexpr$2), - mod_type, - /* Tmodtype_implicit */0, - match[3] - ]); - break; - case 5 : - mod_desc = /* Tmod_unpack */Block.__(5, [ - map_expression(match[0]), - match[1] + List.map(map_core_type, match[2]) ]); break; - - } - return Curry._1(funarg[/* leave_module_expr */37], /* record */[ - /* mod_desc */mod_desc, - /* mod_loc */mexpr$1[/* mod_loc */1], - /* mod_type */mexpr$1[/* mod_type */2], - /* mod_env */mexpr$1[/* mod_env */3], - /* mod_attributes */mexpr$1[/* mod_attributes */4] - ]); - }; - var map_module_type = function (mty) { - var mty$1 = Curry._1(funarg[/* enter_module_type */11], mty); - var match = mty$1[/* mty_desc */0]; - var mty_desc; - switch (match.tag | 0) { case 1 : - mty_desc = /* Tmty_signature */Block.__(1, [map_signature(match[0])]); + cltyp_desc = /* Tcty_signature */Block.__(1, [map_class_signature(match[0])]); break; case 2 : - mty_desc = /* Tmty_functor */Block.__(2, [ + cltyp_desc = /* Tcty_arrow */Block.__(2, [ match[0], - match[1], - may_map(map_module_type, match[2]), - map_module_type(match[3]) - ]); - break; - case 3 : - mty_desc = /* Tmty_with */Block.__(3, [ - map_module_type(match[0]), - List.map((function (param) { - return /* tuple */[ - param[0], - param[1], - map_with_constraint(param[2]) - ]; - }), match[1]) + map_core_type(match[1]), + map_class_type(match[2]) ]); break; - case 4 : - mty_desc = /* Tmty_typeof */Block.__(4, [map_module_expr(match[0])]); - break; - case 0 : - case 5 : - mty_desc = mty$1[/* mty_desc */0]; - break; } - return Curry._1(funarg[/* leave_module_type */36], /* record */[ - /* mty_desc */mty_desc, - /* mty_type */mty$1[/* mty_type */1], - /* mty_env */mty$1[/* mty_env */2], - /* mty_loc */mty$1[/* mty_loc */3], - /* mty_attributes */mty$1[/* mty_attributes */4] + return Curry._1(funarg[/* leave_class_type */44], /* record */[ + /* cltyp_desc */cltyp_desc, + /* cltyp_type */ct$1[/* cltyp_type */1], + /* cltyp_env */ct$1[/* cltyp_env */2], + /* cltyp_loc */ct$1[/* cltyp_loc */3], + /* cltyp_attributes */ct$1[/* cltyp_attributes */4] ]); }; var map_expression = function (exp) { @@ -23044,6 +22948,80 @@ function TypedtreeMap_000(funarg) { /* exp_attributes */exp$1[/* exp_attributes */5] ]); }; + var map_pattern = function (pat) { + var pat$1 = Curry._1(funarg[/* enter_pattern */5], pat); + var match = pat$1[/* pat_desc */0]; + var pat_desc; + if (typeof match === "number") { + pat_desc = pat$1[/* pat_desc */0]; + } else { + switch (match.tag | 0) { + case 1 : + var pat1 = map_pattern(match[0]); + pat_desc = /* Tpat_alias */Block.__(1, [ + pat1, + match[1], + match[2] + ]); + break; + case 3 : + pat_desc = /* Tpat_tuple */Block.__(3, [List.map(map_pattern, match[0])]); + break; + case 4 : + pat_desc = /* Tpat_construct */Block.__(4, [ + match[0], + match[1], + List.map(map_pattern, match[2]) + ]); + break; + case 5 : + var pato = match[1]; + var pato$1 = pato !== undefined ? map_pattern(pato) : pato; + pat_desc = /* Tpat_variant */Block.__(5, [ + match[0], + pato$1, + match[2] + ]); + break; + case 6 : + pat_desc = /* Tpat_record */Block.__(6, [ + List.map((function (param) { + return /* tuple */[ + param[0], + param[1], + map_pattern(param[2]) + ]; + }), match[0]), + match[1] + ]); + break; + case 7 : + pat_desc = /* Tpat_array */Block.__(7, [List.map(map_pattern, match[0])]); + break; + case 8 : + pat_desc = /* Tpat_or */Block.__(8, [ + map_pattern(match[0]), + map_pattern(match[1]), + match[2] + ]); + break; + case 9 : + pat_desc = /* Tpat_lazy */Block.__(9, [map_pattern(match[0])]); + break; + default: + pat_desc = pat$1[/* pat_desc */0]; + } + } + var pat_extra = List.map(map_pat_extra, pat$1[/* pat_extra */2]); + return Curry._1(funarg[/* leave_pattern */30], /* record */[ + /* pat_desc */pat_desc, + /* pat_loc */pat$1[/* pat_loc */1], + /* pat_extra */pat_extra, + /* pat_type */pat$1[/* pat_type */3], + /* pat_env */pat$1[/* pat_env */4], + /* pat_attributes */pat$1[/* pat_attributes */5] + ]); + }; var map_class_expr = function (cexpr) { var cexpr$1 = Curry._1(funarg[/* enter_class_expr */14], cexpr); var match = cexpr$1[/* cl_desc */0]; @@ -23127,79 +23105,204 @@ function TypedtreeMap_000(funarg) { /* cl_attributes */cexpr$1[/* cl_attributes */4] ]); }; - var map_case = function (param) { - return /* record */[ - /* c_lhs */map_pattern(param[/* c_lhs */0]), - /* c_guard */may_map(map_expression, param[/* c_guard */1]), - /* c_rhs */map_expression(param[/* c_rhs */2]) - ]; + var map_class_signature = function (cs) { + var cs$1 = Curry._1(funarg[/* enter_class_signature */15], cs); + var csig_self = map_core_type(cs$1[/* csig_self */0]); + var csig_fields = List.map(map_class_type_field, cs$1[/* csig_fields */1]); + return Curry._1(funarg[/* leave_class_signature */40], /* record */[ + /* csig_self */csig_self, + /* csig_fields */csig_fields, + /* csig_type */cs$1[/* csig_type */2] + ]); }; - var map_exp_extra = function (exp_extra) { - var attrs = exp_extra[2]; - var loc = exp_extra[1]; - var desc = exp_extra[0]; - switch (desc.tag | 0) { + var map_constructor_declaration = function (cd) { + return /* record */[ + /* cd_id */cd[/* cd_id */0], + /* cd_name */cd[/* cd_name */1], + /* cd_args */List.map(map_core_type, cd[/* cd_args */2]), + /* cd_res */may_map(map_core_type, cd[/* cd_res */3]), + /* cd_loc */cd[/* cd_loc */4], + /* cd_attributes */cd[/* cd_attributes */5] + ]; + }; + var map_type_parameter = function (param) { + return /* tuple */[ + map_core_type(param[0]), + param[1] + ]; + }; + var map_module_expr = function (mexpr) { + var mexpr$1 = Curry._1(funarg[/* enter_module_expr */12], mexpr); + var match = mexpr$1[/* mod_desc */0]; + var mod_desc; + switch (match.tag | 0) { case 0 : - return /* tuple */[ - /* Texp_constraint */Block.__(0, [map_core_type(desc[0])]), - loc, - attrs - ]; + mod_desc = mexpr$1[/* mod_desc */0]; + break; case 1 : - var match = desc[0]; - if (match !== undefined) { - return /* tuple */[ - /* Texp_coerce */Block.__(1, [ - map_core_type(match), - map_core_type(desc[1]) - ]), - loc, - attrs - ]; - } else { - return /* tuple */[ - /* Texp_coerce */Block.__(1, [ - undefined, - map_core_type(desc[1]) - ]), - loc, - attrs - ]; - } - case 3 : - var match$1 = desc[0]; - if (match$1 !== undefined) { - return /* tuple */[ - /* Texp_poly */Block.__(3, [map_core_type(match$1)]), - loc, - attrs - ]; - } else { - return exp_extra; - } + mod_desc = /* Tmod_structure */Block.__(1, [map_structure(match[0])]); + break; case 2 : + mod_desc = /* Tmod_functor */Block.__(2, [ + match[0], + match[1], + may_map(map_module_type, match[2]), + map_module_expr(match[3]) + ]); + break; + case 3 : + mod_desc = /* Tmod_apply */Block.__(3, [ + map_module_expr(match[0]), + map_module_expr(match[1]), + match[2] + ]); + break; case 4 : - return exp_extra; + var match$1 = match[2]; + var mod_type = match[1]; + var mexpr$2 = match[0]; + mod_desc = match$1 ? /* Tmod_constraint */Block.__(4, [ + map_module_expr(mexpr$2), + mod_type, + /* Tmodtype_explicit */[map_module_type(match$1[0])], + match[3] + ]) : /* Tmod_constraint */Block.__(4, [ + map_module_expr(mexpr$2), + mod_type, + /* Tmodtype_implicit */0, + match[3] + ]); + break; + case 5 : + mod_desc = /* Tmod_unpack */Block.__(5, [ + map_expression(match[0]), + match[1] + ]); + break; } + return Curry._1(funarg[/* leave_module_expr */37], /* record */[ + /* mod_desc */mod_desc, + /* mod_loc */mexpr$1[/* mod_loc */1], + /* mod_type */mexpr$1[/* mod_type */2], + /* mod_env */mexpr$1[/* mod_env */3], + /* mod_attributes */mexpr$1[/* mod_attributes */4] + ]); }; - var map_binding = function (vb) { + var map_case = function (param) { return /* record */[ - /* vb_pat */map_pattern(vb[/* vb_pat */0]), - /* vb_expr */map_expression(vb[/* vb_expr */1]), - /* vb_attributes */vb[/* vb_attributes */2], - /* vb_loc */vb[/* vb_loc */3] + /* c_lhs */map_pattern(param[/* c_lhs */0]), + /* c_guard */may_map(map_expression, param[/* c_guard */1]), + /* c_rhs */map_expression(param[/* c_rhs */2]) ]; }; - var map_class_structure = function (cs) { - var cs$1 = Curry._1(funarg[/* enter_class_structure */22], cs); - var cstr_self = map_pattern(cs$1[/* cstr_self */0]); - var cstr_fields = List.map(map_class_field, cs$1[/* cstr_fields */1]); - return Curry._1(funarg[/* leave_class_structure */47], /* record */[ - /* cstr_self */cstr_self, - /* cstr_fields */cstr_fields, - /* cstr_type */cs$1[/* cstr_type */2], - /* cstr_meths */cs$1[/* cstr_meths */3] + var map_row_field = function (rf) { + if (rf.tag) { + return /* Tinherit */Block.__(1, [map_core_type(rf[0])]); + } else { + return /* Ttag */Block.__(0, [ + rf[0], + rf[1], + rf[2], + List.map(map_core_type, rf[3]) + ]); + } + }; + var map_package_type = function (pack) { + var pack$1 = Curry._1(funarg[/* enter_package_type */7], pack); + var pack_fields = List.map((function (param) { + return /* tuple */[ + param[0], + map_core_type(param[1]) + ]; + }), pack$1[/* pack_fields */1]); + return Curry._1(funarg[/* leave_package_type */32], /* record */[ + /* pack_path */pack$1[/* pack_path */0], + /* pack_fields */pack_fields, + /* pack_type */pack$1[/* pack_type */2], + /* pack_txt */pack$1[/* pack_txt */3] + ]); + }; + var map_structure_item = function (item) { + var item$1 = Curry._1(funarg[/* enter_structure_item */24], item); + var match = item$1[/* str_desc */0]; + var str_desc; + switch (match.tag | 0) { + case 0 : + str_desc = /* Tstr_eval */Block.__(0, [ + map_expression(match[0]), + match[1] + ]); + break; + case 1 : + str_desc = /* Tstr_value */Block.__(1, [ + match[0], + List.map(map_binding, match[1]) + ]); + break; + case 2 : + str_desc = /* Tstr_primitive */Block.__(2, [map_value_description(match[0])]); + break; + case 3 : + str_desc = /* Tstr_type */Block.__(3, [List.map(map_type_declaration, match[0])]); + break; + case 4 : + str_desc = /* Tstr_typext */Block.__(4, [map_type_extension(match[0])]); + break; + case 5 : + str_desc = /* Tstr_exception */Block.__(5, [map_extension_constructor(match[0])]); + break; + case 6 : + str_desc = /* Tstr_module */Block.__(6, [map_module_binding(match[0])]); + break; + case 7 : + var list = List.map(map_module_binding, match[0]); + str_desc = /* Tstr_recmodule */Block.__(7, [list]); + break; + case 8 : + str_desc = /* Tstr_modtype */Block.__(8, [map_module_type_declaration(match[0])]); + break; + case 9 : + str_desc = /* Tstr_open */Block.__(9, [match[0]]); + break; + case 10 : + var list$1 = List.map((function (param) { + return /* tuple */[ + map_class_declaration(param[0]), + param[1], + param[2] + ]; + }), match[0]); + str_desc = /* Tstr_class */Block.__(10, [list$1]); + break; + case 11 : + var list$2 = List.map((function (param) { + return /* tuple */[ + param[0], + param[1], + map_class_type_declaration(param[2]) + ]; + }), match[0]); + str_desc = /* Tstr_class_type */Block.__(11, [list$2]); + break; + case 12 : + var incl = match[0]; + str_desc = /* Tstr_include */Block.__(12, [/* record */[ + /* incl_mod */map_module_expr(incl[/* incl_mod */0]), + /* incl_type */incl[/* incl_type */1], + /* incl_loc */incl[/* incl_loc */2], + /* incl_attributes */incl[/* incl_attributes */3] + ]]); + break; + case 13 : + str_desc = /* Tstr_attribute */Block.__(13, [match[0]]); + break; + + } + return Curry._1(funarg[/* leave_structure_item */49], /* record */[ + /* str_desc */str_desc, + /* str_loc */item$1[/* str_loc */1], + /* str_env */item$1[/* str_env */2] ]); }; var map_class_type_field = function (ctf) { @@ -23246,137 +23349,136 @@ function TypedtreeMap_000(funarg) { /* ctf_attributes */ctf$1[/* ctf_attributes */2] ]); }; - var map_class_signature = function (cs) { - var cs$1 = Curry._1(funarg[/* enter_class_signature */15], cs); - var csig_self = map_core_type(cs$1[/* csig_self */0]); - var csig_fields = List.map(map_class_type_field, cs$1[/* csig_fields */1]); - return Curry._1(funarg[/* leave_class_signature */40], /* record */[ - /* csig_self */csig_self, - /* csig_fields */csig_fields, - /* csig_type */cs$1[/* csig_type */2] - ]); - }; - var map_class_type = function (ct) { - var ct$1 = Curry._1(funarg[/* enter_class_type */19], ct); - var match = ct$1[/* cltyp_desc */0]; - var cltyp_desc; - switch (match.tag | 0) { + var map_signature_item = function (item) { + var item$1 = Curry._1(funarg[/* enter_signature_item */9], item); + var x = item$1[/* sig_desc */0]; + var sig_desc; + switch (x.tag | 0) { case 0 : - cltyp_desc = /* Tcty_constr */Block.__(0, [ - match[0], - match[1], - List.map(map_core_type, match[2]) - ]); + sig_desc = /* Tsig_value */Block.__(0, [map_value_description(x[0])]); break; case 1 : - cltyp_desc = /* Tcty_signature */Block.__(1, [map_class_signature(match[0])]); + sig_desc = /* Tsig_type */Block.__(1, [List.map(map_type_declaration, x[0])]); + break; + case 2 : + sig_desc = /* Tsig_typext */Block.__(2, [map_type_extension(x[0])]); + break; + case 3 : + sig_desc = /* Tsig_exception */Block.__(3, [map_extension_constructor(x[0])]); + break; + case 4 : + var md = x[0]; + sig_desc = /* Tsig_module */Block.__(4, [/* record */[ + /* md_id */md[/* md_id */0], + /* md_name */md[/* md_name */1], + /* md_type */map_module_type(md[/* md_type */2]), + /* md_attributes */md[/* md_attributes */3], + /* md_loc */md[/* md_loc */4] + ]]); + break; + case 5 : + sig_desc = /* Tsig_recmodule */Block.__(5, [List.map((function (md) { + return /* record */[ + /* md_id */md[/* md_id */0], + /* md_name */md[/* md_name */1], + /* md_type */map_module_type(md[/* md_type */2]), + /* md_attributes */md[/* md_attributes */3], + /* md_loc */md[/* md_loc */4] + ]; + }), x[0])]); + break; + case 6 : + sig_desc = /* Tsig_modtype */Block.__(6, [map_module_type_declaration(x[0])]); + break; + case 7 : + sig_desc = item$1[/* sig_desc */0]; + break; + case 8 : + var incl = x[0]; + sig_desc = /* Tsig_include */Block.__(8, [/* record */[ + /* incl_mod */map_module_type(incl[/* incl_mod */0]), + /* incl_type */incl[/* incl_type */1], + /* incl_loc */incl[/* incl_loc */2], + /* incl_attributes */incl[/* incl_attributes */3] + ]]); + break; + case 9 : + sig_desc = /* Tsig_class */Block.__(9, [List.map(map_class_description, x[0])]); + break; + case 10 : + sig_desc = /* Tsig_class_type */Block.__(10, [List.map(map_class_type_declaration, x[0])]); break; + case 11 : + sig_desc = x; + break; + + } + return Curry._1(funarg[/* leave_signature_item */34], /* record */[ + /* sig_desc */sig_desc, + /* sig_env */item$1[/* sig_env */1], + /* sig_loc */item$1[/* sig_loc */2] + ]); + }; + var map_exp_extra = function (exp_extra) { + var attrs = exp_extra[2]; + var loc = exp_extra[1]; + var desc = exp_extra[0]; + switch (desc.tag | 0) { + case 0 : + return /* tuple */[ + /* Texp_constraint */Block.__(0, [map_core_type(desc[0])]), + loc, + attrs + ]; + case 1 : + var match = desc[0]; + if (match !== undefined) { + return /* tuple */[ + /* Texp_coerce */Block.__(1, [ + map_core_type(match), + map_core_type(desc[1]) + ]), + loc, + attrs + ]; + } else { + return /* tuple */[ + /* Texp_coerce */Block.__(1, [ + undefined, + map_core_type(desc[1]) + ]), + loc, + attrs + ]; + } + case 3 : + var match$1 = desc[0]; + if (match$1 !== undefined) { + return /* tuple */[ + /* Texp_poly */Block.__(3, [map_core_type(match$1)]), + loc, + attrs + ]; + } else { + return exp_extra; + } case 2 : - cltyp_desc = /* Tcty_arrow */Block.__(2, [ - match[0], - map_core_type(match[1]), - map_class_type(match[2]) - ]); - break; + case 4 : + return exp_extra; } - return Curry._1(funarg[/* leave_class_type */44], /* record */[ - /* cltyp_desc */cltyp_desc, - /* cltyp_type */ct$1[/* cltyp_type */1], - /* cltyp_env */ct$1[/* cltyp_env */2], - /* cltyp_loc */ct$1[/* cltyp_loc */3], - /* cltyp_attributes */ct$1[/* cltyp_attributes */4] - ]); }; - var map_pattern = function (pat) { - var pat$1 = Curry._1(funarg[/* enter_pattern */5], pat); - var match = pat$1[/* pat_desc */0]; - var pat_desc; - if (typeof match === "number") { - pat_desc = pat$1[/* pat_desc */0]; + var map_pat_extra = function (pat_extra) { + var match = pat_extra[0]; + if (typeof match === "number" || match.tag) { + return pat_extra; } else { - switch (match.tag | 0) { - case 1 : - var pat1 = map_pattern(match[0]); - pat_desc = /* Tpat_alias */Block.__(1, [ - pat1, - match[1], - match[2] - ]); - break; - case 3 : - pat_desc = /* Tpat_tuple */Block.__(3, [List.map(map_pattern, match[0])]); - break; - case 4 : - pat_desc = /* Tpat_construct */Block.__(4, [ - match[0], - match[1], - List.map(map_pattern, match[2]) - ]); - break; - case 5 : - var pato = match[1]; - var pato$1 = pato !== undefined ? map_pattern(pato) : pato; - pat_desc = /* Tpat_variant */Block.__(5, [ - match[0], - pato$1, - match[2] - ]); - break; - case 6 : - pat_desc = /* Tpat_record */Block.__(6, [ - List.map((function (param) { - return /* tuple */[ - param[0], - param[1], - map_pattern(param[2]) - ]; - }), match[0]), - match[1] - ]); - break; - case 7 : - pat_desc = /* Tpat_array */Block.__(7, [List.map(map_pattern, match[0])]); - break; - case 8 : - pat_desc = /* Tpat_or */Block.__(8, [ - map_pattern(match[0]), - map_pattern(match[1]), - match[2] - ]); - break; - case 9 : - pat_desc = /* Tpat_lazy */Block.__(9, [map_pattern(match[0])]); - break; - default: - pat_desc = pat$1[/* pat_desc */0]; - } + return /* tuple */[ + /* Tpat_constraint */Block.__(0, [map_core_type(match[0])]), + pat_extra[1], + pat_extra[2] + ]; } - var pat_extra = List.map(map_pat_extra, pat$1[/* pat_extra */2]); - return Curry._1(funarg[/* leave_pattern */30], /* record */[ - /* pat_desc */pat_desc, - /* pat_loc */pat$1[/* pat_loc */1], - /* pat_extra */pat_extra, - /* pat_type */pat$1[/* pat_type */3], - /* pat_env */pat$1[/* pat_env */4], - /* pat_attributes */pat$1[/* pat_attributes */5] - ]); - }; - var map_type_parameter = function (param) { - return /* tuple */[ - map_core_type(param[0]), - param[1] - ]; - }; - var map_constructor_declaration = function (cd) { - return /* record */[ - /* cd_id */cd[/* cd_id */0], - /* cd_name */cd[/* cd_name */1], - /* cd_args */List.map(map_core_type, cd[/* cd_args */2]), - /* cd_res */may_map(map_core_type, cd[/* cd_res */3]), - /* cd_loc */cd[/* cd_loc */4], - /* cd_attributes */cd[/* cd_attributes */5] - ]; }; var map_class_field = function (cf) { var cf$1 = Curry._1(funarg[/* enter_class_field */23], cf); @@ -23451,139 +23553,49 @@ function TypedtreeMap_000(funarg) { /* cf_attributes */cf$1[/* cf_attributes */2] ]); }; - var map_pat_extra = function (pat_extra) { - var match = pat_extra[0]; - if (typeof match === "number" || match.tag) { - return pat_extra; - } else { - return /* tuple */[ - /* Tpat_constraint */Block.__(0, [map_core_type(match[0])]), - pat_extra[1], - pat_extra[2] - ]; - } - }; - var map_extension_constructor = function (ext) { - var ext$1 = Curry._1(funarg[/* enter_extension_constructor */4], ext); - var match = ext$1[/* ext_kind */3]; - var ext_kind; - if (match.tag) { - ext_kind = /* Text_rebind */Block.__(1, [ - match[0], - match[1] - ]); - } else { - var args = List.map(map_core_type, match[0]); - var ret = may_map(map_core_type, match[1]); - ext_kind = /* Text_decl */Block.__(0, [ - args, - ret - ]); - } - return Curry._1(funarg[/* leave_extension_constructor */29], /* record */[ - /* ext_id */ext$1[/* ext_id */0], - /* ext_name */ext$1[/* ext_name */1], - /* ext_type */ext$1[/* ext_type */2], - /* ext_kind */ext_kind, - /* ext_loc */ext$1[/* ext_loc */4], - /* ext_attributes */ext$1[/* ext_attributes */5] - ]); - }; - var map_package_type = function (pack) { - var pack$1 = Curry._1(funarg[/* enter_package_type */7], pack); - var pack_fields = List.map((function (param) { - return /* tuple */[ - param[0], - map_core_type(param[1]) - ]; - }), pack$1[/* pack_fields */1]); - return Curry._1(funarg[/* leave_package_type */32], /* record */[ - /* pack_path */pack$1[/* pack_path */0], - /* pack_fields */pack_fields, - /* pack_type */pack$1[/* pack_type */2], - /* pack_txt */pack$1[/* pack_txt */3] - ]); - }; - var map_row_field = function (rf) { - if (rf.tag) { - return /* Tinherit */Block.__(1, [map_core_type(rf[0])]); - } else { - return /* Ttag */Block.__(0, [ - rf[0], - rf[1], - rf[2], - List.map(map_core_type, rf[3]) - ]); - } - }; - var map_signature_item = function (item) { - var item$1 = Curry._1(funarg[/* enter_signature_item */9], item); - var x = item$1[/* sig_desc */0]; - var sig_desc; - switch (x.tag | 0) { - case 0 : - sig_desc = /* Tsig_value */Block.__(0, [map_value_description(x[0])]); - break; + var map_module_type = function (mty) { + var mty$1 = Curry._1(funarg[/* enter_module_type */11], mty); + var match = mty$1[/* mty_desc */0]; + var mty_desc; + switch (match.tag | 0) { case 1 : - sig_desc = /* Tsig_type */Block.__(1, [List.map(map_type_declaration, x[0])]); + mty_desc = /* Tmty_signature */Block.__(1, [map_signature(match[0])]); break; case 2 : - sig_desc = /* Tsig_typext */Block.__(2, [map_type_extension(x[0])]); - break; - case 3 : - sig_desc = /* Tsig_exception */Block.__(3, [map_extension_constructor(x[0])]); - break; - case 4 : - var md = x[0]; - sig_desc = /* Tsig_module */Block.__(4, [/* record */[ - /* md_id */md[/* md_id */0], - /* md_name */md[/* md_name */1], - /* md_type */map_module_type(md[/* md_type */2]), - /* md_attributes */md[/* md_attributes */3], - /* md_loc */md[/* md_loc */4] - ]]); - break; - case 5 : - sig_desc = /* Tsig_recmodule */Block.__(5, [List.map((function (md) { - return /* record */[ - /* md_id */md[/* md_id */0], - /* md_name */md[/* md_name */1], - /* md_type */map_module_type(md[/* md_type */2]), - /* md_attributes */md[/* md_attributes */3], - /* md_loc */md[/* md_loc */4] - ]; - }), x[0])]); - break; - case 6 : - sig_desc = /* Tsig_modtype */Block.__(6, [map_module_type_declaration(x[0])]); - break; - case 7 : - sig_desc = item$1[/* sig_desc */0]; - break; - case 8 : - var incl = x[0]; - sig_desc = /* Tsig_include */Block.__(8, [/* record */[ - /* incl_mod */map_module_type(incl[/* incl_mod */0]), - /* incl_type */incl[/* incl_type */1], - /* incl_loc */incl[/* incl_loc */2], - /* incl_attributes */incl[/* incl_attributes */3] - ]]); + mty_desc = /* Tmty_functor */Block.__(2, [ + match[0], + match[1], + may_map(map_module_type, match[2]), + map_module_type(match[3]) + ]); break; - case 9 : - sig_desc = /* Tsig_class */Block.__(9, [List.map(map_class_description, x[0])]); + case 3 : + mty_desc = /* Tmty_with */Block.__(3, [ + map_module_type(match[0]), + List.map((function (param) { + return /* tuple */[ + param[0], + param[1], + map_with_constraint(param[2]) + ]; + }), match[1]) + ]); break; - case 10 : - sig_desc = /* Tsig_class_type */Block.__(10, [List.map(map_class_type_declaration, x[0])]); + case 4 : + mty_desc = /* Tmty_typeof */Block.__(4, [map_module_expr(match[0])]); break; - case 11 : - sig_desc = x; + case 0 : + case 5 : + mty_desc = mty$1[/* mty_desc */0]; break; } - return Curry._1(funarg[/* leave_signature_item */34], /* record */[ - /* sig_desc */sig_desc, - /* sig_env */item$1[/* sig_env */1], - /* sig_loc */item$1[/* sig_loc */2] + return Curry._1(funarg[/* leave_module_type */36], /* record */[ + /* mty_desc */mty_desc, + /* mty_type */mty$1[/* mty_type */1], + /* mty_env */mty$1[/* mty_env */2], + /* mty_loc */mty$1[/* mty_loc */3], + /* mty_attributes */mty$1[/* mty_attributes */4] ]); }; var map_with_constraint = function (cstr) { @@ -23613,17 +23625,14 @@ function TypedtreeMap_000(funarg) { /* sig_final_env */sg$1[/* sig_final_env */2] ]); }; - var map_value_description = function (v) { - var v$1 = Curry._1(funarg[/* enter_value_description */1], v); - var val_desc = map_core_type(v$1[/* val_desc */2]); - return Curry._1(funarg[/* leave_value_description */26], /* record */[ - /* val_id */v$1[/* val_id */0], - /* val_name */v$1[/* val_name */1], - /* val_desc */val_desc, - /* val_val */v$1[/* val_val */3], - /* val_prim */v$1[/* val_prim */4], - /* val_loc */v$1[/* val_loc */5], - /* val_attributes */v$1[/* val_attributes */6] + var map_module_type_declaration = function (mtd) { + var mtd$1 = Curry._1(funarg[/* enter_module_type_declaration */10], mtd); + return Curry._1(funarg[/* leave_module_type_declaration */35], /* record */[ + /* mtd_id */mtd$1[/* mtd_id */0], + /* mtd_name */mtd$1[/* mtd_name */1], + /* mtd_type */may_map(map_module_type, mtd$1[/* mtd_type */2]), + /* mtd_attributes */mtd$1[/* mtd_attributes */3], + /* mtd_loc */mtd$1[/* mtd_loc */4] ]); }; var map_class_type_declaration = function (cd) { @@ -23645,6 +23654,63 @@ function TypedtreeMap_000(funarg) { /* ci_attributes */cd$1[/* ci_attributes */11] ]); }; + var map_type_extension = function (tyext) { + var tyext$1 = Curry._1(funarg[/* enter_type_extension */3], tyext); + var tyext_params = List.map(map_type_parameter, tyext$1[/* tyext_params */2]); + var tyext_constructors = List.map(map_extension_constructor, tyext$1[/* tyext_constructors */3]); + return Curry._1(funarg[/* leave_type_extension */28], /* record */[ + /* tyext_path */tyext$1[/* tyext_path */0], + /* tyext_txt */tyext$1[/* tyext_txt */1], + /* tyext_params */tyext_params, + /* tyext_constructors */tyext_constructors, + /* tyext_private */tyext$1[/* tyext_private */4], + /* tyext_attributes */tyext$1[/* tyext_attributes */5] + ]); + }; + var map_type_declaration = function (decl) { + var decl$1 = Curry._1(funarg[/* enter_type_declaration */2], decl); + var typ_params = List.map(map_type_parameter, decl$1[/* typ_params */2]); + var typ_cstrs = List.map((function (param) { + return /* tuple */[ + map_core_type(param[0]), + map_core_type(param[1]), + param[2] + ]; + }), decl$1[/* typ_cstrs */4]); + var match = decl$1[/* typ_kind */5]; + var typ_kind; + if (typeof match === "number") { + typ_kind = match === 0 ? /* Ttype_abstract */0 : /* Ttype_open */1; + } else if (match.tag) { + var list = List.map((function (ld) { + return /* record */[ + /* ld_id */ld[/* ld_id */0], + /* ld_name */ld[/* ld_name */1], + /* ld_mutable */ld[/* ld_mutable */2], + /* ld_type */map_core_type(ld[/* ld_type */3]), + /* ld_loc */ld[/* ld_loc */4], + /* ld_attributes */ld[/* ld_attributes */5] + ]; + }), match[0]); + typ_kind = /* Ttype_record */Block.__(1, [list]); + } else { + var list$1 = List.map(map_constructor_declaration, match[0]); + typ_kind = /* Ttype_variant */Block.__(0, [list$1]); + } + var typ_manifest = may_map(map_core_type, decl$1[/* typ_manifest */7]); + return Curry._1(funarg[/* leave_type_declaration */27], /* record */[ + /* typ_id */decl$1[/* typ_id */0], + /* typ_name */decl$1[/* typ_name */1], + /* typ_params */typ_params, + /* typ_type */decl$1[/* typ_type */3], + /* typ_cstrs */typ_cstrs, + /* typ_kind */typ_kind, + /* typ_private */decl$1[/* typ_private */6], + /* typ_manifest */typ_manifest, + /* typ_loc */decl$1[/* typ_loc */8], + /* typ_attributes */decl$1[/* typ_attributes */9] + ]); + }; var map_class_declaration = function (cd) { var cd$1 = Curry._1(funarg[/* enter_class_declaration */16], cd); var ci_params = List.map(map_type_parameter, cd$1[/* ci_params */1]); @@ -23664,6 +23730,45 @@ function TypedtreeMap_000(funarg) { /* ci_attributes */cd$1[/* ci_attributes */11] ]); }; + var map_value_description = function (v) { + var v$1 = Curry._1(funarg[/* enter_value_description */1], v); + var val_desc = map_core_type(v$1[/* val_desc */2]); + return Curry._1(funarg[/* leave_value_description */26], /* record */[ + /* val_id */v$1[/* val_id */0], + /* val_name */v$1[/* val_name */1], + /* val_desc */val_desc, + /* val_val */v$1[/* val_val */3], + /* val_prim */v$1[/* val_prim */4], + /* val_loc */v$1[/* val_loc */5], + /* val_attributes */v$1[/* val_attributes */6] + ]); + }; + var map_extension_constructor = function (ext) { + var ext$1 = Curry._1(funarg[/* enter_extension_constructor */4], ext); + var match = ext$1[/* ext_kind */3]; + var ext_kind; + if (match.tag) { + ext_kind = /* Text_rebind */Block.__(1, [ + match[0], + match[1] + ]); + } else { + var args = List.map(map_core_type, match[0]); + var ret = may_map(map_core_type, match[1]); + ext_kind = /* Text_decl */Block.__(0, [ + args, + ret + ]); + } + return Curry._1(funarg[/* leave_extension_constructor */29], /* record */[ + /* ext_id */ext$1[/* ext_id */0], + /* ext_name */ext$1[/* ext_name */1], + /* ext_type */ext$1[/* ext_type */2], + /* ext_kind */ext_kind, + /* ext_loc */ext$1[/* ext_loc */4], + /* ext_attributes */ext$1[/* ext_attributes */5] + ]); + }; var map_module_binding = function (x) { return /* record */[ /* mb_id */x[/* mb_id */0], @@ -23673,111 +23778,6 @@ function TypedtreeMap_000(funarg) { /* mb_loc */x[/* mb_loc */4] ]; }; - var map_module_type_declaration = function (mtd) { - var mtd$1 = Curry._1(funarg[/* enter_module_type_declaration */10], mtd); - return Curry._1(funarg[/* leave_module_type_declaration */35], /* record */[ - /* mtd_id */mtd$1[/* mtd_id */0], - /* mtd_name */mtd$1[/* mtd_name */1], - /* mtd_type */may_map(map_module_type, mtd$1[/* mtd_type */2]), - /* mtd_attributes */mtd$1[/* mtd_attributes */3], - /* mtd_loc */mtd$1[/* mtd_loc */4] - ]); - }; - var map_type_extension = function (tyext) { - var tyext$1 = Curry._1(funarg[/* enter_type_extension */3], tyext); - var tyext_params = List.map(map_type_parameter, tyext$1[/* tyext_params */2]); - var tyext_constructors = List.map(map_extension_constructor, tyext$1[/* tyext_constructors */3]); - return Curry._1(funarg[/* leave_type_extension */28], /* record */[ - /* tyext_path */tyext$1[/* tyext_path */0], - /* tyext_txt */tyext$1[/* tyext_txt */1], - /* tyext_params */tyext_params, - /* tyext_constructors */tyext_constructors, - /* tyext_private */tyext$1[/* tyext_private */4], - /* tyext_attributes */tyext$1[/* tyext_attributes */5] - ]); - }; - var map_structure_item = function (item) { - var item$1 = Curry._1(funarg[/* enter_structure_item */24], item); - var match = item$1[/* str_desc */0]; - var str_desc; - switch (match.tag | 0) { - case 0 : - str_desc = /* Tstr_eval */Block.__(0, [ - map_expression(match[0]), - match[1] - ]); - break; - case 1 : - str_desc = /* Tstr_value */Block.__(1, [ - match[0], - List.map(map_binding, match[1]) - ]); - break; - case 2 : - str_desc = /* Tstr_primitive */Block.__(2, [map_value_description(match[0])]); - break; - case 3 : - str_desc = /* Tstr_type */Block.__(3, [List.map(map_type_declaration, match[0])]); - break; - case 4 : - str_desc = /* Tstr_typext */Block.__(4, [map_type_extension(match[0])]); - break; - case 5 : - str_desc = /* Tstr_exception */Block.__(5, [map_extension_constructor(match[0])]); - break; - case 6 : - str_desc = /* Tstr_module */Block.__(6, [map_module_binding(match[0])]); - break; - case 7 : - var list = List.map(map_module_binding, match[0]); - str_desc = /* Tstr_recmodule */Block.__(7, [list]); - break; - case 8 : - str_desc = /* Tstr_modtype */Block.__(8, [map_module_type_declaration(match[0])]); - break; - case 9 : - str_desc = /* Tstr_open */Block.__(9, [match[0]]); - break; - case 10 : - var list$1 = List.map((function (param) { - return /* tuple */[ - map_class_declaration(param[0]), - param[1], - param[2] - ]; - }), match[0]); - str_desc = /* Tstr_class */Block.__(10, [list$1]); - break; - case 11 : - var list$2 = List.map((function (param) { - return /* tuple */[ - param[0], - param[1], - map_class_type_declaration(param[2]) - ]; - }), match[0]); - str_desc = /* Tstr_class_type */Block.__(11, [list$2]); - break; - case 12 : - var incl = match[0]; - str_desc = /* Tstr_include */Block.__(12, [/* record */[ - /* incl_mod */map_module_expr(incl[/* incl_mod */0]), - /* incl_type */incl[/* incl_type */1], - /* incl_loc */incl[/* incl_loc */2], - /* incl_attributes */incl[/* incl_attributes */3] - ]]); - break; - case 13 : - str_desc = /* Tstr_attribute */Block.__(13, [match[0]]); - break; - - } - return Curry._1(funarg[/* leave_structure_item */49], /* record */[ - /* str_desc */str_desc, - /* str_loc */item$1[/* str_loc */1], - /* str_env */item$1[/* str_env */2] - ]); - }; var map_class_description = function (cd) { var cd$1 = Curry._1(funarg[/* enter_class_description */17], cd); var ci_params = List.map(map_type_parameter, cd$1[/* ci_params */1]); diff --git a/jscomp/test/ocaml_typedtree_test.ml b/jscomp/test/ocaml_typedtree_test.ml index 2b0df71580..75f48fcb05 100644 --- a/jscomp/test/ocaml_typedtree_test.ml +++ b/jscomp/test/ocaml_typedtree_test.ml @@ -1,5 +1,5 @@ [@@@ocaml.warning "-a"] -module Config : sig +module Config : sig #1 "config.mli" (***********************************************************************) (* *) @@ -161,10 +161,10 @@ let version = Sys.ocaml_version let standard_library_default = "/Users/hongbozhang/git/bucklescript/vendor/ocaml/lib/ocaml" let standard_library = - - try + + try Sys.getenv "BSLIB" - with Not_found -> + with Not_found -> standard_library_default @@ -277,7 +277,7 @@ let print_config oc = ;; end -module Clflags : sig +module Clflags : sig #1 "clflags.mli" (***********************************************************************) (* *) @@ -380,11 +380,11 @@ val unsafe_string : bool ref val opaque : bool ref - + type mli_status = Mli_na | Mli_exists | Mli_non_exists val no_implicit_current_dir : bool ref -val assume_no_mli : mli_status ref -val record_event_when_debug : bool ref +val assume_no_mli : mli_status ref +val record_event_when_debug : bool ref val bs_vscode : bool val dont_record_crc_unit : string option ref val bs_only : bool ref (* set true on bs top*) @@ -515,14 +515,14 @@ let keep_locs = ref false (* -keep-locs *) let unsafe_string = ref true;; (* -safe-string / -unsafe-string *) - + type mli_status = Mli_na | Mli_exists | Mli_non_exists let no_implicit_current_dir = ref false let assume_no_mli = ref Mli_na let record_event_when_debug = ref true (* turned off in BuckleScript*) -let bs_vscode = +let bs_vscode = try ignore @@ Sys.getenv "BS_VSCODE" ; true with _ -> false - (* We get it from environment variable mostly due to + (* We get it from environment variable mostly due to we don't want to rebuild when flip on or off *) let dont_record_crc_unit : string option ref = ref None @@ -540,7 +540,7 @@ let color = ref None ;; (* -color *) end -module Misc : sig +module Misc : sig #1 "misc.mli" (***********************************************************************) (* *) @@ -1228,7 +1228,7 @@ module Color = struct (* external isatty : out_channel -> bool = "caml_sys_isatty" *) (* reasonable heuristic on whether colors should be enabled *) - let should_enable_color () = false + let should_enable_color () = false (* let term = try Sys.getenv "TERM" with Not_found -> "" in term <> "dumb" && term <> "" *) @@ -1254,7 +1254,7 @@ end end -module Terminfo : sig +module Terminfo : sig #1 "terminfo.mli" (***********************************************************************) (* *) @@ -1307,7 +1307,7 @@ external standout : bool -> unit = "caml_terminfo_standout";; external resume : int -> unit = "caml_terminfo_resume";; end -module Warnings : sig +module Warnings : sig #1 "warnings.mli" (***********************************************************************) (* *) @@ -1402,7 +1402,7 @@ val backup: unit -> state val restore: state -> unit -val message : t -> string +val message : t -> string val number: t -> int val super_print : (t -> string) -> formatter -> t -> unit;; @@ -1552,7 +1552,7 @@ let number = function let last_warning_number = 104 (* Must be the max number returned by the [number] function. *) -let letter_all = +let letter_all = let rec loop i = if i = 0 then [] else i :: loop (i - 1) in loop last_warning_number @@ -1819,7 +1819,7 @@ let message = function | Bs_ffi_warning s -> "BuckleScript FFI warning: " ^ s | Bs_derive_warning s -> - "BuckleScript bs.deriving warning: " ^ s + "BuckleScript bs.deriving warning: " ^ s ;; let nerrors = ref 0;; @@ -1938,7 +1938,7 @@ let help_warnings () = ;; end -module Location : sig +module Location : sig #1 "location.mli" (***********************************************************************) (* *) @@ -2047,7 +2047,7 @@ val print_error_prefix: formatter -> unit -> unit val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error - + val pp_ksprintf : ?before:(formatter -> unit) -> (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b @@ -2342,10 +2342,10 @@ let setup_colors () = let print_loc ppf loc = setup_colors (); let (file, line, startchar) = get_pos_info loc.loc_start in - - let startchar = - if Clflags.bs_vscode then startchar + 1 else startchar in - + + let startchar = + if Clflags.bs_vscode then startchar + 1 else startchar in + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in if file = "//toplevel//" then begin if highlight_locations ppf [loc] then () else @@ -2589,7 +2589,7 @@ type variance = | Invariant end -module Ident : sig +module Ident : sig #1 "ident.mli" (***********************************************************************) (* *) @@ -2884,7 +2884,7 @@ let make_key_generator () = { id with name = key_name; stamp = stamp; } end -module Path : sig +module Path : sig #1 "path.mli" (***********************************************************************) (* *) @@ -2975,7 +2975,7 @@ let rec last = function | Papply(_, p) -> last p end -module Longident : sig +module Longident : sig #1 "longident.mli" (***********************************************************************) (* *) @@ -3880,7 +3880,7 @@ and directive_argument = | Pdir_bool of bool end -module Primitive : sig +module Primitive : sig #1 "primitive.mli" (***********************************************************************) (* *) @@ -3976,7 +3976,7 @@ let byte_name p = p.prim_name end -module Types : sig +module Types : sig #1 "types.mli" (***********************************************************************) (* *) @@ -4587,17 +4587,17 @@ and ext_status = | Text_next (* not first constructor of an extension *) | Text_exception (* an exception *) -let equal_tag t1 t2 = +let equal_tag t1 t2 = match (t1, t2) with | Cstr_constant i1, Cstr_constant i2 -> i2 = i1 | Cstr_block i1, Cstr_block i2 -> i2 = i1 - | Cstr_extension (path1, b1), Cstr_extension (path2, b2) -> + | Cstr_extension (path1, b1), Cstr_extension (path2, b2) -> Path.same path1 path2 && b1 = b2 | (Cstr_constant _|Cstr_block _|Cstr_extension _), _ -> false - + end -module Btype : sig +module Btype : sig #1 "btype.mli" (***********************************************************************) (* *) @@ -5481,7 +5481,7 @@ let backtrack (changes, old) = Weak.set trail 0 (Some changes) end -module Cmi_format : sig +module Cmi_format : sig #1 "cmi_format.mli" (***********************************************************************) (* *) @@ -5632,7 +5632,7 @@ let () = ) end -module Consistbl : sig +module Consistbl : sig #1 "consistbl.mli" (***********************************************************************) (* *) @@ -5761,7 +5761,7 @@ let filter p tbl = !to_remove end -module Datarepr : sig +module Datarepr : sig #1 "datarepr.mli" (***********************************************************************) (* *) @@ -5846,7 +5846,7 @@ let free_vars ty = !ret let internal_optional = "internal.optional" - + let optional_shape : Parsetree.attribute = {txt = internal_optional ; loc = Location.none}, PStr [] @@ -5854,7 +5854,7 @@ let constructor_has_optional_shape ({cstr_attributes = attrs} : constructor_desc List.exists (fun (x,_) -> x.txt = internal_optional) attrs - + let constructor_descrs ty_res cstrs priv = let num_consts = ref 0 and num_nonconsts = ref 0 and num_normal = ref 0 in List.iter @@ -5900,7 +5900,7 @@ let constructor_descrs ty_res cstrs priv = cstr_attributes = cd_attributes; } in (cd_id, cstr) :: descr_rem in - let result = describe_constructors 0 0 cstrs in + let result = describe_constructors 0 0 cstrs in match result with | ( [ ({name = "None"} as a_id, ({cstr_args = []} as a_descr) ) ; @@ -6002,7 +6002,7 @@ let find_constr_by_tag tag cstrlist = find_constr tag 0 0 cstrlist end -module Predef : sig +module Predef : sig #1 "predef.mli" (***********************************************************************) (* *) @@ -6310,7 +6310,7 @@ let _ = Ident.set_current_time 999 let builtin_idents = List.rev !builtin_idents end -module Docstrings : sig +module Docstrings : sig #1 "docstrings.mli" (***********************************************************************) (* *) @@ -6809,7 +6809,7 @@ let init () = end -module Ast_helper : sig +module Ast_helper : sig #1 "ast_helper.mli" (***********************************************************************) (* *) @@ -7688,7 +7688,7 @@ end end -module Ast_mapper : sig +module Ast_mapper : sig #1 "ast_mapper.mli" (***********************************************************************) (* *) @@ -8794,7 +8794,7 @@ let register_function = ref (fun _name f -> run_main f) let register name f = !register_function name f end -module Tbl : sig +module Tbl : sig #1 "tbl.mli" (***********************************************************************) (* *) @@ -8943,7 +8943,7 @@ let print print_key print_data ppf tbl = fprintf ppf "@[[[%a]]@]" print_tbl tbl end -module Subst : sig +module Subst : sig #1 "subst.mli" (***********************************************************************) (* *) @@ -9423,7 +9423,7 @@ let compose s1 s2 = for_saving = false } end -module Env : sig +module Env : sig #1 "env.mli" (***********************************************************************) (* *) @@ -11036,7 +11036,7 @@ and check_value_name name loc = (* Note: we could also check here general validity of the identifier, to protect against bad identifiers forged by -pp or -ppx preprocessors. *) - if !Clflags.bs_only && name = "|." then raise (Error(Illegal_value_name(loc, name))) + if !Clflags.bs_only && name = "|." then raise (Error(Illegal_value_name(loc, name))) else if String.length name > 0 && (name.[0] = '#') then for i = 1 to String.length name - 1 do if name.[i] = '#' then @@ -11358,16 +11358,16 @@ let crc_of_unit name = (* Return the list of imported interfaces with their CRCs *) let imports() = - - let dont_record_crc_unit = !Clflags.dont_record_crc_unit in - match dont_record_crc_unit with + + let dont_record_crc_unit = !Clflags.dont_record_crc_unit in + match dont_record_crc_unit with | None -> Consistbl.extract (StringSet.elements !imported_units) crc_units - | Some x -> - Consistbl.extract - (StringSet.fold - (fun m acc -> if m = x then acc else m::acc) + | Some x -> + Consistbl.extract + (StringSet.fold + (fun m acc -> if m = x then acc else m::acc) !imported_units []) crc_units - + (* Save a signature to a file *) @@ -11580,7 +11580,7 @@ let () = ) end -module Mt : sig +module Mt : sig #1 "mt.mli" type eq = | Eq : 'a *'a -> eq @@ -11598,22 +11598,22 @@ type pair_suites = (string * (unit -> eq)) list val from_suites : string -> (string * (unit -> unit)) list -> unit val from_pair_suites : string -> pair_suites -> unit -type promise_suites = (string * eq Js.Promise.t) list +type promise_suites = (string * eq Js.Promise2.t) list -val from_promise_suites : +val from_promise_suites : string -> - promise_suites -> + promise_suites -> unit -val eq_suites : +val eq_suites : test_id:int ref -> suites:pair_suites ref -> string -> 'b -> 'b -> unit - + val bool_suites : test_id:int ref -> suites: pair_suites ref -> string -> bool -> unit -val throw_suites : +val throw_suites : test_id:int ref -> suites: pair_suites ref -> string -> (unit -> unit) -> unit end = struct @@ -11627,7 +11627,7 @@ external describe : string -> (unit -> unit[@bs]) -> unit = "describe" external it : string -> (unit -> unit[@bs.uncurry]) -> unit = "it" [@@bs.val] -external it_promise : string -> (unit -> _ Js.Promise.t [@bs.uncurry]) -> unit = "it" +external it_promise : string -> (unit -> _ Js.Promise2.t [@bs.uncurry]) -> unit = "it" [@@bs.val] external eq : 'a -> 'a -> unit = "deepEqual" @@ -11704,7 +11704,7 @@ type eq = (* TODO: | Exception : exn -> (unit -> unit) -> _ eq *) type pair_suites = (string * (unit -> eq)) list -type promise_suites = (string * eq Js.Promise.t) list +type promise_suites = (string * eq Js.Promise2.t) list let close_enough ?(threshold=0.0000001 (* epsilon_float *)) a b = abs_float (a -. b) < threshold @@ -11724,7 +11724,7 @@ let node_from_pair_suites (name : string) (suites : pair_suites) = | Ok a -> Js.log (name, a, "ok?") ) suites -let handleCode spec = +let handleCode spec = match spec with | Eq(a,b) -> assert_equal a b @@ -11754,8 +11754,8 @@ let from_pair_suites name (suites : pair_suites) = ) else node_from_pair_suites name suites | _ -> () -let val_unit = Js.Promise.resolve () -let from_promise_suites name (suites : (string * _ Js.Promise.t ) list) = +let val_unit = Js.Promise2.resolve () +let from_promise_suites name (suites : (string * _ Js.Promise2.t ) list) = match Array.to_list Node.Process.process##argv with | cmd :: _ -> if is_mocha () then @@ -11763,7 +11763,7 @@ let from_promise_suites name (suites : (string * _ Js.Promise.t ) list) = suites |> List.iter (fun (name, code) -> it_promise name (fun _ -> - code |> Js.Promise.then_ (fun x -> handleCode x; val_unit) + code |. Js.Promise2.then_ (fun x -> handleCode x; val_unit) ) ) @@ -11792,22 +11792,22 @@ let from_pair_suites_non_top name suites = from_pair_suites name suites *) -let eq_suites ~test_id ~suites loc x y = - incr test_id ; - suites := +let eq_suites ~test_id ~suites loc x y = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Eq(x,y))) :: !suites -let bool_suites ~test_id ~suites loc x = - incr test_id ; - suites := - (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Ok(x))) :: !suites +let bool_suites ~test_id ~suites loc x = + incr test_id ; + suites := + (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Ok(x))) :: !suites -let throw_suites ~test_id ~suites loc x = - incr test_id ; - suites := +let throw_suites ~test_id ~suites loc x = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> ThrowAny(x))) :: !suites end -module Syntaxerr : sig +module Syntaxerr : sig #1 "syntaxerr.mli" (***********************************************************************) (* *) @@ -11927,7 +11927,7 @@ let ill_formed_ast loc s = raise (Error (Ill_formed_ast (loc, s))) end -module Parser : sig +module Parser : sig #1 "parser.mli" type token = | AMPERAMPER @@ -24208,7 +24208,7 @@ let parse_pattern (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = ;; end -module Lexer : sig +module Lexer : sig #1 "lexer.mli" (***********************************************************************) (* *) @@ -24228,7 +24228,7 @@ val init : unit -> unit val token: Lexing.lexbuf -> Parser.token val skip_sharp_bang: Lexing.lexbuf -> unit -type directive_type +type directive_type (* type directive_value = *) (* | Dir_bool of bool *) @@ -24247,8 +24247,8 @@ type error = | Literal_overflow of string | Unterminated_paren_in_conditional | Unterminated_if - | Unterminated_else - | Unexpected_token_in_conditional + | Unterminated_else + | Unexpected_token_in_conditional | Expect_hash_then_in_conditional | Illegal_semver of string | Unexpected_directive @@ -24305,7 +24305,7 @@ val filter_directive_from_lexbuf : Lexing.lexbuf -> (int * int) list val replace_directive_int : string -> int -> unit val replace_directive_string : string -> string -> unit -val replace_directive_bool : string -> bool -> unit +val replace_directive_bool : string -> bool -> unit val remove_directive_built_in_value : string -> unit (** @return false means failed to define *) @@ -24315,35 +24315,35 @@ val list_variables : Format.formatter -> unit end = struct #1 "lexer.ml" # 15 "parsing/lexer.mll" - + open Lexing open Misc open Parser type directive_value = - | Dir_bool of bool + | Dir_bool of bool | Dir_float of float | Dir_int of int | Dir_string of string - | Dir_null + | Dir_null -type directive_type = - | Dir_type_bool - | Dir_type_float - | Dir_type_int - | Dir_type_string - | Dir_type_null +type directive_type = + | Dir_type_bool + | Dir_type_float + | Dir_type_int + | Dir_type_string + | Dir_type_null let type_of_directive x = - match x with + match x with | Dir_bool _ -> Dir_type_bool | Dir_float _ -> Dir_type_float | Dir_int _ -> Dir_type_int | Dir_string _ -> Dir_type_string | Dir_null -> Dir_type_null -let string_of_type_directive x = - match x with +let string_of_type_directive x = + match x with | Dir_type_bool -> "bool" | Dir_type_float -> "float" | Dir_type_int -> "int" @@ -24360,20 +24360,20 @@ type error = | Literal_overflow of string | Unterminated_paren_in_conditional | Unterminated_if - | Unterminated_else - | Unexpected_token_in_conditional + | Unterminated_else + | Unexpected_token_in_conditional | Expect_hash_then_in_conditional | Illegal_semver of string - | Unexpected_directive + | Unexpected_directive | Conditional_expr_expected_type of directive_type * directive_type ;; exception Error of error * Location.t;; -let assert_same_type lexbuf x y = +let assert_same_type lexbuf x y = let lhs = type_of_directive x in let rhs = type_of_directive y in - if lhs <> rhs then + if lhs <> rhs then raise (Error(Conditional_expr_expected_type(lhs,rhs), Location.curr lexbuf)) else y @@ -24381,50 +24381,50 @@ let directive_built_in_values = Hashtbl.create 51 -let replace_directive_built_in_value k v = - Hashtbl.replace directive_built_in_values k v +let replace_directive_built_in_value k v = + Hashtbl.replace directive_built_in_values k v -let remove_directive_built_in_value k = +let remove_directive_built_in_value k = Hashtbl.replace directive_built_in_values k Dir_null -let replace_directive_int k v = +let replace_directive_int k v = Hashtbl.replace directive_built_in_values k (Dir_int v) -let replace_directive_bool k v = +let replace_directive_bool k v = Hashtbl.replace directive_built_in_values k (Dir_bool v) -let replace_directive_string k v = +let replace_directive_string k v = Hashtbl.replace directive_built_in_values k (Dir_string v) let () = - (* Note we use {!Config} instead of {!Sys} becasue - we want to overwrite in some cases with the + (* Note we use {!Config} instead of {!Sys} becasue + we want to overwrite in some cases with the same stdlib *) - let version = - + let version = + Config.version (* so that it can be overridden*) in - replace_directive_built_in_value "OCAML_VERSION" + replace_directive_built_in_value "OCAML_VERSION" (Dir_string version); replace_directive_built_in_value "OCAML_PATCH" - (Dir_string - (match String.rindex version '+' with + (Dir_string + (match String.rindex version '+' with | exception Not_found -> "" - | i -> + | i -> String.sub version (i + 1) (String.length version - i - 1))) ; - replace_directive_built_in_value "OS_TYPE" + replace_directive_built_in_value "OS_TYPE" (Dir_string Sys.os_type); - replace_directive_built_in_value "BIG_ENDIAN" + replace_directive_built_in_value "BIG_ENDIAN" (Dir_bool Sys.big_endian); - replace_directive_built_in_value "WORD_SIZE" + replace_directive_built_in_value "WORD_SIZE" (Dir_int Sys.word_size) let find_directive_built_in_value k = - Hashtbl.find directive_built_in_values k + Hashtbl.find directive_built_in_values k let iter_directive_built_in_value f = Hashtbl.iter f directive_built_in_values @@ -24439,15 +24439,15 @@ let iter_directive_built_in_value f = Hashtbl.iter f directive_built_in_values # semver 0 "12.3.10+x";; - : int * int * int * string = (12, 3, 10, "+x") ]} -*) -let zero = Char.code '0' +*) +let zero = Char.code '0' let dot = Char.code '.' -let semantic_version_parse str start last_index = +let semantic_version_parse str start last_index = let rec aux start acc last_index = if start <= last_index then let c = Char.code (String.unsafe_get str start) in if c = dot then (acc, start + 1) (* consume [4.] instead of [4]*) - else + else let v = c - zero in if v >=0 && v <= 9 then aux (start + 1) (acc * 10 + v) last_index @@ -24456,11 +24456,11 @@ let semantic_version_parse str start last_index = in let major, major_end = aux start 0 last_index in let minor, minor_end = aux major_end 0 last_index in - let patch, patch_end = aux minor_end 0 last_index in + let patch, patch_end = aux minor_end 0 last_index in let additional = String.sub str patch_end (last_index - patch_end +1) in (major, minor, patch), additional -(** +(** {[ semver Location.none "1.2.3" "~1.3.0" = false;; semver Location.none "1.2.3" "^1.3.0" = true ;; @@ -24471,38 +24471,38 @@ let semantic_version_parse str start last_index = ]} *) let semver loc lhs str = - let last_index = String.length str - 1 in + let last_index = String.length str - 1 in if last_index < 0 then raise (Error(Illegal_semver str, loc)) - else - let pred, ((major, minor,patch) as version, _) = - let v = String.unsafe_get str 0 in + else + let pred, ((major, minor,patch) as version, _) = + let v = String.unsafe_get str 0 in match v with - | '>' -> - if last_index = 0 then raise (Error(Illegal_semver str, loc)) else - if String.unsafe_get str 1 = '=' then + | '>' -> + if last_index = 0 then raise (Error(Illegal_semver str, loc)) else + if String.unsafe_get str 1 = '=' then `Ge, semantic_version_parse str 2 last_index else `Gt, semantic_version_parse str 1 last_index - | '<' + | '<' -> - if last_index = 0 then raise (Error(Illegal_semver str, loc)) else - if String.unsafe_get str 1 = '=' then + if last_index = 0 then raise (Error(Illegal_semver str, loc)) else + if String.unsafe_get str 1 = '=' then `Le, semantic_version_parse str 2 last_index else `Lt, semantic_version_parse str 1 last_index - | '^' + | '^' -> `Compatible, semantic_version_parse str 1 last_index | '~' -> `Approximate, semantic_version_parse str 1 last_index - | _ -> `Exact, semantic_version_parse str 0 last_index - in + | _ -> `Exact, semantic_version_parse str 0 last_index + in let ((l_major, l_minor, l_patch) as lversion,_) = - semantic_version_parse lhs 0 (String.length lhs - 1) in - match pred with - | `Ge -> lversion >= version - | `Gt -> lversion > version + semantic_version_parse lhs 0 (String.length lhs - 1) in + match pred with + | `Ge -> lversion >= version + | `Gt -> lversion > version | `Le -> lversion <= version - | `Lt -> lversion < version - | `Approximate -> major = l_major && minor = l_minor + | `Lt -> lversion < version + | `Approximate -> major = l_major && minor = l_minor | `Compatible -> major = l_major - | `Exact -> lversion = version + | `Exact -> lversion = version let pp_directive_value fmt (x : directive_value) = @@ -24511,10 +24511,10 @@ let pp_directive_value fmt (x : directive_value) = | Dir_int b -> Format.pp_print_int fmt b | Dir_float b -> Format.pp_print_float fmt b | Dir_string s -> Format.fprintf fmt "%S" s - | Dir_null -> Format.pp_print_string fmt "null" + | Dir_null -> Format.pp_print_string fmt "null" -let list_variables fmt = - iter_directive_built_in_value +let list_variables fmt = + iter_directive_built_in_value (fun s dir_value -> Format.fprintf fmt "@[%s@ %a@]@." @@ -24522,11 +24522,11 @@ let list_variables fmt = ) let defined str = - begin match find_directive_built_in_value str with - | Dir_null -> false + begin match find_directive_built_in_value str with + | Dir_null -> false | _ -> true - | exception _ -> - try ignore @@ Sys.getenv str; true with _ -> false + | exception _ -> + try ignore @@ Sys.getenv str; true with _ -> false end let query loc str = @@ -24534,21 +24534,21 @@ let query loc str = | Dir_null -> Dir_bool false | v -> v | exception Not_found -> - begin match Sys.getenv str with - | v -> - begin - try Dir_bool (bool_of_string v) with - _ -> - begin + begin match Sys.getenv str with + | v -> + begin + try Dir_bool (bool_of_string v) with + _ -> + begin try Dir_int (int_of_string v ) - with - _ -> - begin try (Dir_float (float_of_string v)) + with + _ -> + begin try (Dir_float (float_of_string v)) with _ -> Dir_string v end end end - | exception Not_found -> + | exception Not_found -> Dir_bool false end end @@ -24556,37 +24556,37 @@ let query loc str = let define_key_value key v = if String.length key > 0 - && Char.uppercase (key.[0]) = key.[0] then - begin + && Char.uppercase (key.[0]) = key.[0] then + begin replace_directive_built_in_value key begin (* NEED Sync up across {!lexer.mll} {!bspp.ml} and here, TODO: put it in {!lexer.mll} *) - try Dir_bool (bool_of_string v) with - _ -> - begin + try Dir_bool (bool_of_string v) with + _ -> + begin try Dir_int (int_of_string v ) - with - _ -> - begin try (Dir_float (float_of_string v)) + with + _ -> + begin try (Dir_float (float_of_string v)) with _ -> Dir_string v end end end; true end - else false + else false -let value_of_token loc (t : Parser.token) = - match t with - | INT i -> Dir_int i - | STRING (s,_) -> Dir_string s +let value_of_token loc (t : Parser.token) = + match t with + | INT i -> Dir_int i + | STRING (s,_) -> Dir_string s | FLOAT s -> Dir_float (float_of_string s) | TRUE -> Dir_bool true | FALSE -> Dir_bool false - | UIDENT s -> query loc s + | UIDENT s -> query loc s | _ -> raise (Error (Unexpected_token_in_conditional, loc)) @@ -24594,59 +24594,59 @@ let directive_parse token_with_comments lexbuf = let look_ahead = ref None in let token () : Parser.token = let v = !look_ahead in - match v with - | Some v -> + match v with + | Some v -> look_ahead := None ; v | None -> - let rec skip () = + let rec skip () = match token_with_comments lexbuf with | COMMENT _ -> skip () | DOCSTRING _ -> skip () | EOL -> skip () - | EOF -> raise (Error (Unterminated_if, Location.curr lexbuf)) - | t -> t + | EOF -> raise (Error (Unterminated_if, Location.curr lexbuf)) + | t -> t in skip () in let push e = (* INVARIANT: only look at most one token *) assert (!look_ahead = None); - look_ahead := Some e + look_ahead := Some e in let rec token_op calc ~no lhs = - match token () with - | (LESS - | GREATER - | INFIXOP0 "<=" - | INFIXOP0 ">=" + match token () with + | (LESS + | GREATER + | INFIXOP0 "<=" + | INFIXOP0 ">=" | EQUAL | INFIXOP0 "<>" as op) -> - let f = - match op with - | LESS -> (<) + let f = + match op with + | LESS -> (<) | GREATER -> (>) | INFIXOP0 "<=" -> (<=) | EQUAL -> (=) - | INFIXOP0 "<>" -> (<>) + | INFIXOP0 "<>" -> (<>) | _ -> assert false - in - let curr_loc = Location.curr lexbuf in - let rhs = value_of_token curr_loc (token ()) in + in + let curr_loc = Location.curr lexbuf in + let rhs = value_of_token curr_loc (token ()) in not calc || f lhs (assert_same_type lexbuf lhs rhs) - | INFIXOP0 "=~" -> + | INFIXOP0 "=~" -> not calc || - begin match lhs with + begin match lhs with | Dir_string s -> - let curr_loc = Location.curr lexbuf in - let rhs = value_of_token curr_loc (token ()) in - begin match rhs with - | Dir_string rhs -> + let curr_loc = Location.curr lexbuf in + let rhs = value_of_token curr_loc (token ()) in + begin match rhs with + | Dir_string rhs -> semver curr_loc s rhs - | _ -> + | _ -> raise (Error ( Conditional_expr_expected_type @@ -24657,7 +24657,7 @@ let directive_parse token_with_comments lexbuf = ( Conditional_expr_expected_type (Dir_type_string, type_of_directive lhs), Location.curr lexbuf)) end - | e -> no e + | e -> no e and parse_or calc : bool = parse_or_aux calc (parse_and calc) @@ -24667,9 +24667,9 @@ let directive_parse token_with_comments lexbuf = match token () with | BARBAR -> let b = parse_or (calc && not v) in - v || b + v || b | e -> push e ; v - and parse_and calc = + and parse_and calc = parse_and_aux calc (parse_relation calc) and parse_and_aux calc v = (* a && (b && (c && d)) *) (* let l = v in *) @@ -24682,33 +24682,33 @@ let directive_parse token_with_comments lexbuf = let curr_token = token () in let curr_loc = Location.curr lexbuf in match curr_token with - | TRUE -> true + | TRUE -> true | FALSE -> false | UIDENT v -> let value_v = query curr_loc v in - token_op calc + token_op calc ~no:(fun e -> push e ; - match value_v with - | Dir_bool b -> b - | _ -> + match value_v with + | Dir_bool b -> b + | _ -> let ty = type_of_directive value_v in raise (Error(Conditional_expr_expected_type (Dir_type_bool, ty), curr_loc))) value_v - | INT v -> + | INT v -> token_op calc - ~no:(fun e -> - raise(Error(Conditional_expr_expected_type(Dir_type_bool,Dir_type_int), + ~no:(fun e -> + raise(Error(Conditional_expr_expected_type(Dir_type_bool,Dir_type_int), curr_loc))) (Dir_int v) - | FLOAT v -> + | FLOAT v -> token_op calc - ~no:(fun e -> + ~no:(fun e -> raise (Error(Conditional_expr_expected_type(Dir_type_bool, Dir_type_float), curr_loc))) (Dir_float (float_of_string v)) - | STRING (v,_) -> + | STRING (v,_) -> token_op calc ~no:(fun e -> raise (Error @@ -24716,14 +24716,14 @@ let directive_parse token_with_comments lexbuf = curr_loc))) (Dir_string v) | LIDENT ("defined" | "undefined" as r) -> - let t = token () in + let t = token () in let loc = Location.curr lexbuf in begin match t with - | UIDENT s -> - not calc || - if r.[0] = 'u' then + | UIDENT s -> + not calc || + if r.[0] = 'u' then not @@ defined s - else defined s + else defined s | _ -> raise (Error (Unexpected_token_in_conditional, loc)) end | LPAREN -> @@ -24731,13 +24731,13 @@ let directive_parse token_with_comments lexbuf = begin match token () with | RPAREN -> v | _ -> raise (Error(Unterminated_paren_in_conditional, Location.curr lexbuf)) - end + end | _ -> raise (Error (Unexpected_token_in_conditional, curr_loc)) in let v = parse_or true in begin match token () with - | THEN -> v + | THEN -> v | _ -> raise (Error (Expect_hash_then_in_conditional, Location.curr lexbuf)) end @@ -24745,10 +24745,10 @@ let directive_parse token_with_comments lexbuf = type dir_conditional = | Dir_if_true | Dir_if_false - | Dir_out + | Dir_out let string_of_dir_conditional (x : dir_conditional) = - match x with + match x with | Dir_if_true -> "Dir_if_true" | Dir_if_false -> "Dir_if_false" | Dir_out -> "Dir_out" @@ -24864,10 +24864,10 @@ let in_string () = !is_in_string let print_warnings = ref true let if_then_else = ref Dir_out let sharp_look_ahead = ref None -let update_if_then_else v = +let update_if_then_else v = (* Format.fprintf Format.err_formatter "@[update %s \n@]@." (string_of_dir_conditional v); *) if_then_else := v - + let with_comment_buffer comment lexbuf = let start_loc = Location.curr lexbuf in comment_start_loc := [start_loc]; @@ -25008,22 +25008,22 @@ let report_error ppf = function | Literal_overflow ty -> fprintf ppf "Integer literal exceeds the range of representable \ integers of type %s" ty - | Unterminated_if -> + | Unterminated_if -> fprintf ppf "#if not terminated" - | Unterminated_else -> + | Unterminated_else -> fprintf ppf "#else not terminated" | Unexpected_directive -> fprintf ppf "Unexpected directive" - | Unexpected_token_in_conditional -> + | Unexpected_token_in_conditional -> fprintf ppf "Unexpected token in conditional predicate" | Unterminated_paren_in_conditional -> fprintf ppf "Unterminated parens in conditional predicate" - | Expect_hash_then_in_conditional -> + | Expect_hash_then_in_conditional -> fprintf ppf "Expect `then` after conditional predicate" - | Conditional_expr_expected_type (a,b) -> - fprintf ppf "Conditional expression type mismatch (%s,%s)" + | Conditional_expr_expected_type (a,b) -> + fprintf ppf "Conditional expression type mismatch (%s,%s)" (string_of_type_directive a ) (string_of_type_directive b ) - | Illegal_semver s -> + | Illegal_semver s -> fprintf ppf "Illegal semantic version string %s" s let () = Location.register_error_of_exn @@ -25037,7 +25037,7 @@ let () = # 727 "parsing/lexer.ml" let __ocaml_lex_tables = { - Lexing.lex_base = + Lexing.lex_base = "\000\000\164\255\165\255\224\000\003\001\038\001\073\001\108\001\ \143\001\188\255\178\001\215\001\196\255\091\000\252\001\031\002\ \068\000\071\000\084\000\066\002\213\255\215\255\218\255\101\002\ @@ -25064,7 +25064,7 @@ let __ocaml_lex_tables = { \252\255\238\006\254\255\255\255\111\001\112\001\253\255\074\007\ \016\001\019\001\050\001\063\001\026\001\107\001\033\001\019\000\ \255\255"; - Lexing.lex_backtrk = + Lexing.lex_backtrk = "\255\255\255\255\255\255\088\000\087\000\084\000\083\000\076\000\ \074\000\255\255\065\000\062\000\255\255\055\000\054\000\052\000\ \050\000\046\000\044\000\079\000\255\255\255\255\255\255\035\000\ @@ -25091,7 +25091,7 @@ let __ocaml_lex_tables = { \255\255\003\000\255\255\255\255\003\000\255\255\255\255\255\255\ \002\000\255\255\255\255\001\000\255\255\255\255\255\255\255\255\ \255\255"; - Lexing.lex_default = + Lexing.lex_default = "\001\000\000\000\000\000\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\255\255\255\255\000\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\000\000\000\000\000\000\255\255\ @@ -25118,7 +25118,7 @@ let __ocaml_lex_tables = { \000\000\255\255\000\000\000\000\255\255\255\255\000\000\255\255\ \255\255\255\255\194\000\197\000\255\255\197\000\255\255\255\255\ \000\000"; - Lexing.lex_trans = + Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\039\000\040\000\040\000\039\000\041\000\045\000\043\000\ \043\000\040\000\044\000\044\000\045\000\073\000\098\000\104\000\ @@ -25614,7 +25614,7 @@ let __ocaml_lex_tables = { \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\255\255"; - Lexing.lex_check = + Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\000\000\041\000\000\000\000\000\041\000\042\000\ \044\000\045\000\042\000\044\000\045\000\074\000\099\000\105\000\ @@ -26110,7 +26110,7 @@ let __ocaml_lex_tables = { \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\169\000"; - Lexing.lex_base_code = + Lexing.lex_base_code = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ @@ -26137,7 +26137,7 @@ let __ocaml_lex_tables = { \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000"; - Lexing.lex_backtrk_code = + Lexing.lex_backtrk_code = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ @@ -26164,7 +26164,7 @@ let __ocaml_lex_tables = { \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000"; - Lexing.lex_default_code = + Lexing.lex_default_code = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ @@ -26191,7 +26191,7 @@ let __ocaml_lex_tables = { \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000"; - Lexing.lex_trans_code = + Lexing.lex_trans_code = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\001\000\000\000\036\000\036\000\000\000\036\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ @@ -26229,7 +26229,7 @@ let __ocaml_lex_tables = { \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000"; - Lexing.lex_check_code = + Lexing.lex_check_code = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\024\000\101\000\169\000\176\000\101\000\177\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ @@ -26267,7 +26267,7 @@ let __ocaml_lex_tables = { \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255"; - Lexing.lex_code = + Lexing.lex_code = "\255\004\255\255\005\255\255\007\255\006\255\255\003\255\000\004\ \001\005\255\007\255\255\006\255\007\255\255\000\004\001\005\003\ \006\002\007\255\001\255\255\000\001\255"; @@ -26463,7 +26463,7 @@ and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = # 865 "parsing/lexer.mll" ( let s, loc = with_comment_buffer comment lexbuf in - DOCSTRING (Docstrings.docstring s loc) + DOCSTRING (Docstrings.docstring s loc) ) # 2160 "parsing/lexer.ml" @@ -26818,9 +26818,9 @@ and if !if_then_else = Dir_if_true then raise (Error (Unterminated_if, Location.curr lexbuf)) else raise (Error(Unterminated_else, Location.curr lexbuf)) - else + else EOF - + ) # 2516 "parsing/lexer.ml" @@ -26831,7 +26831,7 @@ and ) # 2523 "parsing/lexer.ml" - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_token_rec lexbuf __ocaml_lex_state and comment lexbuf = @@ -26960,7 +26960,7 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = ( store_lexeme lexbuf; comment lexbuf ) # 2652 "parsing/lexer.ml" - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_comment_rec lexbuf __ocaml_lex_state and string lexbuf = @@ -27042,7 +27042,7 @@ let string lexbuf ) # 2734 "parsing/lexer.ml" - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_string_rec lexbuf __ocaml_lex_state and quoted_string delim lexbuf = @@ -27079,7 +27079,7 @@ and __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state = quoted_string delim lexbuf ) # 2771 "parsing/lexer.ml" - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state and skip_sharp_bang lexbuf = @@ -27101,17 +27101,17 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = ( () ) # 2793 "parsing/lexer.ml" - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state ;; # 1139 "parsing/lexer.mll" - - let at_bol lexbuf = - let pos = Lexing.lexeme_start_p lexbuf in - pos.pos_cnum = pos.pos_bol + + let at_bol lexbuf = + let pos = Lexing.lexeme_start_p lexbuf in + pos.pos_cnum = pos.pos_bol let token_with_comments lexbuf = match !preprocessor with @@ -27137,42 +27137,42 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = and docstring = Docstrings.docstring - let interpret_directive lexbuf cont look_ahead = + let interpret_directive lexbuf cont look_ahead = let if_then_else = !if_then_else in - begin match token_with_comments lexbuf, if_then_else with + begin match token_with_comments lexbuf, if_then_else with | IF, Dir_out -> - let rec skip_from_if_false () = + let rec skip_from_if_false () = let token = token_with_comments lexbuf in - if token = EOF then + if token = EOF then raise (Error (Unterminated_if, Location.curr lexbuf)) else - if token = SHARP && at_bol lexbuf then - begin + if token = SHARP && at_bol lexbuf then + begin let token = token_with_comments lexbuf in match token with - | END -> + | END -> begin update_if_then_else Dir_out; cont lexbuf end - | ELSE -> + | ELSE -> begin update_if_then_else Dir_if_false; cont lexbuf end | IF -> raise (Error (Unexpected_directive, Location.curr lexbuf)) - | _ -> + | _ -> if is_elif token && directive_parse token_with_comments lexbuf then begin update_if_then_else Dir_if_true; cont lexbuf end - else skip_from_if_false () + else skip_from_if_false () end - else skip_from_if_false () in + else skip_from_if_false () in if directive_parse token_with_comments lexbuf then - begin + begin update_if_then_else Dir_if_true (* Next state: ELSE *); cont lexbuf end @@ -27183,46 +27183,46 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = | LIDENT "elif", (Dir_if_false | Dir_out) -> (* when the predicate is false, it will continue eating `elif` *) raise (Error(Unexpected_directive, Location.curr lexbuf)) - | (LIDENT "elif" | ELSE as token), Dir_if_true -> + | (LIDENT "elif" | ELSE as token), Dir_if_true -> (* looking for #end, however, it can not see #if anymore *) - let rec skip_from_if_true else_seen = + let rec skip_from_if_true else_seen = let token = token_with_comments lexbuf in - if token = EOF then + if token = EOF then raise (Error (Unterminated_else, Location.curr lexbuf)) else - if token = SHARP && at_bol lexbuf then - begin - let token = token_with_comments lexbuf in - match token with - | END -> + if token = SHARP && at_bol lexbuf then + begin + let token = token_with_comments lexbuf in + match token with + | END -> begin update_if_then_else Dir_out; cont lexbuf - end - | IF -> - raise (Error (Unexpected_directive, Location.curr lexbuf)) + end + | IF -> + raise (Error (Unexpected_directive, Location.curr lexbuf)) | ELSE -> - if else_seen then + if else_seen then raise (Error (Unexpected_directive, Location.curr lexbuf)) - else + else skip_from_if_true true | _ -> - if else_seen && is_elif token then + if else_seen && is_elif token then raise (Error (Unexpected_directive, Location.curr lexbuf)) - else + else skip_from_if_true else_seen end - else skip_from_if_true else_seen in + else skip_from_if_true else_seen in skip_from_if_true (token = ELSE) - | ELSE, Dir_if_false - | ELSE, Dir_out -> + | ELSE, Dir_if_false + | ELSE, Dir_out -> raise (Error(Unexpected_directive, Location.curr lexbuf)) - | END, (Dir_if_false | Dir_if_true ) -> + | END, (Dir_if_false | Dir_if_true ) -> update_if_then_else Dir_out; cont lexbuf - | END, Dir_out -> + | END, Dir_out -> raise (Error(Unexpected_directive, Location.curr lexbuf)) | token, (Dir_if_true | Dir_if_false | Dir_out) -> - look_ahead token + look_ahead token end let token lexbuf = @@ -27273,8 +27273,8 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = | BlankLine -> BlankLine in loop lines' docs lexbuf - | SHARP when at_bol lexbuf -> - interpret_directive lexbuf + | SHARP when at_bol lexbuf -> + interpret_directive lexbuf (fun lexbuf -> loop lines docs lexbuf) (fun token -> sharp_look_ahead := Some token; SHARP) @@ -27297,12 +27297,12 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = tok - + in match !sharp_look_ahead with - | None -> + | None -> loop NoLine Initial lexbuf - | Some token -> + | Some token -> sharp_look_ahead := None ; token @@ -27320,20 +27320,20 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = match token_with_comments lexbuf with | SHARP when at_bol lexbuf -> (* ^[start_pos]#if ... #then^[end_pos] *) - let start_pos = Lexing.lexeme_start lexbuf in - interpret_directive lexbuf - (fun lexbuf -> - filter_directive + let start_pos = Lexing.lexeme_start lexbuf in + interpret_directive lexbuf + (fun lexbuf -> + filter_directive (Lexing.lexeme_end lexbuf) ((pos, start_pos) :: acc) lexbuf - + ) (fun _token -> filter_directive pos acc lexbuf ) | EOF -> (pos, Lexing.lexeme_end lexbuf) :: acc | _ -> filter_directive pos acc lexbuf - let filter_directive_from_lexbuf lexbuf = + let filter_directive_from_lexbuf lexbuf = List.rev (filter_directive 0 [] lexbuf ) let set_preprocessor init preprocess = @@ -27344,7 +27344,7 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = # 3035 "parsing/lexer.ml" end -module Parse : sig +module Parse : sig #1 "parse.mli" (***********************************************************************) (* *) @@ -27436,7 +27436,7 @@ and expression = wrap Parser.parse_expression and pattern = wrap Parser.parse_pattern end -module Typedtree : sig +module Typedtree : sig #1 "typedtree.mli" (***********************************************************************) (* *) @@ -28569,7 +28569,7 @@ type ident = ;; end -module TypedtreeMap : sig +module TypedtreeMap : sig #1 "typedtreeMap.mli" (***********************************************************************) (* *) @@ -29366,7 +29366,7 @@ module DefaultMapArgument = struct end end -module Cmt_format : sig +module Cmt_format : sig #1 "cmt_format.mli" (***********************************************************************) (* *) @@ -29735,7 +29735,7 @@ let save_cmt filename modname binary_annots sourcefile initial_env sg = clear () end -module Ctype : sig +module Ctype : sig #1 "ctype.mli" (***********************************************************************) (* *) @@ -34654,7 +34654,7 @@ type out_phrase = | Ophr_exception of (exn * out_value) end -module Oprint : sig +module Oprint : sig #1 "oprint.mli" (***********************************************************************) (* *) @@ -34880,7 +34880,7 @@ and print_simple_out_type ppf = Otyp_class (ng, id, tyl) -> fprintf ppf "@[%a%s#%a@]" print_typargs tyl (if ng then "_" else "") print_ident id - + | Otyp_constr ( (Oide_dot (((Oide_dot (Oide_ident "Js", "Internal"))| (Oide_ident "Js_internal")), ("fn" | "meth" as name )) as id) , ([Otyp_variant(_,Ovar_fields [ variant, _, tys], _,_); result] as tyl)) @@ -34891,19 +34891,19 @@ and print_simple_out_type ppf = Otyp_arrow ("", Otyp_constr (Oide_ident "unit", []),result) else match tys with - | [ Otyp_tuple tys as single] -> + | [ Otyp_tuple tys as single] -> if variant = "Arity_1" then Otyp_arrow ("", single, result) - else + else List.fold_right (fun x acc -> Otyp_arrow("",x,acc) ) tys result | [single] -> Otyp_arrow ("", single, result) - | _ -> + | _ -> raise_notrace Not_found in begin match (make tys result) with | exception _ -> - begin + begin pp_open_box ppf 0; print_typargs ppf tyl; print_ident ppf id; @@ -34911,11 +34911,11 @@ and print_simple_out_type ppf = end | res -> begin match name with - | "fn" -> + | "fn" -> fprintf ppf "@[<0>(%a@ [@bs])@]" print_out_type_1 res | "meth" -> fprintf ppf "@[<0>(%a@ [@bs.meth])@]" print_out_type_1 res - | _ -> assert false + | _ -> assert false end end | Otyp_constr ((Oide_dot ((Oide_dot (Oide_ident "Js", "Internal") | (Oide_ident "Js_internal")), "meth_callback" ) as id) , @@ -34923,18 +34923,18 @@ and print_simple_out_type ppf = -> let make tys result = match tys with - | [ Otyp_tuple tys as single ] -> + | [ Otyp_tuple tys as single ] -> if variant = "Arity_1" then Otyp_arrow ("", single, result) - else + else List.fold_right (fun x acc -> Otyp_arrow("",x,acc) ) tys result | [single] -> Otyp_arrow ("", single, result) - | _ -> + | _ -> raise_notrace Not_found in begin match (make tys result) with | exception _ -> - begin + begin pp_open_box ppf 0; print_typargs ppf tyl; print_ident ppf id; @@ -34944,7 +34944,7 @@ and print_simple_out_type ppf = fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 res end - + | Otyp_constr (id, tyl) -> pp_open_box ppf 0; print_typargs ppf tyl; @@ -35193,10 +35193,10 @@ and print_out_sig_item ppf = let len = String.length s in if len >= 3 && s.[0] = 'B' && s.[1] = 'S' && s.[2] = ':' then - fprintf ppf "@ \"BS-EXTERNAL\"" + fprintf ppf "@ \"BS-EXTERNAL\"" else fprintf ppf "@ \"%s\"" s - + ) sl in fprintf ppf "@[<2>%s %a :@ %a%a@]" kwd value_ident name !out_type @@ -35393,7 +35393,7 @@ let print_out_phrase ppf = let out_phrase = ref print_out_phrase end -module Printtyp : sig +module Printtyp : sig #1 "printtyp.mli" (***********************************************************************) (* *) @@ -36977,14 +36977,14 @@ let super_type_expansion ~tag t ppf t' = let super_trace ppf = let rec super_trace first_report ppf = function | (t1, t1') :: (t2, t2') :: rem -> - fprintf ppf + fprintf ppf "@,@,@["; - if first_report then + if first_report then fprintf ppf "The incompatible parts:@," - else begin + else begin fprintf ppf "Further expanded:@," end; - fprintf ppf + fprintf ppf "@[\ @[%a@]@,\ vs@,\ @@ -37090,7 +37090,7 @@ let report_ambiguous_type_error ppf env (tp0, tp0') tpl txt1 txt2 txt3 = txt3 (type_path_expansion tp0) tp0') end -module Includeclass : sig +module Includeclass : sig #1 "includeclass.mli" (***********************************************************************) (* *) @@ -37232,7 +37232,7 @@ let report_error ppf = function fprintf ppf "@[%a%a@]" include_err err print_errs errs end -module Includecore : sig +module Includecore : sig #1 "includecore.mli" (***********************************************************************) (* *) @@ -37615,7 +37615,7 @@ let vars vars1 vars2 = vars2 ([], []) end -module Mtype : sig +module Mtype : sig #1 "mtype.mli" (***********************************************************************) (* *) @@ -38044,7 +38044,7 @@ let remove_aliases env sg = remove_aliases env excl sg end -module Includemod : sig +module Includemod : sig #1 "includemod.mli" (***********************************************************************) (* *) @@ -38721,7 +38721,7 @@ let () = ) end -module Stypes : sig +module Stypes : sig #1 "stypes.mli" (***********************************************************************) (* *) @@ -38970,7 +38970,7 @@ let dump filename = ;; end -module Parmatch : sig +module Parmatch : sig #1 "parmatch.mli" (***********************************************************************) (* *) @@ -41072,7 +41072,7 @@ let check_partial_gadt pred loc casel = do_check_fragile_gadt loc casel end -module Typetexp : sig +module Typetexp : sig #1 "typetexp.mli" (***********************************************************************) (* *) @@ -41302,12 +41302,12 @@ let check_deprecated loc attrs s = | ({txt = "ocaml.deprecated"|"deprecated"; _}, p) -> begin match string_of_payload p with | Some txt -> - -if Clflags.bs_vscode then + +if Clflags.bs_vscode then Location.prerr_warning loc (Warnings.Deprecated (s ^ " " ^ txt)) -else +else Location.prerr_warning loc (Warnings.Deprecated (s ^ "\n" ^ txt)) - + | None -> Location.prerr_warning loc (Warnings.Deprecated s) end @@ -42225,7 +42225,7 @@ let () = ) end -module Typecore : sig +module Typecore : sig #1 "typecore.mli" (***********************************************************************) (* *) @@ -45127,7 +45127,7 @@ and type_label_access env loc srecord lid = and type_format loc str env = #if 1 then assert false -#else +#else let loc = {loc with Location.loc_ghost = true} in try CamlinternalFormatBasics.(CamlinternalFormat.( @@ -46366,7 +46366,7 @@ let () = Env.add_delayed_check_forward := add_delayed_check end -module Typedecl : sig +module Typedecl : sig #1 "typedecl.mli" (***********************************************************************) (* *) @@ -47774,18 +47774,18 @@ let transl_exception env sext = let newenv = Env.add_extension ~check:true ext.ext_id ext.ext_type env in ext, newenv - let customize_arity arity pval_attributes = - let cur_arity = ref arity in - List.iter (fun (x:Parsetree.attribute) -> - match x with - | {txt = "internal.arity";_}, + let customize_arity arity pval_attributes = + let cur_arity = ref arity in + List.iter (fun (x:Parsetree.attribute) -> + match x with + | {txt = "internal.arity";_}, PStr [ {pstr_desc = Pstr_eval ( ({pexp_desc = Pexp_constant (Const_int i)} : Parsetree.expression) ,_)}] -> if i < !cur_arity then cur_arity := i | _ -> () - ) pval_attributes ; + ) pval_attributes ; !cur_arity (* Translate a value declaration *) @@ -47800,7 +47800,7 @@ let transl_value_decl env loc valdecl = | decl -> let arity = customize_arity (Ctype.arity ty) valdecl.pval_attributes in let prim = Primitive.parse_declaration arity decl in - let prim_native_name = prim.prim_native_name in + let prim_native_name = prim.prim_native_name in if arity = 0 && not ( String.length prim_native_name > 3 && String.unsafe_get prim_native_name 0 = 'B' && String.unsafe_get prim_native_name 1 = 'S' && @@ -48148,7 +48148,7 @@ let () = ) end -module Typeclass : sig +module Typeclass : sig #1 "typeclass.mli" (***********************************************************************) (* *) @@ -50120,7 +50120,7 @@ let () = ) end -module Typemod : sig +module Typemod : sig #1 "typemod.mli" (***********************************************************************) (* *) @@ -51822,8 +51822,8 @@ let type_implementation_more sourcefile outputprefix modulename initial_env ast end else begin let sourceintf = Misc.chop_extension_if_any sourcefile ^ !Config.interface_suffix in - - let mli_status = !Clflags.assume_no_mli in + + let mli_status = !Clflags.assume_no_mli in if (mli_status = Clflags.Mli_na && Sys.file_exists sourceintf) || (mli_status = Clflags.Mli_exists) then begin let intf_file = @@ -51871,8 +51871,8 @@ let type_implementation_more sourcefile outputprefix modulename initial_env ast (Some sourcefile) initial_env None; raise e let type_implementation sourcefile outputprefix modulename initial_env ast = - let (a,b,_,_) = - type_implementation_more sourcefile outputprefix modulename initial_env ast in + let (a,b,_,_) = + type_implementation_more sourcefile outputprefix modulename initial_env ast in a,b let save_signature modname tsg outputprefix source_file initial_env cmi = @@ -51923,7 +51923,7 @@ let package_units initial_env objfiles cmifile modulename = let prefix = chop_extension_if_any cmifile in let mlifile = prefix ^ !Config.interface_suffix in - let mli_status = !Clflags.assume_no_mli in + let mli_status = !Clflags.assume_no_mli in if (mli_status = Clflags.Mli_na && Sys.file_exists mlifile) || (mli_status = Clflags.Mli_exists) then begin if not (Sys.file_exists cmifile) then begin @@ -52055,28 +52055,28 @@ module Ocaml_typed_tree_main #1 "ocaml_typed_tree_main.ml" let suites : Mt.pair_suites ref = ref [] let test_id = ref 0 -let eq loc x y = - incr test_id ; - suites := +let eq loc x y = + incr test_id ; + suites := (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites -let v str = - str - |> Lexing.from_string +let v str = + str + |> Lexing.from_string |> Parse.implementation -let ( ) = - begin +let ( ) = + begin Clflags.dont_write_files := true; Clflags.unsafe_string := false; Clflags.debug := true; Clflags.record_event_when_debug := false; - Clflags.binary_annotations := false; + Clflags.binary_annotations := false; Clflags.nopervasives := true; Clflags.assume_no_mli := Mli_non_exists end -let x = +let x = let modulename = "Test" in Typemod.type_implementation modulename modulename modulename Env.empty (v {| type int @@ -52092,8 +52092,8 @@ external ( mod ) : int -> int -> int = "%modint" let f x y = x + y|});; -let () = - match x with +let () = + match x with | ({Typedtree.str_items = {Typedtree.str_desc = Typedtree.Tstr_type @@ -52276,7 +52276,7 @@ let () = | _ -> eq __LOC__ true false (* [%debugger] ; Js.log x *) -let () = +let () = Mt.from_pair_suites __MODULE__ !suites (* local variables: *) (* compile-command: "ocamlc.opt -c -I +compiler-libs ocaml_typed_tree_main.ml" *) diff --git a/jscomp/test/parser_api.js b/jscomp/test/parser_api.js index 545c1401c2..fd33c1e7c3 100644 --- a/jscomp/test/parser_api.js +++ b/jscomp/test/parser_api.js @@ -34,7 +34,7 @@ var Caml_js_exceptions = require("../../lib/js/caml_js_exceptions.js"); var Caml_missing_polyfill = require("../../lib/js/caml_missing_polyfill.js"); var Caml_builtin_exceptions = require("../../lib/js/caml_builtin_exceptions.js"); -var standard_library_default = "/Users/hongbozhang/git/bucklescript/vendor/ocaml/lib/ocaml"; +var standard_library_default = "/Users/chenglou/Github/bucklescript/vendor/ocaml/lib/ocaml"; var standard_library; @@ -49,7 +49,7 @@ catch (exn){ } } -var standard_runtime = "/Users/hongbozhang/git/bucklescript/vendor/ocaml/bin/ocamlrun"; +var standard_runtime = "/Users/chenglou/Github/bucklescript/vendor/ocaml/bin/ocamlrun"; var ccomp_type = "cc"; @@ -107,9 +107,9 @@ var ext_lib = ".a"; var ext_dll = ".so"; -var host = "x86_64-apple-darwin17.7.0"; +var host = "x86_64-apple-darwin18.2.0"; -var target = "x86_64-apple-darwin17.7.0"; +var target = "x86_64-apple-darwin18.2.0"; var default_executable_name = "a.out"; @@ -12639,16 +12639,11 @@ function directive_parse(token_with_comments, lexbuf) { ]; }), /* Dir_float */Block.__(1, [Caml_format.caml_float_of_string(curr_token[0])])); case 7 : + var v$1 = curr_token[0]; return token_op(calc, (function (e) { - throw [ - $$Error$2, - /* Conditional_expr_expected_type */Block.__(7, [ - /* Dir_type_bool */0, - /* Dir_type_int */2 - ]), - curr_loc - ]; - }), /* Dir_int */Block.__(2, [curr_token[0]])); + push(e); + return v$1 !== 0; + }), /* Dir_int */Block.__(2, [v$1])); case 11 : var r = curr_token[0]; var exit = 0; @@ -13960,7 +13955,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 989, + 992, 16 ] ]; @@ -13997,7 +13992,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 1003, + 1006, 18 ] ]; @@ -14048,7 +14043,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 1023, + 1026, 18 ] ]; @@ -14087,7 +14082,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { Caml_builtin_exceptions.assert_failure, /* tuple */[ "lexer.mll", - 1053, + 1056, 16 ] ]; diff --git a/jscomp/test/parser_api.ml b/jscomp/test/parser_api.ml index be2fe2e9be..9b08546101 100644 --- a/jscomp/test/parser_api.ml +++ b/jscomp/test/parser_api.ml @@ -157,7 +157,7 @@ end = struct (* The main OCaml version string has moved to ../VERSION *) let version = Sys.ocaml_version -let standard_library_default = "/Users/hongbozhang/git/bucklescript/vendor/ocaml/lib/ocaml" +let standard_library_default = "/Users/chenglou/Github/bucklescript/vendor/ocaml/lib/ocaml" let standard_library = @@ -167,7 +167,7 @@ let standard_library = standard_library_default -let standard_runtime = "/Users/hongbozhang/git/bucklescript/vendor/ocaml/bin/ocamlrun" +let standard_runtime = "/Users/chenglou/Github/bucklescript/vendor/ocaml/bin/ocamlrun" let ccomp_type = "cc" let bytecomp_c_compiler = "gcc -O -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -O " let bytecomp_c_libraries = "-lcurses -lpthread" @@ -218,8 +218,8 @@ let ext_asm = ".s" let ext_lib = ".a" let ext_dll = ".so" -let host = "x86_64-apple-darwin17.7.0" -let target = "x86_64-apple-darwin17.7.0" +let host = "x86_64-apple-darwin18.2.0" +let target = "x86_64-apple-darwin18.2.0" let default_executable_name = match Sys.os_type with @@ -17763,8 +17763,11 @@ let directive_parse token_with_comments lexbuf = | INT v -> token_op calc ~no:(fun e -> - raise(Error(Conditional_expr_expected_type(Dir_type_bool,Dir_type_int), - curr_loc))) + push e ; + v <> 0 + + + ) (Dir_int v) | FLOAT v -> token_op calc @@ -18099,7 +18102,7 @@ let () = ) -# 727 "parsing/lexer.ml" +# 730 "parsing/lexer.ml" let __ocaml_lex_tables = { Lexing.lex_base = "\000\000\164\255\165\255\224\000\003\001\038\001\073\001\108\001\ @@ -19342,123 +19345,123 @@ let rec token lexbuf = and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 767 "parsing/lexer.mll" +# 770 "parsing/lexer.mll" ( if not !escaped_newlines then raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0), Location.curr lexbuf)); update_loc lexbuf None 1 false 0; token lexbuf ) -# 1977 "parsing/lexer.ml" +# 1980 "parsing/lexer.ml" | 1 -> -# 774 "parsing/lexer.mll" +# 777 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0; EOL ) -# 1983 "parsing/lexer.ml" +# 1986 "parsing/lexer.ml" | 2 -> -# 777 "parsing/lexer.mll" +# 780 "parsing/lexer.mll" ( token lexbuf ) -# 1988 "parsing/lexer.ml" +# 1991 "parsing/lexer.ml" | 3 -> -# 779 "parsing/lexer.mll" +# 782 "parsing/lexer.mll" ( UNDERSCORE ) -# 1993 "parsing/lexer.ml" +# 1996 "parsing/lexer.ml" | 4 -> -# 781 "parsing/lexer.mll" +# 784 "parsing/lexer.mll" ( TILDE ) -# 1998 "parsing/lexer.ml" +# 2001 "parsing/lexer.ml" | 5 -> -# 783 "parsing/lexer.mll" +# 786 "parsing/lexer.mll" ( LABEL (get_label_name lexbuf) ) -# 2003 "parsing/lexer.ml" +# 2006 "parsing/lexer.ml" | 6 -> -# 785 "parsing/lexer.mll" +# 788 "parsing/lexer.mll" ( warn_latin1 lexbuf; LABEL (get_label_name lexbuf) ) -# 2008 "parsing/lexer.ml" +# 2011 "parsing/lexer.ml" | 7 -> -# 787 "parsing/lexer.mll" +# 790 "parsing/lexer.mll" ( QUESTION ) -# 2013 "parsing/lexer.ml" +# 2016 "parsing/lexer.ml" | 8 -> -# 789 "parsing/lexer.mll" +# 792 "parsing/lexer.mll" ( OPTLABEL (get_label_name lexbuf) ) -# 2018 "parsing/lexer.ml" +# 2021 "parsing/lexer.ml" | 9 -> -# 791 "parsing/lexer.mll" +# 794 "parsing/lexer.mll" ( warn_latin1 lexbuf; OPTLABEL (get_label_name lexbuf) ) -# 2023 "parsing/lexer.ml" +# 2026 "parsing/lexer.ml" | 10 -> -# 793 "parsing/lexer.mll" +# 796 "parsing/lexer.mll" ( let s = Lexing.lexeme lexbuf in try Hashtbl.find keyword_table s with Not_found -> LIDENT s ) -# 2030 "parsing/lexer.ml" +# 2033 "parsing/lexer.ml" | 11 -> -# 797 "parsing/lexer.mll" +# 800 "parsing/lexer.mll" ( warn_latin1 lexbuf; LIDENT (Lexing.lexeme lexbuf) ) -# 2035 "parsing/lexer.ml" +# 2038 "parsing/lexer.ml" | 12 -> -# 799 "parsing/lexer.mll" +# 802 "parsing/lexer.mll" ( UIDENT(Lexing.lexeme lexbuf) ) -# 2040 "parsing/lexer.ml" +# 2043 "parsing/lexer.ml" | 13 -> -# 801 "parsing/lexer.mll" +# 804 "parsing/lexer.mll" ( warn_latin1 lexbuf; UIDENT(Lexing.lexeme lexbuf) ) -# 2045 "parsing/lexer.ml" +# 2048 "parsing/lexer.ml" | 14 -> -# 803 "parsing/lexer.mll" +# 806 "parsing/lexer.mll" ( try INT (cvt_int_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int", Location.curr lexbuf)) ) -# 2054 "parsing/lexer.ml" +# 2057 "parsing/lexer.ml" | 15 -> -# 809 "parsing/lexer.mll" +# 812 "parsing/lexer.mll" ( FLOAT (remove_underscores(Lexing.lexeme lexbuf)) ) -# 2059 "parsing/lexer.ml" +# 2062 "parsing/lexer.ml" | 16 -> -# 811 "parsing/lexer.mll" +# 814 "parsing/lexer.mll" ( try INT32 (cvt_int32_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int32", Location.curr lexbuf)) ) -# 2067 "parsing/lexer.ml" +# 2070 "parsing/lexer.ml" | 17 -> -# 816 "parsing/lexer.mll" +# 819 "parsing/lexer.mll" ( try INT64 (cvt_int64_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int64", Location.curr lexbuf)) ) -# 2075 "parsing/lexer.ml" +# 2078 "parsing/lexer.ml" | 18 -> -# 821 "parsing/lexer.mll" +# 824 "parsing/lexer.mll" ( try NATIVEINT (cvt_nativeint_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "nativeint", Location.curr lexbuf)) ) -# 2083 "parsing/lexer.ml" +# 2086 "parsing/lexer.ml" | 19 -> -# 826 "parsing/lexer.mll" +# 829 "parsing/lexer.mll" ( reset_string_buffer(); is_in_string := true; let string_start = lexbuf.lex_start_p in @@ -19467,10 +19470,10 @@ and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = is_in_string := false; lexbuf.lex_start_p <- string_start; STRING (get_stored_string(), None) ) -# 2095 "parsing/lexer.ml" +# 2098 "parsing/lexer.ml" | 20 -> -# 835 "parsing/lexer.mll" +# 838 "parsing/lexer.mll" ( reset_string_buffer(); let delim = Lexing.lexeme lexbuf in let delim = String.sub delim 1 (String.length delim - 2) in @@ -19481,64 +19484,64 @@ and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = is_in_string := false; lexbuf.lex_start_p <- string_start; STRING (get_stored_string(), Some delim) ) -# 2109 "parsing/lexer.ml" +# 2112 "parsing/lexer.ml" | 21 -> -# 846 "parsing/lexer.mll" +# 849 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 1; CHAR (Lexing.lexeme_char lexbuf 1) ) -# 2115 "parsing/lexer.ml" +# 2118 "parsing/lexer.ml" | 22 -> -# 849 "parsing/lexer.mll" +# 852 "parsing/lexer.mll" ( CHAR(Lexing.lexeme_char lexbuf 1) ) -# 2120 "parsing/lexer.ml" +# 2123 "parsing/lexer.ml" | 23 -> -# 851 "parsing/lexer.mll" +# 854 "parsing/lexer.mll" ( CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) ) -# 2125 "parsing/lexer.ml" +# 2128 "parsing/lexer.ml" | 24 -> -# 853 "parsing/lexer.mll" +# 856 "parsing/lexer.mll" ( CHAR(char_for_decimal_code lexbuf 2) ) -# 2130 "parsing/lexer.ml" +# 2133 "parsing/lexer.ml" | 25 -> -# 855 "parsing/lexer.mll" +# 858 "parsing/lexer.mll" ( CHAR(char_for_hexadecimal_code lexbuf 3) ) -# 2135 "parsing/lexer.ml" +# 2138 "parsing/lexer.ml" | 26 -> -# 857 "parsing/lexer.mll" +# 860 "parsing/lexer.mll" ( let l = Lexing.lexeme lexbuf in let esc = String.sub l 1 (String.length l - 1) in raise (Error(Illegal_escape esc, Location.curr lexbuf)) ) -# 2143 "parsing/lexer.ml" +# 2146 "parsing/lexer.ml" | 27 -> -# 862 "parsing/lexer.mll" +# 865 "parsing/lexer.mll" ( let s, loc = with_comment_buffer comment lexbuf in COMMENT (s, loc) ) -# 2149 "parsing/lexer.ml" +# 2152 "parsing/lexer.ml" | 28 -> -# 865 "parsing/lexer.mll" +# 868 "parsing/lexer.mll" ( let s, loc = with_comment_buffer comment lexbuf in DOCSTRING (Docstrings.docstring s loc) ) -# 2160 "parsing/lexer.ml" +# 2163 "parsing/lexer.ml" | 29 -> let -# 872 "parsing/lexer.mll" +# 875 "parsing/lexer.mll" stars -# 2166 "parsing/lexer.ml" +# 2169 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_curr_pos in -# 873 "parsing/lexer.mll" +# 876 "parsing/lexer.mll" ( let s, loc = with_comment_buffer (fun lexbuf -> @@ -19547,28 +19550,28 @@ let lexbuf in COMMENT (s, loc) ) -# 2177 "parsing/lexer.ml" +# 2180 "parsing/lexer.ml" | 30 -> -# 882 "parsing/lexer.mll" +# 885 "parsing/lexer.mll" ( if !print_warnings then Location.prerr_warning (Location.curr lexbuf) Warnings.Comment_start; let s, loc = with_comment_buffer comment lexbuf in COMMENT (s, loc) ) -# 2185 "parsing/lexer.ml" +# 2188 "parsing/lexer.ml" | 31 -> let -# 886 "parsing/lexer.mll" +# 889 "parsing/lexer.mll" stars -# 2191 "parsing/lexer.ml" +# 2194 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_curr_pos + -2) in -# 887 "parsing/lexer.mll" +# 890 "parsing/lexer.mll" ( COMMENT (stars, Location.curr lexbuf) ) -# 2195 "parsing/lexer.ml" +# 2198 "parsing/lexer.ml" | 32 -> -# 889 "parsing/lexer.mll" +# 892 "parsing/lexer.mll" ( let loc = Location.curr lexbuf in Location.prerr_warning loc Warnings.Comment_not_end; lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; @@ -19576,307 +19579,307 @@ let lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 }; STAR ) -# 2206 "parsing/lexer.ml" +# 2209 "parsing/lexer.ml" | 33 -> let -# 896 "parsing/lexer.mll" +# 899 "parsing/lexer.mll" num -# 2212 "parsing/lexer.ml" +# 2215 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_mem.(1) and -# 897 "parsing/lexer.mll" +# 900 "parsing/lexer.mll" name -# 2217 "parsing/lexer.ml" +# 2220 "parsing/lexer.ml" = Lexing.sub_lexeme_opt lexbuf lexbuf.Lexing.lex_mem.(3) lexbuf.Lexing.lex_mem.(2) in -# 899 "parsing/lexer.mll" +# 902 "parsing/lexer.mll" ( update_loc lexbuf name (int_of_string num) true 0; token lexbuf ) -# 2223 "parsing/lexer.ml" +# 2226 "parsing/lexer.ml" | 34 -> -# 902 "parsing/lexer.mll" +# 905 "parsing/lexer.mll" ( SHARP ) -# 2228 "parsing/lexer.ml" +# 2231 "parsing/lexer.ml" | 35 -> -# 903 "parsing/lexer.mll" +# 906 "parsing/lexer.mll" ( AMPERSAND ) -# 2233 "parsing/lexer.ml" +# 2236 "parsing/lexer.ml" | 36 -> -# 904 "parsing/lexer.mll" +# 907 "parsing/lexer.mll" ( AMPERAMPER ) -# 2238 "parsing/lexer.ml" +# 2241 "parsing/lexer.ml" | 37 -> -# 905 "parsing/lexer.mll" +# 908 "parsing/lexer.mll" ( BACKQUOTE ) -# 2243 "parsing/lexer.ml" +# 2246 "parsing/lexer.ml" | 38 -> -# 906 "parsing/lexer.mll" +# 909 "parsing/lexer.mll" ( QUOTE ) -# 2248 "parsing/lexer.ml" +# 2251 "parsing/lexer.ml" | 39 -> -# 907 "parsing/lexer.mll" +# 910 "parsing/lexer.mll" ( LPAREN ) -# 2253 "parsing/lexer.ml" +# 2256 "parsing/lexer.ml" | 40 -> -# 908 "parsing/lexer.mll" +# 911 "parsing/lexer.mll" ( RPAREN ) -# 2258 "parsing/lexer.ml" +# 2261 "parsing/lexer.ml" | 41 -> -# 909 "parsing/lexer.mll" +# 912 "parsing/lexer.mll" ( STAR ) -# 2263 "parsing/lexer.ml" +# 2266 "parsing/lexer.ml" | 42 -> -# 910 "parsing/lexer.mll" +# 913 "parsing/lexer.mll" ( COMMA ) -# 2268 "parsing/lexer.ml" +# 2271 "parsing/lexer.ml" | 43 -> -# 911 "parsing/lexer.mll" +# 914 "parsing/lexer.mll" ( MINUSGREATER ) -# 2273 "parsing/lexer.ml" +# 2276 "parsing/lexer.ml" | 44 -> -# 912 "parsing/lexer.mll" +# 915 "parsing/lexer.mll" ( DOT ) -# 2278 "parsing/lexer.ml" +# 2281 "parsing/lexer.ml" | 45 -> -# 913 "parsing/lexer.mll" +# 916 "parsing/lexer.mll" ( DOTDOT ) -# 2283 "parsing/lexer.ml" +# 2286 "parsing/lexer.ml" | 46 -> -# 914 "parsing/lexer.mll" +# 917 "parsing/lexer.mll" ( COLON ) -# 2288 "parsing/lexer.ml" +# 2291 "parsing/lexer.ml" | 47 -> -# 915 "parsing/lexer.mll" +# 918 "parsing/lexer.mll" ( COLONCOLON ) -# 2293 "parsing/lexer.ml" +# 2296 "parsing/lexer.ml" | 48 -> -# 916 "parsing/lexer.mll" +# 919 "parsing/lexer.mll" ( COLONEQUAL ) -# 2298 "parsing/lexer.ml" +# 2301 "parsing/lexer.ml" | 49 -> -# 917 "parsing/lexer.mll" +# 920 "parsing/lexer.mll" ( COLONGREATER ) -# 2303 "parsing/lexer.ml" +# 2306 "parsing/lexer.ml" | 50 -> -# 918 "parsing/lexer.mll" +# 921 "parsing/lexer.mll" ( SEMI ) -# 2308 "parsing/lexer.ml" +# 2311 "parsing/lexer.ml" | 51 -> -# 919 "parsing/lexer.mll" +# 922 "parsing/lexer.mll" ( SEMISEMI ) -# 2313 "parsing/lexer.ml" +# 2316 "parsing/lexer.ml" | 52 -> -# 920 "parsing/lexer.mll" +# 923 "parsing/lexer.mll" ( LESS ) -# 2318 "parsing/lexer.ml" +# 2321 "parsing/lexer.ml" | 53 -> -# 921 "parsing/lexer.mll" +# 924 "parsing/lexer.mll" ( LESSMINUS ) -# 2323 "parsing/lexer.ml" +# 2326 "parsing/lexer.ml" | 54 -> -# 922 "parsing/lexer.mll" +# 925 "parsing/lexer.mll" ( EQUAL ) -# 2328 "parsing/lexer.ml" +# 2331 "parsing/lexer.ml" | 55 -> -# 923 "parsing/lexer.mll" +# 926 "parsing/lexer.mll" ( LBRACKET ) -# 2333 "parsing/lexer.ml" +# 2336 "parsing/lexer.ml" | 56 -> -# 924 "parsing/lexer.mll" +# 927 "parsing/lexer.mll" ( LBRACKETBAR ) -# 2338 "parsing/lexer.ml" +# 2341 "parsing/lexer.ml" | 57 -> -# 925 "parsing/lexer.mll" +# 928 "parsing/lexer.mll" ( LBRACKETLESS ) -# 2343 "parsing/lexer.ml" +# 2346 "parsing/lexer.ml" | 58 -> -# 926 "parsing/lexer.mll" +# 929 "parsing/lexer.mll" ( LBRACKETGREATER ) -# 2348 "parsing/lexer.ml" +# 2351 "parsing/lexer.ml" | 59 -> -# 927 "parsing/lexer.mll" +# 930 "parsing/lexer.mll" ( RBRACKET ) -# 2353 "parsing/lexer.ml" +# 2356 "parsing/lexer.ml" | 60 -> -# 928 "parsing/lexer.mll" +# 931 "parsing/lexer.mll" ( LBRACE ) -# 2358 "parsing/lexer.ml" +# 2361 "parsing/lexer.ml" | 61 -> -# 929 "parsing/lexer.mll" +# 932 "parsing/lexer.mll" ( LBRACELESS ) -# 2363 "parsing/lexer.ml" +# 2366 "parsing/lexer.ml" | 62 -> -# 930 "parsing/lexer.mll" +# 933 "parsing/lexer.mll" ( BAR ) -# 2368 "parsing/lexer.ml" +# 2371 "parsing/lexer.ml" | 63 -> -# 931 "parsing/lexer.mll" +# 934 "parsing/lexer.mll" ( BARBAR ) -# 2373 "parsing/lexer.ml" +# 2376 "parsing/lexer.ml" | 64 -> -# 932 "parsing/lexer.mll" +# 935 "parsing/lexer.mll" ( BARRBRACKET ) -# 2378 "parsing/lexer.ml" +# 2381 "parsing/lexer.ml" | 65 -> -# 933 "parsing/lexer.mll" +# 936 "parsing/lexer.mll" ( GREATER ) -# 2383 "parsing/lexer.ml" +# 2386 "parsing/lexer.ml" | 66 -> -# 934 "parsing/lexer.mll" +# 937 "parsing/lexer.mll" ( GREATERRBRACKET ) -# 2388 "parsing/lexer.ml" +# 2391 "parsing/lexer.ml" | 67 -> -# 935 "parsing/lexer.mll" +# 938 "parsing/lexer.mll" ( RBRACE ) -# 2393 "parsing/lexer.ml" +# 2396 "parsing/lexer.ml" | 68 -> -# 936 "parsing/lexer.mll" +# 939 "parsing/lexer.mll" ( GREATERRBRACE ) -# 2398 "parsing/lexer.ml" +# 2401 "parsing/lexer.ml" | 69 -> -# 937 "parsing/lexer.mll" +# 940 "parsing/lexer.mll" ( LBRACKETAT ) -# 2403 "parsing/lexer.ml" +# 2406 "parsing/lexer.ml" | 70 -> -# 938 "parsing/lexer.mll" +# 941 "parsing/lexer.mll" ( LBRACKETPERCENT ) -# 2408 "parsing/lexer.ml" +# 2411 "parsing/lexer.ml" | 71 -> -# 939 "parsing/lexer.mll" +# 942 "parsing/lexer.mll" ( LBRACKETPERCENTPERCENT ) -# 2413 "parsing/lexer.ml" +# 2416 "parsing/lexer.ml" | 72 -> -# 940 "parsing/lexer.mll" +# 943 "parsing/lexer.mll" ( LBRACKETATAT ) -# 2418 "parsing/lexer.ml" +# 2421 "parsing/lexer.ml" | 73 -> -# 941 "parsing/lexer.mll" +# 944 "parsing/lexer.mll" ( LBRACKETATATAT ) -# 2423 "parsing/lexer.ml" +# 2426 "parsing/lexer.ml" | 74 -> -# 942 "parsing/lexer.mll" +# 945 "parsing/lexer.mll" ( BANG ) -# 2428 "parsing/lexer.ml" +# 2431 "parsing/lexer.ml" | 75 -> -# 943 "parsing/lexer.mll" +# 946 "parsing/lexer.mll" ( INFIXOP0 "!=" ) -# 2433 "parsing/lexer.ml" +# 2436 "parsing/lexer.ml" | 76 -> -# 944 "parsing/lexer.mll" +# 947 "parsing/lexer.mll" ( PLUS ) -# 2438 "parsing/lexer.ml" +# 2441 "parsing/lexer.ml" | 77 -> -# 945 "parsing/lexer.mll" +# 948 "parsing/lexer.mll" ( PLUSDOT ) -# 2443 "parsing/lexer.ml" +# 2446 "parsing/lexer.ml" | 78 -> -# 946 "parsing/lexer.mll" +# 949 "parsing/lexer.mll" ( PLUSEQ ) -# 2448 "parsing/lexer.ml" +# 2451 "parsing/lexer.ml" | 79 -> -# 947 "parsing/lexer.mll" +# 950 "parsing/lexer.mll" ( MINUS ) -# 2453 "parsing/lexer.ml" +# 2456 "parsing/lexer.ml" | 80 -> -# 948 "parsing/lexer.mll" +# 951 "parsing/lexer.mll" ( MINUSDOT ) -# 2458 "parsing/lexer.ml" +# 2461 "parsing/lexer.ml" | 81 -> -# 951 "parsing/lexer.mll" +# 954 "parsing/lexer.mll" ( PREFIXOP(Lexing.lexeme lexbuf) ) -# 2463 "parsing/lexer.ml" +# 2466 "parsing/lexer.ml" | 82 -> -# 953 "parsing/lexer.mll" +# 956 "parsing/lexer.mll" ( PREFIXOP(Lexing.lexeme lexbuf) ) -# 2468 "parsing/lexer.ml" +# 2471 "parsing/lexer.ml" | 83 -> -# 955 "parsing/lexer.mll" +# 958 "parsing/lexer.mll" ( INFIXOP0(Lexing.lexeme lexbuf) ) -# 2473 "parsing/lexer.ml" +# 2476 "parsing/lexer.ml" | 84 -> -# 957 "parsing/lexer.mll" +# 960 "parsing/lexer.mll" ( INFIXOP1(Lexing.lexeme lexbuf) ) -# 2478 "parsing/lexer.ml" +# 2481 "parsing/lexer.ml" | 85 -> -# 959 "parsing/lexer.mll" +# 962 "parsing/lexer.mll" ( INFIXOP2(Lexing.lexeme lexbuf) ) -# 2483 "parsing/lexer.ml" +# 2486 "parsing/lexer.ml" | 86 -> -# 961 "parsing/lexer.mll" +# 964 "parsing/lexer.mll" ( INFIXOP4(Lexing.lexeme lexbuf) ) -# 2488 "parsing/lexer.ml" +# 2491 "parsing/lexer.ml" | 87 -> -# 962 "parsing/lexer.mll" +# 965 "parsing/lexer.mll" ( PERCENT ) -# 2493 "parsing/lexer.ml" +# 2496 "parsing/lexer.ml" | 88 -> -# 964 "parsing/lexer.mll" +# 967 "parsing/lexer.mll" ( INFIXOP3(Lexing.lexeme lexbuf) ) -# 2498 "parsing/lexer.ml" +# 2501 "parsing/lexer.ml" | 89 -> -# 966 "parsing/lexer.mll" +# 969 "parsing/lexer.mll" ( SHARPOP(Lexing.lexeme lexbuf) ) -# 2503 "parsing/lexer.ml" +# 2506 "parsing/lexer.ml" | 90 -> -# 967 "parsing/lexer.mll" +# 970 "parsing/lexer.mll" ( if !if_then_else <> Dir_out then if !if_then_else = Dir_if_true then @@ -19886,14 +19889,14 @@ and EOF ) -# 2516 "parsing/lexer.ml" +# 2519 "parsing/lexer.ml" | 91 -> -# 977 "parsing/lexer.mll" +# 980 "parsing/lexer.mll" ( raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0), Location.curr lexbuf)) ) -# 2523 "parsing/lexer.ml" +# 2526 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_token_rec lexbuf __ocaml_lex_state @@ -19903,15 +19906,15 @@ and comment lexbuf = and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 983 "parsing/lexer.mll" +# 986 "parsing/lexer.mll" ( comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc; store_lexeme lexbuf; comment lexbuf; ) -# 2538 "parsing/lexer.ml" +# 2541 "parsing/lexer.ml" | 1 -> -# 988 "parsing/lexer.mll" +# 991 "parsing/lexer.mll" ( match !comment_start_loc with | [] -> assert false | [_] -> comment_start_loc := []; Location.curr lexbuf @@ -19919,10 +19922,10 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = store_lexeme lexbuf; comment lexbuf; ) -# 2549 "parsing/lexer.ml" +# 2552 "parsing/lexer.ml" | 2 -> -# 996 "parsing/lexer.mll" +# 999 "parsing/lexer.mll" ( string_start_loc := Location.curr lexbuf; store_string_char '"'; @@ -19940,10 +19943,10 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = is_in_string := false; store_string_char '"'; comment lexbuf ) -# 2570 "parsing/lexer.ml" +# 2573 "parsing/lexer.ml" | 3 -> -# 1014 "parsing/lexer.mll" +# 1017 "parsing/lexer.mll" ( let delim = Lexing.lexeme lexbuf in let delim = String.sub delim 1 (String.length delim - 2) in @@ -19965,43 +19968,43 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = store_string delim; store_string_char '}'; comment lexbuf ) -# 2595 "parsing/lexer.ml" +# 2598 "parsing/lexer.ml" | 4 -> -# 1037 "parsing/lexer.mll" +# 1040 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2600 "parsing/lexer.ml" +# 2603 "parsing/lexer.ml" | 5 -> -# 1039 "parsing/lexer.mll" +# 1042 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 1; store_lexeme lexbuf; comment lexbuf ) -# 2608 "parsing/lexer.ml" +# 2611 "parsing/lexer.ml" | 6 -> -# 1044 "parsing/lexer.mll" +# 1047 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2613 "parsing/lexer.ml" +# 2616 "parsing/lexer.ml" | 7 -> -# 1046 "parsing/lexer.mll" +# 1049 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2618 "parsing/lexer.ml" +# 2621 "parsing/lexer.ml" | 8 -> -# 1048 "parsing/lexer.mll" +# 1051 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2623 "parsing/lexer.ml" +# 2626 "parsing/lexer.ml" | 9 -> -# 1050 "parsing/lexer.mll" +# 1053 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2628 "parsing/lexer.ml" +# 2631 "parsing/lexer.ml" | 10 -> -# 1052 "parsing/lexer.mll" +# 1055 "parsing/lexer.mll" ( match !comment_start_loc with | [] -> assert false | loc :: _ -> @@ -20009,20 +20012,20 @@ and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = comment_start_loc := []; raise (Error (Unterminated_comment start, loc)) ) -# 2639 "parsing/lexer.ml" +# 2642 "parsing/lexer.ml" | 11 -> -# 1060 "parsing/lexer.mll" +# 1063 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0; store_lexeme lexbuf; comment lexbuf ) -# 2647 "parsing/lexer.ml" +# 2650 "parsing/lexer.ml" | 12 -> -# 1065 "parsing/lexer.mll" +# 1068 "parsing/lexer.mll" ( store_lexeme lexbuf; comment lexbuf ) -# 2652 "parsing/lexer.ml" +# 2655 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_comment_rec lexbuf __ocaml_lex_state @@ -20032,42 +20035,42 @@ and string lexbuf = and __ocaml_lex_string_rec lexbuf __ocaml_lex_state = match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 1069 "parsing/lexer.mll" +# 1072 "parsing/lexer.mll" ( () ) -# 2664 "parsing/lexer.ml" +# 2667 "parsing/lexer.ml" | 1 -> let -# 1070 "parsing/lexer.mll" +# 1073 "parsing/lexer.mll" space -# 2670 "parsing/lexer.ml" +# 2673 "parsing/lexer.ml" = Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_curr_pos in -# 1071 "parsing/lexer.mll" +# 1074 "parsing/lexer.mll" ( update_loc lexbuf None 1 false (String.length space); string lexbuf ) -# 2676 "parsing/lexer.ml" +# 2679 "parsing/lexer.ml" | 2 -> -# 1075 "parsing/lexer.mll" +# 1078 "parsing/lexer.mll" ( store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); string lexbuf ) -# 2682 "parsing/lexer.ml" +# 2685 "parsing/lexer.ml" | 3 -> -# 1078 "parsing/lexer.mll" +# 1081 "parsing/lexer.mll" ( store_string_char(char_for_decimal_code lexbuf 1); string lexbuf ) -# 2688 "parsing/lexer.ml" +# 2691 "parsing/lexer.ml" | 4 -> -# 1081 "parsing/lexer.mll" +# 1084 "parsing/lexer.mll" ( store_string_char(char_for_hexadecimal_code lexbuf 2); string lexbuf ) -# 2694 "parsing/lexer.ml" +# 2697 "parsing/lexer.ml" | 5 -> -# 1084 "parsing/lexer.mll" +# 1087 "parsing/lexer.mll" ( if in_comment () then string lexbuf else begin @@ -20082,29 +20085,29 @@ let string lexbuf end ) -# 2712 "parsing/lexer.ml" +# 2715 "parsing/lexer.ml" | 6 -> -# 1099 "parsing/lexer.mll" +# 1102 "parsing/lexer.mll" ( if not (in_comment ()) then Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string; update_loc lexbuf None 1 false 0; store_lexeme lexbuf; string lexbuf ) -# 2722 "parsing/lexer.ml" +# 2725 "parsing/lexer.ml" | 7 -> -# 1106 "parsing/lexer.mll" +# 1109 "parsing/lexer.mll" ( is_in_string := false; raise (Error (Unterminated_string, !string_start_loc)) ) -# 2728 "parsing/lexer.ml" +# 2731 "parsing/lexer.ml" | 8 -> -# 1109 "parsing/lexer.mll" +# 1112 "parsing/lexer.mll" ( store_string_char(Lexing.lexeme_char lexbuf 0); string lexbuf ) -# 2734 "parsing/lexer.ml" +# 2737 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_string_rec lexbuf __ocaml_lex_state @@ -20114,34 +20117,34 @@ and quoted_string delim lexbuf = and __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 1114 "parsing/lexer.mll" +# 1117 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0; store_lexeme lexbuf; quoted_string delim lexbuf ) -# 2749 "parsing/lexer.ml" +# 2752 "parsing/lexer.ml" | 1 -> -# 1119 "parsing/lexer.mll" +# 1122 "parsing/lexer.mll" ( is_in_string := false; raise (Error (Unterminated_string, !string_start_loc)) ) -# 2755 "parsing/lexer.ml" +# 2758 "parsing/lexer.ml" | 2 -> -# 1122 "parsing/lexer.mll" +# 1125 "parsing/lexer.mll" ( let edelim = Lexing.lexeme lexbuf in let edelim = String.sub edelim 1 (String.length edelim - 2) in if delim = edelim then () else (store_lexeme lexbuf; quoted_string delim lexbuf) ) -# 2765 "parsing/lexer.ml" +# 2768 "parsing/lexer.ml" | 3 -> -# 1129 "parsing/lexer.mll" +# 1132 "parsing/lexer.mll" ( store_string_char(Lexing.lexeme_char lexbuf 0); quoted_string delim lexbuf ) -# 2771 "parsing/lexer.ml" +# 2774 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state @@ -20151,26 +20154,26 @@ and skip_sharp_bang lexbuf = and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with | 0 -> -# 1134 "parsing/lexer.mll" +# 1137 "parsing/lexer.mll" ( update_loc lexbuf None 3 false 0 ) -# 2783 "parsing/lexer.ml" +# 2786 "parsing/lexer.ml" | 1 -> -# 1136 "parsing/lexer.mll" +# 1139 "parsing/lexer.mll" ( update_loc lexbuf None 1 false 0 ) -# 2788 "parsing/lexer.ml" +# 2791 "parsing/lexer.ml" | 2 -> -# 1137 "parsing/lexer.mll" +# 1140 "parsing/lexer.mll" ( () ) -# 2793 "parsing/lexer.ml" +# 2796 "parsing/lexer.ml" | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state ;; -# 1139 "parsing/lexer.mll" +# 1142 "parsing/lexer.mll" let at_bol lexbuf = @@ -20405,7 +20408,7 @@ and __ocaml_lex_skip_sharp_bang_rec lexbuf __ocaml_lex_state = preprocessor := Some (init, preprocess) -# 3035 "parsing/lexer.ml" +# 3038 "parsing/lexer.ml" end module Parse : sig @@ -20500,21 +20503,10 @@ and expression = wrap Parser.parse_expression and pattern = wrap Parser.parse_pattern end -include (struct -#1 "parser_api_main.ml" +#1 "parser_api_main_bspack.ml" let from_string : string -> Lexing.lexbuf = Lexing.from_string let implementation : Lexing.lexbuf -> Parsetree.structure = - Parse.implementation -end : sig -#1 "parser_api_main.mli" - - - - - -val from_string : string -> Lexing.lexbuf -val implementation: Lexing.lexbuf -> Parsetree.structure -end) \ No newline at end of file + Parse.implementation \ No newline at end of file diff --git a/jscomp/test/parser_api.ml.d b/jscomp/test/parser_api.ml.d new file mode 100644 index 0000000000..3917e074ce --- /dev/null +++ b/jscomp/test/parser_api.ml.d @@ -0,0 +1,30 @@ +parser_api.ml: +../../vendor/ocaml/parsing/ast_helper.ml +../../vendor/ocaml/parsing/ast_helper.mli +../../vendor/ocaml/parsing/asttypes.mli +../../vendor/ocaml/parsing/docstrings.ml +../../vendor/ocaml/parsing/docstrings.mli +../../vendor/ocaml/parsing/lexer.ml +../../vendor/ocaml/parsing/lexer.mli +../../vendor/ocaml/parsing/location.ml +../../vendor/ocaml/parsing/location.mli +../../vendor/ocaml/parsing/longident.ml +../../vendor/ocaml/parsing/longident.mli +../../vendor/ocaml/parsing/parse.ml +../../vendor/ocaml/parsing/parse.mli +../../vendor/ocaml/parsing/parser.ml +../../vendor/ocaml/parsing/parser.mli +../../vendor/ocaml/parsing/parsetree.mli +../../vendor/ocaml/parsing/syntaxerr.ml +../../vendor/ocaml/parsing/syntaxerr.mli +../../vendor/ocaml/utils/clflags.ml +../../vendor/ocaml/utils/clflags.mli +../../vendor/ocaml/utils/config.ml +../../vendor/ocaml/utils/config.mli +../../vendor/ocaml/utils/misc.ml +../../vendor/ocaml/utils/misc.mli +../../vendor/ocaml/utils/terminfo.ml +../../vendor/ocaml/utils/terminfo.mli +../../vendor/ocaml/utils/warnings.ml +../../vendor/ocaml/utils/warnings.mli +./parser_api_main_bspack.ml diff --git a/lib/js/js.js b/lib/js/js.js index b9480b8e43..d608fd87b2 100644 --- a/lib/js/js.js +++ b/lib/js/js.js @@ -29,6 +29,8 @@ var Re2 = 0; var $$Promise = 0; +var Promise2 = 0; + var $$Date = 0; var Dict = 0; @@ -75,6 +77,7 @@ exports.String2 = String2; exports.Re = Re; exports.Re2 = Re2; exports.$$Promise = $$Promise; +exports.Promise2 = Promise2; exports.$$Date = $$Date; exports.Dict = Dict; exports.Global = Global; diff --git a/lib/js/js_promise2.js b/lib/js/js_promise2.js new file mode 100644 index 0000000000..ae1b9f17e6 --- /dev/null +++ b/lib/js/js_promise2.js @@ -0,0 +1 @@ +/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */