diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 386bebcf0..9d46185c0 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/compiler/bin-wasm_of_ocaml/compile.ml @@ -250,6 +250,7 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file = let i = find "CODE" 0 in let j = find "PRIMITIVES" 0 in let k = find "STRINGS" 0 in + let l = find "FRAGMENTS" 0 in let rec trim_semi s = let l = String.length s in if l = 0 @@ -270,9 +271,9 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file = ^ trim_semi (Buffer.contents b') ^ String.sub s ~pos:(j + 10) ~len:(k - j - 10) ^ trim_semi (Buffer.contents b'') - ^ "," + ^ String.sub s ~pos:(k + 7) ~len:(l - k - 7) ^ trim_semi (Buffer.contents fragment_buffer) - ^ String.sub s ~pos:(k + 7) ~len:(String.length s - k - 7)) + ^ String.sub s ~pos:(l + 9) ~len:(String.length s - l - 9)) let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } = Jsoo_cmdline.Arg.eval common; diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml index 651fa4cbd..808c6d62a 100644 --- a/compiler/lib/specialize_js.ml +++ b/compiler/lib/specialize_js.ml @@ -41,7 +41,7 @@ let specialize_instr ~target info i = , Prim ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim) , [ (Pv _ as y) ] ) ) - , `JavaScript ) + , _ ) when Config.Flag.safe_string () -> ( match the_string_of info y with | Some s -> Let (x, Prim (Extern prim, [ Pc (String s) ])) diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml index ec98462cc..14cc7e843 100644 --- a/compiler/lib/wasm/wa_gc_target.ml +++ b/compiler/lib/wasm/wa_gc_target.ml @@ -1263,6 +1263,54 @@ let internal_primitives = Hashtbl.create 100 let () = let register name f = Hashtbl.add internal_primitives name f in let module J = Javascript in + let call_prim ~transl_prim_arg name args = + let arity = List.length args in + (* [Type.func_type] counts one additional argument for the closure environment (absent + here) *) + let* f = register_import ~name (Fun (Type.func_type (arity - 1))) in + let args = List.map ~f:transl_prim_arg args in + let* args = expression_list Fun.id args in + return (W.Call (f, args)) + in + let register_js_expr prim_name = + register prim_name (fun transl_prim_arg l -> + let* wrap = + register_import + ~name:"wrap" + (Fun { params = [ JavaScript.anyref ]; result = [ Value.value ] }) + in + match l with + | Code.[ Pc (String str) ] -> + (try + let lex = Parse_js.Lexer.of_string str in + let e = Parse_js.parse_expr lex in + let name = Printf.sprintf "js_expr_%x" (String.hash str) in + let* () = register_fragment name (fun () -> + EArrow + ( J.fun_ + [] + [ (Return_statement (Some e), N) ] + N + , AUnknown )) + in + let* js_val = JavaScript.invoke_fragment name [] in + return (W.Call (wrap, [ js_val ])) + with Parse_js.Parsing_error pi -> + failwith + (Printf.sprintf + "Parse error in argument of %s %S at position %d:%d" + prim_name + str + pi.Parse_info.line + pi.Parse_info.col)) + | [ Pv _ ] -> + call_prim ~transl_prim_arg prim_name l + | [] | _ :: _ -> + failwith (Printf.sprintf "Wrong number argument to primitive %s" prim_name) + ) + in + List.iter ~f:register_js_expr + [ "caml_js_expr"; "caml_pure_js_expr"; "caml_js_var"; "caml_js_eval_string" ]; register "%caml_js_opt_call" (fun transl_prim_arg l -> let arity = List.length l - 2 in let name = Printf.sprintf "call_%d" arity in @@ -1397,10 +1445,7 @@ let () = in JavaScript.invoke_fragment name [ transl_prim_arg x ] | [ _; _ ] -> - let* f = register_import ~name:"caml_js_get" (Fun (Type.func_type 1)) in - let l = List.map ~f:transl_prim_arg l in - let* l = expression_list (fun e -> e) l in - return (W.Call (f, l)) + call_prim ~transl_prim_arg "caml_js_get" l | _ -> assert false); register "caml_js_set" (fun transl_prim_arg l -> match l with @@ -1428,10 +1473,7 @@ let () = let l = List.map ~f:transl_prim_arg [ x; y ] in JavaScript.invoke_fragment name l | [ _; _; _ ] -> - let* f = register_import ~name:"caml_js_set" (Fun (Type.func_type 2)) in - let l = List.map ~f:transl_prim_arg l in - let* l = expression_list (fun e -> e) l in - return (W.Call (f, l)) + call_prim ~transl_prim_arg "caml_js_set" l | _ -> assert false); let counter = ref (-1) in register "%caml_js_opt_object" (fun transl_prim_arg l -> diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml index 0f0931135..5e7d57c51 100644 --- a/compiler/lib/wasm/wa_initialize_locals.ml +++ b/compiler/lib/wasm/wa_initialize_locals.ml @@ -51,6 +51,10 @@ let rec scan_expression ctx e = | Call (_, l) | ArrayNewFixed (_, l) | StructNew (_, l) -> scan_expressions ctx l | BlockExpr (_, l) -> scan_instructions ctx l | Seq (l, e') -> scan_instructions ctx (l @ [ Push e' ]) + | IfExpr (_, cond, e1, e2) -> + scan_expression ctx cond; + scan_expression (fork_context ctx) e1; + scan_expression (fork_context ctx) e2; and scan_expressions ctx l = List.iter ~f:(fun e -> scan_expression ctx e) l diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js index ba356f46a..27729b465 100644 --- a/runtime/wasm/runtime.js +++ b/runtime/wasm/runtime.js @@ -360,23 +360,24 @@ var buffer = caml_buffer?.buffer var out_buffer = buffer&&new Uint8Array(buffer,0,buffer.length) - start_fiber = wrap_fun( - {parameters: ['eqref'], results: ['externref']}, - caml_start_fiber, {promising: 'first'} - ) - var _initialize = wrap_fun( - {parameters: [], results: ['externref']}, - _initialize, {promising: 'first'} - ) - var process = globalThis.process; - if(process && process.on) { - process.on('uncaughtException', (err, origin) => - caml_handle_uncaught_exception(err)) - } - else if(globalThis.addEventListener){ - globalThis.addEventListener('error', event=> - event.error&&caml_handle_uncaught_exception(event.error)) - } - await _initialize(); -})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval("("+x+")"))(globalThis,globalThis?.module?.exports||globalThis,globalThis), - PRIMITIVES, STRINGS); + start_fiber = wrap_fun( + {parameters: ['eqref'], results: ['externref']}, + caml_start_fiber, {promising: 'first'} + ) + var _initialize = wrap_fun( + {parameters: [], results: ['externref']}, + _initialize, {promising: 'first'} + ) + var process = globalThis.process; + if(process && process.on) { + process.on('uncaughtException', (err, origin) => + caml_handle_uncaught_exception(err)) + } + else if(globalThis.addEventListener){ + globalThis.addEventListener('error', event=> + event.error&&caml_handle_uncaught_exception(event.error)) + } + await _initialize(); +})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>{return eval("("+x+")")})(globalThis,globalThis?.module?.exports||globalThis,globalThis), + PRIMITIVES, STRINGS, + ((joo_global_object,jsoo_exports,globalThis)=>FRAGMENTS)(globalThis,globalThis?.module?.exports||globalThis,globalThis)) \ No newline at end of file