diff --git a/compiler/lib-wasm/call_graph_analysis.ml b/compiler/lib-wasm/call_graph_analysis.ml index 0332a3feeb..dd287b4152 100644 --- a/compiler/lib-wasm/call_graph_analysis.ml +++ b/compiler/lib-wasm/call_graph_analysis.ml @@ -42,6 +42,156 @@ type t = { unambiguous_non_escaping : unit Var.Hashtbl.t } let direct_calls_only info f = Config.Flag.optcall () && Var.Hashtbl.mem info.unambiguous_non_escaping f +let callee_if_known info call_info exact f = + match get_approx info f with + | Top -> None + | Values { known; others } -> + if + exact + && (not others) + && Var.Set.for_all (fun f -> direct_calls_only call_info f) known + then Some (Var.Set.choose known) + else None + +let propagate nodes edges eligible = + let rec propagate n = + List.iter + ~f:(fun n' -> + if (not (Var.Hashtbl.mem nodes n')) && eligible n' + then ( + Var.Hashtbl.add nodes n' (); + propagate n')) + (Var.Hashtbl.find_all edges n) + in + Var.Hashtbl.iter (fun n () -> propagate n) nodes + +let call_graph p info call_info eligible = + let under_handler = Var.Hashtbl.create 16 in + let callees = Var.Hashtbl.create 16 in + let callers = Var.Hashtbl.create 16 in + let has_tail_calls = Var.Hashtbl.create 16 in + let tail_callers = Var.Hashtbl.create 16 in + let rec traverse name_opt pc visited nesting = + if not (Addr.Set.mem pc visited) + then ( + let visited = Addr.Set.add pc visited in + let block = Addr.Map.find pc p.blocks in + List.iter block.body ~f:(fun i -> + match i with + | Let (_, Apply { f; exact; _ }) -> ( + match get_approx info f with + | Top -> () + | Values { known; others } -> + if + exact + && (not others) + && Var.Set.for_all (fun f -> direct_calls_only call_info f) known + then + if nesting > 0 + then + Var.Set.iter + (fun f -> + (* Format.eprintf "BBB %a@." Code.Var.print f; *) + Var.Hashtbl.replace under_handler f ()) + known + else + Option.iter + ~f:(fun f -> + Var.Set.iter + (fun g -> + Var.Hashtbl.add callees f g; + Var.Hashtbl.add callers g f) + known) + name_opt) + | Let (_, (Closure _ | Prim _ | Block _ | Constant _ | Field _ | Special _)) + | Event _ | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> ()); + if nesting = 0 + then + Option.iter + ~f:(fun f -> + Code.traverse + { fold = Code.fold_children } + (fun pc () -> + let block = Addr.Map.find pc p.blocks in + match block.branch with + | Return x -> ( + match last_instr block.body with + | Some (Let (x', Apply { f = g; exact; _ })) when Code.Var.equal x x' + -> ( + match callee_if_known info call_info exact g with + | None -> Var.Hashtbl.replace has_tail_calls f () + | Some g -> Var.Hashtbl.add tail_callers g f) + | _ -> ()) + | _ -> ()) + pc + p.blocks + ()) + name_opt; + Code.fold_children + p.blocks + pc + (fun pc' visited -> + let nesting = + match block.branch with + | Pushtrap ((body_pc, _), _, _) when pc' = body_pc -> nesting + 1 + | Poptrap _ -> nesting - 1 + | _ -> nesting + in + traverse name_opt pc' visited nesting) + visited) + else visited + in + fold_closures + p + (fun name_opt _ (pc, _) _ () -> ignore (traverse name_opt pc Addr.Set.empty 0)) + (); + propagate has_tail_calls tail_callers eligible; + under_handler, callers, callees, has_tail_calls + +let function_do_raise p pc = + Code.traverse + { fold = Code.fold_children_skip_try_body } + (fun pc do_raise -> + let block = Addr.Map.find pc p.blocks in + do_raise + || + match block.branch with + | Raise _ -> true + | _ -> false) + pc + p.blocks + false + +let raising_functions p info call_info eligible = + let under_handler, callers, callees, has_tail_calls = + call_graph p info call_info eligible + in + propagate under_handler callees (fun f -> + eligible f && not (Var.Hashtbl.mem has_tail_calls f)); + let h = Var.Hashtbl.create 16 in + let eligible f = + eligible f + && Var.Hashtbl.mem under_handler f + && not (Var.Hashtbl.mem has_tail_calls f) + in + Code.fold_closures + p + (fun name_opt _params (pc, _) _ () -> + match name_opt with + | None -> () + | Some name -> + if direct_calls_only call_info name && eligible name && function_do_raise p pc + then Var.Hashtbl.add h name ()) + (); + propagate h callers eligible; + if false + then + Var.Hashtbl.iter + (fun name () -> + Format.eprintf "ZZZ %a %b@." Var.print name (Var.Hashtbl.mem under_handler name)) + h; + h + let f p info = let t = Timer.make () in let non_escaping = Var.Hashtbl.create 128 in @@ -62,4 +212,12 @@ let f p info = if debug () then Format.eprintf " unambiguous-non-escaping:%d@." (Var.Hashtbl.length non_escaping); if times () then Format.eprintf " call graph analysis: %a@." Timer.print t; - { unambiguous_non_escaping = non_escaping } + (* + Var.Hashtbl.iter (fun f _ -> Format.eprintf "AAA %a@." Code.Var.print f) non_escaping; +*) + let call_info = { unambiguous_non_escaping = non_escaping } in + call_info + +(* +- Optimize tail-calls +*) diff --git a/compiler/lib-wasm/call_graph_analysis.mli b/compiler/lib-wasm/call_graph_analysis.mli index 3188253a2a..07ee8ffd1e 100644 --- a/compiler/lib-wasm/call_graph_analysis.mli +++ b/compiler/lib-wasm/call_graph_analysis.mli @@ -2,4 +2,7 @@ type t val direct_calls_only : t -> Code.Var.t -> bool +val raising_functions : + Code.program -> Global_flow.info -> t -> (Code.Var.t -> bool) -> unit Code.Var.Hashtbl.t + val f : Code.program -> Global_flow.info -> t diff --git a/compiler/lib-wasm/code_generation.ml b/compiler/lib-wasm/code_generation.ml index d9e3335d19..2b8362293d 100644 --- a/compiler/lib-wasm/code_generation.ml +++ b/compiler/lib-wasm/code_generation.ml @@ -709,7 +709,7 @@ let need_dummy_fun ~cps ~arity st = let init_code context = instrs context.init_code -let function_body ~context ~param_names ~body = +let function_body ~context ~return_exn ~param_names ~body = let st = { var_count = 0; vars = Var.Map.empty; instrs = []; context } in let (), st = body st in let local_count, body = st.var_count, List.rev st.instrs in @@ -721,7 +721,7 @@ let function_body ~context ~param_names ~body = | Local (i, x, typ) -> local_types.(i) <- x, typ | Expr _ -> ()) st.vars; - let body = Tail_call.f ~no_tail_call:context.no_tail_call body in + let body = Tail_call.f ~return_exn ~no_tail_call:context.no_tail_call body in let param_count = List.length param_names in let locals = local_types diff --git a/compiler/lib-wasm/code_generation.mli b/compiler/lib-wasm/code_generation.mli index 9bdc41e982..299f5d3b86 100644 --- a/compiler/lib-wasm/code_generation.mli +++ b/compiler/lib-wasm/code_generation.mli @@ -199,6 +199,7 @@ val need_dummy_fun : cps:bool -> arity:int -> Code.Var.t t val function_body : context:context + -> return_exn:bool -> param_names:Code.Var.t list -> body:unit t -> (Wasm_ast.var * Wasm_ast.value_type) list * Wasm_ast.instruction list diff --git a/compiler/lib-wasm/curry.ml b/compiler/lib-wasm/curry.ml index 32b339e5be..7513212645 100644 --- a/compiler/lib-wasm/curry.ml +++ b/compiler/lib-wasm/curry.ml @@ -95,7 +95,7 @@ module Make (Target : Target_sig.S) = struct loop m [] f None in let param_names = args @ [ f ] in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name ; exported_name = None @@ -130,7 +130,7 @@ module Make (Target : Target_sig.S) = struct push (Closure.curry_allocate ~cps:false ~arity m ~f:name' ~closure:f ~arg:x) in let param_names = [ x; f ] in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name ; exported_name = None @@ -181,7 +181,7 @@ module Make (Target : Target_sig.S) = struct loop m [] f None in let param_names = args @ [ f ] in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name ; exported_name = None @@ -220,7 +220,7 @@ module Make (Target : Target_sig.S) = struct instr (W.Return (Some c)) in let param_names = [ x; cont; f ] in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name ; exported_name = None @@ -264,7 +264,7 @@ module Make (Target : Target_sig.S) = struct build_applies (load f) l) in let param_names = l @ [ f ] in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name ; exported_name = None @@ -305,7 +305,7 @@ module Make (Target : Target_sig.S) = struct push (call ~cps:true ~arity:2 (load f) [ x; iterate ])) in let param_names = l @ [ f ] in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name ; exported_name = None @@ -340,7 +340,7 @@ module Make (Target : Target_sig.S) = struct instr (W.Return (Some e)) in let param_names = l @ [ f ] in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name ; exported_name = None diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml index df63676c68..68d9deedce 100644 --- a/compiler/lib-wasm/gc_target.ml +++ b/compiler/lib-wasm/gc_target.ml @@ -25,6 +25,8 @@ type expression = Wasm_ast.expression Code_generation.t module Type = struct let value = W.Ref { nullable = false; typ = Eq } + let value_or_exn = W.Ref { nullable = true; typ = Eq } + let block_type = register_type "block" (fun () -> return diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index 5c51a05321..08d864c074 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -38,6 +38,7 @@ module Generate (Target : Target_sig.S) = struct ; global_flow_info : Global_flow.info ; fun_info : Call_graph_analysis.t ; types : Typing.t + ; raising_funcs : unit Var.Hashtbl.t ; blocks : block Addr.Map.t ; closures : Closure_conversion.closure Var.Map.t ; global_context : Code_generation.context @@ -1342,6 +1343,19 @@ module Generate (Target : Target_sig.S) = struct | Number (n, Boxed) as into -> convert ~from:(Number (n, Unboxed)) ~into e | _ -> e + let exception_handler_pc = -3 + + let direct_call ctx context f args closure = + let e = W.Call (f, args @ [ closure ]) in + let e = + if Var.Hashtbl.mem ctx.raising_funcs f + then + let label = label_index context exception_handler_pc in + W.Br_on_null (label, e) + else e + in + return e + let rec translate_expr ctx context x e = match e with | Apply { f; args; exact; _ } -> @@ -1375,7 +1389,7 @@ module Generate (Target : Target_sig.S) = struct convert ~from:(Typing.return_type ctx.types g) ~into:(Typing.var_type ctx.types x) - (return (W.Call (g, args @ [ cl ]))) + (direct_call ctx context g args cl) | None -> ( let funct = Var.fresh () in let* closure = tee funct (return closure) in @@ -1387,7 +1401,7 @@ module Generate (Target : Target_sig.S) = struct in let* args = expression_list (fun x -> load_and_box ctx x) args in match funct with - | W.RefFunc g -> return (W.Call (g, args @ [ closure ])) + | W.RefFunc g -> direct_call ctx context g args closure | _ -> return (W.Call_ref (ty, funct, args @ [ closure ]))) else let* apply = @@ -1694,25 +1708,47 @@ module Generate (Target : Target_sig.S) = struct instr W.Unreachable else body ~result_typ ~fall_through ~context - let wrap_with_handlers p pc ~result_typ ~fall_through ~context body = + let wrap_with_handlers ~location p pc ~result_typ ~fall_through ~context body = let need_zero_divide_handler, need_bound_error_handler = needed_handlers p pc in wrap_with_handler - need_bound_error_handler - bound_error_pc - (let* f = - register_import ~name:"caml_bound_error" (Fun { params = []; result = [] }) - in - instr (CallInstr (f, []))) + true + exception_handler_pc + (match location with + | `Toplevel -> + let* exn = + register_import + ~import_module:"env" + ~name:"caml_exception" + (Global { mut = true; typ = Type.value }) + in + let* tag = register_import ~name:exception_name (Tag Type.value) in + instr (Throw (tag, GlobalGet exn)) + | `Exception_handler -> + let* exn = + register_import + ~import_module:"env" + ~name:"caml_exception" + (Global { mut = true; typ = Type.value }) + in + instr (Br (2, Some (GlobalGet exn))) + | `Function -> instr (Return (Some (RefNull Any)))) (wrap_with_handler - need_zero_divide_handler - zero_divide_pc + need_bound_error_handler + bound_error_pc (let* f = - register_import - ~name:"caml_raise_zero_divide" - (Fun { params = []; result = [] }) + register_import ~name:"caml_bound_error" (Fun { params = []; result = [] }) in instr (CallInstr (f, []))) - body) + (wrap_with_handler + need_zero_divide_handler + zero_divide_pc + (let* f = + register_import + ~name:"caml_raise_zero_divide" + (Fun { params = []; result = [] }) + in + instr (CallInstr (f, []))) + body)) ~result_typ ~fall_through ~context @@ -1732,6 +1768,11 @@ module Generate (Target : Target_sig.S) = struct | Some f -> Typing.return_type ctx.types f | _ -> Typing.Top in + let return_exn = + match name_opt with + | Some f -> Var.Hashtbl.mem ctx.raising_funcs f + | _ -> false + in let g = Structure.build_graph ctx.blocks pc in let dom = Structure.dominator_tree g in let rec translate_tree result_typ fall_through pc context = @@ -1830,19 +1871,34 @@ module Generate (Target : Target_sig.S) = struct instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1))) | Raise (x, _) -> ( let* e = load x in - let* tag = register_import ~name:exception_name (Tag Type.value) in match fall_through with | `Catch -> instr (Push e) | `Block _ | `Return | `Skip -> ( match catch_index context with | Some i -> instr (Br (i, Some e)) - | None -> instr (Throw (tag, e)))) + | None -> + if return_exn + then + let* exn = + register_import + ~import_module:"env" + ~name:"caml_exception" + (Global { mut = true; typ = Type.value }) + in + let* () = instr (GlobalSet (exn, e)) in + instr (Return (Some (RefNull Any))) + else + let* tag = + register_import ~name:exception_name (Tag Type.value) + in + instr (Throw (tag, e)))) | Pushtrap (cont, x, cont') -> handle_exceptions ~result_typ ~fall_through ~context:(extend_context fall_through context) (wrap_with_handlers + ~location:`Exception_handler p (fst cont) (fun ~result_typ ~fall_through ~context -> @@ -1903,6 +1959,7 @@ module Generate (Target : Target_sig.S) = struct let locals, body = function_body ~context:ctx.global_context + ~return_exn ~param_names ~body: (let* () = @@ -1914,6 +1971,7 @@ module Generate (Target : Target_sig.S) = struct let* () = build_initial_env in let* () = wrap_with_handlers + ~location:(if return_exn then `Function else `Toplevel) p pc ~result_typ:[ Option.value ~default:Type.value (unboxed_type return_type) ] @@ -1951,7 +2009,11 @@ module Generate (Target : Target_sig.S) = struct (unboxed_type (Typing.var_type ctx.types x))) params @ [ Type.value ] - ; result = [ Option.value ~default:Type.value (unboxed_type return_type) ] + ; result = + [ Option.value + ~default:(if return_exn then Type.value_or_exn else Type.value) + (unboxed_type return_type) + ] } else Type.func_type (param_count - 1)) ; param_names @@ -1966,6 +2028,7 @@ module Generate (Target : Target_sig.S) = struct let locals, body = function_body ~context + ~return_exn:false ~param_names:[] ~body: (List.fold_right @@ -1996,7 +2059,7 @@ module Generate (Target : Target_sig.S) = struct let entry_point context toplevel_fun entry_name = let signature, param_names, body = entry_point ~toplevel_fun in - let locals, body = function_body ~context ~param_names ~body in + let locals, body = function_body ~context ~return_exn:false ~param_names ~body in W.Function { name = Var.fresh_n "entry_point" ; exported_name = Some entry_name @@ -2026,7 +2089,8 @@ module Generate (Target : Target_sig.S) = struct *) ~global_flow_info ~fun_info - ~types = + ~types + ~raising_funcs = global_context.unit_name <- unit_name; let p, closures = Closure_conversion.f p in (* @@ -2038,6 +2102,7 @@ module Generate (Target : Target_sig.S) = struct ; global_flow_info ; fun_info ; types + ; raising_funcs ; blocks = p.blocks ; closures ; global_context @@ -2150,11 +2215,26 @@ let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~global_flow_d let types = Typing.f ~global_flow_state ~global_flow_info ~fun_info ~deadcode_sentinal p in + let raising_funcs = + Call_graph_analysis.raising_functions p global_flow_info fun_info (fun f -> + match Typing.return_type types f with + | Int (Normalized | Unnormalized) | Number (_, Unboxed) -> false + | Int Ref | Number (_, Boxed) | Top | Bot | Tuple _ | Bigarray _ -> true) + in let t = Timer.make () in let p = Structure.norm p in let p = fix_switch_branches p in let res = - G.f ~context ~unit_name ~live_vars ~in_cps ~global_flow_info ~fun_info ~types p + G.f + ~context + ~unit_name + ~live_vars + ~in_cps + ~global_flow_info + ~fun_info + ~types + ~raising_funcs + p in if times () then Format.eprintf " code gen.: %a@." Timer.print t; res diff --git a/compiler/lib-wasm/tail_call.ml b/compiler/lib-wasm/tail_call.ml index ab2cf29a85..d1b7126759 100644 --- a/compiler/lib-wasm/tail_call.ml +++ b/compiler/lib-wasm/tail_call.ml @@ -24,21 +24,30 @@ let get_return ~tail i = | Push (LocalGet y) when tail -> Some y | _ -> None -let rewrite_tail_call ~no_tail_call ~y i = +let rewrite_tail_call ~return_exn ~no_tail_call ~y i = match i with | Wasm_ast.LocalSet (x, Call (symb, l)) when Code.Var.equal x y && not (Code.Var.Hashtbl.mem no_tail_call symb) -> Some (Wasm_ast.Return_call (symb, l)) | LocalSet (x, Call_ref (ty, e, l)) when Code.Var.equal x y -> Some (Return_call_ref (ty, e, l)) + | LocalSet (x, Br_on_null (_, Call (symb, l))) when return_exn && Code.Var.equal x y -> + Some (Wasm_ast.Return_call (symb, l)) + | LocalSet (x, Br_on_null (_, Call_ref (ty, e, l))) + when return_exn && Code.Var.equal x y -> Some (Return_call_ref (ty, e, l)) | _ -> None -let rec instruction ~no_tail_call ~tail i = +let rec instruction ~return_exn ~no_tail_call ~tail i = match i with - | Wasm_ast.Loop (ty, l) -> Wasm_ast.Loop (ty, instructions ~no_tail_call ~tail l) - | Block (ty, l) -> Block (ty, instructions ~no_tail_call ~tail l) + | Wasm_ast.Loop (ty, l) -> + Wasm_ast.Loop (ty, instructions ~return_exn ~no_tail_call ~tail l) + | Block (ty, l) -> Block (ty, instructions ~return_exn ~no_tail_call ~tail l) | If (ty, e, l1, l2) -> - If (ty, e, instructions ~no_tail_call ~tail l1, instructions ~no_tail_call ~tail l2) + If + ( ty + , e + , instructions ~return_exn ~no_tail_call ~tail l1 + , instructions ~return_exn ~no_tail_call ~tail l2 ) | Return (Some (Call (symb, l))) when not (Code.Var.Hashtbl.mem no_tail_call symb) -> Return_call (symb, l) | Return (Some (Call_ref (ty, e, l))) -> Return_call_ref (ty, e, l) @@ -46,8 +55,15 @@ let rec instruction ~no_tail_call ~tail i = Return_call (symb, l) | Push (Call_ref (ty, e, l)) when tail -> Return_call_ref (ty, e, l) | Push (Call_ref _) -> i + | Return (Some (Br_on_null (_, Call (symb, l)))) when return_exn -> Return_call (symb, l) + | Return (Some (Br_on_null (_, Call_ref (ty, e, l)))) when return_exn -> + Return_call_ref (ty, e, l) + | Push (Br_on_null (_, Call (symb, l))) when return_exn && tail -> Return_call (symb, l) + | Push (Br_on_null (_, Call_ref (ty, e, l))) when return_exn && tail -> + Return_call_ref (ty, e, l) + | Push (Br_on_null (_, Call_ref _)) when return_exn -> i | Drop (BlockExpr (typ, l)) -> - Drop (BlockExpr (typ, instructions ~no_tail_call ~tail:false l)) + Drop (BlockExpr (typ, instructions ~return_exn ~no_tail_call ~tail:false l)) | Drop _ | LocalSet _ | GlobalSet _ @@ -67,28 +83,29 @@ let rec instruction ~no_tail_call ~tail i = | Unreachable | Event _ -> i -and instructions ~no_tail_call ~tail l = +and instructions ~return_exn ~no_tail_call ~tail l = match l with | [] -> [] - | [ i ] -> [ instruction ~no_tail_call ~tail i ] - | i :: Nop :: rem -> instructions ~no_tail_call ~tail (i :: rem) - | i :: i' :: Nop :: rem -> instructions ~no_tail_call ~tail (i :: i' :: rem) + | [ i ] -> [ instruction ~return_exn ~no_tail_call ~tail i ] + | i :: Nop :: rem -> instructions ~return_exn ~no_tail_call ~tail (i :: rem) + | i :: i' :: Nop :: rem -> instructions ~return_exn ~no_tail_call ~tail (i :: i' :: rem) | i :: i' :: (([] | [ Event _ ]) as event_opt) -> ( (* There can be an event at the end of the function, which we should keep. *) match get_return ~tail i' with | None -> - instruction ~no_tail_call ~tail:false i - :: instruction ~no_tail_call ~tail i' + instruction ~return_exn ~no_tail_call ~tail:false i + :: instruction ~return_exn ~no_tail_call ~tail i' :: event_opt | Some y -> ( - match rewrite_tail_call ~no_tail_call ~y i with + match rewrite_tail_call ~return_exn ~no_tail_call ~y i with | None -> - instruction ~no_tail_call ~tail:false i - :: instruction ~no_tail_call ~tail i' + instruction ~return_exn ~no_tail_call ~tail:false i + :: instruction ~return_exn ~no_tail_call ~tail i' :: event_opt | Some i'' -> i'' :: event_opt)) | i :: rem -> - instruction ~no_tail_call ~tail:false i :: instructions ~no_tail_call ~tail rem + instruction ~return_exn ~no_tail_call ~tail:false i + :: instructions ~return_exn ~no_tail_call ~tail rem -let f ~no_tail_call l = instructions ~no_tail_call ~tail:true l +let f ~return_exn ~no_tail_call l = instructions ~return_exn ~no_tail_call ~tail:true l diff --git a/compiler/lib-wasm/tail_call.mli b/compiler/lib-wasm/tail_call.mli index ecd717f1c2..7b3d8a80eb 100644 --- a/compiler/lib-wasm/tail_call.mli +++ b/compiler/lib-wasm/tail_call.mli @@ -17,6 +17,7 @@ *) val f : - no_tail_call:unit Code.Var.Hashtbl.t + return_exn:bool + -> no_tail_call:unit Code.Var.Hashtbl.t -> Wasm_ast.instruction list -> Wasm_ast.instruction list diff --git a/compiler/lib-wasm/target_sig.ml b/compiler/lib-wasm/target_sig.ml index a0fc5e8ce9..ea55710ce0 100644 --- a/compiler/lib-wasm/target_sig.ml +++ b/compiler/lib-wasm/target_sig.ml @@ -97,6 +97,8 @@ module type S = sig module Type : sig val value : Wasm_ast.value_type + val value_or_exn : Wasm_ast.value_type + val func_type : int -> Wasm_ast.func_type val primitive_type : int -> Wasm_ast.func_type diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat index 65dfa0c313..ab8aa58367 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -234,4 +234,6 @@ (call $unwrap (call $caml_jsstring_of_string (local.get $msg))))) (call $exit (i32.const 2))))) + + (global (export "caml_exception") (mut (ref eq)) (ref.i31 (i32.const 0))) )