+2 -2

example/example.ml

··· 14 14 { 15 15 stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 16 16 findlib_index = "/lib/findlib_index"; 17 17 - findlib_requires = [ "astring" ]; 17 17 + findlib_requires = [ "stringext" ]; 18 18 execute = true; 19 19 } 20 20 in ··· 43 43 let* rpc = initialise "worker.js" (fun _ -> log "Timeout") in 44 44 let* o = W.setup rpc () in 45 45 log_output o; 46 46 - let* o = W.exec rpc "Astring.String.fields \"foo bar baz\";;" in 46 46 + let* o = W.exec rpc "Stringext.of_list ['a';'b';'c'];;" in 47 47 log_output o; 48 48 Lwt.return (Ok ())

+7 -7

example/mklib.sh

··· 2 2 3 3 mkdir -p lib/ocaml 4 4 cp $OPAM_SWITCH_PREFIX/lib/ocaml/*.cmi lib/ocaml/ 5 5 - mkdir -p lib/astring 6 6 - cp $OPAM_SWITCH_PREFIX/lib/astring/META lib/astring 7 7 - cp $OPAM_SWITCH_PREFIX/lib/astring/*.cmi lib/astring 5 5 + mkdir -p lib/stringext 6 6 + cp $OPAM_SWITCH_PREFIX/lib/stringext/META lib/stringext 7 7 + cp $OPAM_SWITCH_PREFIX/lib/stringext/*.cmi lib/stringext 8 8 9 9 - js_of_ocaml $OPAM_SWITCH_PREFIX/lib/astring/astring.cma -o lib/astring/astring.cma.js --effects=cps 9 9 + js_of_ocaml $OPAM_SWITCH_PREFIX/lib/stringext/stringext.cma -o lib/stringext/stringext.cma.js --effects cps 10 10 11 11 cat > lib/ocaml/dynamic_cmis.json << EOF 12 12 { ··· 16 16 } 17 17 EOF 18 18 19 19 - cat > lib/astring/dynamic_cmis.json << EOF 19 19 + cat > lib/stringext/dynamic_cmis.json << EOF 20 20 { 21 21 - dcs_url: "/lib/astring/", 22 22 - dcs_toplevel_modules: ["Astring"], 21 21 + dcs_url: "/lib/stringext/", 22 22 + dcs_toplevel_modules: ["Stringext"], 23 23 dcs_file_prefixes : [] 24 24 } 25 25 EOF

+7 -7

lib/findlibish.ml

··· 101 101 102 102 let dcs_filename = "dynamic_cmis.json" 103 103 104 104 - let fetch_dynamic_cmis url = 105 105 - match Jslib.sync_get url with 104 104 + let fetch_dynamic_cmis sync_get url = 105 105 + match sync_get url with 106 106 | None -> Error (`Msg "Failed to fetch dynamic cmis") 107 107 | Some json -> 108 108 let rpc = Jsonrpc.of_string json in 109 109 Rpcmarshal.unmarshal 110 110 Js_top_worker_rpc.Toplevel_api_gen.typ_of_dynamic_cmis rpc 111 111 112 112 - let init findlib_index : t = 112 112 + let init sync_get findlib_index : t = 113 113 let findlib_metas = 114 114 - match Jslib.sync_get findlib_index with 114 114 + match sync_get findlib_index with 115 115 | None -> [] 116 116 | Some txt -> Astring.String.fields ~empty:false txt 117 117 in 118 118 let metas = 119 119 List.filter_map 120 120 (fun x -> 121 121 - match Jslib.sync_get x with Some meta -> Some (x, meta) | None -> None) 121 121 + match sync_get x with Some meta -> Some (x, meta) | None -> None) 122 122 findlib_metas 123 123 in 124 124 List.filter_map ··· 150 150 None) 151 151 metas |> flatten_libs 152 152 153 153 - let require cmi_only v packages = 153 153 + let require sync_get cmi_only v packages = 154 154 let rec require dcss package : 155 155 Js_top_worker_rpc.Toplevel_api_gen.dynamic_cmis list = 156 156 match List.find (fun lib -> lib.name = package) v with ··· 170 170 let dcs = Fpath.(dir / dcs_filename |> to_string) in 171 171 let uri = Uri.with_path lib.meta_uri dcs in 172 172 Jslib.log "uri: %s" (Uri.to_string uri); 173 173 - match fetch_dynamic_cmis (Uri.to_string uri) with 173 173 + match fetch_dynamic_cmis sync_get (Uri.to_string uri) with 174 174 | Ok dcs -> 175 175 let () = 176 176 match lib.archive_name with

+6 -3

lib/impl.ml

··· 353 353 354 354 requires := init_libs.findlib_requires; 355 355 functions := Some []; 356 356 + execution_allowed := init_libs.execute; 357 357 + 358 358 + (* Set up the toplevel environment *) 356 359 Logs.info (fun m -> m "init() finished"); 357 360 358 361 IdlM.ErrM.return () ··· 775 778 let filename = modname_of_id id |> String.uncapitalize_ascii in 776 779 let prefix = Printf.sprintf "%s/%s" path filename in 777 780 let filename = Printf.sprintf "%s.ml" prefix in 778 778 - Logs.info (fun m -> m "prefix: %s\n%!" prefix); 781 781 + Logs.info (fun m -> m "prefix: %s" prefix); 779 782 let oc = open_out filename in 780 783 Printf.fprintf oc "%s" source; 781 784 close_out oc; 782 782 - (try Sys.remove (prefix ^ ".cmi") with e -> Logs.err (fun m -> m "Error removing %s: %s" filename (Printexc.to_string e))); 785 785 + (try Sys.remove (prefix ^ ".cmi") with | Sys_error _ -> ()); 783 786 let unit_info = Unit_info.make ~source_file:filename prefix in 784 787 try 785 788 let store = Local_store.fresh () in ··· 792 795 let _ = Typemod.type_implementation unit_info env ast in 793 796 let b = Sys.file_exists (prefix ^ ".cmi") in 794 797 failed_cells := StringSet.remove id !failed_cells; 795 795 - Logs.info (fun m -> m "file_exists: %s = %b\n%!" (prefix ^ ".cmi") b)); 798 798 + Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b)); 796 799 (* reset_dirs () *) () 797 800 with 798 801 | Env.Error e ->

+3 -3

lib/worker.ml

··· 53 53 54 54 let sync_get = Jslib.sync_get 55 55 let create_file = Js_of_ocaml.Sys_js.create_file 56 56 - let get_stdlib_dcs uri = Findlibish.fetch_dynamic_cmis uri |> Result.to_list 56 56 + let get_stdlib_dcs uri = Findlibish.fetch_dynamic_cmis sync_get uri |> Result.to_list 57 57 let import_scripts = Js_of_ocaml.Worker.import_scripts 58 58 - let findlib_init = Findlibish.init 58 58 + let findlib_init = Findlibish.init sync_get 59 59 60 60 let require b v = function 61 61 | [] -> [] 62 62 - | packages -> Findlibish.require b v packages 62 62 + | packages -> Findlibish.require sync_get b v packages 63 63 64 64 let init_function func_name = 65 65 let open Js_of_ocaml in

+26 -3

test/node/dune

··· 3 3 (modes byte) 4 4 (modules node_test) 5 5 (link_flags (-linkall)) 6 6 - (libraries js_of_ocaml js_of_ocaml-toplevel js_top_worker logs logs.fmt rpclib.core rpclib.json findlib.top)) 6 6 + (libraries fpath js_of_ocaml js_top_worker-web js_of_ocaml-toplevel js_top_worker logs logs.fmt rpclib.core rpclib.json findlib.top)) 7 7 8 8 (rule 9 9 (targets node_test.js) ··· 11 11 (run 12 12 %{bin:js_of_ocaml} 13 13 --toplevel 14 14 - ; --pretty 14 14 + --pretty 15 15 --no-cmis 16 16 --effects=cps 17 17 + --debuginfo 18 18 + --target-env=nodejs 17 19 +toplevel.js 18 20 +dynlink.js 19 21 +bigstringaf/runtime.js 22 22 + +js_top_worker/stubs.js 20 23 %{dep:node_test.bc} 21 24 -o 22 22 - %{targets}))) 25 25 + %{targets}))) 26 26 + 27 27 + (rule 28 28 + (targets 29 29 + (dir lib)) 30 30 + (deps mklib.sh) 31 31 + (action 32 32 + (system "./mklib.sh"))) 33 33 + 34 34 + (rule 35 35 + (with-outputs-to node_test.out 36 36 + (run 37 37 + node --stack-size=2000 -r ./%{dep:import_scripts.js} %{dep:node_test.js}))) 38 38 + 39 39 + (rule 40 40 + (alias runtest) 41 41 + (action (diff node_test.expected node_test.out))) 42 42 + 43 43 + 44 44 + 45 45 +

+18

test/node/import_scripts.js

··· 1 1 + 2 2 + fs=require('fs'); 3 3 + vm=require('vm');// vm must be in the global context to work properly 4 4 + 5 5 + 6 6 + function include(filename){ 7 7 + var code = fs.readFileSync(filename, 'utf-8'); 8 8 + vm.runInThisContext(code, filename); 9 9 + } 10 10 + 11 11 + function importScripts(filename){ 12 12 + console.log('importScripts: ' + filename); 13 13 + filename='./'+filename; 14 14 + include(filename); 15 15 + } 16 16 + 17 17 + global.importScripts=importScripts; 18 18 + global.include=include;

+1

test/node/mklib.sh

··· 1 1 + ../../example/mklib.sh

+23

test/node/node_test.expected

··· 1 1 + node_test.js: [INFO] init() 2 2 + node_test.js: [INFO] sync_get: ./lib/findlib_index 3 3 + node_test.js: [ERROR] Error reading file ./lib/findlib_index: Sys_error("Error: ENOENT: no such file or directory, open '/Users/jon/devel/learno/codemirror3/js_top_worker/_build/default/test/node/lib/findlib_index'") 4 4 + node_test.js: [INFO] sync_get: ./lib/ocaml/dynamic_cmis.json 5 5 + node_test.js: [ERROR] Error reading file ./lib/ocaml/dynamic_cmis.json: Sys_error("Error: ENOENT: no such file or directory, open '/Users/jon/devel/learno/codemirror3/js_top_worker/_build/default/test/node/lib/ocaml/dynamic_cmis.json'") 6 6 + node_test.js: [INFO] init() finished 7 7 + node_test.js: [INFO] setup() ... 8 8 + error while evaluating #enable "pretty";; 9 9 + error while evaluating #disable "shortvar";; 10 10 + node_test.js: [INFO] Setup complete 11 11 + Package stringext not found 12 12 + node_test.js: [INFO] setup() finished 13 13 + node_test.js: [INFO] setup output: OCaml version 5.2.0 14 14 + Unknown directive enable. 15 15 + Unknown directive disable. 16 16 + node_test.js: [INFO] Number of errors: 1 17 17 + node_test.js: [INFO] add_cmi 18 18 + node_test.js: [INFO] prefix: /static/cmis/cell__c1 19 19 + node_test.js: [INFO] About to type_implementation 20 20 + node_test.js: [INFO] file_exists: /static/cmis/cell__c1.cmi = true 21 21 + node_test.js: [INFO] Number of errors1: 1 22 22 + node_test.js: [INFO] Number of errors2: 1 23 23 + node_test.js: [INFO] Success

+31 -42

test/node/node_test.ml

··· 8 8 let stderr_buff = Buffer.create 1024 in 9 9 Js_of_ocaml.Sys_js.set_channel_flusher stdout 10 10 (Buffer.add_string stdout_buff); 11 11 - Js_of_ocaml.Sys_js.set_channel_flusher stderr 12 12 - (Buffer.add_string stderr_buff); 11 11 + 13 12 let x = f () in 14 13 let captured = 15 14 { ··· 19 18 in 20 19 (captured, x) 21 20 22 22 - let handle_findlib_error = function 21 21 + let _handle_findlib_error = function 23 22 | Failure msg -> Printf.fprintf stderr "%s" msg 24 23 | Fl_package_base.No_such_package (pkg, reason) -> 25 24 Printf.fprintf stderr "No such package: %s%s\n" pkg ··· 31 30 module Server = Js_top_worker_rpc.Toplevel_api_gen.Make (Impl.IdlM.GenServer ()) 32 31 33 32 module S : Impl.S = struct 34 34 - type findlib_t = unit 33 33 + type findlib_t = Js_top_worker_web.Findlibish.t 34 34 + 35 35 36 36 let capture = capture 37 37 - let sync_get _ = None 37 37 + let sync_get f = 38 38 + let f = Fpath.v ("./" ^ f) in 39 39 + Logs.info (fun m -> m "sync_get: %a" Fpath.pp f); 40 40 + try 41 41 + Some (In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all) 42 42 + with e -> 43 43 + Logs.err (fun m -> m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e)); 44 44 + None 45 45 + 38 46 let create_file = Js_of_ocaml.Sys_js.create_file 39 47 40 48 let import_scripts urls = 41 49 if List.length urls > 0 then failwith "Not implemented" else () 42 50 43 51 let init_function _ () = failwith "Not implemented" 44 44 - let findlib_init _ = () 45 45 - let get_stdlib_dcs _uri = [] 52 52 + let findlib_init = Js_top_worker_web.Findlibish.init sync_get 53 53 + let get_stdlib_dcs uri = Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri |> Result.to_list 46 54 47 47 - let require _ () packages = 48 48 - try 49 49 - let eff_packages = 50 50 - Findlib.package_deep_ancestors !Topfind.predicates packages 51 51 - in 52 52 - Topfind.load eff_packages; 53 53 - [] 54 54 - with exn -> 55 55 - handle_findlib_error exn; 56 56 - [] 55 55 + let require b v = function 56 56 + | [] -> [] 57 57 + | packages -> Js_top_worker_web.Findlibish.require sync_get b v packages 58 58 + 57 59 end 58 60 59 61 module U = Impl.Make (S) 60 62 61 61 - (* let test () = 62 62 - let _x = Compmisc.initial_env in 63 63 - let oc = open_out "/tmp/unix_worker.ml" in 64 64 - Printf.fprintf oc "let x=1;;\n"; 65 65 - close_out oc; 66 66 - let unit_info = Unit_info.make ~source_file:"/tmp/unix_worker.ml" "/tmp/unix_worker" in 67 67 - try 68 68 - let _ast = Pparse.parse_implementation ~tool_name:"worker" "/tmp/unix_worker.ml" in 69 69 - let _ = Typemod.type_implementation unit_info (Compmisc.initial_env ()) _ast in 70 70 - () 71 71 - with exn -> 72 72 - Printf.eprintf "error: %s\n%!" (Printexc.to_string exn); 73 73 - let ppf = Format.err_formatter in 74 74 - let _ = Location.report_exception ppf exn in 75 75 - () *) 76 76 - 77 63 let start_server () = 78 64 let open U in 79 65 Logs.set_reporter (Logs_fmt.reporter ()); ··· 94 80 95 81 let _ = 96 82 let rpc = start_server () in 97 97 - Printf.printf "Starting worker...\n%!"; 98 83 let ( let* ) = IdlM.ErrM.bind in 99 84 let init = 100 85 Js_top_worker_rpc.Toplevel_api_gen. 101 86 { 102 87 stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 103 88 findlib_index = "/lib/findlib_index"; 104 104 - findlib_requires = []; 105 105 - execute = true; 89 89 + findlib_requires = ["stringext"]; 90 90 + execute = false; 106 91 } 107 92 in 108 93 let x = 109 94 let* _ = Client.init rpc init in 110 95 let* o = Client.setup rpc () in 111 111 - Printf.printf "setup output: %s\n%!" (Option.value ~default:"" o.stdout); 96 96 + Logs.info (fun m -> m "setup output: %s" (Option.value ~default:"" o.stdout)); 112 97 let* _ = 113 98 Client.query_errors rpc (Some "c1") [] false "typ xxxx = int;;\n" 114 99 in 115 100 let* o1 = 116 101 Client.query_errors rpc (Some "c2") ["c1"] false "type yyy = xxx;;\n" 117 102 in 118 118 - Printf.printf "Number of errors: %d\n%!" (List.length o1); 103 103 + Logs.info (fun m -> m "Number of errors: %d" (List.length o1)); 119 104 let* _ = 120 105 Client.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" 121 106 in ··· 123 108 Client.query_errors rpc (Some "c2") ["c1"] false 124 109 "type yyy = xxx;;\n" 125 110 in 126 126 - Printf.printf "Number of errors1: %d\n%!" (List.length o1); 127 127 - Printf.printf "Number of errors2: %d\n%!" (List.length o2); 111 111 + Logs.info (fun m -> m "Number of errors1: %d" (List.length o1)); 112 112 + Logs.info (fun m -> m "Number of errors2: %d" (List.length o2)); 113 113 + (* let* o3 = 114 114 + Client.exec_toplevel rpc 115 115 + "# Stringext.of_list ['a';'b';'c'];;\n" in 116 116 + Logs.info (fun m -> m "Exec toplevel output: %s" o3.script); *) 128 117 IdlM.ErrM.return () 129 118 in 130 119 match x |> IdlM.T.get |> M.run with 131 131 - | Ok () -> Printf.printf "Success\n%!" 132 132 - | Error (InternalError s) -> Printf.printf "Error: %s\n%!" s 120 120 + | Ok () -> Logs.info (fun m -> m "Success") 121 121 + | Error (InternalError s) -> Logs.err (fun m -> m "Error: %s" s)