diff --git a/CHANGES.md b/CHANGES.md index 436ee10642..5c9aa8340d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -37,6 +37,7 @@ * Compiler: speed-up compilation by improving the scheduling of optimization passes (#1962, #2001) * Compiler: deadcode elimination of cyclic values (#1978) * Compiler: directly write Wasm binary modules (#2000, #2003) +* Compiler: rewrote inlining pass (#1935) ## Bug fixes * Compiler: fix stack overflow issues with double translation (#1869) diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index a07afd3a5b..db97d62450 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -146,7 +146,7 @@ module Param = struct p ~name:"switch_size" ~desc:"set the maximum number of case in a switch" (int 60) let inlining_limit = - p ~name:"inlining-limit" ~desc:"set the size limit for inlining" (int 200) + p ~name:"inlining-limit" ~desc:"set the size limit for inlining" (int 150) let tailcall_max_depth = p diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 1ec644848d..8e6d099bf6 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -49,12 +49,12 @@ let deadcode p = let p = Code.compact p in p -let inline p = +let inline profile p = if Config.Flag.inline () && Config.Flag.deadcode () then ( let p, live_vars = deadcode' p in if debug () then Format.eprintf "Inlining...@."; - Inline.f p live_vars) + Inline.f ~profile p live_vars) else p let specialize_1 (p, info) = @@ -153,20 +153,26 @@ let rec loop max name round i (p : 'a) : 'a = p') else loop max name round (i + 1) p' -let round : 'a -> 'a = - print +> tailcall +> (flow +> specialize +> eval +> fst) +> inline +> phi +> deadcode +let round profile : 'a -> 'a = + print + +> tailcall + +> (flow +> specialize +> eval +> fst) + +> inline profile + +> phi + +> deadcode (* o1 *) -let o1 = loop 2 "round" round 1 +> (flow +> specialize +> eval +> fst) +> print +let o1 = + loop 2 "round" (round Profile.O1) 1 +> (flow +> specialize +> eval +> fst) +> print (* o2 *) -let o2 = loop 10 "round" round 1 +> print +let o2 = loop 10 "round" (round Profile.O2) 1 +> print (* o3 *) -let o3 = loop 30 "round" round 1 +> print +let o3 = loop 30 "round" (round Profile.O3) 1 +> print let generate ~exported_runtime diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml index 7fd11f9337..7188e1f273 100644 --- a/compiler/lib/inline.ml +++ b/compiler/lib/inline.ml @@ -21,283 +21,441 @@ open! Stdlib open Code -type prop = - { size : int - ; optimizable : bool - } +let debug = Debug.find "inlining" -type closure_info = - { cl_params : Var.t list - ; cl_cont : int * Var.t list - ; cl_prop : prop - ; cl_simpl : (int Var.Map.t * Var.Set.t) option - } +let times = Debug.find "times" -let block_size { branch; body; _ } = - List.fold_left - ~f:(fun n i -> - match i with - | Event _ -> n - | _ -> n + 1) - ~init:0 - body - + - match branch with - | Cond _ -> 2 - | Switch (_, a1) -> Array.length a1 - | _ -> 0 - -let simple_function blocks size name params pc = - let bound_vars = - ref (List.fold_left ~f:(fun s x -> Var.Set.add x s) ~init:Var.Set.empty params) +let stats = Debug.find "stats" + +let debug_stats = Debug.find "stats-debug" + +(****) + +(* +We try to find a good order to traverse the code: +- when a function calls another function or contains another function, + we process it after the other function +- in case of recursive cycles, we process functions called only once + first +*) + +let collect_closures p = + let closures = Var.Hashtbl.create 128 in + let rec traverse p enclosing pc = + Code.traverse + { fold = Code.fold_children } + (fun pc () -> + let block = Addr.Map.find pc p.blocks in + List.iter + ~f:(fun i -> + match i with + | Let (f, Closure (params, ((pc', _) as cont), _)) -> + Var.Hashtbl.add closures f (params, cont, enclosing); + traverse p (Some f) pc' + | _ -> ()) + block.body) + pc + p.blocks + () in - let free_vars = ref Var.Map.empty in - let tc = ref Var.Set.empty in - try - (* Ignore large functions *) - if size > 10 then raise Exit; - Code.preorder_traverse + traverse p None p.start; + closures + +let collect_deps p closures = + let deps = Var.Hashtbl.create (Var.Hashtbl.length closures) in + Var.Hashtbl.iter (fun f _ -> Var.Hashtbl.add deps f (ref Var.Set.empty)) closures; + let traverse p g pc = + let add_dep f = + if Var.Hashtbl.mem closures f + then + let s = Var.Hashtbl.find deps f in + s := Var.Set.add g !s + in + Code.traverse { fold = Code.fold_children } (fun pc () -> - let block = Addr.Map.find pc blocks in - (match block.branch with - (* We currenly disable inlining when raising and catching exception *) - | Poptrap _ | Pushtrap _ -> raise Exit - | Raise _ -> raise Exit - | Stop -> raise Exit - | Return x -> ( - match List.last block.body with - | None -> () - | Some (Let (y, Apply { f; _ })) -> - (* track if some params are called in tail position *) - if Code.Var.equal x y && List.mem ~eq:Var.equal f params - then tc := Var.Set.add f !tc - | Some _ -> ()) - | Branch _ | Cond _ | Switch _ -> ()); - List.iter block.body ~f:(fun i -> + let block = Addr.Map.find pc p.blocks in + Freevars.iter_block_free_vars add_dep block; + List.iter + ~f:(fun i -> match i with - (* We currenly don't want to duplicate Closure *) - | Let (_, Closure _) -> raise Exit - | _ -> ()); - Freevars.iter_block_bound_vars - (fun x -> bound_vars := Var.Set.add x !bound_vars) - block; - Freevars.iter_block_free_vars - (fun x -> - if not (Var.Set.mem x !bound_vars) - then - free_vars := - Var.Map.update - x - (function - | None -> Some 1 - | Some n -> Some (succ n)) - !free_vars) - block) + | Let (f, Closure _) -> add_dep f + | _ -> ()) + block.body) pc - blocks - (); - if Var.Map.mem name !free_vars then raise Exit; - Some (!free_vars, !tc) - with Exit -> None + p.blocks + () + in + Var.Hashtbl.iter (fun f (_, (pc, _), _) -> traverse p f pc) closures; + Var.Hashtbl.fold (fun f s m -> Var.Map.add f !s m) deps Var.Map.empty + +module Var_SCC = Strongly_connected_components.Make (Var) + +let visit_closures p ~live_vars f acc = + let closures = collect_closures p in + let deps = collect_deps p closures in + let scc = Var_SCC.connected_components_sorted_from_roots_to_leaf deps in + let f' recursive acc g = + let params, cont, enclosing_function = Var.Hashtbl.find closures g in + f ~recursive ~enclosing_function ~current_function:(Some g) ~params ~cont acc + in + let acc = + Array.fold_left + scc + ~f:(fun acc group -> + match group with + | Var_SCC.No_loop g -> f' false acc g + | Has_loop l -> + let set = Var.Set.of_list l in + let deps' = + List.fold_left + ~f:(fun deps' g -> + Var.Map.add + g + (if live_vars.(Var.idx g) > 1 + then Var.Set.empty + else Var.Set.inter (Var.Map.find g deps) set) + deps') + ~init:Var.Map.empty + l + in + let scc = Var_SCC.connected_components_sorted_from_roots_to_leaf deps' in + Array.fold_left + scc + ~f:(fun acc group -> + match group with + | Var_SCC.No_loop g -> f' true acc g + | Has_loop l -> List.fold_left ~f:(fun acc g -> f' true acc g) ~init:acc l) + ~init:acc) + ~init:acc + in + f + ~recursive:false + ~enclosing_function:None + ~current_function:None + ~params:[] + ~cont:(p.start, []) + acc (****) -let optimizable blocks pc = - Code.traverse - { fold = Code.fold_children } - (fun pc { size; optimizable } -> - let b = Addr.Map.find pc blocks in - let this_size = block_size b in - let optimizable = - optimizable - && List.for_all b.body ~f:(function - | Let (_, Prim (Extern "caml_js_eval_string", _)) -> false - | Let (_, Prim (Extern "debugger", _)) -> false - | Let - ( _ - , Prim (Extern ("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr"), _) - ) -> - (* TODO: we should be smarter here and look the generated js *) - (* let's consider it this opmiziable *) - true - | _ -> true) - in - { optimizable; size = size + this_size }) - pc - blocks - { optimizable = true; size = 0 } +module SCC = Strongly_connected_components.Make (Addr) -let get_closures { blocks; _ } = - Addr.Map.fold - (fun _ block closures -> - List.fold_left block.body ~init:closures ~f:(fun closures i -> - match i with - | Let (x, Closure (cl_params, cl_cont, _)) -> - (* we can compute this once during the pass - as the property won't change with inlining *) - let cl_prop = optimizable blocks (fst cl_cont) in - let cl_simpl = - simple_function blocks cl_prop.size x cl_params (fst cl_cont) - in - Var.Map.add x { cl_params; cl_cont; cl_prop; cl_simpl } closures - | _ -> closures)) - blocks - Var.Map.empty +let blocks_in_loop p pc = + let g = + Code.traverse + { fold = Code.fold_children } + (fun pc g -> + Addr.Map.add pc (Code.fold_children p.blocks pc Addr.Set.add Addr.Set.empty) g) + pc + p.blocks + Addr.Map.empty + in + let scc = SCC.component_graph g in + Array.fold_left + ~f:(fun s (c, _) -> + match c with + | SCC.No_loop _ -> s + | Has_loop l -> List.fold_left ~f:(fun s x -> Addr.Set.add x s) l ~init:s) + ~init:Addr.Set.empty + scc (****) -let rewrite_block pc' pc blocks = - let block = Addr.Map.find pc blocks in - let block = - match block.branch, pc' with - | Return y, Some pc' -> { block with branch = Branch (pc', [ y ]) } - | _ -> block - in - Addr.Map.add pc block blocks +type 'a cache = 'a option ref -let rewrite_closure blocks cont_pc clos_pc = +(* Information about a function candidate for inlining. Some + information / statistics about this function are computed lazily + and stored there. *) + +type info = + { f : Var.t + ; params : Var.t list + ; cont : Code.cont + ; enclosing_function : Var.t option + ; recursive : bool + ; loops : bool cache + ; body_size : int cache + ; full_size : int cache + ; closure_count : int cache + ; init_code : int cache + ; returns_a_block : bool cache + ; interesting_params : (Var.t * int) list cache + } + +type context = + { profile : Profile.t (** Aggressive inlining? *) + ; p : program + ; live_vars : int array (** Occurence count of all variables *) + ; inline_count : int ref (** Inlining statistics *) + ; env : info Var.Map.t (** Functions that are candidate for inlining *) + ; in_loop : bool (** Whether the current block is in a loop *) + ; has_closures : bool ref (** Whether the current function contains closures *) + ; current_function : Var.t option (** Name of the current function *) + ; enclosing_function : Var.t option + (** Name of the function enclosing the current function *) + } +(** Current context into which we consider inlining some functions. *) + +let cache ~info:{ cont = pc, _; _ } ref f = + match !ref with + | Some v -> v + | None -> + let v = f pc in + ref := Some v; + v + +(** Does the function contain a loop? *) +let contains_loop ~context info = + cache ~info info.loops (fun pc -> + let rec traverse pc ((visited, loop) as accu) : _ * bool = + if loop + then accu + else if Addr.Map.mem pc visited + then visited, Addr.Map.find pc visited + else + let visited, loop = + Code.fold_children + context.p.blocks + pc + traverse + (Addr.Map.add pc true visited, false) + in + Addr.Map.add pc false visited, loop + in + snd (traverse pc (Addr.Map.empty, false))) + +let sum ~context f pc = + let blocks = context.p.blocks in Code.traverse - { fold = Code.fold_children_skip_try_body } - (rewrite_block cont_pc) - clos_pc - blocks + { fold = fold_children } + (fun pc acc -> f (Addr.Map.find pc blocks) + acc) + pc blocks + 0 -(****) +let rec block_size ~recurse ~context { branch; body; _ } = + List.fold_left + ~f:(fun n i -> + match i with + | Event _ -> n + | Let (_, Closure (_, (pc, _), _)) -> + if recurse then size ~recurse ~context pc + n + 1 else n + 1 + | _ -> n + 1) + ~init: + (match branch with + | Cond _ | Raise _ -> 2 + | Switch (_, a1) -> Array.length a1 + | _ -> 0) + body -let inline inline_count live_vars closures pc (outer, p) = - let block = Addr.Map.find pc p.blocks in - let body, (outer, branch, p) = - List.fold_right - block.body - ~init:([], (outer, block.branch, p)) - ~f:(fun i (rem, state) -> +and size ~recurse ~context = sum ~context (block_size ~recurse ~context) + +(** Size of the function body *) +let body_size ~context info = cache ~info info.body_size (size ~recurse:false ~context) + +(** Size of the function, including the size of the closures it contains *) +let full_size ~context info = cache ~info info.full_size (size ~recurse:true ~context) + +let closure_count_uncached ~context = + sum ~context (fun { body; _ } -> + List.fold_left + ~f:(fun n i -> + match i with + | Let (_, Closure _) -> n + 1 + | _ -> n) + ~init:0 + body) + +(** Number of closures contained in the function *) +let closure_count ~context info = + cache ~info info.closure_count (closure_count_uncached ~context) + +(** Number of instructions in the function which look like + initialization code. *) +let count_init_code ~context info = + cache + ~info + info.init_code + (sum ~context + @@ fun { body; _ } -> + List.fold_left + ~f:(fun n i -> match i with - | Let (x, Apply { f; args; exact = true; _ }) when Var.Map.mem f closures -> ( - let outer, branch, p = state in - let { cl_params = params - ; cl_cont = clos_cont - ; cl_prop = { size = f_size; optimizable = f_optimizable } - ; cl_simpl - } = - Var.Map.find f closures - in - let map_param_to_arg = - List.fold_left2 - ~f:(fun map a b -> Var.Map.add a b map) - ~init:Var.Map.empty - params - args - in - if - live_vars.(Var.idx f) = 1 - && Bool.equal outer.optimizable f_optimizable - (* Inlining the code of an optimizable function could - make this code unoptimized. (wrt to Jit compilers) *) - && f_size < Config.Param.inlining_limit () - then ( - live_vars.(Var.idx f) <- 0; - let blocks, cont_pc, free_pc = - match rem, branch with - | [], Return y when Var.compare x y = 0 -> - (* We do not need a continuation block for tail calls *) - p.blocks, None, p.free_pc - | _ -> - let fresh_addr = p.free_pc in - let free_pc = fresh_addr + 1 in - ( Addr.Map.add - fresh_addr - { params = [ x ]; body = rem; branch } - p.blocks - , Some fresh_addr - , free_pc ) - in - let blocks = rewrite_closure blocks cont_pc (fst clos_cont) in - (* We do not really need this intermediate block. - It just avoids the need to find which function - parameters are used in the function body. *) - let fresh_addr = free_pc in - let free_pc = fresh_addr + 1 in - let blocks = - Addr.Map.add - fresh_addr - { params; body = []; branch = Branch clos_cont } - blocks - in - let outer = { outer with size = outer.size + f_size } in - incr inline_count; - [], (outer, Branch (fresh_addr, args), { p with blocks; free_pc })) - else - match cl_simpl with - | Some (free_vars, tc_params) - (* We inline/duplicate - - single instruction functions (f_size = 1) - - small funtions that call one of their arguments in - tail position when the argument is a direct closure - used only once. *) - when Code.Var.Set.exists - (fun x -> - let farg_tc = Var.Map.find x map_param_to_arg in - Var.Map.mem farg_tc closures && live_vars.(Var.idx farg_tc) = 1) - tc_params - || f_size <= 1 -> - let () = - (* Update live_vars *) - Var.Map.iter - (fun fv c -> - if not (Var.equal fv f) - then - let idx = Var.idx fv in - live_vars.(idx) <- live_vars.(idx) + c) - free_vars; - live_vars.(Var.idx f) <- live_vars.(Var.idx f) - 1 - in - let p, _f, params, clos_cont = - Duplicate.closure p ~f ~params ~cont:clos_cont - in - let blocks, cont_pc, free_pc = - match rem, branch with - | [], Return y when Var.compare x y = 0 -> - (* We do not need a continuation block for tail calls *) - p.blocks, None, p.free_pc - | _ -> - let fresh_addr = p.free_pc in - let free_pc = fresh_addr + 1 in - ( Addr.Map.add - fresh_addr - { params = [ x ]; body = rem; branch } - p.blocks - , Some fresh_addr - , free_pc ) - in - let blocks = rewrite_closure blocks cont_pc (fst clos_cont) in - (* We do not really need this intermediate block. - It just avoids the need to find which function - parameters are used in the function body. *) - let fresh_addr = free_pc in - let free_pc = fresh_addr + 1 in - let blocks = - Addr.Map.add - fresh_addr - { params; body = []; branch = Branch clos_cont } - blocks - in - let outer = { outer with size = outer.size + f_size } in - incr inline_count; - [], (outer, Branch (fresh_addr, args), { p with blocks; free_pc }) - | _ -> i :: rem, state) - | _ -> i :: rem, state) - in - outer, { p with blocks = Addr.Map.add pc { block with body; branch } p.blocks } + | Let (_, (Closure _ | Field _ | Constant _ | Block _)) -> n + 1 + | Let (_, (Apply _ | Prim _ | Special _)) + | Assign _ | Set_field _ | Offset_ref _ | Array_set _ | Event _ -> n) + ~init:0 + body) -(****) +(** Whether the function returns a block. *) +let returns_a_block ~context info = + cache ~info info.returns_a_block (fun pc -> + let blocks = context.p.blocks in + Code.traverse + { fold = fold_children } + (fun pc acc -> + acc + && + let block = Addr.Map.find pc blocks in + match block.branch with + | Return x -> ( + match Code.last_instr block.body with + | Some (Let (x', Block _)) -> Var.equal x x' + | _ -> false) + | Raise _ | Stop | Branch _ | Cond _ | Switch _ | Pushtrap _ | Poptrap _ -> true) + pc + blocks + true) -let times = Debug.find "times" +(** List of parameters that corresponds to functions called once in + the function body. *) +let interesting_parameters ~context info = + let params = info.params in + cache ~info info.interesting_params (fun pc -> + let params = List.filter ~f:(fun x -> context.live_vars.(Var.idx x) = 1) params in + if List.is_empty params + then [] + else + let blocks = context.p.blocks in + Code.traverse + { fold = fold_children } + (fun pc lst -> + let block = Addr.Map.find pc blocks in + List.fold_left + ~f:(fun lst i -> + match i with + | Let (_, Apply { f; args; _ }) when List.mem ~eq:Var.equal f params -> + (f, List.length args) :: lst + | _ -> lst) + ~init:lst + block.body) + pc + blocks + []) -let stats = Debug.find "stats" +(* + We are very aggressive at optimizing functor-like code, even if + this might duplicate quite a lot of code, since this is likely to + allow other optimizations: direct function calls, more precise dead + code elimination, ... +*) +let functor_like ~context info = + (match Config.target (), context.profile with + | `Wasm, (O2 | O3) -> true + | `Wasm, O1 -> body_size ~context info <= 15 + | `JavaScript, (O1 | O2) -> false + | `JavaScript, O3 -> body_size ~context info <= 15) + && (not info.recursive) + && (not (contains_loop ~context info)) + && returns_a_block ~context info + && count_init_code ~context info * 2 > body_size ~context info + (* A large portion of the body is initialization code *) + && + (* The closures defined in this function are small on average *) + full_size ~context info - body_size ~context info <= 20 * closure_count ~context info -let debug_stats = Debug.find "stats-debug" +let trivial_function ~context info = + body_size ~context info <= 1 && closure_count ~context info = 0 + +(* + We inline small functions which are simple (no closure, no + recursive) when one of the argument is a function that would get + inlined afterwards. +*) +let rec small_function ~context info args = + (not info.recursive) + && body_size ~context info <= 15 + && closure_count ~context info = 0 + && (not (List.is_empty args)) + && + let relevant_params = interesting_parameters ~context info in + try + List.iter2 args info.params ~f:(fun arg param -> + if + Var.Map.mem arg context.env + && List.exists ~f:(fun (p, _) -> Var.equal p param) relevant_params + then + let info' = Var.Map.find arg context.env in + let _, arity = List.find ~f:(fun (p, _) -> Var.equal p param) relevant_params in + if + List.compare_length_with info'.params ~len:arity = 0 + && should_inline + ~context: + { context with + in_loop = context.in_loop || contains_loop ~context info + } + info' + [] + then raise Exit); + false + with Exit -> true + +and should_inline ~context info args = + (* Typically, in JavaScript implementations, a closure contains a + pointer to (recursively) the contexts of its enclosing functions. + The context of a function contains the variables bound in this + function which are referred to from one of the enclosed function. + To limit the risk of memory leaks, we try to avoid inlining functions + containing closures if this makes these closures capture + additional contexts shared with other closures. + We still inline into toplevel functions ([Option.is_none + context.enclosing_function]) since this results in significant + performance improvements. *) + (match Config.target (), Config.effects () with + | `JavaScript, (`Disabled | `Cps) -> + closure_count ~context info = 0 + || Option.is_none context.enclosing_function + || Option.equal Var.equal info.enclosing_function context.current_function + || (not !(context.has_closures)) + && Option.equal Var.equal info.enclosing_function context.enclosing_function + | `Wasm, _ | `JavaScript, `Double_translation -> true + | `JavaScript, `Jspi -> assert false) + && (functor_like ~context info + || (context.live_vars.(Var.idx info.f) = 1 + && + match Config.target () with + | `Wasm when context.in_loop -> + (* Avoid inlining in a loop since, if the loop is not hot, + the code might never get optimized *) + body_size ~context info < 30 && not (contains_loop ~context info) + | `JavaScript + when Option.is_none context.current_function && contains_loop ~context info -> + (* Avoid inlining loops at toplevel since the toplevel + code is less likely to get optimized *) + false + | _ -> body_size ~context info < Config.Param.inlining_limit ()) + || trivial_function ~context info + || small_function ~context info args) + +let trace_inlining ~context info x args = + if debug () + then + let sz = body_size ~context info in + let sz' = full_size ~context info in + Format.eprintf + "%a <- %a%s: %b uses:%d size:%d/%d loop:%b rec:%b closures:%d init:%d \ + return_block:%b functor:%b small:%b@." + Var.print + x + Var.print + info.f + (match Var.get_name info.f with + | Some s -> "(" ^ s ^ ")" + | None -> "") + (should_inline ~context info args) + context.live_vars.(Var.idx info.f) + sz + sz' + (contains_loop ~context info) + info.recursive + (closure_count ~context info) + (count_init_code ~context info) + (returns_a_block ~context info) + (functor_like ~context info) + (small_function ~context info args) + +(****) (* Inlining a function used only once will leave an unused closure with an initial continuation pointing to a block belonging to @@ -341,46 +499,164 @@ let remove_dead_closures ~live_vars p pc = p.blocks p -let f p live_vars = +(****) + +let rewrite_block pc' pc blocks = + let block = Addr.Map.find pc blocks in + let block = + match block.branch, pc' with + | Return y, Some pc' -> { block with branch = Branch (pc', [ y ]) } + | _ -> block + in + Addr.Map.add pc block blocks + +let rewrite_closure blocks cont_pc clos_pc = + Code.traverse + { fold = Code.fold_children_skip_try_body } + (rewrite_block cont_pc) + clos_pc + blocks + blocks + +let inline_function p rem branch x params cont args = + let blocks, cont_pc, free_pc = + match rem, branch with + | [], Return y when Var.equal x y -> + (* We do not need a continuation block for tail calls *) + p.blocks, None, p.free_pc + | _ -> + let fresh_addr = p.free_pc in + let free_pc = fresh_addr + 1 in + ( Addr.Map.add fresh_addr { params = [ x ]; body = rem; branch } p.blocks + , Some fresh_addr + , free_pc ) + in + let blocks = rewrite_closure blocks cont_pc (fst cont) in + (* We do not really need this intermediate block. + It just avoids the need to find which function + parameters are used in the function body. *) + let fresh_addr = free_pc in + let free_pc = fresh_addr + 1 in + assert (List.compare_lengths args params = 0); + let blocks = + Addr.Map.add fresh_addr { params; body = []; branch = Branch cont } blocks + in + [], (Branch (fresh_addr, args), { p with blocks; free_pc }) + +let inline_in_block ~context pc block p = + let body, (branch, p) = + List.fold_right + ~f:(fun i (rem, state) -> + match i with + | Let (x, Apply { f; args; exact = true; _ }) when Var.Map.mem f context.env -> + let info = Var.Map.find f context.env in + let { params; cont; _ } = info in + trace_inlining ~context info x args; + if should_inline ~context info args + then ( + let branch, p = state in + incr context.inline_count; + if closure_count ~context info > 0 then context.has_closures := true; + context.live_vars.(Var.idx f) <- context.live_vars.(Var.idx f) - 1; + if context.live_vars.(Var.idx f) > 0 + then + let p, _, params, cont = Duplicate.closure p ~f ~params ~cont in + inline_function p rem branch x params cont args + else inline_function p rem branch x params cont args) + else i :: rem, state + | _ -> i :: rem, state) + ~init:([], (block.branch, p)) + block.body + in + { p with blocks = Addr.Map.add pc { block with body; branch } p.blocks } + +let inline ~profile ~inline_count p ~live_vars = + if debug () then Format.eprintf "====== inlining ======@."; + (visit_closures + p + ~live_vars + (fun ~recursive + ~enclosing_function + ~current_function + ~params + ~cont:((pc, _) as cont) + (context : context) + -> + let p = context.p in + let has_closures = ref (closure_count_uncached ~context pc > 0) in + let in_loop = blocks_in_loop p pc in + let context = + { context with has_closures; enclosing_function; current_function } + in + let p = + Code.traverse + { fold = Code.fold_children } + (fun pc p -> + let block = Addr.Map.find pc p.blocks in + if + (* Skip blocks with no call of known function *) + List.for_all + ~f:(fun i -> + match i with + | Let (_, Apply { f; _ }) -> not (Var.Map.mem f context.env) + | _ -> true) + block.body + then p + else + inline_in_block + ~context:{ context with in_loop = Addr.Set.mem pc in_loop } + pc + block + p) + pc + p.blocks + p + in + let p = remove_dead_closures ~live_vars p pc in + let env = + match current_function with + | Some f -> + Var.Map.add + f + { f + ; params + ; cont + ; enclosing_function + ; recursive + ; loops = ref None + ; body_size = ref None + ; full_size = ref None + ; closure_count = ref None + ; init_code = ref None + ; returns_a_block = ref None + ; interesting_params = ref None + } + context.env + | None -> context.env + in + { context with p; env }) + { profile + ; p + ; live_vars + ; inline_count + ; env = Var.Map.empty + ; in_loop = false + ; has_closures = ref false + ; current_function = None + ; enclosing_function = None + }) + .p + +(****) + +let f ~profile p live_vars = let previous_p = p in let inline_count = ref 0 in Code.invariant p; let t = Timer.make () in - let closures = get_closures p in - let _closures, p = - Code.fold_closures_innermost_first - p - (fun name cl_params (pc, _) _ (closures, p) -> - let traverse outer = - let outer, p = - Code.traverse - { fold = Code.fold_children } - (inline inline_count live_vars closures) - pc - p.blocks - (outer, p) - in - let p = remove_dead_closures ~live_vars p pc in - outer, p - in - match name with - | None -> - let _, p = traverse (optimizable p.blocks pc) in - closures, p - | Some x -> - let info = Var.Map.find x closures in - let outer, p = traverse info.cl_prop in - let cl_simpl = simple_function p.blocks outer.size x cl_params pc in - let closures = - Var.Map.add x { info with cl_prop = outer; cl_simpl } closures - in - closures, p) - (closures, p) - in - (* Inlining a raising function can result in empty blocks *) + let p = inline ~profile ~inline_count p ~live_vars in if times () then Format.eprintf " inlining: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - inline: %d optimizations@." !inline_count; - let p = Deadcode.remove_unused_blocks p in + if stats () then Format.eprintf "Stats - inlining: %d inlined functions@." !inline_count; if debug_stats () then Code.check_updates ~name:"inline" previous_p p ~updates:!inline_count; Code.invariant p; diff --git a/compiler/lib/inline.mli b/compiler/lib/inline.mli index 9799e882a2..595bc76ecb 100644 --- a/compiler/lib/inline.mli +++ b/compiler/lib/inline.mli @@ -18,4 +18,4 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val f : Code.program -> Deadcode.variable_uses -> Code.program +val f : profile:Profile.t -> Code.program -> Deadcode.variable_uses -> Code.program diff --git a/compiler/tests-compiler/direct_calls.ml b/compiler/tests-compiler/direct_calls.ml index a7774dac4d..830941a5f8 100644 --- a/compiler/tests-compiler/direct_calls.ml +++ b/compiler/tests-compiler/direct_calls.ml @@ -22,21 +22,31 @@ let%expect_test "direct calls without --effects=cps" = let code = compile_and_parse {| + let l = ref [] + (* Arity of the argument of a function / direct call *) let test1 () = - let f g x = try g x with e -> raise e in + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x *. 2.) 4.) (* Arity of the argument of a function / CPS call *) let test2 () = - let f g x = try g x with e -> raise e in + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x ^ "a") "a") (* Arity of functions in a functor / direct call *) let test3 x = - let module F(_ : sig end) = struct let f x = x + 1 end in + let module F(_ : sig end) = struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = x + 1 + end in let module M1 = F (struct end) in let module M2 = F (struct end) in (M1.f 1, M2.f 2) @@ -44,7 +54,11 @@ let%expect_test "direct calls without --effects=cps" = (* Arity of functions in a functor / CPS call *) let test4 x = let module F(_ : sig end) = - struct let f x = Printf.printf "%d" x end in + struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = Printf.printf "%d" x + end in let module M1 = F (struct end) in let module M2 = F (struct end) in M1.f 1; M2.f 2 @@ -58,6 +72,7 @@ let%expect_test "direct calls without --effects=cps" = {| function test1(param){ function f(g, x){ + l[1] = [0, function(param){return 0;}, l[1]]; try{caml_call1(g, x); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -71,6 +86,7 @@ let%expect_test "direct calls without --effects=cps" = //end function test2(param){ function f(g, x){ + l[1] = [0, function(param){return 0;}, l[1]]; try{caml_call1(g, x); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -83,19 +99,26 @@ let%expect_test "direct calls without --effects=cps" = } //end function test3(x){ - function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} - var M1 = F([0]), M2 = F([0]), _a_ = M2[1].call(null, 2); - return [0, M1[1].call(null, 1), _a_]; + function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} + function f(x){return x + 1 | 0;} + return [0, , f]; + } + var M1 = F([0]), M2 = F([0]), _b_ = M2[2].call(null, 2); + return [0, M1[2].call(null, 1), _b_]; } //end function test4(x){ function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} function f(x){return caml_call2(Stdlib_Printf[2], _a_, x);} - return [0, f]; + return [0, , f]; } var M1 = F([0]), M2 = F([0]); - M1[1].call(null, 1); - return M2[1].call(null, 2); + M1[2].call(null, 1); + return M2[2].call(null, 2); } //end |}] @@ -105,21 +128,31 @@ let%expect_test "direct calls with --effects=cps" = compile_and_parse ~effects:`Cps {| + let l = ref [] + (* Arity of the argument of a function / direct call *) let test1 () = - let f g x = try g x with e -> raise e in + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x *. 2.) 4.) (* Arity of the argument of a function / CPS call *) let test2 () = - let f g x = try g x with e -> raise e in + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x ^ "a") "a") (* Arity of functions in a functor / direct call *) let test3 x = - let module F(_ : sig end) = struct let f x = x + 1 end in + let module F(_ : sig end) = struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = x + 1 + end in let module M1 = F (struct end) in let module M2 = F (struct end) in (M1.f 1, M2.f 2) @@ -127,7 +160,11 @@ let%expect_test "direct calls with --effects=cps" = (* Arity of functions in a functor / CPS call *) let test4 x = let module F(_ : sig end) = - struct let f x = Printf.printf "%d" x end in + struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = Printf.printf "%d" x + end in let module M1 = F (struct end) in let module M2 = F (struct end) in M1.f 1; M2.f 2 @@ -141,6 +178,7 @@ let%expect_test "direct calls with --effects=cps" = {| function test1(param, cont){ function f(g, x){ + l[1] = [0, function(param, cont){return cont(0);}, l[1]]; try{g(); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -154,19 +192,20 @@ let%expect_test "direct calls with --effects=cps" = //end function test2(param, cont){ function f(g, x, cont){ + l[1] = [0, function(param, cont){return cont(0);}, l[1]]; runtime.caml_push_trap (function(e){ var raise = caml_pop_trap(), e$0 = caml_maybe_attach_backtrace(e, 0); return raise(e$0); }); return caml_exact_trampoline_cps_call - (g, x, function(_a_){caml_pop_trap(); return cont();}); + (g, x, function(_b_){caml_pop_trap(); return cont();}); } return caml_exact_trampoline_cps_call$0 (f, function(x, cont){return cont();}, 7, - function(_a_){ + function(_b_){ return caml_exact_trampoline_cps_call$0 (f, function(x, cont){ @@ -174,29 +213,36 @@ let%expect_test "direct calls with --effects=cps" = (Stdlib[28], x, cst_a$0, cont); }, cst_a, - function(_a_){return cont(0);}); + function(_b_){return cont(0);}); }); } //end function test3(x, cont){ - function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} - var M1 = F(), M2 = F(), _a_ = M2[1].call(null, 2); - return cont([0, M1[1].call(null, 1), _a_]); + function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} + function f(x){return x + 1 | 0;} + return [0, , f]; + } + var M1 = F(), M2 = F(), _b_ = M2[2].call(null, 2); + return cont([0, M1[2].call(null, 1), _b_]); } //end function test4(x, cont){ function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} function f(x, cont){ return caml_trampoline_cps_call3(Stdlib_Printf[2], _a_, x, cont); } - return [0, f]; + return [0, , f]; } var M1 = F(), M2 = F(); return caml_exact_trampoline_cps_call - (M1[1], + (M1[2], 1, function(_a_){ - return caml_exact_trampoline_cps_call(M2[1], 2, cont); + return caml_exact_trampoline_cps_call(M2[2], 2, cont); }); } //end diff --git a/compiler/tests-compiler/double-translation/direct_calls.ml b/compiler/tests-compiler/double-translation/direct_calls.ml index 9b9dacf531..6ffaf65aa2 100644 --- a/compiler/tests-compiler/double-translation/direct_calls.ml +++ b/compiler/tests-compiler/double-translation/direct_calls.ml @@ -23,21 +23,31 @@ let%expect_test "direct calls with --effects=double-translation" = compile_and_parse ~effects:`Double_translation {| + let l = ref [] + (* Arity of the argument of a function / direct call *) let test1 () = - let f g x = try g x with e -> raise e in + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x *. 2.) 4.) (* Arity of the argument of a function / CPS call *) let test2 () = - let f g x = try g x with e -> raise e in + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x ^ "a") "a") (* Arity of functions in a functor / direct call *) let test3 x = - let module F(_ : sig end) = struct let f x = x + 1 end in + let module F(_ : sig end) = struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = x + 1 + end in let module M1 = F (struct end) in let module M2 = F (struct end) in (M1.f 1, M2.f 2) @@ -45,7 +55,11 @@ let%expect_test "direct calls with --effects=double-translation" = (* Arity of functions in a functor / CPS call *) let test4 x = let module F(_ : sig end) = - struct let f x = Printf.printf "%d" x end in + struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = Printf.printf "%d" x + end in let module M1 = F (struct end) in let module M2 = F (struct end) in M1.f 1; M2.f 2 @@ -53,6 +67,7 @@ let%expect_test "direct calls with --effects=double-translation" = (* Result of double-translating two mutually recursive functions *) let test5 () = let g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) let rec f y = if y = 0 then 1 else x + h (y - 1) and h z = if z = 0 then 1 else x + f (z - 1) in @@ -133,9 +148,11 @@ let%expect_test "direct calls with --effects=double-translation" = cst_a$0 = caml_string_of_jsbytes("a"), cst_a = caml_string_of_jsbytes("a"), Stdlib = global_data.Stdlib, - Stdlib_Printf = global_data.Stdlib__Printf; + Stdlib_Printf = global_data.Stdlib__Printf, + l = [0, 0]; function test1(param){ function f(g, x){ + l[1] = [0, function(param){return 0;}, l[1]]; try{caml_call1(g, dummy); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -146,8 +163,11 @@ let%expect_test "direct calls with --effects=double-translation" = f(function(x){}); return 0; } + function _c_(){return function(param){return 0;};} function f$0(){ function f$0(g, x){ + var _i_ = l[1]; + l[1] = [0, _c_(), _i_]; try{caml_call1(g, x); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -155,19 +175,21 @@ let%expect_test "direct calls with --effects=double-translation" = } } function f$1(g, x, cont){ + var _i_ = l[1]; + l[1] = [0, _c_(), _i_]; runtime.caml_push_trap (function(e$0){ var raise = caml_pop_trap(), e = caml_maybe_attach_backtrace(e$0, 0); return raise(e); }); return caml_exact_trampoline_cps_call - (g, x, function(_e_){caml_pop_trap(); return cont();}); + (g, x, function(_i_){caml_pop_trap(); return cont();}); } var f = caml_cps_closure(f$0, f$1); return f; } - function _b_(){return function(x){};} - function _c_(){ + function _d_(){return function(x){};} + function _e_(){ return caml_cps_closure (function(x){return caml_call2(Stdlib[28], x, cst_a$0);}, function(x, cont){ @@ -176,26 +198,36 @@ let%expect_test "direct calls with --effects=double-translation" = } function test2$0(param){ var f = f$0(); - f(_b_(), 7); - f(_c_(), cst_a); + f(_d_(), 7); + f(_e_(), cst_a); return 0; } function test2$1(param, cont){ var f = f$0(); return caml_exact_trampoline_cps_call$0 (f, - _b_(), + _d_(), 7, - function(_e_){ + function(_i_){ return caml_exact_trampoline_cps_call$0 - (f, _c_(), cst_a, function(_e_){return cont(0);}); + (f, _e_(), cst_a, function(_i_){return cont(0);}); }); } var test2 = caml_cps_closure(test2$0, test2$1); function test3(x){ - function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} - var M1 = F(), M2 = F(), _e_ = caml_call1(M2[1], 2); - return [0, caml_call1(M1[1], 1), _e_]; + function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){ + r[1]++; + var _i_ = for$ + 1 | 0; + if(2 === for$) break; + for$ = _i_; + } + function f(x){return x + 1 | 0;} + return [0, , f]; + } + var M1 = F(), M2 = F(), _i_ = caml_call1(M2[2], 2); + return [0, caml_call1(M1[2], 1), _i_]; } function f(){ function f$0(x){return caml_call2(Stdlib_Printf[2], _a_, x);} @@ -205,22 +237,34 @@ let%expect_test "direct calls with --effects=double-translation" = var f = caml_cps_closure(f$0, f$1); return f; } - function F(){function F(symbol){var f$0 = f(); return [0, f$0];} return F;} + function F(){ + function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){ + r[1]++; + var _i_ = for$ + 1 | 0; + if(2 === for$){var f$0 = f(); return [0, , f$0];} + for$ = _i_; + } + } + return F; + } function test4$0(x){ var F$0 = F(), M1 = F$0(), M2 = F$0(); - caml_call1(M1[1], 1); - return caml_call1(M2[1], 2); + caml_call1(M1[2], 1); + return caml_call1(M2[2], 2); } function test4$1(x, cont){ var F$0 = F(), M1 = F$0(), M2 = F$0(); return caml_exact_trampoline_cps_call - (M1[1], + (M1[2], 1, - function(_e_){ - return caml_exact_trampoline_cps_call(M2[1], 2, cont); + function(_i_){ + return caml_exact_trampoline_cps_call(M2[2], 2, cont); }); } var test4 = caml_cps_closure(test4$0, test4$1); + function _b_(){return function(param){return 0;};} function recfuncs(x){ function f(y){return 0 === y ? 1 : x + h(y - 1 | 0) | 0;} function h(z){return 0 === z ? 1 : x + f(z - 1 | 0) | 0;} @@ -229,22 +273,26 @@ let%expect_test "direct calls with --effects=double-translation" = } function g(){ function g$0(x){ + var _g_ = l[1]; + l[1] = [0, _b_(), _g_]; var tuple = recfuncs(x), f = tuple[2], h = tuple[1], - _d_ = h(100), - _e_ = f(12) + _d_ | 0; - return caml_call1(Stdlib[44], _e_); + _h_ = h(100), + _i_ = f(12) + _h_ | 0; + return caml_call1(Stdlib[44], _i_); } function g$1(x, cont){ + var _e_ = l[1]; + l[1] = [0, _b_(), _e_]; var tuple = recfuncs(x), f = tuple[2], h = tuple[1], - _c_ = h(100), - _d_ = f(12) + _c_ | 0; - return caml_trampoline_cps_call2(Stdlib[44], _d_, cont); + _f_ = h(100), + _g_ = f(12) + _f_ | 0; + return caml_trampoline_cps_call2(Stdlib[44], _g_, cont); } var g = caml_cps_closure(g$0, g$1); return g; @@ -255,14 +303,14 @@ let%expect_test "direct calls with --effects=double-translation" = return caml_exact_trampoline_cps_call (g$0, 42, - function(_c_){ + function(_e_){ return caml_exact_trampoline_cps_call - (g$0, - 5, function(_c_){return cont(0);}); + (g$0, - 5, function(_e_){return cont(0);}); }); } var test5 = caml_cps_closure(test5$0, test5$1), - Test = [0, test1, test2, test3, test4, test5]; + Test = [0, l, test1, test2, test3, test4, test5]; runtime.caml_register_global(7, Test, "Test"); return; } diff --git a/compiler/tests-compiler/double-translation/effects_toplevel.ml b/compiler/tests-compiler/double-translation/effects_toplevel.ml index c04484c464..cfd5f570e3 100644 --- a/compiler/tests-compiler/double-translation/effects_toplevel.ml +++ b/compiler/tests-compiler/double-translation/effects_toplevel.ml @@ -38,12 +38,18 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = "use strict"; var runtime = globalThis.jsoo_runtime, + caml_cps_closure = runtime.caml_cps_closure, caml_string_of_jsbytes = runtime.caml_string_of_jsbytes; function caml_call1(f, a0){ return (f.l >= 0 ? f.l : f.l = f.length) === 1 ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_exact_trampoline_call1(f, a0){ + return runtime.caml_stack_check_depth() + ? f(a0) + : runtime.caml_trampoline_return(f, [a0], 1); + } function caml_trampoline_cps_call2(f, a0, a1){ return runtime.caml_stack_check_depth() ? f.cps @@ -60,6 +66,11 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = : runtime.caml_call_gen(f, [a0])) : runtime.caml_trampoline_return(f, [a0, a1], 0); } + function caml_exact_trampoline_cps_call(f, a0, a1){ + return runtime.caml_stack_check_depth() + ? f.cps ? f.cps.call(null, a0, a1) : a1(f(a0)) + : runtime.caml_trampoline_return(f, [a0, a1], 0); + } var dummy = 0, global_data = runtime.caml_get_global_data(), @@ -72,20 +83,30 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = function g$1(param, cont){ return caml_trampoline_cps_call2(Stdlib_Printf[2], _a_, cont); } - var g = runtime.caml_cps_closure(g$0, g$1); - g(); - var i = 1; - for(;;){ - g(); - var _b_ = i + 1 | 0; - if(5 === i){ - g(); - var Test = [0]; - runtime.caml_register_global(2, Test, "Test"); - return; + var g = caml_cps_closure(g$0, g$1); + function f$0(param){ + var i = 1; + for(;;){g(); var _c_ = i + 1 | 0; if(5 === i) return; i = _c_;} + } + function f$1(param, cont){ + function _a_(i){ + return caml_exact_trampoline_cps_call + (g, + dummy, + function(_c_){ + var _b_ = i + 1 | 0; + return 5 !== i ? caml_exact_trampoline_call1(_a_, _b_) : cont(); + }); } - i = _b_; + return _a_(1); } + var f = caml_cps_closure(f$0, f$1); + g(); + f(); + g(); + var Test = [0]; + runtime.caml_register_global(2, Test, "Test"); + return; } (globalThis)); //end diff --git a/compiler/tests-compiler/effects_toplevel.ml b/compiler/tests-compiler/effects_toplevel.ml index 367e03818d..e9e24c4e2a 100644 --- a/compiler/tests-compiler/effects_toplevel.ml +++ b/compiler/tests-compiler/effects_toplevel.ml @@ -61,35 +61,35 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = ? f(a0, a1) : runtime.caml_trampoline_return(f, [a0, a1], 0); } - return caml_callback - (function(cont){ - var - dummy = 0, - global_data = runtime.caml_get_global_data(), - Stdlib_Printf = global_data.Stdlib__Printf, - _b_ = - [0, - [11, caml_string_of_jsbytes("abc"), 0], - caml_string_of_jsbytes("abc")]; - function g(param, cont){ - return caml_trampoline_cps_call2(Stdlib_Printf[2], _b_, cont); - } - caml_callback(g, [dummy]); - function _a_(i){ - return caml_exact_trampoline_cps_call - (g, - dummy, - function(_c_){ - var _b_ = i + 1 | 0; - if(5 !== i) return caml_exact_trampoline_call1(_a_, _b_); - caml_callback(g, [dummy]); - var Test = [0]; - runtime.caml_register_global(2, Test, "Test"); - }); - } - return _a_(1); - }, - []); + var + dummy = 0, + global_data = runtime.caml_get_global_data(), + Stdlib_Printf = global_data.Stdlib__Printf, + _a_ = + [0, + [11, caml_string_of_jsbytes("abc"), 0], + caml_string_of_jsbytes("abc")]; + function g(param, cont){ + return caml_trampoline_cps_call2(Stdlib_Printf[2], _a_, cont); + } + function f(param, cont){ + function _a_(i){ + return caml_exact_trampoline_cps_call + (g, + dummy, + function(_c_){ + var _b_ = i + 1 | 0; + return 5 !== i ? caml_exact_trampoline_call1(_a_, _b_) : cont(); + }); + } + return _a_(1); + } + caml_callback(g, [dummy]); + caml_callback(f, [dummy]); + caml_callback(g, [dummy]); + var Test = [0]; + runtime.caml_register_global(2, Test, "Test"); + return; } (globalThis)); //end diff --git a/compiler/tests-compiler/gh1320.ml b/compiler/tests-compiler/gh1320.ml index ed86db9b6b..3b86d7944f 100644 --- a/compiler/tests-compiler/gh1320.ml +++ b/compiler/tests-compiler/gh1320.ml @@ -22,7 +22,8 @@ let%expect_test _ = let prog = {| -let app f x = try f x with e -> raise e +exception I of int +let app f x = try f x with e -> raise (I (f x)) let myfun () = for i = 1 to 4 do diff --git a/compiler/tests-compiler/gh1559.ml b/compiler/tests-compiler/gh1559.ml index 7ecb98acb6..602acc195c 100644 --- a/compiler/tests-compiler/gh1559.ml +++ b/compiler/tests-compiler/gh1559.ml @@ -81,32 +81,33 @@ let () = my_ref := 2 } var global_data = runtime.caml_get_global_data(), - t$0 = [0, 0], + t = [0, 0], init = [0, 1], Stdlib_Int = global_data.Stdlib__Int, Stdlib = global_data.Stdlib, my_ref = [0, 1], nesting = 1; - a: - { - var t = init; + function handle_state(t$1){ + var t$0 = t$1; for(;;){ - let t$1 = t; + let t$1 = t$0; var this_will_be_undefined = - function(param){var _b_ = 1 === t$1[1] ? 1 : 0; return _b_ ? 1 : 2;}, - i = t[1]; - if(0 === i){var _a_ = this_will_be_undefined(0); break a;} - if(1 === i) break; - t = t$0; + function(param){ + a: + {if(t$1 && 1 === t$1[1]){var _b_ = 1; break a;} var _b_ = 0;} + return _b_ ? 1 : 2; + }; + if(t$0) var i = t$0[1], match = i; else var match = - 1; + if(0 === match) return this_will_be_undefined(0); + if(1 === match) + return caml_call2(Stdlib_Int[8], nesting, 0) + ? nesting + : this_will_be_undefined(0); + t$0 = t; } - var - _a_ = - caml_call2(Stdlib_Int[8], nesting, 0) - ? nesting - : this_will_be_undefined(0); } - var _b_ = caml_call1(Stdlib_Int[12], _a_); + var _a_ = handle_state(init), _b_ = caml_call1(Stdlib_Int[12], _a_); caml_call1(Stdlib[46], _b_); my_ref[1] = 2; var Test = [0, my_ref]; @@ -186,49 +187,48 @@ let () = my_ref := 2 } var global_data = runtime.caml_get_global_data(), - t$0 = [0, 0], + t = [0, 0], init = [0, 1], Stdlib_Random = global_data.Stdlib__Random, Stdlib_Int = global_data.Stdlib__Int, Stdlib = global_data.Stdlib, my_ref = [0, 1], nesting = 1; - a: - { - b: - { - var t = init; - for(;;){ - let t$1 = t; + function handle_state(t$1){ + var t$0 = t$1; + for(;;){ + let t$1 = t$0; + var + this_will_be_undefined = + function(param){ + a: + {if(t$1 && 1 === t$1[1]){var _c_ = 1; break a;} var _c_ = 0;} + return _c_ ? 1 : 2; + }; + if(t$0) var i = t$0[1], match = i; else var match = - 1; + if(0 === match){ var - this_will_be_undefined = - function(param){var _d_ = 1 === t$1[1] ? 1 : 0; return _d_ ? 1 : 2;}, - i = t[1]; - if(0 === i) break; - if(1 === i) break b; - t = t$0; + g = function(param){return 2 + this_will_be_undefined(0) | 0;}, + _b_ = g(0); + return g(0) + _b_ | 0; } - var - g = function(param){return 2 + this_will_be_undefined(0) | 0;}, - _b_ = g(0), - _a_ = g(0) + _b_ | 0; - break a; + if(1 === match){ + if(caml_call2(Stdlib_Int[8], nesting, 0)) return nesting; + var + g$0 = + function(param){ + return 1 < caml_call1(Stdlib_Random[5], 3) + ? 2 + this_will_be_undefined(0) | 0 + : 1; + }, + _c_ = g$0(0); + return g$0(0) + _c_ | 0; + } + t$0 = t; } - if(caml_call2(Stdlib_Int[8], nesting, 0)) - var _a_ = nesting; - else - var - g$0 = - function(param){ - return 1 < caml_call1(Stdlib_Random[5], 3) - ? 2 + this_will_be_undefined(0) | 0 - : 1; - }, - _c_ = g$0(0), - _a_ = g$0(0) + _c_ | 0; } - var _d_ = caml_call1(Stdlib_Int[12], _a_); - caml_call1(Stdlib[46], _d_); + var _a_ = handle_state(init), _b_ = caml_call1(Stdlib_Int[12], _a_); + caml_call1(Stdlib[46], _b_); my_ref[1] = 2; var Test = [0, my_ref]; runtime.caml_register_global(5, Test, "Test"); diff --git a/compiler/tests-compiler/global_deadcode.ml b/compiler/tests-compiler/global_deadcode.ml index 956e436407..e27d97c374 100644 --- a/compiler/tests-compiler/global_deadcode.ml +++ b/compiler/tests-compiler/global_deadcode.ml @@ -92,11 +92,15 @@ let%expect_test "Omit unused fields" = let program = compile_and_parse {| + let l = ref [] + let f b x = + l := (fun y -> x + y) :: !l; (* Prevent inlining *) let t = if b then (1, 2, x) else (3, x, 4) in let (u, _, v) = t in (u, v) - in print_int (fst (f true 1) + snd (f false 2)) + + let () = print_int (fst (f true 1) + snd (f false 2)) |} in (* Expect second field in each triple to be omitted. *) @@ -104,10 +108,12 @@ let%expect_test "Omit unused fields" = [%expect {| function f(b, x){ + l[1] = [0, function(y){return x + y | 0;}, l[1]]; var t = b ? [0, 1, , x] : [0, 3, , 4], v = t[3], u = t[1]; return [0, u, v]; } - //end |}] + //end + |}] let%expect_test "Omit unused return expressions" = let program = diff --git a/compiler/tests-compiler/rec52.ml b/compiler/tests-compiler/rec52.ml index cdcd016c1b..3012a17088 100644 --- a/compiler/tests-compiler/rec52.ml +++ b/compiler/tests-compiler/rec52.ml @@ -70,7 +70,7 @@ let%expect_test "let rec" = default$ = 42; function a(x){return b(x);} function b(x){ - var _a_ = b(0); + var _a_ = a(0); return [0, 84, [0, letrec_function_context[1], c, _a_]]; } var tbl = caml_call2(Stdlib_Hashtbl[1], 0, 17); diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js index 001fa8941c..9f79a6046e 100644 --- a/compiler/tests-full/stdlib.cma.expected.js +++ b/compiler/tests-full/stdlib.cma.expected.js @@ -13496,6 +13496,15 @@ /*<>*/ throw caml_maybe_attach_backtrace ([0, Assert_failure, _a_], 1); /*<>*/ } + function set_initial_keys(l){ + /*<>*/ return caml_call2 + (Stdlib_List[18], + function(param){ + var v = /*<>*/ param[2], k = param[1]; + /*<>*/ return set(k, v) /*<>*/ ; + }, + l) /*<>*/ ; + } function get_id(param){ var domain = /*<>*/ param[1]; /*<>*/ return domain; @@ -13578,13 +13587,7 @@ function body(param){ /*<>*/ try{ /*<>*/ create_dls(0); - /*<>*/ caml_call2 - (Stdlib_List[18], - function(param){ - var v = /*<>*/ param[2], k = param[1]; - /*<>*/ return set(k, v) /*<>*/ ; - }, - pk); + /*<>*/ set_initial_keys(pk); var res = /*<>*/ caml_call1(f, 0); } catch(exn$0){ @@ -14031,6 +14034,158 @@ default: /*<>*/ return 70; } /*<>*/ } + function bprint_char_set(buf, char_set){ + function print_char(buf, i){ + var c = /*<>*/ caml_call1(Stdlib[29], i); + /*<>*/ return 37 === c + ? ( /*<>*/ buffer_add_char + (buf, 37), + /*<>*/ buffer_add_char(buf, 37)) + : 64 + === c + ? ( /*<>*/ buffer_add_char + (buf, 37), + /*<>*/ buffer_add_char + (buf, 64)) + : /*<>*/ buffer_add_char(buf, c) /*<>*/ ; + } + /*<>*/ buffer_add_char(buf, 91); + var + set = + /*<>*/ is_in_char_set(char_set, 0) + ? ( /*<>*/ buffer_add_char + (buf, 94), + /*<>*/ rev_char_set(char_set)) + : char_set; + function is_alone(c){ + var + after = + /*<>*/ caml_call1 + (Stdlib_Char[1], c + 1 | 0), + before = + /*<>*/ caml_call1 + (Stdlib_Char[1], c - 1 | 0), + _a3_ = /*<>*/ is_in_char_set(set, c); + /*<>*/ if(_a3_) + var + _a4_ = + /*<>*/ is_in_char_set(set, before), + _a6_ = + /*<>*/ _a4_ + ? /*<>*/ is_in_char_set(set, after) + : _a4_, + _a5_ = /*<>*/ 1 - _a6_; + else + var _a5_ = /*<>*/ _a3_; + return _a5_; + /*<>*/ } + /*<>*/ if(is_alone(93)) + /*<>*/ buffer_add_char(buf, 93); + var i = /*<>*/ 1; + for(;;){ + a: + if(i < 256){ + /*<>*/ if + (! + /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1(Stdlib[29], i))){ + var i$0 = /*<>*/ i + 1 | 0; + i = i$0; + continue; + } + var + switcher = + /*<>*/ caml_call1(Stdlib[29], i) - 45 + | 0; + /*<>*/ if(48 < switcher >>> 0){ + if(210 <= switcher){ + /*<>*/ print_char(buf, 255); + break a; + } + } + else if(46 < switcher - 1 >>> 0){ + var i$2 = /*<>*/ i + 1 | 0; + i = i$2; + continue; + } + var i$1 = /*<>*/ i + 1 | 0; + /*<>*/ if + (! + /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1(Stdlib[29], i$1))){ + /*<>*/ print_char(buf, i$1 - 1 | 0); + var i$6 = /*<>*/ i$1 + 1 | 0; + i = i$6; + continue; + } + var + switcher$0 = + /*<>*/ caml_call1(Stdlib[29], i$1) + - 45 + | 0; + /*<>*/ if(48 < switcher$0 >>> 0){ + if(210 <= switcher$0){ + /*<>*/ print_char(buf, 254); + /*<>*/ print_char(buf, 255); + break a; + } + } + else if + (46 < switcher$0 - 1 >>> 0 + && + ! + /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1 + (Stdlib[29], i$1 + 1 | 0))){ + /*<>*/ print_char(buf, i$1 - 1 | 0); + var i$5 = /*<>*/ i$1 + 1 | 0; + i = i$5; + continue; + } + /*<>*/ if + (! + /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1 + (Stdlib[29], i$1 + 1 | 0))){ + /*<>*/ print_char(buf, i$1 - 1 | 0); + /*<>*/ print_char(buf, i$1); + var i$4 = /*<>*/ i$1 + 2 | 0; + i = i$4; + continue; + } + var + j = /*<>*/ i$1 + 2 | 0, + i$3 = i$1 - 1 | 0, + j$0 = j; + for(;;){ + /*<>*/ if(256 === j$0) break; + /*<>*/ if + (! + /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1(Stdlib[29], j$0))) + break; + var j$1 = /*<>*/ j$0 + 1 | 0; + j$0 = j$1; + } + /*<>*/ print_char(buf, i$3); + /*<>*/ print_char(buf, 45); + /*<>*/ print_char(buf, j$0 - 1 | 0); + /*<>*/ if(j$0 < 256){ + var i$7 = /*<>*/ j$0 + 1 | 0; + i = i$7; + continue; + } + } + /*<>*/ if(is_alone(45)) + /*<>*/ buffer_add_char(buf, 45); + /*<>*/ return buffer_add_char(buf, 93) /*<>*/ ; + } + } function bprint_padty(buf, padty){ /*<>*/ switch(padty){ case 0: @@ -14148,11 +14303,11 @@ default: var c = /*<>*/ formatting_lit[1], - _a6_ = + _a3_ = /*<>*/ caml_call2 (Stdlib_String[1], 1, c); /*<>*/ return caml_call2 - (Stdlib[28], cst$7, _a6_); + (Stdlib[28], cst$7, _a3_); } } function bprint_char_literal(buf, chr){ @@ -14163,17 +14318,17 @@ } function bprint_string_literal(buf, str){ var - _a4_ = + _a1_ = /*<>*/ caml_ml_string_length(str) - 1 | 0, - _a5_ = 0; - if(_a4_ >= 0){ - var i = _a5_; + _a2_ = 0; + if(_a1_ >= 0){ + var i = _a2_; for(;;){ /*<>*/ /*<>*/ bprint_char_literal (buf, /*<>*/ caml_string_get(str, i)); - var _a6_ = /*<>*/ i + 1 | 0; - if(_a4_ === i) break; - i = _a6_; + var _a3_ = /*<>*/ i + 1 | 0; + if(_a1_ === i) break; + i = _a3_; } } /*<>*/ } @@ -14520,178 +14675,7 @@ /*<>*/ bprint_ignored_flag (buf, ign_flag); /*<>*/ bprint_pad_opt(buf, width_opt); - var - print_char = - /*<>*/ function(buf, i){ - var - c = - /*<>*/ caml_call1 - (Stdlib[29], i); - /*<>*/ return 37 === c - ? ( /*<>*/ buffer_add_char - (buf, 37), - /*<>*/ buffer_add_char - (buf, 37)) - : 64 - === c - ? ( /*<>*/ buffer_add_char - (buf, 37), - /*<>*/ buffer_add_char - (buf, 64)) - : /*<>*/ buffer_add_char - (buf, c) /*<>*/ ; - }; - /*<>*/ buffer_add_char(buf, 91); - var - set = - /*<>*/ is_in_char_set(char_set, 0) - ? ( /*<>*/ buffer_add_char - (buf, 94), - /*<>*/ rev_char_set(char_set)) - : char_set; - let set$0 = /*<>*/ set; - var - is_alone = - function(c){ - var - after = - /*<>*/ caml_call1 - (Stdlib_Char[1], c + 1 | 0), - before = - /*<>*/ caml_call1 - (Stdlib_Char[1], c - 1 | 0), - _a1_ = - /*<>*/ is_in_char_set(set$0, c); - /*<>*/ if(_a1_) - var - _a2_ = - /*<>*/ is_in_char_set - (set$0, before), - _a4_ = - /*<>*/ _a2_ - ? /*<>*/ is_in_char_set - (set$0, after) - : _a2_, - _a3_ = /*<>*/ 1 - _a4_; - else - var _a3_ = /*<>*/ _a1_; - return _a3_; - /*<>*/ }; - /*<>*/ if(is_alone(93)) - /*<>*/ buffer_add_char(buf, 93); - a: - { - b: - { - var i = /*<>*/ 1; - for(;;){ - /*<>*/ if(i >= 256) break a; - /*<>*/ if - ( /*<>*/ is_in_char_set - (set, - /*<>*/ caml_call1 - (Stdlib[29], i))){ - var - switcher = - /*<>*/ caml_call1 - (Stdlib[29], i) - - 45 - | 0; - /*<>*/ if(48 < switcher >>> 0){ - if(210 <= switcher) break; - } - else if(46 < switcher - 1 >>> 0){ - var i$2 = /*<>*/ i + 1 | 0; - i = i$2; - continue; - } - var i$1 = /*<>*/ i + 1 | 0; - /*<>*/ if - ( /*<>*/ is_in_char_set - (set, - /*<>*/ caml_call1 - (Stdlib[29], i$1))){ - var - switcher$0 = - /*<>*/ caml_call1 - (Stdlib[29], i$1) - - 45 - | 0; - /*<>*/ if(48 < switcher$0 >>> 0){ - if(210 <= switcher$0) break b; - } - else if - (46 < switcher$0 - 1 >>> 0 - && - ! - /*<>*/ is_in_char_set - (set, - /*<>*/ caml_call1 - (Stdlib[29], i$1 + 1 | 0))){ - /*<>*/ print_char - (buf, i$1 - 1 | 0); - var i$5 = /*<>*/ i$1 + 1 | 0; - i = i$5; - continue; - } - /*<>*/ if - ( /*<>*/ is_in_char_set - (set, - /*<>*/ caml_call1 - (Stdlib[29], i$1 + 1 | 0))){ - var - j = /*<>*/ i$1 + 2 | 0, - i$3 = i$1 - 1 | 0, - j$0 = j; - for(;;){ - /*<>*/ if(256 === j$0) break; - /*<>*/ if - (! - /*<>*/ is_in_char_set - (set, - /*<>*/ caml_call1 - (Stdlib[29], j$0))) - break; - var j$1 = /*<>*/ j$0 + 1 | 0; - j$0 = j$1; - } - /*<>*/ print_char(buf, i$3); - /*<>*/ print_char(buf, 45); - /*<>*/ print_char - (buf, j$0 - 1 | 0); - /*<>*/ if(j$0 >= 256) break a; - var i$7 = /*<>*/ j$0 + 1 | 0; - i = i$7; - } - else{ - /*<>*/ print_char - (buf, i$1 - 1 | 0); - /*<>*/ print_char(buf, i$1); - var i$4 = /*<>*/ i$1 + 2 | 0; - i = i$4; - } - } - else{ - /*<>*/ print_char - (buf, i$1 - 1 | 0); - var i$6 = /*<>*/ i$1 + 1 | 0; - i = i$6; - } - } - else{ - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; - } - } - /*<>*/ print_char(buf, 255); - break a; - } - /*<>*/ print_char(buf, 254); - /*<>*/ print_char(buf, 255); - } - /*<>*/ if(is_alone(45)) - /*<>*/ buffer_add_char(buf, 45); - /*<>*/ buffer_add_char(buf, 93); + /*<>*/ bprint_char_set(buf, char_set); /*<>*/ fmt = rest$19; ign_flag = 0; break; @@ -14742,15 +14726,15 @@ /*<>*/ int_of_custom_arity(arity), _a0_ = /*<>*/ 1; if(_aZ_ >= 1){ - var i$8 = _a0_; + var i = _a0_; for(;;){ /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag (buf, ign_flag); /*<>*/ buffer_add_char(buf, 63); - var _a1_ = /*<>*/ i$8 + 1 | 0; - if(_aZ_ === i$8) break; - i$8 = _a1_; + var _a1_ = /*<>*/ i + 1 | 0; + if(_aZ_ === i) break; + i = _a1_; } } /*<>*/ fmt = rest$23; @@ -18719,377 +18703,42 @@ (failwith_message(_B_), str, str_ind, expected, read) /*<>*/ ; } function parse(lit_start, end_ind){ - a: - { - var str_ind = /*<>*/ lit_start; - for(;;){ - /*<>*/ if(str_ind === end_ind) - /*<>*/ return add_literal - (lit_start, str_ind, 0) /*<>*/ ; - var - match = - /*<>*/ caml_string_get(str, str_ind); - /*<>*/ if(37 === match) break; - if(64 === match) break a; - var str_ind$1 = /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$1; - } - var str_ind$2 = /*<>*/ str_ind + 1 | 0; - /*<>*/ if(str_ind$2 === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - match$1 = - /*<>*/ 95 - === caml_string_get(str, str_ind$2) - ? /*<>*/ parse_flags - (str_ind, str_ind$2 + 1 | 0, end_ind, 1) - : /*<>*/ parse_flags - (str_ind, str_ind$2, end_ind, 0), - fmt_rest = /*<>*/ match$1[1]; - /*<>*/ return add_literal - (lit_start, str_ind, fmt_rest) /*<>*/ ; - } - var str_ind$0 = /*<>*/ str_ind + 1 | 0; - a: - if(str_ind$0 === end_ind) - var match$0 = /*<>*/ _N_; - else{ + var str_ind = /*<>*/ lit_start; + for(;;){ + /*<>*/ if(str_ind === end_ind) + /*<>*/ return add_literal + (lit_start, str_ind, 0) /*<>*/ ; var - c = - /*<>*/ caml_string_get - (str, str_ind$0); - /*<>*/ if(65 <= c){ - if(94 <= c){ - var switcher = c - 123 | 0; - if(2 >= switcher >>> 0) - switch(switcher){ - case 0: - var - match$0 = - /*<>*/ parse_tag - (1, str_ind$0 + 1 | 0, end_ind); - break a; - case 2: - var - fmt_rest$2 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, 1, fmt_rest$2]]; - break a; - } - } - else if(91 <= c) - /*<>*/ switch(c - 91 | 0){ - case 0: - var - match$0 = - /*<>*/ parse_tag - (0, str_ind$0 + 1 | 0, end_ind); - break a; - case 2: - var - fmt_rest$3 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, 0, fmt_rest$3]]; - break a; - } - } - else{ - /*<>*/ if(10 === c){ - var - fmt_rest$4 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, 3, fmt_rest$4]]; - break a; - } - /*<>*/ if(32 <= c) - switch(c - 32 | 0){ - case 0: - var - fmt_rest$5 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, _O_, fmt_rest$5]]; - break a; - case 5: - /*<>*/ if - ((str_ind$0 + 1 | 0) < end_ind - && - 37 - === - /*<>*/ caml_string_get - (str, str_ind$0 + 1 | 0)){ - var - fmt_rest$6 = - /*<>*/ parse - (str_ind$0 + 2 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, 6, fmt_rest$6]]; - break a; - } - var - fmt_rest$7 = - /*<>*/ parse(str_ind$0, end_ind) - [1], - match$0 = - /*<>*/ [0, [12, 64, fmt_rest$7]]; - break a; - case 12: - var - fmt_rest$8 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, _P_, fmt_rest$8]]; - break a; - case 14: - var - fmt_rest$9 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, 4, fmt_rest$9]]; - break a; - case 27: - var - str_ind$3 = - /*<>*/ str_ind$0 + 1 | 0; - b: - try{ - var - _aG_ = str_ind$3 === end_ind ? 1 : 0, - _aH_ = - _aG_ - || - (60 - !== - /*<>*/ caml_string_get - (str, str_ind$3) - ? 1 - : 0); - if(_aH_) - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - var - str_ind_1 = - /*<>*/ parse_spaces - (str_ind$3 + 1 | 0, end_ind), - match$2 = - /*<>*/ caml_string_get - (str, str_ind_1); - c: - { - /*<>*/ if(48 <= match$2){ - if(58 <= match$2) break c; - } - else if(45 !== match$2) break c; - var - match$3 = - /*<>*/ parse_integer - (str_ind_1, end_ind), - width = /*<>*/ match$3[2], - str_ind_2 = match$3[1], - str_ind_3 = - /*<>*/ parse_spaces - (str_ind_2, end_ind), - switcher$0 = - /*<>*/ caml_string_get - (str, str_ind_3) - - 45 - | 0; - /*<>*/ if(12 < switcher$0 >>> 0){ - if(17 === switcher$0){ - var - s = - /*<>*/ caml_call3 - (Stdlib_String[16], - str, - str_ind$3 - 2 | 0, - (str_ind_3 - str_ind$3 | 0) + 3 | 0), - _aI_ = /*<>*/ [0, s, width, 0], - _aJ_ = str_ind_3 + 1 | 0, - formatting_lit$0 = _aI_, - next_ind = _aJ_; - break b; - } - } - else if(1 < switcher$0 - 1 >>> 0){ - var - match$4 = - /*<>*/ parse_integer - (str_ind_3, end_ind), - offset = /*<>*/ match$4[2], - str_ind_4 = match$4[1], - str_ind_5 = - /*<>*/ parse_spaces - (str_ind_4, end_ind); - /*<>*/ if - (62 !== caml_string_get(str, str_ind_5)) - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - var - s$0 = - /*<>*/ caml_call3 - (Stdlib_String[16], - str, - str_ind$3 - 2 | 0, - (str_ind_5 - str_ind$3 | 0) + 3 | 0), - _aK_ = - /*<>*/ [0, - s$0, - width, - offset], - _aL_ = str_ind_5 + 1 | 0, - formatting_lit$0 = _aK_, - next_ind = _aL_; - break b; - } - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - } - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) - var formatting_lit$0 = formatting_lit, next_ind = str_ind$3; - else{ - if(exn[1] !== Stdlib[7]) - throw caml_maybe_attach_backtrace(exn, 0); - var formatting_lit$0 = formatting_lit, next_ind = str_ind$3; - } - } - var - fmt_rest$12 = - /*<>*/ parse(next_ind, end_ind) - [1], - match$0 = - /*<>*/ [0, - [17, formatting_lit$0, fmt_rest$12]]; - break a; - case 28: - var - str_ind$4 = - /*<>*/ str_ind$0 + 1 | 0; - try{ - var - str_ind_1$0 = - /*<>*/ parse_spaces - (str_ind$4, end_ind), - match$7 = - /*<>*/ caml_string_get - (str, str_ind_1$0); - b: - { - c: - { - /*<>*/ if(48 <= match$7){ - if(58 <= match$7) break c; - } - else if(45 !== match$7) break c; - var - match$8 = - /*<>*/ parse_integer - (str_ind_1$0, end_ind), - size = /*<>*/ match$8[2], - str_ind_2$0 = match$8[1], - str_ind_3$0 = - /*<>*/ parse_spaces - (str_ind_2$0, end_ind); - /*<>*/ if - (62 !== caml_string_get(str, str_ind_3$0)) - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - var - s$1 = - /*<>*/ caml_call3 - (Stdlib_String[16], - str, - str_ind$4 - 2 | 0, - (str_ind_3$0 - str_ind$4 | 0) + 3 | 0), - _aF_ = - /*<>*/ [0, - [0, str_ind_3$0 + 1 | 0, [1, s$1, size]]]; - break b; - } - var _aF_ = /*<>*/ 0; - } - var match$5 = _aF_; - } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8] && exn$0[1] !== Stdlib[7]) - throw caml_maybe_attach_backtrace(exn$0, 0); - var match$5 = /*<>*/ 0; - } - /*<>*/ if(match$5){ - var - match$6 = match$5[1], - formatting_lit$1 = match$6[2], - next_ind$0 = match$6[1], - fmt_rest$13 = - /*<>*/ parse - (next_ind$0, end_ind) - [1], - match$0 = - /*<>*/ [0, - [17, formatting_lit$1, fmt_rest$13]]; - break a; - } - var - fmt_rest$14 = - /*<>*/ parse(str_ind$4, end_ind) - [1], - match$0 = - /*<>*/ [0, - [17, _Q_, fmt_rest$14]]; - break a; - case 31: - var - fmt_rest$10 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, 2, fmt_rest$10]]; - break a; - case 32: - var - fmt_rest$11 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, 5, fmt_rest$11]]; - break a; - } + match = + /*<>*/ caml_string_get(str, str_ind); + /*<>*/ if(37 === match) break; + if(64 === match){ + var + fmt_rest$0 = + /*<>*/ parse_after_at + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return add_literal + (lit_start, str_ind, fmt_rest$0) /*<>*/ ; } - var - fmt_rest$1 = - /*<>*/ parse - (str_ind$0 + 1 | 0, end_ind) - [1], - match$0 = - /*<>*/ [0, [17, [2, c], fmt_rest$1]]; + var str_ind$0 = /*<>*/ str_ind + 1 | 0; + str_ind = str_ind$0; } - var fmt_rest$0 = /*<>*/ match$0[1]; - /*<>*/ return add_literal - (lit_start, str_ind, fmt_rest$0) /*<>*/ ; + var str_ind$1 = /*<>*/ str_ind + 1 | 0; + /*<>*/ if(str_ind$1 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + match$0 = + /*<>*/ 95 + === caml_string_get(str, str_ind$1) + ? /*<>*/ parse_flags + (str_ind, str_ind$1 + 1 | 0, end_ind, 1) + : /*<>*/ parse_flags + (str_ind, str_ind$1, end_ind, 0), + fmt_rest = /*<>*/ match$0[1]; + /*<>*/ return add_literal + (lit_start, str_ind, fmt_rest) /*<>*/ ; } function parse_flags(pct_ind, str_ind, end_ind, ign){ var @@ -19100,14 +18749,14 @@ hash = [0, 0]; function set_flag(str_ind, flag){ var - _aD_ = /*<>*/ flag[1], - _aE_ = _aD_ ? 1 - legacy_behavior$0 : _aD_; - if(_aE_){ + _aJ_ = /*<>*/ flag[1], + _aK_ = _aJ_ ? 1 - legacy_behavior$0 : _aJ_; + if(_aK_){ var - _aF_ = + _aL_ = /*<>*/ caml_string_get(str, str_ind); /*<>*/ caml_call3 - (failwith_message(_C_), str, str_ind, _aF_); + (failwith_message(_C_), str, str_ind, _aL_); } /*<>*/ flag[1] = 1; /*<>*/ } @@ -19319,9 +18968,9 @@ case 3: /*<>*/ if(legacy_behavior$0){ var - _aD_ = /*<>*/ str_ind$0 + 1 | 0, + _aJ_ = /*<>*/ str_ind$0 + 1 | 0, minus$0 = minus || (45 === symb$0 ? 1 : 0); - return parse_literal(minus$0, _aD_) /*<>*/ ; + return parse_literal(minus$0, _aJ_) /*<>*/ ; } break; } @@ -19604,6 +19253,35 @@ /*<>*/ [0, [3, pad$7, fmt_rest$16]]; break a; + case 91: + var + match$7 = + /*<>*/ parse_char_set + (str_ind, end_ind), + char_set = /*<>*/ match$7[2], + next_ind = match$7[1], + fmt_rest$19 = + /*<>*/ parse(next_ind, end_ind) + [1]; + /*<>*/ if(get_ign(0)){ + var + ignored$9 = + /*<>*/ [10, + get_pad_opt(95), + char_set], + fmt_result = + /*<>*/ [0, + [23, ignored$9, fmt_rest$19]]; + break a; + } + var + fmt_result = + /*<>*/ [0, + [20, + /*<>*/ get_pad_opt(91), + char_set, + fmt_rest$19]]; + break a; case 97: var fmt_rest$20 = @@ -19621,15 +19299,15 @@ }, fmt_rest$21 = /*<>*/ parse(str_ind, end_ind)[1], - match$7 = /*<>*/ get_pad_opt(99); - /*<>*/ if(! match$7){ + match$8 = /*<>*/ get_pad_opt(99); + /*<>*/ if(! match$8){ var fmt_result = /*<>*/ /*<>*/ char_format (fmt_rest$21); break a; } - var n = /*<>*/ match$7[1]; + var n = /*<>*/ match$8[1]; if(0 === n){ /*<>*/ if(get_ign(0)){ var @@ -19686,11 +19364,11 @@ break a; } var - match$8 = + match$9 = /*<>*/ make_padding_fmt_ebb (pad$9, fmt_rest$23), - fmt_rest$24 = /*<>*/ match$8[2], - pad$10 = match$8[1], + fmt_rest$24 = /*<>*/ match$9[2], + pad$10 = match$9[1], fmt_result = /*<>*/ [0, [2, pad$10, fmt_rest$24]]; @@ -19735,235 +19413,6 @@ sub_fmtty$0, fmt_rest$26]]; break a; - case 91: - /*<>*/ if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - char_set = - /*<>*/ create_char_set(0), - add_range = - /*<>*/ function(c$0, c){ - /*<>*/ if(c >= c$0){ - var i = c$0; - for(;;){ - /*<>*/ /*<>*/ add_in_char_set - (char_set, - /*<>*/ caml_call1 - (Stdlib[29], i)); - var _aD_ = /*<>*/ i + 1 | 0; - if(c === i) break; - i = _aD_; - } - } - /*<>*/ }, - fail_single_percent = - /*<>*/ function(str_ind){ - /*<>*/ return caml_call2 - (failwith_message(_R_), str, str_ind) /*<>*/ ; - }, - parse_char_set_content = - /*<>*/ function - (counter, str_ind$1, end_ind){ - var str_ind = /*<>*/ str_ind$1; - for(;;){ - if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c = - /*<>*/ caml_string_get - (str, str_ind); - /*<>*/ if(45 !== c){ - if(93 === c) - /*<>*/ return str_ind + 1 | 0; - var - _aD_ = /*<>*/ str_ind + 1 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_after_char$0, [0, _aD_, end_ind, c]) /*<>*/ ; - var - counter$0 = - /*<>*/ counter + 1 | 0; - return parse_char_set_after_char$0 - (counter$0, _aD_, end_ind, c) /*<>*/ ; - } - /*<>*/ add_in_char_set - (char_set, 45); - var - str_ind$0 = - /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$0; - } - /*<>*/ }, - parse_char_set_after_char$0 = - /*<>*/ function - (counter, str_ind$2, end_ind, c$3){ - var - str_ind = /*<>*/ str_ind$2, - c = c$3; - for(;;){ - if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c$0 = - /*<>*/ caml_string_get - (str, str_ind); - a: - { - /*<>*/ if(46 <= c$0){ - if(64 !== c$0){ - if(93 !== c$0) break a; - /*<>*/ add_in_char_set - (char_set, c); - /*<>*/ return str_ind + 1 - | 0; - } - } - else if(37 !== c$0){ - /*<>*/ if(45 > c$0) break a; - var - str_ind$1 = - /*<>*/ str_ind + 1 | 0; - /*<>*/ if - (str_ind$1 === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c$1 = - /*<>*/ caml_string_get - (str, str_ind$1); - /*<>*/ if(37 === c$1){ - /*<>*/ if - ((str_ind$1 + 1 | 0) === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c$2 = - /*<>*/ caml_string_get - (str, str_ind$1 + 1 | 0); - /*<>*/ if - (37 !== c$2 && 64 !== c$2) - /*<>*/ return fail_single_percent - (str_ind$1) /*<>*/ ; - /*<>*/ add_range(c, c$2); - var - _aC_ = - /*<>*/ str_ind$1 + 2 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_content, [0, _aC_, end_ind]) /*<>*/ ; - var - counter$1 = - /*<>*/ counter + 1 | 0; - return parse_char_set_content(counter$1, _aC_, end_ind) /*<>*/ ; - } - /*<>*/ if(93 === c$1){ - /*<>*/ add_in_char_set - (char_set, c); - add_in_char_set(char_set, 45); - /*<>*/ return str_ind$1 + 1 - | 0; - } - /*<>*/ add_range(c, c$1); - var - _aD_ = - /*<>*/ str_ind$1 + 1 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_content, [0, _aD_, end_ind]) /*<>*/ ; - var - counter$0 = - /*<>*/ counter + 1 | 0; - return parse_char_set_content(counter$0, _aD_, end_ind) /*<>*/ ; - } - /*<>*/ if(37 === c){ - /*<>*/ add_in_char_set - (char_set, c$0); - var - _aB_ = - /*<>*/ str_ind + 1 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_content, [0, _aB_, end_ind]) /*<>*/ ; - var - counter$2 = - /*<>*/ counter + 1 | 0; - return parse_char_set_content(counter$2, _aB_, end_ind) /*<>*/ ; - } - } - /*<>*/ if(37 === c) - /*<>*/ fail_single_percent - (str_ind); - /*<>*/ add_in_char_set - (char_set, c); - var - str_ind$0 = - /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$0; - c = c$0; - } - /*<>*/ }, - parse_char_set_after_char = - /*<>*/ function - (str_ind, end_ind, c){ - /*<>*/ return /*<>*/ caml_trampoline - ( /*<>*/ parse_char_set_after_char$0 - (0, str_ind, end_ind, c)) /*<>*/ ; - }; - /*<>*/ if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - /*<>*/ if - (94 === caml_string_get(str, str_ind)) - var - str_ind$0 = /*<>*/ str_ind + 1 | 0, - reverse = /*<>*/ 1, - str_ind$1 = str_ind$0; - else - var - reverse = /*<>*/ 0, - str_ind$1 = str_ind; - /*<>*/ if(str_ind$1 === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c = - /*<>*/ caml_string_get - (str, str_ind$1), - next_ind = - /*<>*/ parse_char_set_after_char - (str_ind$1 + 1 | 0, end_ind, c), - char_set$0 = - /*<>*/ freeze_char_set(char_set), - char_set$1 = - /*<>*/ reverse - ? /*<>*/ rev_char_set - (char_set$0) - : char_set$0, - fmt_rest$19 = - /*<>*/ parse(next_ind, end_ind) - [1]; - /*<>*/ if(get_ign(0)){ - var - ignored$9 = - /*<>*/ [10, - get_pad_opt(95), - char_set$1], - fmt_result = - /*<>*/ [0, - [23, ignored$9, fmt_rest$19]]; - break a; - } - var - fmt_result = - /*<>*/ [0, - [20, - /*<>*/ get_pad_opt(91), - char_set$1, - fmt_rest$19]]; - break a; case 66: case 98: var @@ -20006,22 +19455,22 @@ symb$0 = /*<>*/ caml_string_get (str, str_ind), - _ai_ = /*<>*/ symb$0 - 88 | 0; + _aq_ = /*<>*/ symb$0 - 88 | 0; b: { - if(32 >= _ai_ >>> 0) - switch(_ai_){ + if(32 >= _aq_ >>> 0) + switch(_aq_){ case 0: case 12: case 17: case 23: case 29: case 32: - var _ah_ = /*<>*/ 1; break b; + var _ap_ = /*<>*/ 1; break b; } - var _ah_ = /*<>*/ 0; + var _ap_ = /*<>*/ 0; } - /*<>*/ if(_ah_) break; + /*<>*/ if(_ap_) break; } var fmt_rest$13 = @@ -20076,15 +19525,15 @@ case 117: case 120: var - _az_ = /*<>*/ get_space(0), - _aA_ = /*<>*/ get_hash(0), + _aH_ = /*<>*/ get_space(0), + _aI_ = /*<>*/ get_hash(0), iconv$2 = /*<>*/ /*<>*/ compute_int_conv (pct_ind, str_ind, /*<>*/ get_plus(0), - _aA_, - _az_, + _aI_, + _aH_, symb), fmt_rest$17 = /*<>*/ parse(str_ind, end_ind)[1]; @@ -20100,11 +19549,11 @@ break a; } var - _aB_ = /*<>*/ get_prec(0), + _aJ_ = /*<>*/ get_prec(0), match$6 = /*<>*/ /*<>*/ make_padprec_fmt_ebb ( /*<>*/ get_int_pad(0), - _aB_, + _aJ_, fmt_rest$17), fmt_rest$18 = /*<>*/ match$6[3], prec$4 = match$6[2], @@ -20178,11 +19627,11 @@ /*<>*/ parse(str_ind, end_ind)[1]; /*<>*/ if(! get_ign(0)){ var - _ay_ = /*<>*/ get_prec(0), + _aG_ = /*<>*/ get_prec(0), match$4 = /*<>*/ /*<>*/ make_padprec_fmt_ebb ( /*<>*/ get_pad(0), - _ay_, + _aG_, fmt_rest$11), fmt_rest$12 = /*<>*/ match$4[3], prec$3 = match$4[2], @@ -20195,7 +19644,7 @@ var match = /*<>*/ get_prec(0); /*<>*/ if(typeof match === "number") var - _ag_ = + _ao_ = match ? /*<>*/ incompatible_flag (pct_ind, str_ind, 95, cst$26) @@ -20203,10 +19652,10 @@ else var ndec = /*<>*/ match[1], - _ag_ = /*<>*/ [0, ndec]; + _ao_ = /*<>*/ [0, ndec]; var ignored$4 = - /*<>*/ [6, get_pad_opt(95), _ag_], + /*<>*/ [6, get_pad_opt(95), _ao_], fmt_result = /*<>*/ [0, [23, ignored$4, fmt_rest$11]]; @@ -20217,19 +19666,19 @@ switch(symb - 108 | 0){ case 0: var - _am_ = + _au_ = /*<>*/ caml_string_get (str, str_ind), - _an_ = /*<>*/ get_space(0), - _ao_ = /*<>*/ get_hash(0), + _av_ = /*<>*/ get_space(0), + _aw_ = /*<>*/ get_hash(0), iconv = /*<>*/ /*<>*/ compute_int_conv (pct_ind, str_ind + 1 | 0, /*<>*/ get_plus(0), - _ao_, - _an_, - _am_), + _aw_, + _av_, + _au_), fmt_rest = /*<>*/ parse (str_ind + 1 | 0, end_ind) @@ -20246,11 +19695,11 @@ break a; } var - _ap_ = /*<>*/ get_prec(0), + _ax_ = /*<>*/ get_prec(0), match$0 = /*<>*/ /*<>*/ make_padprec_fmt_ebb ( /*<>*/ get_int_pad(0), - _ap_, + _ax_, fmt_rest), fmt_rest$0 = /*<>*/ match$0[3], prec$0 = match$0[2], @@ -20261,19 +19710,19 @@ break a; case 2: var - _aq_ = + _ay_ = /*<>*/ caml_string_get (str, str_ind), - _ar_ = /*<>*/ get_space(0), - _as_ = /*<>*/ get_hash(0), + _az_ = /*<>*/ get_space(0), + _aA_ = /*<>*/ get_hash(0), iconv$0 = /*<>*/ /*<>*/ compute_int_conv (pct_ind, str_ind + 1 | 0, /*<>*/ get_plus(0), - _as_, - _ar_, - _aq_), + _aA_, + _az_, + _ay_), fmt_rest$1 = /*<>*/ parse (str_ind + 1 | 0, end_ind) @@ -20290,11 +19739,11 @@ break a; } var - _at_ = /*<>*/ get_prec(0), + _aB_ = /*<>*/ get_prec(0), match$1 = /*<>*/ /*<>*/ make_padprec_fmt_ebb ( /*<>*/ get_int_pad(0), - _at_, + _aB_, fmt_rest$1), fmt_rest$2 = /*<>*/ match$1[3], prec$1 = match$1[2], @@ -20307,18 +19756,18 @@ } else if(76 === symb){ var - _au_ = + _aC_ = /*<>*/ caml_string_get(str, str_ind), - _av_ = /*<>*/ get_space(0), - _aw_ = /*<>*/ get_hash(0), + _aD_ = /*<>*/ get_space(0), + _aE_ = /*<>*/ get_hash(0), iconv$1 = /*<>*/ /*<>*/ compute_int_conv (pct_ind, str_ind + 1 | 0, /*<>*/ get_plus(0), - _aw_, - _av_, - _au_), + _aE_, + _aD_, + _aC_), fmt_rest$3 = /*<>*/ parse (str_ind + 1 | 0, end_ind) @@ -20335,11 +19784,11 @@ break a; } var - _ax_ = /*<>*/ get_prec(0), + _aF_ = /*<>*/ get_prec(0), match$2 = /*<>*/ /*<>*/ make_padprec_fmt_ebb ( /*<>*/ get_int_pad(0), - _ax_, + _aF_, fmt_rest$3), fmt_rest$4 = /*<>*/ match$2[3], prec$2 = match$2[2], @@ -20356,43 +19805,43 @@ } /*<>*/ if(1 - legacy_behavior$0){ var - _aa_ = /*<>*/ 1 - plus_used[1], - plus$0 = _aa_ ? plus : _aa_; + _ai_ = /*<>*/ 1 - plus_used[1], + plus$0 = _ai_ ? plus : _ai_; if(plus$0) /*<>*/ incompatible_flag (pct_ind, str_ind, symb, cst$27); var - _ab_ = /*<>*/ 1 - hash_used[1], - hash$0 = _ab_ ? hash : _ab_; + _aj_ = /*<>*/ 1 - hash_used[1], + hash$0 = _aj_ ? hash : _aj_; if(hash$0) /*<>*/ incompatible_flag (pct_ind, str_ind, symb, cst$28); var - _ac_ = /*<>*/ 1 - space_used[1], - space$0 = _ac_ ? space : _ac_; + _ak_ = /*<>*/ 1 - space_used[1], + space$0 = _ak_ ? space : _ak_; if(space$0) /*<>*/ incompatible_flag (pct_ind, str_ind, symb, cst$29); var - _ad_ = /*<>*/ 1 - pad_used[1], - _aj_ = - _ad_ + _al_ = /*<>*/ 1 - pad_used[1], + _ar_ = + _al_ ? /*<>*/ caml_notequal ([0, pad], _K_) - : _ad_; - /*<>*/ if(_aj_) + : _al_; + /*<>*/ if(_ar_) /*<>*/ incompatible_flag (pct_ind, str_ind, symb, cst_padding$0); var - _ae_ = /*<>*/ 1 - prec_used[1], - _ak_ = - _ae_ + _am_ = /*<>*/ 1 - prec_used[1], + _as_ = + _am_ ? /*<>*/ caml_notequal ([0, prec], _L_) - : _ae_; - /*<>*/ if(_ak_){ - var _al_ = /*<>*/ ign ? 95 : symb; - incompatible_flag(pct_ind, str_ind, _al_, cst_precision$2); + : _am_; + /*<>*/ if(_as_){ + var _at_ = /*<>*/ ign ? 95 : symb; + incompatible_flag(pct_ind, str_ind, _at_, cst_precision$2); } var plus$1 = /*<>*/ ign ? plus : ign; if(plus$1) @@ -20400,8 +19849,8 @@ (pct_ind, str_ind, 95, cst$30); } var - _af_ = /*<>*/ 1 - ign_used[1], - ign$0 = _af_ ? ign : _af_; + _an_ = /*<>*/ 1 - ign_used[1], + ign$0 = _an_ ? ign : _an_; a: if(ign$0){ b: @@ -20417,6 +19866,308 @@ } /*<>*/ return fmt_result; } + function parse_after_at(str_ind, end_ind){ + /*<>*/ if(str_ind === end_ind) + /*<>*/ return _N_; + var + c = /*<>*/ caml_string_get(str, str_ind); + /*<>*/ if(65 <= c){ + if(94 <= c){ + var switcher = c - 123 | 0; + if(2 >= switcher >>> 0) + switch(switcher){ + case 0: + /*<>*/ return parse_tag + (1, str_ind + 1 | 0, end_ind) /*<>*/ ; + case 2: + var + fmt_rest$0 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, 1, fmt_rest$0]]; + } + } + else if(91 <= c) + /*<>*/ switch(c - 91 | 0){ + case 0: + /*<>*/ return parse_tag + (0, str_ind + 1 | 0, end_ind) /*<>*/ ; + case 2: + var + fmt_rest$1 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, 0, fmt_rest$1]]; + } + } + else{ + /*<>*/ if(10 === c){ + var + fmt_rest$2 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, [17, 3, fmt_rest$2]]; + } + /*<>*/ if(32 <= c) + switch(c - 32 | 0){ + case 0: + var + fmt_rest$3 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, _O_, fmt_rest$3]]; + case 5: + /*<>*/ if + ((str_ind + 1 | 0) < end_ind + && + 37 + === + /*<>*/ caml_string_get + (str, str_ind + 1 | 0)){ + var + fmt_rest$4 = + /*<>*/ parse + (str_ind + 2 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, 6, fmt_rest$4]]; + } + var + fmt_rest$5 = + /*<>*/ parse(str_ind, end_ind)[1]; + /*<>*/ return [0, + [12, 64, fmt_rest$5]]; + case 12: + var + fmt_rest$6 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, _P_, fmt_rest$6]]; + case 14: + var + fmt_rest$7 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, 4, fmt_rest$7]]; + case 27: + var + str_ind$0 = /*<>*/ str_ind + 1 | 0; + a: + try{ + var + _ad_ = str_ind$0 === end_ind ? 1 : 0, + _ae_ = + _ad_ + || + (60 + !== + /*<>*/ caml_string_get + (str, str_ind$0) + ? 1 + : 0); + if(_ae_) + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + var + str_ind_1 = + /*<>*/ parse_spaces + (str_ind$0 + 1 | 0, end_ind), + match = + /*<>*/ caml_string_get + (str, str_ind_1); + b: + { + /*<>*/ if(48 <= match){ + if(58 <= match) break b; + } + else if(45 !== match) break b; + var + match$0 = + /*<>*/ parse_integer + (str_ind_1, end_ind), + width = /*<>*/ match$0[2], + str_ind_2 = match$0[1], + str_ind_3 = + /*<>*/ parse_spaces + (str_ind_2, end_ind), + switcher$0 = + /*<>*/ caml_string_get + (str, str_ind_3) + - 45 + | 0; + /*<>*/ if(12 < switcher$0 >>> 0){ + if(17 === switcher$0){ + var + s = + /*<>*/ caml_call3 + (Stdlib_String[16], + str, + str_ind$0 - 2 | 0, + (str_ind_3 - str_ind$0 | 0) + 3 | 0), + _af_ = /*<>*/ [0, s, width, 0], + _ag_ = str_ind_3 + 1 | 0, + formatting_lit$0 = _af_, + next_ind = _ag_; + break a; + } + } + else if(1 < switcher$0 - 1 >>> 0){ + var + match$1 = + /*<>*/ parse_integer + (str_ind_3, end_ind), + offset = /*<>*/ match$1[2], + str_ind_4 = match$1[1], + str_ind_5 = + /*<>*/ parse_spaces + (str_ind_4, end_ind); + /*<>*/ if + (62 !== caml_string_get(str, str_ind_5)) + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + var + s$0 = + /*<>*/ caml_call3 + (Stdlib_String[16], + str, + str_ind$0 - 2 | 0, + (str_ind_5 - str_ind$0 | 0) + 3 | 0), + _ah_ = + /*<>*/ [0, s$0, width, offset], + _ai_ = str_ind_5 + 1 | 0, + formatting_lit$0 = _ah_, + next_ind = _ai_; + break a; + } + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + } + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + } + catch(exn$0){ + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn === Stdlib[8]) + var formatting_lit$0 = formatting_lit, next_ind = str_ind$0; + else{ + if(exn[1] !== Stdlib[7]) + throw caml_maybe_attach_backtrace(exn, 0); + var formatting_lit$0 = formatting_lit, next_ind = str_ind$0; + } + } + var + fmt_rest$10 = + /*<>*/ parse(next_ind, end_ind) + [1]; + /*<>*/ return [0, + [17, formatting_lit$0, fmt_rest$10]]; + case 28: + var + str_ind$1 = /*<>*/ str_ind + 1 | 0; + try{ + var + str_ind_1$0 = + /*<>*/ parse_spaces + (str_ind$1, end_ind), + match$4 = + /*<>*/ caml_string_get + (str, str_ind_1$0); + a: + { + b: + { + /*<>*/ if(48 <= match$4){ + if(58 <= match$4) break b; + } + else if(45 !== match$4) break b; + var + match$5 = + /*<>*/ parse_integer + (str_ind_1$0, end_ind), + size = /*<>*/ match$5[2], + str_ind_2$0 = match$5[1], + str_ind_3$0 = + /*<>*/ parse_spaces + (str_ind_2$0, end_ind); + /*<>*/ if + (62 !== caml_string_get(str, str_ind_3$0)) + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + var + s$1 = + /*<>*/ caml_call3 + (Stdlib_String[16], + str, + str_ind$1 - 2 | 0, + (str_ind_3$0 - str_ind$1 | 0) + 3 | 0), + _ac_ = + /*<>*/ [0, + [0, str_ind_3$0 + 1 | 0, [1, s$1, size]]]; + break a; + } + var _ac_ = /*<>*/ 0; + } + var match$2 = _ac_; + } + catch(exn){ + var exn$0 = /*<>*/ caml_wrap_exception(exn); + if(exn$0 !== Stdlib[8] && exn$0[1] !== Stdlib[7]) + throw caml_maybe_attach_backtrace(exn$0, 0); + var match$2 = /*<>*/ 0; + } + /*<>*/ if(match$2){ + var + match$3 = match$2[1], + formatting_lit$1 = match$3[2], + next_ind$0 = match$3[1], + fmt_rest$11 = + /*<>*/ parse + (next_ind$0, end_ind) + [1]; + /*<>*/ return [0, + [17, formatting_lit$1, fmt_rest$11]]; + } + var + fmt_rest$12 = + /*<>*/ parse(str_ind$1, end_ind) + [1]; + /*<>*/ return [0, + [17, _Q_, fmt_rest$12]]; + case 31: + var + fmt_rest$8 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, 2, fmt_rest$8]]; + case 32: + var + fmt_rest$9 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, + [17, 5, fmt_rest$9]]; + } + } + var + fmt_rest = + /*<>*/ parse(str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ return [0, [17, [2, c], fmt_rest]]; + /*<>*/ } function parse_tag(is_open_tag, str_ind, end_ind){ /*<>*/ try{ if(str_ind === end_ind) @@ -20447,10 +20198,10 @@ /*<>*/ is_open_tag ? [0, sub_format$0] : [1, sub_format$0], - _aa_ = + _ac_ = /*<>*/ [0, [18, formatting$0, fmt_rest$0]]; - return _aa_; + return _ac_; } catch(exn$0){ var exn = /*<>*/ caml_wrap_exception(exn$0); @@ -20466,6 +20217,170 @@ [18, formatting, fmt_rest]]; } /*<>*/ } + function parse_char_set(str_ind, end_ind){ + /*<>*/ if(str_ind === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var char_set = /*<>*/ create_char_set(0); + function add_range(c$0, c){ + /*<>*/ if(c >= c$0){ + var i = c$0; + for(;;){ + /*<>*/ /*<>*/ add_in_char_set + (char_set, + /*<>*/ caml_call1(Stdlib[29], i)); + var _ac_ = /*<>*/ i + 1 | 0; + if(c === i) break; + i = _ac_; + } + } + /*<>*/ } + function fail_single_percent(str_ind){ + /*<>*/ return caml_call2 + (failwith_message(_R_), str, str_ind) /*<>*/ ; + } + function parse_char_set_content(counter, str_ind$1, end_ind){ + var str_ind = /*<>*/ str_ind$1; + for(;;){ + if(str_ind === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c = + /*<>*/ caml_string_get(str, str_ind); + /*<>*/ if(45 !== c){ + if(93 === c) + /*<>*/ return str_ind + 1 | 0; + var _ac_ = /*<>*/ str_ind + 1 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_after_char$0, [0, _ac_, end_ind, c]) /*<>*/ ; + var counter$0 = /*<>*/ counter + 1 | 0; + return parse_char_set_after_char$0(counter$0, _ac_, end_ind, c) /*<>*/ ; + } + /*<>*/ add_in_char_set(char_set, 45); + var str_ind$0 = /*<>*/ str_ind + 1 | 0; + str_ind = str_ind$0; + } + /*<>*/ } + function parse_char_set_after_char$0(counter, str_ind$2, end_ind, c$3){ + var str_ind = /*<>*/ str_ind$2, c = c$3; + for(;;){ + if(str_ind === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c$0 = + /*<>*/ caml_string_get(str, str_ind); + a: + { + /*<>*/ if(46 <= c$0){ + if(64 !== c$0){ + if(93 !== c$0) break a; + /*<>*/ add_in_char_set(char_set, c); + /*<>*/ return str_ind + 1 | 0; + } + } + else if(37 !== c$0){ + /*<>*/ if(45 > c$0) break a; + var + str_ind$1 = /*<>*/ str_ind + 1 | 0; + /*<>*/ if(str_ind$1 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c$1 = + /*<>*/ caml_string_get + (str, str_ind$1); + /*<>*/ if(37 === c$1){ + /*<>*/ if + ((str_ind$1 + 1 | 0) === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c$2 = + /*<>*/ caml_string_get + (str, str_ind$1 + 1 | 0); + /*<>*/ if(37 !== c$2 && 64 !== c$2) + /*<>*/ return fail_single_percent + (str_ind$1) /*<>*/ ; + /*<>*/ add_range(c, c$2); + var _ab_ = /*<>*/ str_ind$1 + 2 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_content, [0, _ab_, end_ind]) /*<>*/ ; + var + counter$1 = /*<>*/ counter + 1 | 0; + return parse_char_set_content(counter$1, _ab_, end_ind) /*<>*/ ; + } + /*<>*/ if(93 === c$1){ + /*<>*/ add_in_char_set(char_set, c); + add_in_char_set(char_set, 45); + /*<>*/ return str_ind$1 + 1 | 0; + } + /*<>*/ add_range(c, c$1); + var _ac_ = /*<>*/ str_ind$1 + 1 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_content, [0, _ac_, end_ind]) /*<>*/ ; + var + counter$0 = /*<>*/ counter + 1 | 0; + return parse_char_set_content(counter$0, _ac_, end_ind) /*<>*/ ; + } + /*<>*/ if(37 === c){ + /*<>*/ add_in_char_set(char_set, c$0); + var _aa_ = /*<>*/ str_ind + 1 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_content, [0, _aa_, end_ind]) /*<>*/ ; + var + counter$2 = /*<>*/ counter + 1 | 0; + return parse_char_set_content(counter$2, _aa_, end_ind) /*<>*/ ; + } + } + /*<>*/ if(37 === c) + /*<>*/ fail_single_percent(str_ind); + /*<>*/ add_in_char_set(char_set, c); + var str_ind$0 = /*<>*/ str_ind + 1 | 0; + str_ind = str_ind$0; + c = c$0; + } + /*<>*/ } + function parse_char_set_after_char(str_ind, end_ind, c){ + /*<>*/ return /*<>*/ caml_trampoline + ( /*<>*/ parse_char_set_after_char$0 + (0, str_ind, end_ind, c)) /*<>*/ ; + } + /*<>*/ if(str_ind === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + /*<>*/ if + (94 === caml_string_get(str, str_ind)) + var + str_ind$0 = /*<>*/ str_ind + 1 | 0, + reverse = /*<>*/ 1, + str_ind$1 = str_ind$0; + else + var + reverse = /*<>*/ 0, + str_ind$1 = str_ind; + /*<>*/ if(str_ind$1 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c = + /*<>*/ caml_string_get(str, str_ind$1), + next_ind = + /*<>*/ parse_char_set_after_char + (str_ind$1 + 1 | 0, end_ind, c), + char_set$0 = + /*<>*/ freeze_char_set(char_set), + _aa_ = + /*<>*/ reverse + ? /*<>*/ rev_char_set(char_set$0) + : char_set$0; + /*<>*/ return [0, next_ind, _aa_]; + /*<>*/ } function parse_spaces(str_ind$1, end_ind){ var str_ind = /*<>*/ str_ind$1; for(;;){ @@ -26041,6 +25956,30 @@ }, t[1]) /*<>*/ ; } + function iter_weak(f, t){ + var i = /*<>*/ 0; + /*<>*/ return caml_call2 + (Stdlib_Array[13], + function(j, b){ + var i$0 = /*<>*/ i; + for(;;){ + /*<>*/ if(length(b) <= i$0) + /*<>*/ return 0; + /*<>*/ if(check(b, i$0)){ + /*<>*/ /*<>*/ caml_call3 + (f, + b, + /*<>*/ caml_check_bound(t[2], j)[j + 1], + i$0); + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; + } + else{var i$2 = /*<>*/ i$0 + 1 | 0; i$0 = i$2; + } + } + }, + t[1]) /*<>*/ ; + } function count_bucket(i$1, b, accu$1){ var i = /*<>*/ i$1, accu = accu$1; for(;;){ @@ -26063,113 +26002,7 @@ t[1], 0) /*<>*/ ; } - function add_aux(t, setter, d, h, index){ - var - bucket$0 = - /*<>*/ caml_check_bound(t[1], index)[index + 1], - hashes = - /*<>*/ caml_check_bound(t[2], index)[index + 1], - sz = /*<>*/ length(bucket$0), - i$3 = /*<>*/ 0; - for(;;){ - /*<>*/ if(sz <= i$3) break; - /*<>*/ if(! check(bucket$0, i$3)){ - /*<>*/ caml_call3(setter, bucket$0, i$3, d); - /*<>*/ caml_check_bound(hashes, i$3)[i$3 + 1] = h; - /*<>*/ return 0; - } - var i$5 = /*<>*/ i$3 + 1 | 0; - i$3 = i$5; - } - var - newsz = - /*<>*/ caml_call2 - (Stdlib_Int[10], - ((3 * sz | 0) / 2 | 0) + 3 | 0, - Stdlib_Sys[13] - 2 | 0); - /*<>*/ if(newsz <= sz) - /*<>*/ caml_call1 - (Stdlib[2], cst_Weak_Make_hash_bucket_cann); - var - newbucket$0 = /*<>*/ create(newsz), - newhashes = /*<>*/ caml_array_make(newsz, 0); - /*<>*/ blit(bucket$0, 0, newbucket$0, 0, sz); - /*<>*/ caml_call5 - (Stdlib_Array[9], hashes, 0, newhashes, 0, sz); - /*<>*/ caml_call3(setter, newbucket$0, sz, d); - /*<>*/ caml_check_bound(newhashes, sz)[sz + 1] = h; - /*<>*/ caml_check_bound(t[1], index)[index + 1] = newbucket$0; - /*<>*/ caml_check_bound(t[2], index)[index + 1] = newhashes; - var - _m_ = /*<>*/ sz <= t[3] ? 1 : 0, - _r_ = _m_ ? t[3] < newsz ? 1 : 0 : _m_; - if(_r_){ - /*<>*/ t[4] = t[4] + 1 | 0; - var i$4 = /*<>*/ 0; - for(;;){ - var - _f_ = /*<>*/ t[5], - bucket = /*<>*/ caml_check_bound(t[1], _f_)[_f_ + 1], - _g_ = /*<>*/ t[5], - hbucket = /*<>*/ caml_check_bound(t[2], _g_)[_g_ + 1], - len = /*<>*/ length(bucket), - prev_len = - /*<>*/ (((len - 3 | 0) * 2 | 0) + 2 | 0) / 3 | 0, - live = /*<>*/ count_bucket(0, bucket, 0); - /*<>*/ if(live <= prev_len){ - var - j$2 = /*<>*/ length(bucket) - 1 | 0, - i$0 = /*<>*/ 0, - j = j$2; - for(;;){ - /*<>*/ if(prev_len > j) break; - /*<>*/ if(check(bucket, i$0)){ - var i$1 = /*<>*/ i$0 + 1 | 0; - i$0 = i$1; - } - else if( /*<>*/ check(bucket, j)){ - /*<>*/ blit(bucket, j, bucket, i$0, 1); - var - _o_ = /*<>*/ caml_check_bound(hbucket, j)[j + 1]; - /*<>*/ caml_check_bound(hbucket, i$0)[i$0 + 1] = _o_; - var j$0 = /*<>*/ j - 1 | 0, i$2 = i$0 + 1 | 0; - i$0 = i$2; - j = j$0; - } - else{var j$1 = /*<>*/ j - 1 | 0; j = j$1;} - } - /*<>*/ if(0 === prev_len){ - var _h_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[1], _h_)[_h_ + 1] = emptybucket; - var _i_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[2], _i_)[_i_ + 1] = [0]; - } - else{ - var newbucket = /*<>*/ create(prev_len); - /*<>*/ blit(bucket, 0, newbucket, 0, prev_len); - var _k_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[1], _k_)[_k_ + 1] = newbucket; - var - _q_ = - /*<>*/ caml_call3 - (Stdlib_Array[6], hbucket, 0, prev_len), - _l_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[2], _l_)[_l_ + 1] = _q_; - } - var - _j_ = /*<>*/ t[3] < len ? 1 : 0, - _p_ = _j_ ? prev_len <= t[3] ? 1 : 0 : _j_; - if(_p_) /*<>*/ t[4] = t[4] - 1 | 0; - } - /*<>*/ t[5] = caml_mod(t[5] + 1 | 0, t[1].length - 1); - var _s_ = /*<>*/ i$4 + 1 | 0; - if(2 === i$4) break; - i$4 = _s_; - } - } - var - _n_ = /*<>*/ ((t[1].length - 1) / 2 | 0) < t[4] ? 1 : 0; - if(! _n_) return _n_; + function resize(t){ var oldlen = /*<>*/ t[1].length - 1, newlen = @@ -26178,32 +26011,20 @@ /*<>*/ if(oldlen < newlen){ var newt = /*<>*/ create$0(newlen), - i = /*<>*/ 0; - /*<>*/ caml_call2 - (Stdlib_Array[13], - function(j, ob){ - var oi = /*<>*/ i; - for(;;){ - /*<>*/ if(length(ob) <= oi) - /*<>*/ return 0; - /*<>*/ if(check(ob, oi)){ - var oh = /*<>*/ caml_check_bound(t[2], j)[j + 1]; - let oi$0 = /*<>*/ oi; - var - setter = - function(nb, ni, param){ - /*<>*/ return blit(ob, oi$0, nb, ni, 1) /*<>*/ ; - }, - h = /*<>*/ caml_check_bound(oh, oi)[oi + 1]; - /*<>*/ /*<>*/ add_aux - (newt, setter, 0, h, /*<>*/ get_index(newt, h)); - var i$0 = /*<>*/ oi + 1 | 0; - oi = i$0; + add_weak = + /*<>*/ function(ob, oh, oi){ + function setter(nb, ni, param){ + /*<>*/ return blit(ob, oi, nb, ni, 1) /*<>*/ ; } - else{var i$1 = /*<>*/ oi + 1 | 0; oi = i$1;} - } - }, - t[1]); + var h = /*<>*/ caml_check_bound(oh, oi)[oi + 1]; + /*<>*/ return /*<>*/ add_aux + (newt, + setter, + 0, + h, + /*<>*/ get_index(newt, h)) /*<>*/ ; + }; + /*<>*/ iter_weak(add_weak, t); /*<>*/ t[1] = newt[1]; /*<>*/ t[2] = newt[2]; /*<>*/ t[3] = newt[3]; @@ -26214,7 +26035,124 @@ /*<>*/ t[3] = Stdlib[19]; /*<>*/ t[4] = 0; return 0; - /*<>*/ } + /*<>*/ } + function add_aux(t, setter, d, h, index){ + var + bucket = + /*<>*/ caml_check_bound(t[1], index)[index + 1], + hashes = + /*<>*/ caml_check_bound(t[2], index)[index + 1], + sz = /*<>*/ length(bucket); + function loop(i$5){ + var i$2 = /*<>*/ i$5; + for(;;){ + if(sz <= i$2){ + var + newsz = + /*<>*/ caml_call2 + (Stdlib_Int[10], + ((3 * sz | 0) / 2 | 0) + 3 | 0, + Stdlib_Sys[13] - 2 | 0); + /*<>*/ if(newsz <= sz) + /*<>*/ caml_call1 + (Stdlib[2], cst_Weak_Make_hash_bucket_cann); + var + newbucket$0 = /*<>*/ create(newsz), + newhashes = /*<>*/ caml_array_make(newsz, 0); + /*<>*/ blit(bucket, 0, newbucket$0, 0, sz); + /*<>*/ caml_call5 + (Stdlib_Array[9], hashes, 0, newhashes, 0, sz); + /*<>*/ caml_call3(setter, newbucket$0, sz, d); + /*<>*/ caml_check_bound(newhashes, sz)[sz + 1] = h; + /*<>*/ caml_check_bound(t[1], index)[index + 1] = newbucket$0; + /*<>*/ caml_check_bound(t[2], index)[index + 1] = newhashes; + var + _m_ = /*<>*/ sz <= t[3] ? 1 : 0, + _r_ = _m_ ? t[3] < newsz ? 1 : 0 : _m_; + if(_r_){ + /*<>*/ t[4] = t[4] + 1 | 0; + var i$3 = /*<>*/ 0; + for(;;){ + var + _f_ = /*<>*/ t[5], + bucket$0 = + /*<>*/ caml_check_bound(t[1], _f_)[_f_ + 1], + _g_ = /*<>*/ t[5], + hbucket = + /*<>*/ caml_check_bound(t[2], _g_)[_g_ + 1], + len = /*<>*/ length(bucket$0), + prev_len = + /*<>*/ (((len - 3 | 0) * 2 | 0) + 2 | 0) / 3 | 0, + live = /*<>*/ count_bucket(0, bucket$0, 0); + /*<>*/ if(live <= prev_len){ + var + j$2 = /*<>*/ length(bucket$0) - 1 | 0, + i = /*<>*/ 0, + j = j$2; + for(;;){ + /*<>*/ if(prev_len > j) break; + /*<>*/ if(check(bucket$0, i)){ + var i$0 = /*<>*/ i + 1 | 0; + i = i$0; + } + else if( /*<>*/ check(bucket$0, j)){ + /*<>*/ blit(bucket$0, j, bucket$0, i, 1); + var + _o_ = + /*<>*/ caml_check_bound(hbucket, j)[j + 1]; + /*<>*/ caml_check_bound(hbucket, i)[i + 1] = _o_; + var j$0 = /*<>*/ j - 1 | 0, i$1 = i + 1 | 0; + i = i$1; + j = j$0; + } + else{var j$1 = /*<>*/ j - 1 | 0; j = j$1;} + } + /*<>*/ if(0 === prev_len){ + var _h_ = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[1], _h_)[_h_ + 1] = emptybucket; + var _i_ = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[2], _i_)[_i_ + 1] = [0]; + } + else{ + var newbucket = /*<>*/ create(prev_len); + /*<>*/ blit(bucket$0, 0, newbucket, 0, prev_len); + var _k_ = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[1], _k_)[_k_ + 1] = newbucket; + var + _q_ = + /*<>*/ caml_call3 + (Stdlib_Array[6], hbucket, 0, prev_len), + _l_ = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[2], _l_)[_l_ + 1] = _q_; + } + var + _j_ = /*<>*/ t[3] < len ? 1 : 0, + _p_ = _j_ ? prev_len <= t[3] ? 1 : 0 : _j_; + if(_p_) /*<>*/ t[4] = t[4] - 1 | 0; + } + /*<>*/ t[5] = + caml_mod(t[5] + 1 | 0, t[1].length - 1); + var _s_ = /*<>*/ i$3 + 1 | 0; + if(2 === i$3) break; + i$3 = _s_; + } + } + var + _n_ = + /*<>*/ ((t[1].length - 1) / 2 | 0) < t[4] ? 1 : 0; + return _n_ ? /*<>*/ resize(t) : _n_ /*<>*/ ; + } + /*<>*/ if(! check(bucket, i$2)){ + /*<>*/ caml_call3(setter, bucket, i$2, d); + /*<>*/ caml_check_bound(hashes, i$2)[i$2 + 1] = h; + /*<>*/ return 0; + } + var i$4 = /*<>*/ i$2 + 1 | 0; + i$2 = i$4; + } + /*<>*/ } + /*<>*/ return loop(0) /*<>*/ ; + } function add(t, d){ var h = /*<>*/ caml_call1(H[2], d); /*<>*/ return /*<>*/ add_aux @@ -31560,6 +31498,205 @@ = 0; /*<>*/ return n$0; /*<>*/ } + function method_impl(table, i, arr){ + function next(param){ + /*<>*/ i[1]++; + var _g_ = /*<>*/ i[1]; + /*<>*/ return caml_check_bound(arr, _g_) + [_g_ + 1] /*<>*/ ; + } + var clo = /*<>*/ next(0); + /*<>*/ if(typeof clo === "number") + switch(clo){ + case 0: + var x = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return x; /*<>*/ } /*<>*/ ; + case 1: + var n = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return obj[n + 1]; /*<>*/ } /*<>*/ ; + case 2: + var + e = /*<>*/ next(0), + n$0 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return obj[e + 1][n$0 + 1]; /*<>*/ } /*<>*/ ; + case 3: + var n$1 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call1 + (obj[1][n$1 + 1], obj) /*<>*/ ;} /*<>*/ ; + case 4: + var n$2 = /*<>*/ next(0); + /*<>*/ return function(obj, x){ + /*<>*/ obj[n$2 + 1] = x; + return 0; /*<>*/ } /*<>*/ ; + case 5: + var + f = /*<>*/ next(0), + x$0 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call1(f, x$0) /*<>*/ ;} /*<>*/ ; + case 6: + var + f$0 = /*<>*/ next(0), + n$3 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call1 + (f$0, obj[n$3 + 1]) /*<>*/ ;} /*<>*/ ; + case 7: + var + f$1 = /*<>*/ next(0), + e$0 = /*<>*/ next(0), + n$4 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call1 + (f$1, obj[e$0 + 1][n$4 + 1]) /*<>*/ ;} /*<>*/ ; + case 8: + var + f$2 = /*<>*/ next(0), + n$5 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return /*<>*/ caml_call1 + (f$2, + /*<>*/ caml_call1 + (obj[1][n$5 + 1], obj)) /*<>*/ ;} /*<>*/ ; + case 9: + var + f$3 = /*<>*/ next(0), + x$1 = /*<>*/ next(0), + y = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2(f$3, x$1, y) /*<>*/ ;} /*<>*/ ; + case 10: + var + f$4 = /*<>*/ next(0), + x$2 = /*<>*/ next(0), + n$6 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2 + (f$4, x$2, obj[n$6 + 1]) /*<>*/ ;} /*<>*/ ; + case 11: + var + f$5 = /*<>*/ next(0), + x$3 = /*<>*/ next(0), + e$1 = /*<>*/ next(0), + n$7 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2 + (f$5, x$3, obj[e$1 + 1][n$7 + 1]) /*<>*/ ;} /*<>*/ ; + case 12: + var + f$6 = /*<>*/ next(0), + x$4 = /*<>*/ next(0), + n$8 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return /*<>*/ caml_call2 + (f$6, + x$4, + /*<>*/ caml_call1 + (obj[1][n$8 + 1], obj)) /*<>*/ ;} /*<>*/ ; + case 13: + var + f$7 = /*<>*/ next(0), + n$9 = /*<>*/ next(0), + x$5 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2 + (f$7, obj[n$9 + 1], x$5) /*<>*/ ;} /*<>*/ ; + case 14: + var + f$8 = /*<>*/ next(0), + e$2 = /*<>*/ next(0), + n$10 = /*<>*/ next(0), + x$6 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2 + (f$8, obj[e$2 + 1][n$10 + 1], x$6) /*<>*/ ;} /*<>*/ ; + case 15: + var + f$9 = /*<>*/ next(0), + n$11 = /*<>*/ next(0), + x$7 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return /*<>*/ caml_call2 + (f$9, + /*<>*/ caml_call1 + (obj[1][n$11 + 1], obj), + x$7) /*<>*/ ;} /*<>*/ ; + case 16: + var + n$12 = /*<>*/ next(0), + x$8 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2 + (obj[1][n$12 + 1], obj, x$8) /*<>*/ ;} /*<>*/ ; + case 17: + var + n$13 = /*<>*/ next(0), + m = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2 + (obj[1][n$13 + 1], obj, obj[m + 1]) /*<>*/ ;} /*<>*/ ; + case 18: + var + n$14 = /*<>*/ next(0), + e$3 = /*<>*/ next(0), + m$0 = /*<>*/ next(0); + /*<>*/ return function(obj){ + /*<>*/ return caml_call2 + (obj[1][n$14 + 1], obj, obj[e$3 + 1][m$0 + 1]) /*<>*/ ;} /*<>*/ ; + case 19: + var + n$15 = /*<>*/ next(0), + m$1 = /*<>*/ next(0); + /*<>*/ return function(obj){ + var + _g_ = + /*<>*/ caml_call1(obj[1][m$1 + 1], obj); + /*<>*/ return caml_call2 + (obj[1][n$15 + 1], obj, _g_);} /*<>*/ ; + case 20: + var + m$2 = /*<>*/ next(0), + x$9 = /*<>*/ next(0); + /*<>*/ new_cache(table); + /*<>*/ return function(obj){ + /*<>*/ return caml_call1 + (caml_get_public_method(x$9, m$2, 0), x$9) /*<>*/ ;} /*<>*/ ; + case 21: + var + m$3 = /*<>*/ next(0), + n$16 = /*<>*/ next(0); + /*<>*/ new_cache(table); + /*<>*/ return function(obj){ + var _g_ = /*<>*/ obj[n$16 + 1]; + return caml_call1(caml_get_public_method(_g_, m$3, 0), _g_) /*<>*/ ;} /*<>*/ ; + case 22: + var + m$4 = /*<>*/ next(0), + e$4 = /*<>*/ next(0), + n$17 = /*<>*/ next(0); + /*<>*/ new_cache(table); + /*<>*/ return function(obj){ + var _g_ = /*<>*/ obj[e$4 + 1][n$17 + 1]; + return caml_call1(caml_get_public_method(_g_, m$4, 0), _g_) /*<>*/ ;} /*<>*/ ; + default: + var + m$5 = /*<>*/ next(0), + n$18 = /*<>*/ next(0); + /*<>*/ new_cache(table); + /*<>*/ return function(obj){ + var + _g_ = + /*<>*/ caml_call1 + (obj[1][n$18 + 1], obj); + /*<>*/ return caml_call1 + (caml_get_public_method(_g_, m$5, 0), _g_) /*<>*/ ;} /*<>*/ ; + } + /*<>*/ return clo; + /*<>*/ } function set_methods(table, methods){ var len = /*<>*/ methods.length - 1, @@ -31571,361 +31708,8 @@ label = /*<>*/ caml_check_bound(methods, _g_) [_g_ + 1], - next = - /*<>*/ function(param){ - /*<>*/ i[1]++; - var _g_ = /*<>*/ i[1]; - /*<>*/ return caml_check_bound - (methods, _g_) - [_g_ + 1] /*<>*/ ; - }, - clo = /*<>*/ next(0); - /*<>*/ if(typeof clo === "number") - switch(clo){ - case 0: - var x = /*<>*/ next(0); - let x$20 = /*<>*/ x; - var - clo$0 = - function(obj){ - /*<>*/ return x$20; - /*<>*/ }; - break; - case 1: - var n = /*<>*/ next(0); - let n$38 = /*<>*/ n; - var - clo$0 = - function(obj){ - /*<>*/ return obj[n$38 + 1]; - /*<>*/ }; - break; - case 2: - var - e = /*<>*/ next(0), - n$0 = /*<>*/ next(0); - let e$10 = /*<>*/ e, n$37 = n$0; - var - clo$0 = - function(obj){ - /*<>*/ return obj[e$10 + 1][n$37 + 1]; - /*<>*/ }; - break; - case 3: - var n$1 = /*<>*/ next(0); - let n$36 = /*<>*/ n$1; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call1 - (obj[1][n$36 + 1], obj) /*<>*/ ; - }; - break; - case 4: - var n$2 = /*<>*/ next(0); - let n$35 = /*<>*/ n$2; - var - clo$0 = - function(obj, x){ - /*<>*/ obj[n$35 + 1] = x; - return 0; - /*<>*/ }; - break; - case 5: - var - f = /*<>*/ next(0), - x$0 = /*<>*/ next(0); - let f$20 = /*<>*/ f, x$19 = x$0; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call1(f$20, x$19) /*<>*/ ; - }; - break; - case 6: - var - f$0 = /*<>*/ next(0), - n$3 = /*<>*/ next(0); - let f$19 = /*<>*/ f$0, n$34 = n$3; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call1 - (f$19, obj[n$34 + 1]) /*<>*/ ; - }; - break; - case 7: - var - f$1 = /*<>*/ next(0), - e$0 = /*<>*/ next(0), - n$4 = /*<>*/ next(0); - let - f$18 = /*<>*/ f$1, - e$9 = e$0, - n$33 = n$4; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call1 - (f$18, obj[e$9 + 1][n$33 + 1]) /*<>*/ ; - }; - break; - case 8: - var - f$2 = /*<>*/ next(0), - n$5 = /*<>*/ next(0); - let f$17 = /*<>*/ f$2, n$32 = n$5; - var - clo$0 = - function(obj){ - /*<>*/ return /*<>*/ caml_call1 - (f$17, - /*<>*/ caml_call1 - (obj[1][n$32 + 1], obj)) /*<>*/ ; - }; - break; - case 9: - var - f$3 = /*<>*/ next(0), - x$1 = /*<>*/ next(0), - y = /*<>*/ next(0); - let - f$16 = /*<>*/ f$3, - x$18 = x$1, - y$0 = y; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (f$16, x$18, y$0) /*<>*/ ; - }; - break; - case 10: - var - f$4 = /*<>*/ next(0), - x$2 = /*<>*/ next(0), - n$6 = /*<>*/ next(0); - let - f$15 = /*<>*/ f$4, - x$17 = x$2, - n$31 = n$6; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (f$15, x$17, obj[n$31 + 1]) /*<>*/ ; - }; - break; - case 11: - var - f$5 = /*<>*/ next(0), - x$3 = /*<>*/ next(0), - e$1 = /*<>*/ next(0), - n$7 = /*<>*/ next(0); - let - f$14 = /*<>*/ f$5, - x$16 = x$3, - e$8 = e$1, - n$30 = n$7; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (f$14, x$16, obj[e$8 + 1][n$30 + 1]) /*<>*/ ; - }; - break; - case 12: - var - f$6 = /*<>*/ next(0), - x$4 = /*<>*/ next(0), - n$8 = /*<>*/ next(0); - let - f$13 = /*<>*/ f$6, - x$15 = x$4, - n$29 = n$8; - var - clo$0 = - function(obj){ - /*<>*/ return /*<>*/ caml_call2 - (f$13, - x$15, - /*<>*/ caml_call1 - (obj[1][n$29 + 1], obj)) /*<>*/ ; - }; - break; - case 13: - var - f$7 = /*<>*/ next(0), - n$9 = /*<>*/ next(0), - x$5 = /*<>*/ next(0); - let - f$12 = /*<>*/ f$7, - n$28 = n$9, - x$14 = x$5; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (f$12, obj[n$28 + 1], x$14) /*<>*/ ; - }; - break; - case 14: - var - f$8 = /*<>*/ next(0), - e$2 = /*<>*/ next(0), - n$10 = /*<>*/ next(0), - x$6 = /*<>*/ next(0); - let - f$11 = /*<>*/ f$8, - e$7 = e$2, - n$27 = n$10, - x$13 = x$6; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (f$11, obj[e$7 + 1][n$27 + 1], x$13) /*<>*/ ; - }; - break; - case 15: - var - f$9 = /*<>*/ next(0), - n$11 = /*<>*/ next(0), - x$7 = /*<>*/ next(0); - let - f$10 = /*<>*/ f$9, - n$26 = n$11, - x$12 = x$7; - var - clo$0 = - function(obj){ - /*<>*/ return /*<>*/ caml_call2 - (f$10, - /*<>*/ caml_call1 - (obj[1][n$26 + 1], obj), - x$12) /*<>*/ ; - }; - break; - case 16: - var - n$12 = /*<>*/ next(0), - x$8 = /*<>*/ next(0); - let n$25 = /*<>*/ n$12, x$11 = x$8; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (obj[1][n$25 + 1], obj, x$11) /*<>*/ ; - }; - break; - case 17: - var - n$13 = /*<>*/ next(0), - m = /*<>*/ next(0); - let n$24 = /*<>*/ n$13, m$12 = m; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (obj[1][n$24 + 1], obj, obj[m$12 + 1]) /*<>*/ ; - }; - break; - case 18: - var - n$14 = /*<>*/ next(0), - e$3 = /*<>*/ next(0), - m$0 = /*<>*/ next(0); - let - n$23 = /*<>*/ n$14, - e$6 = e$3, - m$11 = m$0; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call2 - (obj[1][n$23 + 1], obj, obj[e$6 + 1][m$11 + 1]) /*<>*/ ; - }; - break; - case 19: - var - n$15 = /*<>*/ next(0), - m$1 = /*<>*/ next(0); - let n$22 = /*<>*/ n$15, m$10 = m$1; - var - clo$0 = - function(obj){ - var - _g_ = - /*<>*/ caml_call1 - (obj[1][m$10 + 1], obj); - /*<>*/ return caml_call2 - (obj[1][n$22 + 1], obj, _g_); - }; - break; - case 20: - var - m$2 = /*<>*/ next(0), - x$9 = /*<>*/ next(0); - /*<>*/ new_cache(table); - let m$9 = /*<>*/ m$2, x$10 = x$9; - var - clo$0 = - function(obj){ - /*<>*/ return caml_call1 - (caml_get_public_method(x$10, m$9, 0), x$10) /*<>*/ ; - }; - break; - case 21: - var - m$3 = /*<>*/ next(0), - n$16 = /*<>*/ next(0); - /*<>*/ new_cache(table); - let m$8 = /*<>*/ m$3, n$21 = n$16; - var - clo$0 = - function(obj){ - var _g_ = /*<>*/ obj[n$21 + 1]; - return caml_call1(caml_get_public_method(_g_, m$8, 0), _g_) /*<>*/ ; - }; - break; - case 22: - var - m$4 = /*<>*/ next(0), - e$4 = /*<>*/ next(0), - n$17 = /*<>*/ next(0); - /*<>*/ new_cache(table); - let - m$7 = /*<>*/ m$4, - e$5 = e$4, - n$20 = n$17; - var - clo$0 = - function(obj){ - var - _g_ = /*<>*/ obj[e$5 + 1][n$20 + 1]; - return caml_call1(caml_get_public_method(_g_, m$7, 0), _g_) /*<>*/ ; - }; - break; - default: - var - m$5 = /*<>*/ next(0), - n$18 = /*<>*/ next(0); - /*<>*/ new_cache(table); - let m$6 = /*<>*/ m$5, n$19 = n$18; - var - clo$0 = - function(obj){ - var - _g_ = - /*<>*/ caml_call1 - (obj[1][n$19 + 1], obj); - /*<>*/ return caml_call1 - (caml_get_public_method(_g_, m$6, 0), _g_) /*<>*/ ; - }; - } - else - var clo$0 = /*<>*/ clo; - /*<>*/ set_method(table, label, clo$0); + clo = /*<>*/ method_impl(table, i, methods); + /*<>*/ set_method(table, label, clo); /*<>*/ i[1]++; } /*<>*/ } diff --git a/compiler/tests-ocaml/match-exception/streams.ml b/compiler/tests-ocaml/match-exception/streams.ml index a9a4c9e81a..1d55419d23 100644 --- a/compiler/tests-ocaml/match-exception/streams.ml +++ b/compiler/tests-ocaml/match-exception/streams.ml @@ -29,7 +29,7 @@ let rec iter_stream_match f s = end ;; -let test_iter_stream = +let test_iter_stream () = let limit = 10000000 in try iter_stream_match ignore (make_stream_up_to limit); @@ -37,3 +37,6 @@ let test_iter_stream = with Stack_overflow -> assert false ;; + +let () = test_iter_stream () +;;