-1

example/unix_worker.ml

reviewed

··· 165 165 Server.complete_prefix complete_prefix; 166 166 Server.query_errors query_errors; 167 167 Server.type_enclosing type_enclosing; 168 168 - Server.compile_js compile_js; 169 168 Server.exec_toplevel exec_toplevel; 170 169 let rpc_fn = IdlM.server Server.implementation in 171 170 let process x =

-8

idl/js_top_worker_client.ml

reviewed

··· 102 102 bool -> 103 103 string -> 104 104 (Toplevel_api_gen.error list, Toplevel_api_gen.err) result Lwt.t 105 105 - 106 106 - val compile_js : 107 107 - rpc -> 108 108 - string option -> 109 109 - string -> 110 110 - (string, Toplevel_api_gen.err) result Lwt.t 111 105 end = struct 112 106 type init_config = Toplevel_api_gen.init_config 113 107 type err = Toplevel_api_gen.err ··· 120 114 121 115 let query_errors rpc id deps is_toplevel doc = 122 116 Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_lwt.T.get 123 123 - 124 124 - let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_lwt.T.get 125 117 end

-2

idl/js_top_worker_client.mli

reviewed

··· 60 60 (** Query the toplevel for errors. The first argument is the phrase to check 61 61 for errors. If it is [None], the toplevel will return all errors. If it is 62 62 [Some s], the toplevel will return only errors related to [s]. *) 63 63 - 64 64 - val compile_js : rpc -> string option -> string -> (string, err) result Lwt.t 65 63 end

-1

idl/js_top_worker_client_fut.ml

reviewed

··· 81 81 let setup rpc a = Wraw.setup rpc a |> Rpc_fut.T.get 82 82 let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_fut.T.get 83 83 let exec rpc a = Wraw.exec rpc a |> Rpc_fut.T.get 84 84 - let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_fut.T.get 85 84 86 85 let query_errors rpc id deps is_toplevel doc = 87 86 Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_fut.T.get

-8

idl/toplevel_api.ml

reviewed

··· 284 284 ] 285 285 (toplevel_script_p @-> returning exec_toplevel_result_p err) 286 286 287 287 - let compile_js = 288 288 - declare "compile_js" 289 289 - [ 290 290 - "Compile a phrase to javascript. The toplevel must have been"; 291 291 - "Initialised first."; 292 292 - ] 293 293 - (id_p @-> phrase_p @-> returning phrase_p err) 294 294 - 295 287 let complete_prefix = 296 288 declare "complete_prefix" 297 289 [

-5

idl/toplevel_api_gen.ml

reviewed

··· 2201 2201 ["Execute a toplevel script. The toplevel must have been"; 2202 2202 "Initialised first. Returns the updated toplevel script."] 2203 2203 (toplevel_script_p @-> (returning exec_toplevel_result_p err)) 2204 2204 - let compile_js = 2205 2205 - declare "compile_js" 2206 2206 - ["Compile a phrase to javascript. The toplevel must have been"; 2207 2207 - "Initialised first."] 2208 2208 - (id_p @-> (phrase_p @-> (returning phrase_p err))) 2209 2204 let complete_prefix = 2210 2205 declare "complete_prefix" ["Complete a prefix"] 2211 2206 (id_p @->

-81

lib/impl.ml

reviewed

··· 519 519 in 520 520 Array.of_list (split 0 0) 521 521 522 522 - let compile_js (id : string option) prog = 523 523 - try 524 524 - let l = Lexing.from_string prog in 525 525 - let phr = Parse.toplevel_phrase l in 526 526 - Typecore.reset_delayed_checks (); 527 527 - Env.reset_cache_toplevel (); 528 528 - Js_of_ocaml_compiler.Config.set_target `JavaScript; 529 529 - Js_of_ocaml_compiler.Config.set_effects_backend `Cps; 530 530 - let oldenv = !Toploop.toplevel_env in 531 531 - (* let oldenv = Compmisc.initial_env() in *) 532 532 - let phr = JsooTopPpx.preprocess_phrase phr in 533 533 - match phr with 534 534 - | Ptop_def sstr -> 535 535 - Logs.info (fun m -> m "Typing..."); 536 536 - let str, sg, sn, _shape, newenv = 537 537 - try Typemod.type_toplevel_phrase oldenv sstr 538 538 - with Env.Error _ as exn -> 539 539 - Location.report_exception Format.err_formatter exn; 540 540 - (* exit 1 *) 541 541 - let err = Format.asprintf "%a" Location.report_exception exn in 542 542 - failwith ("Error: " ^ err) 543 543 - in 544 544 - Logs.info (fun m -> m "simplify..."); 545 545 - let sg' = Typemod.Signature_names.simplify newenv sn sg in 546 546 - ignore (Includemod.signatures ~mark:true oldenv sg sg'); 547 547 - Typecore.force_delayed_checks (); 548 548 - Logs.info (fun m -> m "Translmod..."); 549 549 - let lam = Translmod.transl_toplevel_definition str in 550 550 - Logs.info (fun m -> m "Simplif..."); 551 551 - let slam = Simplif.simplify_lambda lam in 552 552 - Logs.info (fun m -> m "Bytegen..."); 553 553 - let code, _can_free = Bytegen.compile_phrase slam in 554 554 - Logs.info (fun m -> m "Emitcode..."); 555 555 - let code, reloc, _events = Emitcode.to_memory code in 556 556 - Toploop.toplevel_env := newenv; 557 557 - (* let prims = split_primitives (Symtable.data_primitive_names ()) in *) 558 558 - let b = Buffer.create 100 in 559 559 - let cmo = 560 560 - Cmo_format. 561 561 - { 562 562 - cu_name = Compunit "test"; 563 563 - cu_pos = 0; 564 564 - cu_codesize = Bigarray.Array1.dim code; 565 565 - cu_reloc = reloc; 566 566 - cu_imports = []; 567 567 - cu_required_compunits = []; 568 568 - cu_primitives = []; 569 569 - cu_force_link = false; 570 570 - cu_debug = 0; 571 571 - cu_debugsize = 0; 572 572 - } 573 573 - in 574 574 - 575 575 - let fmt = Js_of_ocaml_compiler.Pretty_print.to_buffer b in 576 576 - (* Symtable.patch_object code reloc; 577 577 - Symtable.check_global_initialized reloc; 578 578 - Symtable.update_global_table(); *) 579 579 - let oc = open_out "/tmp/test.cmo" in 580 580 - Emitcode.marshal_to_channel_with_possibly_32bit_compat 581 581 - ~filename:"/tmp/test.cmo" ~kind:"bytecode unit" oc cmo; 582 582 - 583 583 - (* let code = String.init (Misc.LongString.length code) ~f:(fun i -> Misc.LongString.get code i) in *) 584 584 - close_out oc; 585 585 - (* Js_of_ocaml_compiler.Config.Flag.enable "pretty"; *) 586 586 - Js_of_ocaml_compiler.Driver.configure fmt; 587 587 - let ic = open_in "/tmp/test.cmo" in 588 588 - let p = Js_of_ocaml_compiler.Parse_bytecode.from_cmo cmo ic in 589 589 - let wrap_with_fun = 590 590 - match id with Some id -> `Named id | None -> `Iife 591 591 - in 592 592 - Js_of_ocaml_compiler.Driver.f' ~standalone:false ~wrap_with_fun 593 593 - ~link:`No fmt p.code; 594 594 - Format.(pp_print_flush std_formatter ()); 595 595 - Format.(pp_print_flush err_formatter ()); 596 596 - flush stdout; 597 597 - flush stderr; 598 598 - let js = Buffer.contents b in 599 599 - IdlM.ErrM.return js 600 600 - | _ -> IdlM.ErrM.return_err (Toplevel_api_gen.InternalError "Parse error") 601 601 - with e -> IdlM.ErrM.return ("Exception: %s" ^ Printexc.to_string e) 602 602 - 603 522 let handle_toplevel stripped = 604 523 if String.length stripped < 2 || stripped.[0] <> '#' || stripped.[1] <> ' ' 605 524 then (

-1

lib/worker.ml

reviewed

··· 97 97 Server.complete_prefix complete_prefix; 98 98 Server.query_errors query_errors; 99 99 Server.type_enclosing type_enclosing; 100 100 - Server.compile_js compile_js; 101 100 Server.exec_toplevel exec_toplevel; 102 101 let rpc_fn = Impl.IdlM.server Server.implementation in 103 102 Js_of_ocaml.Worker.set_onmessage (fun x ->

-1

test/node/node_test.ml

reviewed

··· 89 89 Server.complete_prefix complete_prefix; 90 90 Server.query_errors query_errors; 91 91 Server.type_enclosing type_enclosing; 92 92 - Server.compile_js compile_js; 93 92 Server.exec_toplevel exec_toplevel; 94 93 IdlM.server Server.implementation 95 94

-1

test/unix/unix_test.ml

reviewed

··· 105 105 Server.complete_prefix complete_prefix; 106 106 Server.query_errors query_errors; 107 107 Server.type_enclosing type_enclosing; 108 108 - Server.compile_js compile_js; 109 108 Server.exec_toplevel exec_toplevel; 110 109 IdlM.server Server.implementation 111 110