+35

bin/cmd_outputs.ml

··· 1 1 + type log_dest = 2 2 + [ `Compile 3 3 + | `Compile_src 4 4 + | `Link 5 5 + | `Count_occurrences 6 6 + | `Generate 7 7 + | `Index 8 8 + | `Sherlodoc 9 9 + | `Classify ] 10 10 + 11 11 + type log_line = { log_dest : log_dest; prefix : string; run : Run.t } 12 12 + 13 13 + let outputs : log_line list ref = ref [] 14 14 + 15 15 + let maybe_log log_dest run = 16 16 + match log_dest with 17 17 + | Some (log_dest, prefix) -> 18 18 + outputs := !outputs @ [ { log_dest; run; prefix } ] 19 19 + | None -> () 20 20 + 21 21 + let submit log_dest desc cmd output_file = 22 22 + match Worker_pool.submit desc cmd output_file with 23 23 + | Ok x -> 24 24 + maybe_log log_dest x; 25 25 + String.split_on_char '\n' x.output 26 26 + | Error exn -> raise exn 27 27 + 28 28 + let submit_ignore_failures log_dest desc cmd output_file = 29 29 + match Worker_pool.submit desc cmd output_file with 30 30 + | Ok x -> 31 31 + maybe_log log_dest x; 32 32 + () 33 33 + | Error exn -> 34 34 + Logs.err (fun m -> m "Error: %s" (Printexc.to_string exn)); 35 35 + ()

+15

bin/dune

··· 1 1 + (executable 2 2 + (name jtw) 3 3 + (public_name jtw) 4 4 + (package js_top_worker) 5 5 + (libraries 6 6 + eio 7 7 + eio_main 8 8 + bos 9 9 + opam-format 10 10 + findlib 11 11 + logs 12 12 + logs.fmt 13 13 + js_top_worker-rpc 14 14 + rpclib.json 15 15 + cmdliner))

+227

bin/jtw.ml

··· 1 1 + let cmi_files dir = 2 2 + Bos.OS.Dir.fold_contents ~traverse:`None ~elements:`Files 3 3 + (fun path acc -> 4 4 + if Fpath.has_ext ".cmi" path then Fpath.filename path :: acc else acc) 5 5 + [] dir 6 6 + 7 7 + let gen_cmis cmis = 8 8 + let gen_one (dir, cmis) = 9 9 + let all_cmis = 10 10 + List.map (fun s -> String.sub s 0 (String.length s - 4)) cmis 11 11 + in 12 12 + let hidden, non_hidden = 13 13 + List.partition (fun x -> Astring.String.is_infix ~affix:"__" x) all_cmis 14 14 + in 15 15 + let prefixes = 16 16 + List.filter_map 17 17 + (fun x -> 18 18 + match Astring.String.cuts ~sep:"__" x with 19 19 + | x :: _ -> Some (x ^ "__") 20 20 + | _ -> None) 21 21 + hidden 22 22 + in 23 23 + let prefixes = Util.StringSet.(of_list prefixes |> to_list) in 24 24 + let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in 25 25 + let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 26 26 + let dcs = 27 27 + { 28 28 + Js_top_worker_rpc.Toplevel_api_gen.dcs_url = 29 29 + Fpath.(v "lib" // d |> to_string); 30 30 + dcs_toplevel_modules = List.map String.capitalize_ascii non_hidden; 31 31 + dcs_file_prefixes = prefixes; 32 32 + } 33 33 + in 34 34 + ( dir, 35 35 + Jsonrpc.to_string 36 36 + (Rpcmarshal.marshal 37 37 + Js_top_worker_rpc.Toplevel_api_gen.typ_of_dynamic_cmis dcs) ) 38 38 + in 39 39 + List.map gen_one cmis 40 40 + 41 41 + let opam output_dir_str switch libraries no_worker = 42 42 + Opam.switch := switch; 43 43 + let libraries = 44 44 + match Ocamlfind.deps libraries with 45 45 + | Ok l -> Util.StringSet.of_list ("stdlib" :: l) 46 46 + | Error (`Msg m) -> 47 47 + Format.eprintf "Failed to find libs: %s\n%!" m; 48 48 + (* Format.eprintf "Bad libs: %s\n%!" m; *) 49 49 + (* failwith ("Bad libs: " ^ m) *) 50 50 + failwith ("Bad libs: " ^ m) 51 51 + in 52 52 + let verbose = true in 53 53 + Eio_main.run @@ fun env -> 54 54 + Eio.Switch.run @@ fun sw -> 55 55 + if verbose then Logs.set_level (Some Logs.Debug) else Logs.set_level None; 56 56 + Logs.set_reporter (Logs_fmt.reporter ()); 57 57 + let () = Worker_pool.start_workers env sw 16 in 58 58 + Logs.debug (fun m -> 59 59 + m "Libraries: %a" 60 60 + (Fmt.list ~sep:Fmt.comma Fmt.string) 61 61 + (Util.StringSet.elements libraries)); 62 62 + let output_dir = Fpath.v output_dir_str in 63 63 + let meta_files = 64 64 + List.map 65 65 + (fun lib -> Ocamlfind.meta_file lib) 66 66 + (Util.StringSet.elements libraries) 67 67 + |> Util.StringSet.of_list 68 68 + in 69 69 + let cmi_dirs = 70 70 + match Ocamlfind.deps (Util.StringSet.to_list libraries) with 71 71 + | Ok libs -> 72 72 + let dirs = 73 73 + List.filter_map 74 74 + (fun lib -> 75 75 + match Ocamlfind.get_dir lib with Ok x -> Some x | _ -> None) 76 76 + libs 77 77 + in 78 78 + dirs 79 79 + | Error (`Msg m) -> 80 80 + Format.eprintf "Failed to find libs: %s\n%!" m; 81 81 + [] 82 82 + in 83 83 + Format.eprintf "cmi_dirs: %a\n%!" (Fmt.list ~sep:Fmt.comma Fpath.pp) cmi_dirs; 84 84 + let cmis = 85 85 + List.fold_left 86 86 + (fun acc dir -> 87 87 + match cmi_files dir with 88 88 + | Ok files -> (dir, files) :: acc 89 89 + | Error _ -> acc) 90 90 + [] cmi_dirs 91 91 + in 92 92 + let ( let* ) = Result.bind in 93 93 + 94 94 + let _ = 95 95 + let* _ = Bos.OS.Dir.create output_dir in 96 96 + let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in 97 97 + 98 98 + List.iter 99 99 + (fun (dir, files) -> 100 100 + let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 101 101 + List.iter 102 102 + (fun f -> 103 103 + let dest_dir = Fpath.(output_dir / "lib" // d) in 104 104 + let dest = Fpath.(dest_dir / f) in 105 105 + let _ = Bos.OS.Dir.create ~path:true dest_dir in 106 106 + match Bos.OS.File.exists dest with 107 107 + | Ok true -> () 108 108 + | Ok false -> Util.cp Fpath.(dir / f) dest 109 109 + | Error _ -> failwith "file exists failed") 110 110 + files) 111 111 + cmis; 112 112 + 113 113 + let meta_rels = 114 114 + Util.StringSet.fold 115 115 + (fun meta_file acc -> 116 116 + let meta_file = Fpath.v meta_file in 117 117 + let d = 118 118 + Fpath.relativize ~root:findlib_dir meta_file 119 119 + |> Option.get |> Fpath.parent 120 120 + in 121 121 + (meta_file, d) :: acc) 122 122 + meta_files [] 123 123 + in 124 124 + 125 125 + List.iter 126 126 + (fun (meta_file, d) -> 127 127 + let dest = Fpath.(output_dir / "lib" // d) in 128 128 + let _ = Bos.OS.Dir.create dest in 129 129 + Util.cp meta_file dest) 130 130 + meta_rels; 131 131 + 132 132 + Out_channel.with_open_bin 133 133 + Fpath.(output_dir / "findlib_index" |> to_string) 134 134 + (fun oc -> 135 135 + List.iter 136 136 + (fun (meta_file, d) -> 137 137 + let file = Fpath.filename meta_file in 138 138 + let path = Fpath.(v "lib" // d / file) in 139 139 + Printf.fprintf oc "%s\n" (Fpath.to_string path)) 140 140 + meta_rels); 141 141 + 142 142 + Util.StringSet.iter 143 143 + (fun lib -> 144 144 + let archives = Ocamlfind.archives lib in 145 145 + let dir = Ocamlfind.get_dir lib |> Result.get_ok in 146 146 + let archives = List.map (fun x -> Fpath.(dir / x)) archives in 147 147 + let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 148 148 + let dest = Fpath.(output_dir / "lib" // d) in 149 149 + let _ = Bos.OS.Dir.create dest in 150 150 + let doit archive = 151 151 + let output = Fpath.(dest / (Fpath.filename archive ^ ".js")) in 152 152 + let cmd = 153 153 + match switch with 154 154 + | None -> 155 155 + Bos.Cmd.( 156 156 + v "js_of_ocaml" % "compile" % Fpath.to_string archive % "-o" 157 157 + % Fpath.to_string output) 158 158 + | Some s -> 159 159 + Bos.Cmd.( 160 160 + v "opam" % "exec" % "--switch" % s % "--" % "js_of_ocaml" 161 161 + % "compile" % Fpath.to_string archive % "-o" 162 162 + % Fpath.to_string output) 163 163 + in 164 164 + let _ = Util.lines_of_process cmd in 165 165 + () 166 166 + in 167 167 + List.iter doit archives) 168 168 + libraries; 169 169 + 170 170 + (* Format.eprintf "@[<hov 2>dir: %a [%a]@]\n%!" Fpath.pp dir (Fmt.list ~sep:Fmt.sp Fmt.string) files) cmis; *) 171 171 + Ok () 172 172 + in 173 173 + let init_cmis = gen_cmis cmis in 174 174 + List.iter 175 175 + (fun (dir, dcs) -> 176 176 + let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in 177 177 + let d = Fpath.relativize ~root:findlib_dir dir in 178 178 + match d with 179 179 + | None -> 180 180 + Format.eprintf "Failed to relativize %a wrt %a\n%!" Fpath.pp dir 181 181 + Fpath.pp findlib_dir 182 182 + | Some dir -> 183 183 + Format.eprintf "Generating %a\n%!" Fpath.pp dir; 184 184 + let dir = Fpath.(output_dir / "lib" // dir) in 185 185 + let _ = Bos.OS.Dir.create dir in 186 186 + let oc = open_out Fpath.(dir / "dynamic_cmis.json" |> to_string) in 187 187 + Printf.fprintf oc "%s" dcs; 188 188 + close_out oc) 189 189 + init_cmis; 190 190 + Format.eprintf "Number of cmis: %d\n%!" (List.length init_cmis); 191 191 + 192 192 + let () = 193 193 + if no_worker then () else Mk_backend.mk switch libraries output_dir 194 194 + in 195 195 + 196 196 + `Ok () 197 197 + 198 198 + open Cmdliner 199 199 + 200 200 + let opam_cmd = 201 201 + let libraries = Arg.(value & pos_all string [] & info [] ~docv:"LIB") in 202 202 + let output_dir = 203 203 + let doc = 204 204 + "Output directory in which to put all outputs. This should be the root \ 205 205 + directory of the HTTP server" 206 206 + in 207 207 + Arg.(value & opt string "html" & info [ "o"; "output" ] ~doc) 208 208 + in 209 209 + let no_worker = 210 210 + let doc = "Do not create worker.js" in 211 211 + Arg.(value & flag & info [ "no-worker" ] ~doc) 212 212 + in 213 213 + let switch = 214 214 + let doc = "Opam switch to use" in 215 215 + Arg.(value & opt (some string) None & info [ "switch" ] ~doc) 216 216 + in 217 217 + let info = Cmd.info "opam" ~doc:"Generate opam files" in 218 218 + Cmd.v info 219 219 + Term.(ret (const opam $ output_dir $ switch $ libraries $ no_worker)) 220 220 + 221 221 + let main_cmd = 222 222 + let doc = "An odoc notebook tool" in 223 223 + let info = Cmd.info "odoc-notebook" ~version:"%%VERSION%%" ~doc in 224 224 + let default = Term.(ret (const (`Help (`Pager, None)))) in 225 225 + Cmd.group info ~default [ opam_cmd ] 226 226 + 227 227 + let () = exit (Cmd.eval main_cmd)

+66

bin/mk_backend.ml

··· 1 1 + (* To make a toplevel backend.js *) 2 2 + 3 3 + let mk switch libs dir = 4 4 + let txt = {|let _ = Js_top_worker_web.Worker.run ()|} in 5 5 + let file = Fpath.(dir / "worker.ml") in 6 6 + Util.write_file file [ txt ]; 7 7 + let ocamlfind_cmd, js_of_ocaml_cmd = 8 8 + match switch with 9 9 + | None -> (Bos.Cmd.(v "ocamlfind"), Bos.Cmd.(v "js_of_ocaml")) 10 10 + | Some s -> 11 11 + ( Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "ocamlfind"), 12 12 + Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "js_of_ocaml") ) 13 13 + in 14 14 + let cmd = 15 15 + Bos.Cmd.( 16 16 + ocamlfind_cmd % "ocamlc" % "-package" % "js_of_ocaml-ppx.as-lib" 17 17 + % "-package" % "js_top_worker-web") 18 18 + in 19 19 + let cmd = Bos.Cmd.(cmd % "-linkpkg" % "-linkall" % Fpath.to_string file) in 20 20 + let cmd = 21 21 + Bos.Cmd.(cmd % "-g" % "-o" % Fpath.(dir / "worker.bc" |> to_string)) 22 22 + in 23 23 + let _ = Util.lines_of_process cmd in 24 24 + let cmd = 25 25 + Bos.Cmd.( 26 26 + ocamlfind_cmd % "query" % "-format" % "%+(jsoo_runtime)" % "-r" 27 27 + % "js_top_worker-web") 28 28 + in 29 29 + let cmd = Util.StringSet.fold (fun lib cmd -> Bos.Cmd.(cmd % lib)) libs cmd in 30 30 + let js_files = 31 31 + Util.lines_of_process cmd 32 32 + |> List.filter (fun x -> String.length x > 0) 33 33 + |> List.map (fun x -> Astring.String.cuts ~sep:" " x) 34 34 + |> List.flatten 35 35 + in 36 36 + let cmd = 37 37 + Bos.Cmd.( 38 38 + js_of_ocaml_cmd % "--toplevel" % "--no-cmis" % "--linkall" % "--pretty") 39 39 + in 40 40 + let cmd = 41 41 + List.fold_right 42 42 + (fun a cmd -> Bos.Cmd.(cmd % a)) 43 43 + (js_files 44 44 + @ [ 45 45 + "+dynlink.js"; 46 46 + "+toplevel.js"; 47 47 + "+bigstringaf/runtime.js"; 48 48 + "+js_top_worker/stubs.js"; 49 49 + ]) 50 50 + cmd 51 51 + in 52 52 + let cmd = 53 53 + Bos.Cmd.( 54 54 + cmd 55 55 + % Fpath.(dir / "worker.bc" |> to_string) 56 56 + % "-o" 57 57 + % Fpath.(dir / "worker.js" |> to_string)) 58 58 + in 59 59 + Logs.info (fun m -> m "cmd: %s" (Bos.Cmd.to_string cmd)); 60 60 + let _ = Util.lines_of_process cmd in 61 61 + let to_delete = [ "worker.bc"; "worker.ml"; "worker.cmi"; "worker.cmo" ] in 62 62 + let results = 63 63 + List.map (fun f -> Bos.OS.File.delete Fpath.(dir / f)) to_delete 64 64 + in 65 65 + ignore results; 66 66 + ()

+67

bin/ocamlfind.ml

··· 1 1 + let init = 2 2 + let initialized = ref false in 3 3 + fun () -> 4 4 + if !initialized then () 5 5 + else 6 6 + let prefix = Opam.prefix () in 7 7 + let env_camllib = Fpath.(v prefix / "lib" / "ocaml" |> to_string) in 8 8 + let config = Fpath.(v prefix / "lib" / "findlib.conf" |> to_string) in 9 9 + Findlib.init ~config ~env_camllib () 10 10 + 11 11 + let all () = 12 12 + init (); 13 13 + Fl_package_base.list_packages () 14 14 + 15 15 + let get_dir lib = 16 16 + try 17 17 + init (); 18 18 + Fl_package_base.query lib |> fun x -> 19 19 + Logs.debug (fun m -> m "Package %s is in directory %s@." lib x.package_dir); 20 20 + Ok Fpath.(v x.package_dir |> to_dir_path) 21 21 + with e -> 22 22 + Printf.eprintf "Error: %s\n" (Printexc.to_string e); 23 23 + Error (`Msg "Error getting directory") 24 24 + 25 25 + let findlib_dir () = Findlib.default_location () 26 26 + 27 27 + let archives pkg = 28 28 + init (); 29 29 + let package = Fl_package_base.query pkg in 30 30 + let get_1 preds = 31 31 + try 32 32 + [ 33 33 + Fl_metascanner.lookup "archive" preds 34 34 + package.Fl_package_base.package_defs; 35 35 + ] 36 36 + with _ -> [] 37 37 + in 38 38 + match pkg with 39 39 + | "stdlib" -> [ "stdlib.cma" ] 40 40 + | _ -> 41 41 + get_1 [ "byte" ] @ get_1 [ "byte"; "ppx_driver" ] 42 42 + |> List.filter (fun x -> String.length x > 0) 43 43 + |> List.sort_uniq String.compare 44 44 + 45 45 + let sub_libraries top = 46 46 + init (); 47 47 + let packages = Fl_package_base.list_packages () in 48 48 + List.fold_left 49 49 + (fun acc lib -> 50 50 + let package = String.split_on_char '.' lib |> List.hd in 51 51 + if package = top then Util.StringSet.add lib acc else acc) 52 52 + Util.StringSet.empty packages 53 53 + 54 54 + let deps pkgs = 55 55 + init (); 56 56 + try 57 57 + let packages = 58 58 + Fl_package_base.requires_deeply ~preds:[ "ppx_driver"; "byte" ] pkgs 59 59 + in 60 60 + Ok packages 61 61 + with e -> Error (`Msg (Printexc.to_string e)) 62 62 + 63 63 + let meta_file pkg = 64 64 + init (); 65 65 + let package = Fl_package_base.query pkg in 66 66 + let meta = package.Fl_package_base.package_meta in 67 67 + meta

+170

bin/opam.ml

··· 1 1 + open Bos 2 2 + 3 3 + let opam = Cmd.v "opam" 4 4 + let switch = ref None 5 5 + let prefix = ref None 6 6 + 7 7 + type package = { name : string; version : string } 8 8 + 9 9 + let pp fmt p = Format.fprintf fmt "%s.%s" p.name p.version 10 10 + 11 11 + let rec get_switch () = 12 12 + match !switch with 13 13 + | None -> 14 14 + let cur_switch = 15 15 + Util.lines_of_process Cmd.(opam % "switch" % "show") |> List.hd 16 16 + in 17 17 + switch := Some cur_switch; 18 18 + get_switch () 19 19 + | Some s -> s 20 20 + 21 21 + let prefix () = 22 22 + match !prefix with 23 23 + | Some p -> p 24 24 + | None -> 25 25 + let p = 26 26 + Util.lines_of_process 27 27 + Cmd.(opam % "var" % "--switch" % get_switch () % "prefix") 28 28 + |> List.hd 29 29 + in 30 30 + prefix := Some p; 31 31 + p 32 32 + 33 33 + let deps_of_opam_result line = 34 34 + match Astring.String.fields ~empty:false line with 35 35 + | [ name; version ] -> [ { name; version } ] 36 36 + | _ -> [] 37 37 + 38 38 + let all_opam_packages () = 39 39 + Util.lines_of_process 40 40 + Cmd.( 41 41 + opam % "list" % "--switch" % get_switch () % "--columns=name,version" 42 42 + % "--color=never" % "--short") 43 43 + |> List.map deps_of_opam_result 44 44 + |> List.flatten 45 45 + 46 46 + let pkg_contents { name; _ } = 47 47 + let prefix = Fpath.v (prefix ()) in 48 48 + let changes_file = 49 49 + Format.asprintf "%a/.opam-switch/install/%s.changes" Fpath.pp prefix name 50 50 + in 51 51 + let file = OpamFilename.raw changes_file in 52 52 + let filename = 53 53 + OpamFile.make @@ OpamFilename.raw @@ Filename.basename changes_file 54 54 + in 55 55 + let changed = 56 56 + OpamFilename.with_contents 57 57 + (fun str -> 58 58 + OpamFile.Changes.read_from_string ~filename 59 59 + @@ 60 60 + (* Field [opam-version] is invalid in [*.changes] files, displaying a warning. *) 61 61 + if OpamStd.String.starts_with ~prefix:"opam-version" str then 62 62 + match OpamStd.String.cut_at str '\n' with 63 63 + | Some (_, str) -> str 64 64 + | None -> assert false 65 65 + else str) 66 66 + file 67 67 + in 68 68 + let added = 69 69 + OpamStd.String.Map.fold 70 70 + (fun file x acc -> 71 71 + match x with 72 72 + | OpamDirTrack.Added _ -> ( 73 73 + try 74 74 + if not @@ Sys.is_directory Fpath.(to_string (prefix // v file)) 75 75 + then file :: acc 76 76 + else acc 77 77 + with _ -> 78 78 + acc 79 79 + (* dose (and maybe others) sometimes creates a symlink to something that doesn't exist *) 80 80 + ) 81 81 + | _ -> acc) 82 82 + changed [] 83 83 + in 84 84 + List.map Fpath.v added 85 85 + 86 86 + (* let opam_file { name; version } = *) 87 87 + (* let prefix = Fpath.v (prefix ()) in *) 88 88 + (* let opam_file = *) 89 89 + (* Format.asprintf "%a/.opam-switch/packages/%s.%s/opam" Fpath.pp prefix name *) 90 90 + (* version *) 91 91 + (* in *) 92 92 + (* let ic = open_in opam_file in *) 93 93 + (* try *) 94 94 + (* let lines = Util.lines_of_channel ic in *) 95 95 + (* close_in ic; *) 96 96 + (* Some lines *) 97 97 + (* with _ -> *) 98 98 + (* close_in ic; *) 99 99 + (* None *) 100 100 + 101 101 + type installed_files = { 102 102 + libs : Fpath.set; 103 103 + odoc_pages : Fpath.set; 104 104 + other_docs : Fpath.set; 105 105 + } 106 106 + 107 107 + type package_of_fpath = package Fpath.map 108 108 + 109 109 + (* Here we use an associative list *) 110 110 + type fpaths_of_package = (package * installed_files) list 111 111 + 112 112 + let pkg_to_dir_map () = 113 113 + let pkgs = all_opam_packages () in 114 114 + let prefix = prefix () in 115 115 + let pkg_content = 116 116 + List.map 117 117 + (fun p -> 118 118 + let contents = pkg_contents p in 119 119 + let libs = 120 120 + List.fold_left 121 121 + (fun set fpath -> 122 122 + match Fpath.segs fpath with 123 123 + | "lib" :: "stublibs" :: _ -> set 124 124 + | "lib" :: _ :: _ :: _ when Fpath.has_ext ".cmi" fpath -> 125 125 + Fpath.Set.add 126 126 + Fpath.(v prefix // fpath |> split_base |> fst) 127 127 + set 128 128 + | _ -> set) 129 129 + Fpath.Set.empty contents 130 130 + in 131 131 + let odoc_pages, other_docs = 132 132 + List.fold_left 133 133 + (fun (odoc_pages, others) fpath -> 134 134 + match Fpath.segs fpath with 135 135 + | "doc" :: _pkg :: "odoc-pages" :: _ -> 136 136 + Logs.debug (fun m -> m "Found odoc page: %a" Fpath.pp fpath); 137 137 + 138 138 + (Fpath.Set.add Fpath.(v prefix // fpath) odoc_pages, others) 139 139 + | "doc" :: _ -> 140 140 + Logs.debug (fun m -> m "Found other doc: %a" Fpath.pp fpath); 141 141 + (odoc_pages, Fpath.Set.add Fpath.(v prefix // fpath) others) 142 142 + | _ -> (odoc_pages, others)) 143 143 + Fpath.Set.(empty, empty) 144 144 + contents 145 145 + in 146 146 + Logs.debug (fun m -> 147 147 + m "Found %d odoc pages, %d other docs" 148 148 + (Fpath.Set.cardinal odoc_pages) 149 149 + (Fpath.Set.cardinal other_docs)); 150 150 + (p, { libs; odoc_pages; other_docs })) 151 151 + pkgs 152 152 + in 153 153 + let map = 154 154 + List.fold_left 155 155 + (fun map (p, { libs; _ }) -> 156 156 + Fpath.Set.fold 157 157 + (fun dir map -> 158 158 + Fpath.Map.update dir 159 159 + (function 160 160 + | None -> Some p 161 161 + | Some x -> 162 162 + Logs.debug (fun m -> 163 163 + m "Multiple packages (%a,%a) found for dir %a" pp x pp p 164 164 + Fpath.pp dir); 165 165 + Some p) 166 166 + map) 167 167 + libs map) 168 168 + Fpath.Map.empty pkg_content 169 169 + in 170 170 + (pkg_content, map)

+116

bin/run.ml

··· 1 1 + let instrument = false 2 2 + 3 3 + open Bos 4 4 + 5 5 + let instrument_dir = 6 6 + lazy 7 7 + (let dir = Fpath.v "landmarks" in 8 8 + OS.Dir.delete dir |> Result.get_ok; 9 9 + OS.Dir.create dir |> Result.get_ok |> ignore; 10 10 + dir) 11 11 + 12 12 + type t = { 13 13 + cmd : string list; 14 14 + time : float; (** Running time in seconds. *) 15 15 + output_file : Fpath.t option; 16 16 + output : string; 17 17 + errors : string; 18 18 + status : [ `Exited of int | `Signaled of int ]; 19 19 + } 20 20 + 21 21 + (* Environment variables passed to commands. *) 22 22 + 23 23 + (* Record the commands executed, their running time and optionally the path to 24 24 + the produced file. *) 25 25 + let commands = ref [] 26 26 + let n = Atomic.make 0 27 27 + 28 28 + (** Return the list of executed commands where the first argument was [cmd]. *) 29 29 + let run env cmd output_file = 30 30 + let cmd = Bos.Cmd.to_list cmd in 31 31 + let myn = Atomic.fetch_and_add n 1 in 32 32 + Logs.debug (fun m -> m "%d - Executing: %s" myn (String.concat " " cmd)); 33 33 + let proc_mgr = Eio.Stdenv.process_mgr env in 34 34 + let t_start = Unix.gettimeofday () in 35 35 + let env = 36 36 + let env = OS.Env.current () |> Result.get_ok in 37 37 + env 38 38 + in 39 39 + let env = 40 40 + Astring.String.Map.fold 41 41 + (fun k v env -> Astring.String.concat [ k; "="; v ] :: env) 42 42 + env [] 43 43 + |> Array.of_list 44 44 + in 45 45 + (* Logs.debug (fun m -> m "Running cmd %a" Fmt.(list ~sep:sp string) cmd); *) 46 46 + let output, errors, status = 47 47 + Eio.Switch.run ~name:"Process.parse_out" @@ fun sw -> 48 48 + let r, w = Eio.Process.pipe proc_mgr ~sw in 49 49 + let re, we = Eio.Process.pipe proc_mgr ~sw in 50 50 + try 51 51 + let child = 52 52 + Eio.Process.spawn ~sw proc_mgr ~stdout:w ~stderr:we ~env cmd 53 53 + in 54 54 + Eio.Flow.close w; 55 55 + Eio.Flow.close we; 56 56 + let output, err = 57 57 + Eio.Fiber.pair 58 58 + (fun () -> 59 59 + Eio.Buf_read.parse_exn Eio.Buf_read.take_all r ~max_size:max_int) 60 60 + (fun () -> 61 61 + Eio.Buf_read.parse_exn Eio.Buf_read.take_all re ~max_size:max_int) 62 62 + in 63 63 + Eio.Flow.close r; 64 64 + Eio.Flow.close re; 65 65 + let status = Eio.Process.await child in 66 66 + (output, err, status) 67 67 + with Eio.Exn.Io _ as ex -> 68 68 + let bt = Printexc.get_raw_backtrace () in 69 69 + Eio.Exn.reraise_with_context ex bt "%d - running command: %a" myn 70 70 + Eio.Process.pp_args cmd 71 71 + in 72 72 + (* Logs.debug (fun m -> 73 73 + m "Finished running cmd %a" Fmt.(list ~sep:sp string) cmd); *) 74 74 + let t_end = Unix.gettimeofday () in 75 75 + let time = t_end -. t_start in 76 76 + let result = { cmd; time; output_file; output; errors; status } in 77 77 + commands := result :: !commands; 78 78 + (match result.status with 79 79 + | `Exited 0 -> () 80 80 + | _ -> 81 81 + let verb, n = 82 82 + match result.status with 83 83 + | `Exited n -> ("exited", n) 84 84 + | `Signaled n -> ("signaled", n) 85 85 + in 86 86 + Logs.err (fun m -> 87 87 + m 88 88 + "@[<2>Process %s with %d:@ '@[%a'@]@]@\n\n\ 89 89 + Stdout:\n\ 90 90 + %s\n\n\ 91 91 + Stderr:\n\ 92 92 + %s" 93 93 + verb n 94 94 + Fmt.(list ~sep:sp string) 95 95 + result.cmd result.output result.errors)); 96 96 + result 97 97 + 98 98 + (** Print an executed command and its time. *) 99 99 + 100 100 + let filter_commands cmd = 101 101 + match 102 102 + List.filter 103 103 + (fun c -> match c.cmd with _ :: cmd' :: _ -> cmd = cmd' | _ -> false) 104 104 + !commands 105 105 + with 106 106 + | [] -> [] 107 107 + | _ :: _ as cmds -> cmds 108 108 + 109 109 + let print_cmd c = 110 110 + Printf.printf "[%4.2f] $ %s\n" c.time (String.concat " " c.cmd) 111 111 + 112 112 + (** Returns the [k] commands that took the most time for a given subcommand. *) 113 113 + let k_longest_commands cmd k = 114 114 + filter_commands cmd 115 115 + |> List.sort (fun a b -> Float.compare b.time a.time) 116 116 + |> List.filteri (fun i _ -> i < k)

+47

bin/util.ml

··· 1 1 + open Bos 2 2 + module StringSet = Set.Make (String) 3 3 + module StringMap = Map.Make (String) 4 4 + 5 5 + let lines_of_channel ic = 6 6 + let rec inner acc = 7 7 + try 8 8 + let l = input_line ic in 9 9 + inner (l :: acc) 10 10 + with End_of_file -> List.rev acc 11 11 + in 12 12 + inner [] 13 13 + 14 14 + let lines_of_process cmd = 15 15 + match OS.Cmd.(run_out ~err:err_null cmd |> to_lines) with 16 16 + | Ok x -> x 17 17 + | Error (`Msg e) -> failwith ("Error: " ^ e) 18 18 + 19 19 + let mkdir_p d = 20 20 + let segs = 21 21 + Fpath.segs (Fpath.normalize d) |> List.filter (fun s -> String.length s > 0) 22 22 + in 23 23 + let _ = 24 24 + List.fold_left 25 25 + (fun path seg -> 26 26 + let d = Fpath.(path // v seg) in 27 27 + try 28 28 + Unix.mkdir (Fpath.to_string d) 0o755; 29 29 + d 30 30 + with 31 31 + | Unix.Unix_error (Unix.EEXIST, _, _) -> d 32 32 + | exn -> raise exn) 33 33 + (Fpath.v ".") segs 34 34 + in 35 35 + () 36 36 + 37 37 + let write_file filename lines = 38 38 + let dir = fst (Fpath.split_base filename) in 39 39 + mkdir_p dir; 40 40 + let oc = open_out (Fpath.to_string filename) in 41 41 + List.iter (fun line -> Printf.fprintf oc "%s\n" line) lines; 42 42 + close_out oc 43 43 + 44 44 + let cp src dst = 45 45 + assert ( 46 46 + lines_of_process Cmd.(v "cp" % Fpath.to_string src % Fpath.to_string dst) 47 47 + = [])

+47

bin/worker_pool.ml

··· 1 1 + (* Worker pool *) 2 2 + open Eio 3 3 + 4 4 + type request = { 5 5 + description : string; 6 6 + request : Bos.Cmd.t; 7 7 + output_file : Fpath.t option; 8 8 + } 9 9 + 10 10 + type response = (Run.t, exn) result 11 11 + type resolver = response Eio.Promise.u 12 12 + type t = (request * resolver) Eio.Stream.t 13 13 + 14 14 + let stream : t = Eio.Stream.create 0 15 15 + let handle_job env request output_file = Run.run env request output_file 16 16 + 17 17 + exception Worker_failure of Run.t 18 18 + 19 19 + let rec run_worker env id : unit = 20 20 + let { request; output_file; description = _ }, reply = 21 21 + Eio.Stream.take stream 22 22 + in 23 23 + (try 24 24 + let result = handle_job env request output_file in 25 25 + match result.status with 26 26 + | `Exited 0 -> Promise.resolve reply (Ok result) 27 27 + | _ -> Promise.resolve_error reply (Worker_failure result) 28 28 + with e -> Promise.resolve_error reply e); 29 29 + run_worker env id 30 30 + 31 31 + let submit description request output_file = 32 32 + let reply, resolve_reply = Promise.create () in 33 33 + Eio.Stream.add stream ({ description; request; output_file }, resolve_reply); 34 34 + Promise.await reply 35 35 + 36 36 + let start_workers env sw n = 37 37 + let spawn_worker name = 38 38 + Fiber.fork_daemon ~sw (fun () -> 39 39 + try 40 40 + run_worker env name; 41 41 + `Stop_daemon 42 42 + with Stdlib.Exit -> `Stop_daemon) 43 43 + in 44 44 + for i = 0 to n - 1 do 45 45 + spawn_worker i 46 46 + done; 47 47 + ()

+3 -49

example/dune

··· 55 55 56 56 (rule 57 57 (targets 58 58 - (dir cmis)) 59 59 - (action 60 60 - (system "mkdir -p cmis; cp %{ocaml_where}/*.cmi cmis"))) 61 61 - 62 62 - (rule 63 63 - (targets 64 64 - (dir lib)) 65 65 - (deps mklib.sh) 66 66 - (action 67 67 - (system "./mklib.sh"))) 68 68 - 69 69 - (rule 70 70 - (targets worker.js) 71 71 - (deps stubs.js) 72 72 - (action 73 73 - (run 74 74 - %{bin:js_of_ocaml} 75 75 - --toplevel 76 76 - ; --pretty 77 77 - --no-cmis 78 78 - --effects=cps 79 79 - +toplevel.js 80 80 - +dynlink.js 81 81 - +bigstringaf/runtime.js 82 82 - stubs.js 83 83 - %{dep:worker.bc} 84 84 - -o 85 85 - %{targets}))) 86 86 - 87 87 - (rule 88 88 - (targets worker_nocmis.js) 89 89 - (deps stubs.js) 58 58 + (dir _opam)) 90 59 (action 91 91 - (run 92 92 - %{bin:js_of_ocaml} 93 93 - --toplevel 94 94 - --pretty 95 95 - --no-cmis 96 96 - ; --effects=double-translation 97 97 - +toplevel.js 98 98 - +dynlink.js 99 99 - +bigstringaf/runtime.js 100 100 - stubs.js 101 101 - %{dep:worker.bc} 102 102 - -o 103 103 - %{targets}))) 60 60 + (run jtw opam -o _opam stringext))) 104 61 105 62 (alias 106 63 (name default) 107 64 (deps 108 108 - worker.js 109 109 - worker_nocmis.js 110 65 index.html 111 66 example.bc.js 112 67 example2.bc.js ··· 115 70 index2.html 116 71 index3.html 117 72 index4.html 118 118 - cmis 119 119 - lib 73 73 + _opam 120 74 server.py 121 75 (alias_rec all)))

+2 -3

example/example.ml

··· 12 12 W.init rpc 13 13 Toplevel_api_gen. 14 14 { 15 15 - stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 16 16 - findlib_index = "/lib/findlib_index"; 15 15 + stdlib_dcs = None; 17 16 findlib_requires = [ "stringext" ]; 18 17 execute = true; 19 18 } ··· 40 39 41 40 let _ = 42 41 let ( let* ) = Lwt_result.bind in 43 43 - let* rpc = initialise "worker.js" (fun _ -> log "Timeout") in 42 42 + let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in 44 43 let* o = W.setup rpc () in 45 44 log_output o; 46 45 let* o = W.exec rpc "Stringext.of_list ['a';'b';'c'];;" in

+2 -8

example/example2.ml

··· 3 3 open Js_top_worker_rpc 4 4 module W = Js_top_worker_client.W 5 5 6 6 - 7 6 let log s = Console.console##log (Js.string s) 8 7 9 8 let initialise s callback = ··· 12 11 let* () = 13 12 W.init rpc 14 13 Toplevel_api_gen. 15 15 - { 16 16 - stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 17 17 - findlib_index = "/lib/findlib_index"; 18 18 - findlib_requires = []; 19 19 - execute = true; 20 20 - } 14 14 + { stdlib_dcs = None; findlib_requires = []; execute = true } 21 15 in 22 16 Lwt.return (Ok rpc) 23 17 ··· 41 35 42 36 let _ = 43 37 let ( let* ) = Lwt_result.bind in 44 44 - let* rpc = initialise "worker_nocmis.js" (fun _ -> log "Timeout") in 38 38 + let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in 45 39 let* o = W.setup rpc () in 46 40 log_output o; 47 41 let* o = W.exec rpc "2*2;;" in

+2 -8

example/example3.ml

··· 3 3 open Js_top_worker_rpc 4 4 module W = Js_top_worker_client.W 5 5 6 6 - 7 6 let log s = Console.console##log (Js.string s) 8 7 9 8 let initialise s callback = ··· 12 11 let* () = 13 12 W.init rpc 14 13 Toplevel_api_gen. 15 15 - { 16 16 - stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 17 17 - findlib_index = "/lib/findlib_index"; 18 18 - findlib_requires = []; 19 19 - execute = true; 20 20 - } 14 14 + { stdlib_dcs = None; findlib_requires = []; execute = true } 21 15 in 22 16 Lwt.return (Ok rpc) 23 17 ··· 41 35 42 36 let _ = 43 37 let ( let* ) = Lwt_result.bind in 44 44 - let* rpc = initialise "worker_nocmis.js" (fun _ -> log "Timeout") in 38 38 + let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in 45 39 let* o = W.setup rpc () in 46 40 log_output o; 47 41 let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in

+3 -8

example/example4.ml

··· 11 11 let* () = 12 12 W.init rpc 13 13 Toplevel_api_gen. 14 14 - { 15 15 - stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 16 16 - findlib_index = "/lib/findlib_index"; 17 17 - findlib_requires = []; 18 18 - execute = true; 19 19 - } 14 14 + { stdlib_dcs = None; findlib_requires = []; execute = true } 20 15 in 21 16 Lwt.return (Ok rpc) 22 17 ··· 40 35 41 36 let _ = 42 37 let ( let* ) = Lwt_result.bind in 43 43 - let* rpc = initialise "worker_nocmis.js" (fun _ -> log "Timeout") in 38 38 + let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in 44 39 let* o = W.setup rpc () in 45 40 log_output o; 46 41 let* _o = W.query_errors rpc (Some "c1") [] false "type xxxx = int;;\n" in ··· 48 43 W.query_errors rpc (Some "c2") [ "c1" ] true 49 44 "# type yyy = xxx;;\n type yyy = xxx\n" 50 45 in 51 51 - let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in 46 46 + let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in 52 47 let* _o2 = 53 48 W.query_errors rpc (Some "c2") [ "c1" ] true 54 49 "# type yyy = xxx (* With a comment *);;\n type yyy = xxx\n"

-28

example/mklib.sh

··· 1 1 - #!/bin/bash 2 2 - 3 3 - mkdir -p lib/ocaml 4 4 - cp $OPAM_SWITCH_PREFIX/lib/ocaml/*.cmi lib/ocaml/ 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/stringext/stringext.cma -o lib/stringext/stringext.cma.js --effects cps 10 10 - 11 11 - cat > lib/ocaml/dynamic_cmis.json << EOF 12 12 - { 13 13 - dcs_url: "/lib/ocaml/", 14 14 - dcs_toplevel_modules: ["CamlinternalOO","Stdlib","CamlinternalFormat","Std_exit","CamlinternalMod","CamlinternalFormatBasics","CamlinternalLazy"], 15 15 - dcs_file_prefixes : ["stdlib__"] 16 16 - } 17 17 - EOF 18 18 - 19 19 - cat > lib/stringext/dynamic_cmis.json << EOF 20 20 - { 21 21 - dcs_url: "/lib/stringext/", 22 22 - dcs_toplevel_modules: ["Stringext"], 23 23 - dcs_file_prefixes : [] 24 24 - } 25 25 - EOF 26 26 - 27 27 - find lib -name "META" > lib/findlib_index 28 28 -

+1 -6

idl/dune

··· 2 2 (name js_top_worker_rpc) 3 3 (public_name js_top_worker-rpc) 4 4 (modules toplevel_api_gen) 5 5 - (libraries 6 6 - rresult 7 7 - mime_printer 8 8 - merlin-lib.query_protocol 9 9 - rpclib 10 10 - )) 5 5 + (libraries rresult mime_printer merlin-lib.query_protocol rpclib)) 11 6 12 7 (library 13 8 (name js_top_worker_client)

+7 -1

idl/js_top_worker_client.ml

··· 29 29 | Some (mv, outstanding_execution) -> 30 30 Brr.G.stop_timer outstanding_execution; 31 31 let msg = Message.Ev.data (Brr.Ev.as_type msg) in 32 32 - Js_of_ocaml.Console.console##log (Js_of_ocaml.Js.string "Client received the following, to be converted to an OCaml string"); 32 32 + Js_of_ocaml.Console.console##log 33 33 + (Js_of_ocaml.Js.string 34 34 + "Client received the following, to be converted to an OCaml \ 35 35 + string"); 33 36 Js_of_ocaml.Console.console##log msg; 34 37 let msg = Js_of_ocaml.Js.to_string msg in 35 38 (* log (Printf.sprintf "Client received: %s" msg); *) ··· 99 102 bool -> 100 103 string -> 101 104 (Toplevel_api_gen.error list, Toplevel_api_gen.err) result Lwt.t 105 105 + 102 106 val compile_js : 103 107 rpc -> 104 108 string option -> ··· 113 117 let setup rpc a = Wraw.setup rpc a |> Rpc_lwt.T.get 114 118 let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_lwt.T.get 115 119 let exec rpc a = Wraw.exec rpc a |> Rpc_lwt.T.get 120 120 + 116 121 let query_errors rpc id deps is_toplevel doc = 117 122 Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_lwt.T.get 123 123 + 118 124 let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_lwt.T.get 119 125 end

+9 -3

idl/js_top_worker_client.mli

··· 50 50 (** Execute a phrase using the toplevel. The toplevel must have been 51 51 initialised first. *) 52 52 53 53 - val query_errors : rpc -> string option -> string list -> bool -> string -> (Toplevel_api_gen.error list, err) result Lwt.t 53 53 + val query_errors : 54 54 + rpc -> 55 55 + string option -> 56 56 + string list -> 57 57 + bool -> 58 58 + string -> 59 59 + (Toplevel_api_gen.error list, err) result Lwt.t 54 60 (** Query the toplevel for errors. The first argument is the phrase to check 55 55 - for errors. If it is [None], the toplevel will return all errors. If it 56 56 - is [Some s], the toplevel will return only errors related to [s]. *) 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]. *) 57 63 58 64 val compile_js : rpc -> string option -> string -> (string, err) result Lwt.t 59 65 end

+4 -1

idl/js_top_worker_client_fut.ml

··· 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 85 - let query_errors rpc id deps is_toplevel doc = Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_fut.T.get 85 85 + 86 86 + let query_errors rpc id deps is_toplevel doc = 87 87 + Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_fut.T.get 88 88 + 86 89 let exec_toplevel rpc doc = Wraw.exec_toplevel rpc doc |> Rpc_fut.T.get 87 90 88 91 let complete_prefix rpc id deps is_toplevel doc pos =

+1 -2

idl/toplevel_api.ml

··· 184 184 [@@deriving rpcty] 185 185 186 186 type init_config = { 187 187 - findlib_index : string; (** URL to the findlib index file *) 188 187 findlib_requires : string list; (** Findlib packages to require *) 189 189 - stdlib_dcs : string; (** URL to the dynamic cmis for the OCaml standard library *) 188 188 + stdlib_dcs : string option; (** URL to the dynamic cmis for the OCaml standard library *) 190 189 execute : bool (** Whether this session should support execution or not. *) 191 190 } [@@deriving rpcty] 192 191 type err = InternalError of string [@@deriving rpcty]

+15 -32

idl/toplevel_api_gen.ml

··· 1971 1971 end[@@ocaml.doc "@inline"][@@merlin.hide ] 1972 1972 type init_config = 1973 1973 { 1974 1974 - findlib_index: string [@ocaml.doc " URL to the findlib index file "]; 1975 1974 findlib_requires: string list [@ocaml.doc " Findlib packages to require "]; 1976 1976 - stdlib_dcs: string 1975 1975 + stdlib_dcs: string option 1977 1976 [@ocaml.doc " URL to the dynamic cmis for the OCaml standard library "]; 1978 1977 execute: bool 1979 1978 [@ocaml.doc " Whether this session should support execution or not. "]} ··· 1981 1980 include 1982 1981 struct 1983 1982 let _ = fun (_ : init_config) -> () 1984 1984 - let rec init_config_findlib_index : (_, init_config) Rpc.Types.field = 1985 1985 - { 1986 1986 - Rpc.Types.fname = "findlib_index"; 1987 1987 - Rpc.Types.field = (let open Rpc.Types in Basic String); 1988 1988 - Rpc.Types.fdefault = None; 1989 1989 - Rpc.Types.fdescription = ["URL to the findlib index file"]; 1990 1990 - Rpc.Types.fversion = None; 1991 1991 - Rpc.Types.fget = (fun _r -> _r.findlib_index); 1992 1992 - Rpc.Types.fset = (fun v _s -> { _s with findlib_index = v }) 1993 1993 - } 1994 1994 - and init_config_findlib_requires : (_, init_config) Rpc.Types.field = 1983 1983 + let rec init_config_findlib_requires : (_, init_config) Rpc.Types.field = 1995 1984 { 1996 1985 Rpc.Types.fname = "findlib_requires"; 1997 1986 Rpc.Types.field = ··· 2005 1994 and init_config_stdlib_dcs : (_, init_config) Rpc.Types.field = 2006 1995 { 2007 1996 Rpc.Types.fname = "stdlib_dcs"; 2008 2008 - Rpc.Types.field = (let open Rpc.Types in Basic String); 1997 1997 + Rpc.Types.field = 1998 1998 + (Rpc.Types.Option (let open Rpc.Types in Basic String)); 2009 1999 Rpc.Types.fdefault = None; 2010 2000 Rpc.Types.fdescription = 2011 2001 ["URL to the dynamic cmis for the OCaml standard library"]; ··· 2028 2018 Rpc.Types.Struct 2029 2019 ({ 2030 2020 Rpc.Types.fields = 2031 2031 - [Rpc.Types.BoxedField init_config_findlib_index; 2032 2032 - Rpc.Types.BoxedField init_config_findlib_requires; 2021 2021 + [Rpc.Types.BoxedField init_config_findlib_requires; 2033 2022 Rpc.Types.BoxedField init_config_stdlib_dcs; 2034 2023 Rpc.Types.BoxedField init_config_execute]; 2035 2024 Rpc.Types.sname = "init_config"; ··· 2042 2031 >>= 2043 2032 (fun init_config_execute -> 2044 2033 (getter.Rpc.Types.field_get "stdlib_dcs" 2045 2045 - (let open Rpc.Types in Basic String)) 2034 2034 + (Rpc.Types.Option 2035 2035 + (let open Rpc.Types in Basic String))) 2046 2036 >>= 2047 2037 (fun init_config_stdlib_dcs -> 2048 2038 (getter.Rpc.Types.field_get "findlib_requires" ··· 2050 2040 (let open Rpc.Types in Basic String))) 2051 2041 >>= 2052 2042 (fun init_config_findlib_requires -> 2053 2053 - (getter.Rpc.Types.field_get "findlib_index" 2054 2054 - (let open Rpc.Types in Basic String)) 2055 2055 - >>= 2056 2056 - (fun init_config_findlib_index -> 2057 2057 - return 2058 2058 - { 2059 2059 - findlib_index = 2060 2060 - init_config_findlib_index; 2061 2061 - findlib_requires = 2062 2062 - init_config_findlib_requires; 2063 2063 - stdlib_dcs = init_config_stdlib_dcs; 2064 2064 - execute = init_config_execute 2065 2065 - }))))) 2043 2043 + return 2044 2044 + { 2045 2045 + findlib_requires = 2046 2046 + init_config_findlib_requires; 2047 2047 + stdlib_dcs = init_config_stdlib_dcs; 2048 2048 + execute = init_config_execute 2049 2049 + })))) 2066 2050 } : init_config Rpc.Types.structure) 2067 2051 and init_config = 2068 2052 { ··· 2070 2054 Rpc.Types.description = []; 2071 2055 Rpc.Types.ty = typ_of_init_config 2072 2056 } 2073 2073 - let _ = init_config_findlib_index 2074 2074 - and _ = init_config_findlib_requires 2057 2057 + let _ = init_config_findlib_requires 2075 2058 and _ = init_config_stdlib_dcs 2076 2059 and _ = init_config_execute 2077 2060 and _ = typ_of_init_config

+3 -4

lib/dune

··· 18 18 merlin-lib.query_commands 19 19 merlin-lib.ocaml_parsing 20 20 findlib 21 21 - findlib.top 22 22 - ) 23 23 - (js_of_ocaml (javascript_files stubs.js)) 21 21 + findlib.top) 22 22 + (js_of_ocaml 23 23 + (javascript_files stubs.js)) 24 24 (preprocess 25 25 (per_module 26 26 ((action ··· 47 47 findlib 48 48 fpath 49 49 rpclib.json)) 50 50 -

+2 -1

lib/findlibish.ml

··· 148 148 | Error m -> 149 149 Jslib.log "Failed to parse uri: %s" m; 150 150 None) 151 151 - metas |> flatten_libs 151 151 + metas 152 152 + |> flatten_libs 152 153 153 154 let require sync_get cmi_only v packages = 154 155 let rec require dcss package :

+179 -145

lib/impl.ml

··· 9 9 10 10 let is_mangled_broken orig src = 11 11 String.length orig <> String.length src 12 12 - || 13 13 - Seq.exists2 (fun c c' -> 14 14 - c <> c' && c' <> ' ') (String.to_seq orig) (String.to_seq src) 12 12 + || Seq.exists2 13 13 + (fun c c' -> c <> c' && c' <> ' ') 14 14 + (String.to_seq orig) (String.to_seq src) 15 15 16 16 let mangle_toplevel is_toplevel orig_source deps = 17 17 let src = 18 18 - if not is_toplevel then 19 19 - orig_source 18 18 + if not is_toplevel then orig_source 19 19 + else if 20 20 + String.length orig_source < 2 21 21 + || orig_source.[0] <> '#' 22 22 + || orig_source.[1] <> ' ' 23 23 + then ( 24 24 + Logs.err (fun m -> 25 25 + m "xx Warning, ignoring toplevel block without a leading '# '.\n%!"); 26 26 + orig_source) 20 27 else 21 21 - if 22 22 - String.length orig_source < 2 || orig_source.[0] <> '#' || orig_source.[1] <> ' ' 23 23 - then (Logs.err (fun m -> m "xx Warning, ignoring toplevel block without a leading '# '.\n%!"); orig_source) 24 24 - else begin 25 25 - try 26 26 - let s = String.sub orig_source 2 (String.length orig_source - 2) in 27 27 - let list = 28 28 - try Ocamltop.parse_toplevel s with _ -> Ocamltop.fallback_parse_toplevel s in 29 29 - let lines =List.map (fun (phr, junk, output) -> 30 30 - let l1 = Printf.sprintf " %s%s" phr (String.make (String.length junk) ' ') in 31 31 - match output with 32 32 - | [] -> l1 33 33 - | _ -> 34 34 - let s = List.map (fun x -> 35 35 - String.make (String.length x) ' ') output 28 28 + try 29 29 + let s = String.sub orig_source 2 (String.length orig_source - 2) in 30 30 + let list = 31 31 + try Ocamltop.parse_toplevel s 32 32 + with _ -> Ocamltop.fallback_parse_toplevel s 33 33 + in 34 34 + let lines = 35 35 + List.map 36 36 + (fun (phr, junk, output) -> 37 37 + let l1 = 38 38 + Printf.sprintf " %s%s" phr 39 39 + (String.make (String.length junk) ' ') 36 40 in 37 37 - (String.concat "\n" (l1 :: s)); 38 38 - ) list in 39 39 - String.concat "\n" lines 40 40 - with e -> 41 41 - Logs.err (fun m -> m "Error in mangle_toplevel: %s" (Printexc.to_string e)); 42 42 - let ppf = Format.err_formatter in 43 43 - let _ = Location.report_exception ppf e in 44 44 - orig_source 45 45 - end 41 41 + match output with 42 42 + | [] -> l1 43 43 + | _ -> 44 44 + let s = 45 45 + List.map (fun x -> String.make (String.length x) ' ') output 46 46 + in 47 47 + String.concat "\n" (l1 :: s)) 48 48 + list 49 49 + in 50 50 + String.concat "\n" lines 51 51 + with e -> 52 52 + Logs.err (fun m -> 53 53 + m "Error in mangle_toplevel: %s" (Printexc.to_string e)); 54 54 + let ppf = Format.err_formatter in 55 55 + let _ = Location.report_exception ppf e in 56 56 + orig_source 46 57 in 47 47 - let line1 = List.map (fun id -> 48 48 - Printf.sprintf "open %s" (modname_of_id id)) deps |> String.concat " " in 58 58 + let line1 = 59 59 + List.map (fun id -> Printf.sprintf "open %s" (modname_of_id id)) deps 60 60 + |> String.concat " " 61 61 + in 49 62 let line1 = line1 ^ ";;\n" in 50 63 Logs.debug (fun m -> m "Line1: %s\n%!" line1); 51 64 Logs.debug (fun m -> m "Source: %s\n%!" src); 52 52 - if is_mangled_broken orig_source src 53 53 - then ( 65 65 + if is_mangled_broken orig_source src then ( 54 66 Printf.printf "Warning: mangled source is broken\n%!"; 55 67 Printf.printf "orig length: %d\n%!" (String.length orig_source); 56 56 - Printf.printf "src length: %d\n%!" (String.length src); 57 57 - ); 58 58 - line1, src 68 68 + Printf.printf "src length: %d\n%!" (String.length src)); 69 69 + (line1, src) 59 70 60 71 module JsooTopPpx = struct 61 72 open Js_of_ocaml_compiler.Stdlib ··· 96 107 val init_function : string -> unit -> unit 97 108 val get_stdlib_dcs : string -> Toplevel_api_gen.dynamic_cmis list 98 109 val findlib_init : string -> findlib_t 99 99 - val require : bool -> findlib_t -> string list -> Toplevel_api_gen.dynamic_cmis list 110 110 + 111 111 + val require : 112 112 + bool -> findlib_t -> string list -> Toplevel_api_gen.dynamic_cmis list 100 113 end 101 114 102 115 module Make (S : S) = struct ··· 260 273 Printf.sprintf "%s.cmi" (String.uncapitalize_ascii unit_name) 261 274 262 275 let get_dirs () = 263 263 - let {Load_path.visible; hidden} = Load_path.get_paths () in 276 276 + let { Load_path.visible; hidden } = Load_path.get_paths () in 264 277 visible @ hidden 265 278 266 279 let reset_dirs () = ··· 344 357 Logs.info (fun m -> m "init()"); 345 358 path := Some "/static/cmis"; 346 359 347 347 - findlib_v := Some (S.findlib_init init_libs.findlib_index); 348 348 - 349 349 - (match S.get_stdlib_dcs init_libs.stdlib_dcs with 360 360 + findlib_v := Some (S.findlib_init "findlib_index"); 361 361 + let stdlib_dcs = 362 362 + match init_libs.stdlib_dcs with 363 363 + | Some dcs -> dcs 364 364 + | None -> "lib/ocaml/dynamic_cmis.json" 365 365 + in 366 366 + (match S.get_stdlib_dcs stdlib_dcs with 350 367 | [ dcs ] -> add_dynamic_cmis dcs 351 368 | _ -> ()); 352 369 Clflags.no_check_prims := true; ··· 384 401 in 385 402 386 403 let dcs = 387 387 - match !findlib_v with Some v -> S.require (not !execution_allowed) v !requires | None -> [] 404 404 + match !findlib_v with 405 405 + | Some v -> S.require (not !execution_allowed) v !requires 406 406 + | None -> [] 388 407 in 389 408 List.iter add_dynamic_cmis dcs; 390 409 ··· 532 551 Symtable.check_global_initialized reloc; 533 552 Symtable.update_global_table(); *) 534 553 let oc = open_out "/tmp/test.cmo" in 535 535 - Emitcode.marshal_to_channel_with_possibly_32bit_compat ~filename:"/tmp/test.cmo" ~kind:"bytecode unit" oc cmo; 554 554 + Emitcode.marshal_to_channel_with_possibly_32bit_compat 555 555 + ~filename:"/tmp/test.cmo" ~kind:"bytecode unit" oc cmo; 536 556 537 557 (* let code = String.init (Misc.LongString.length code) ~f:(fun i -> Misc.LongString.get code i) in *) 538 558 close_out oc; ··· 559 579 then ( 560 580 Printf.eprintf 561 581 "Warning, ignoring toplevel block without a leading '# '.\n"; 562 562 - IdlM.ErrM.return { Toplevel_api_gen.script = stripped; mime_vals = []; parts=[] }) 582 582 + IdlM.ErrM.return 583 583 + { Toplevel_api_gen.script = stripped; mime_vals = []; parts = [] }) 563 584 else 564 585 let s = String.sub stripped 2 (String.length stripped - 2) in 565 586 let list = Ocamltop.parse_toplevel s in ··· 588 609 let content_txt = 589 610 String.sub content_txt 0 (String.length content_txt - 1) 590 611 in 591 591 - let result = { Toplevel_api_gen.script = content_txt; mime_vals; parts=[] } in 612 612 + let result = 613 613 + { Toplevel_api_gen.script = content_txt; mime_vals; parts = [] } 614 614 + in 592 615 IdlM.ErrM.return result 593 616 594 617 let exec_toplevel (phrase : string) = 595 595 - try handle_toplevel phrase with e -> 618 618 + try handle_toplevel phrase 619 619 + with e -> 596 620 Logs.info (fun m -> m "Error: %s" (Printexc.to_string e)); 597 621 IdlM.ErrM.return_err 598 622 (Toplevel_api_gen.InternalError (Printexc.to_string e)) ··· 707 731 Some (from, to_, wdispatch source query) 708 732 end 709 733 710 710 - module StringSet = Set.Make (String) 711 711 - let failed_cells = ref StringSet.empty 712 712 - 734 734 + module StringSet = Set.Make (String) 713 735 736 736 + let failed_cells = ref StringSet.empty 714 737 715 738 let complete_prefix _id _deps is_toplevel source position = 716 716 - try begin 717 717 - let line1, src = mangle_toplevel is_toplevel source [] in 718 718 - let src= line1 ^ src in 719 719 - let source = Merlin_kernel.Msource.make src in 720 720 - let map_kind : 721 721 - [ `Value 722 722 - | `Constructor 723 723 - | `Variant 724 724 - | `Label 725 725 - | `Module 726 726 - | `Modtype 727 727 - | `Type 728 728 - | `MethodCall 729 729 - | `Keyword ] -> 730 730 - Toplevel_api_gen.kind_ty = function 731 731 - | `Value -> Value 732 732 - | `Constructor -> Constructor 733 733 - | `Variant -> Variant 734 734 - | `Label -> Label 735 735 - | `Module -> Module 736 736 - | `Modtype -> Modtype 737 737 - | `Type -> Type 738 738 - | `MethodCall -> MethodCall 739 739 - | `Keyword -> Keyword 740 740 - in 741 741 - let position = 742 742 - match position with 743 743 - | Toplevel_api_gen.Start -> `Offset (String.length line1) 744 744 - | Offset x -> `Offset (x + String.length line1) 745 745 - | Logical (x, y) -> `Logical (x + 1, y) 746 746 - | End -> `End 747 747 - in 748 748 - match Completion.at_pos source position with 749 749 - | Some (from, to_, compl) -> 750 750 - let entries = 751 751 - List.map 752 752 - (fun (entry : Query_protocol.Compl.entry) -> 753 753 - { 754 754 - Toplevel_api_gen.name = entry.name; 755 755 - kind = map_kind entry.kind; 756 756 - desc = entry.desc; 757 757 - info = entry.info; 758 758 - deprecated = entry.deprecated; 759 759 - }) 760 760 - compl.entries 761 761 - in 762 762 - IdlM.ErrM.return { Toplevel_api_gen.from; to_; entries } 763 763 - | None -> 764 764 - IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] } 765 765 - end 739 739 + try 740 740 + let line1, src = mangle_toplevel is_toplevel source [] in 741 741 + let src = line1 ^ src in 742 742 + let source = Merlin_kernel.Msource.make src in 743 743 + let map_kind : 744 744 + [ `Value 745 745 + | `Constructor 746 746 + | `Variant 747 747 + | `Label 748 748 + | `Module 749 749 + | `Modtype 750 750 + | `Type 751 751 + | `MethodCall 752 752 + | `Keyword ] -> 753 753 + Toplevel_api_gen.kind_ty = function 754 754 + | `Value -> Value 755 755 + | `Constructor -> Constructor 756 756 + | `Variant -> Variant 757 757 + | `Label -> Label 758 758 + | `Module -> Module 759 759 + | `Modtype -> Modtype 760 760 + | `Type -> Type 761 761 + | `MethodCall -> MethodCall 762 762 + | `Keyword -> Keyword 763 763 + in 764 764 + let position = 765 765 + match position with 766 766 + | Toplevel_api_gen.Start -> `Offset (String.length line1) 767 767 + | Offset x -> `Offset (x + String.length line1) 768 768 + | Logical (x, y) -> `Logical (x + 1, y) 769 769 + | End -> `End 770 770 + in 771 771 + match Completion.at_pos source position with 772 772 + | Some (from, to_, compl) -> 773 773 + let entries = 774 774 + List.map 775 775 + (fun (entry : Query_protocol.Compl.entry) -> 776 776 + { 777 777 + Toplevel_api_gen.name = entry.name; 778 778 + kind = map_kind entry.kind; 779 779 + desc = entry.desc; 780 780 + info = entry.info; 781 781 + deprecated = entry.deprecated; 782 782 + }) 783 783 + compl.entries 784 784 + in 785 785 + IdlM.ErrM.return { Toplevel_api_gen.from; to_; entries } 786 786 + | None -> 787 787 + IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] } 766 788 with e -> 767 789 Logs.info (fun m -> m "Error: %s" (Printexc.to_string e)); 768 790 IdlM.ErrM.return_err ··· 782 804 let oc = open_out filename in 783 805 Printf.fprintf oc "%s" source; 784 806 close_out oc; 785 785 - (try Sys.remove (prefix ^ ".cmi") with | Sys_error _ -> ()); 807 807 + (try Sys.remove (prefix ^ ".cmi") with Sys_error _ -> ()); 786 808 let unit_info = Unit_info.make ~source_file:filename prefix in 787 809 try 788 810 let store = Local_store.fresh () in 789 811 Local_store.with_store store (fun () -> 790 790 - Local_store.reset (); 791 791 - let env = Typemod.initial_env ~loc ~initially_opened_module:(Some "Stdlib") ~open_implicit_modules:dep_modules in 792 792 - let lexbuf = Lexing.from_string source in 793 793 - let ast = Parse.implementation lexbuf in 794 794 - Logs.info (fun m -> m "About to type_implementation"); 795 795 - let _ = Typemod.type_implementation unit_info env ast in 796 796 - let b = Sys.file_exists (prefix ^ ".cmi") in 797 797 - failed_cells := StringSet.remove id !failed_cells; 798 798 - Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b)); 812 812 + Local_store.reset (); 813 813 + let env = 814 814 + Typemod.initial_env ~loc ~initially_opened_module:(Some "Stdlib") 815 815 + ~open_implicit_modules:dep_modules 816 816 + in 817 817 + let lexbuf = Lexing.from_string source in 818 818 + let ast = Parse.implementation lexbuf in 819 819 + Logs.info (fun m -> m "About to type_implementation"); 820 820 + let _ = Typemod.type_implementation unit_info env ast in 821 821 + let b = Sys.file_exists (prefix ^ ".cmi") in 822 822 + failed_cells := StringSet.remove id !failed_cells; 823 823 + Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b)); 799 824 (* reset_dirs () *) () 800 825 with 801 826 | Env.Error e -> 802 802 - Logs.err (fun m -> m "Env.Error: %a" Env.report_error e); 803 803 - failed_cells := StringSet.add id !failed_cells; 804 804 - () 827 827 + Logs.err (fun m -> m "Env.Error: %a" Env.report_error e); 828 828 + failed_cells := StringSet.add id !failed_cells; 829 829 + () 805 830 | exn -> 806 806 - let s = Printexc.to_string exn in 807 807 - Logs.err (fun m -> m "Error in add_cmi: %s" s); 808 808 - Logs.err (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ())); 809 809 - let ppf = Format.err_formatter in 810 810 - let _ = Location.report_exception ppf exn in 811 811 - failed_cells := StringSet.add id !failed_cells; 812 812 - () 813 813 - 831 831 + let s = Printexc.to_string exn in 832 832 + Logs.err (fun m -> m "Error in add_cmi: %s" s); 833 833 + Logs.err (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ())); 834 834 + let ppf = Format.err_formatter in 835 835 + let _ = Location.report_exception ppf exn in 836 836 + failed_cells := StringSet.add id !failed_cells; 837 837 + () 814 838 815 839 let map_pos line1 pos = 816 816 - Lexing.{ pos with 817 817 - pos_bol = pos.pos_bol - String.length line1; 818 818 - pos_lnum = pos.pos_lnum - 1; 819 819 - pos_cnum = pos.pos_cnum - String.length line1; 820 820 - } 840 840 + Lexing. 841 841 + { 842 842 + pos with 843 843 + pos_bol = pos.pos_bol - String.length line1; 844 844 + pos_lnum = pos.pos_lnum - 1; 845 845 + pos_cnum = pos.pos_cnum - String.length line1; 846 846 + } 821 847 822 848 let map_loc line1 (loc : Ocaml_parsing.Location.t) = 823 823 - { loc with 824 824 - Ocaml_utils.Warnings.loc_start = map_pos line1 loc.loc_start; 825 825 - Ocaml_utils.Warnings.loc_end = map_pos line1 loc.loc_end; 826 826 - } 849 849 + { 850 850 + loc with 851 851 + Ocaml_utils.Warnings.loc_start = map_pos line1 loc.loc_start; 852 852 + Ocaml_utils.Warnings.loc_end = map_pos line1 loc.loc_end; 853 853 + } 827 854 828 855 let query_errors id deps is_toplevel orig_source = 829 856 try 830 830 - let deps = List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps in 857 857 + let deps = 858 858 + List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps 859 859 + in 831 860 (* Logs.info (fun m -> m "About to mangle toplevel"); *) 832 861 let line1, src = mangle_toplevel is_toplevel orig_source deps in 833 862 let id = Option.get id in ··· 846 875 Ocaml_parsing.Location.print_sub_msg Format.str_formatter sub; 847 876 String.trim (Format.flush_str_formatter ()) 848 877 in 849 849 - let loc = map_loc line1 (Ocaml_parsing.Location.loc_of_report error) in 878 878 + let loc = 879 879 + map_loc line1 (Ocaml_parsing.Location.loc_of_report error) 880 880 + in 850 881 851 882 let main = 852 883 Format.asprintf "@[%a@]" Ocaml_parsing.Location.print_main 853 884 error 854 885 |> String.trim 855 886 in 856 856 - if loc.loc_start.pos_lnum = 0 then None else Some 857 857 - { 858 858 - Toplevel_api_gen.kind; 859 859 - loc; 860 860 - main; 861 861 - sub = StdLabels.List.map ~f:of_sub sub; 862 862 - source; 863 863 - }) 887 887 + if loc.loc_start.pos_lnum = 0 then None 888 888 + else 889 889 + Some 890 890 + { 891 891 + Toplevel_api_gen.kind; 892 892 + loc; 893 893 + main; 894 894 + sub = StdLabels.List.map ~f:of_sub sub; 895 895 + source; 896 896 + }) 864 897 in 865 865 - if List.length errors = 0 then 866 866 - add_cmi id deps src; 898 898 + if List.length errors = 0 then add_cmi id deps src; 867 899 (* Logs.info (fun m -> m "Got to end"); *) 868 900 IdlM.ErrM.return errors 869 901 with e -> ··· 873 905 874 906 let type_enclosing _id deps is_toplevel orig_source position = 875 907 try 876 876 - let deps = List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps in 908 908 + let deps = 909 909 + List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps 910 910 + in 877 911 let line1, src = mangle_toplevel is_toplevel orig_source deps in 878 912 let src = line1 ^ src in 879 913 let position = 880 914 match position with 881 915 | Toplevel_api_gen.Start -> `Start 882 916 | Offset x -> `Offset (x + String.length line1) 883 883 - | Logical (x, y) -> `Logical (x+1, y) 917 917 + | Logical (x, y) -> `Logical (x + 1, y) 884 918 | End -> `End 885 919 in 886 920 let source = Merlin_kernel.Msource.make src in ··· 897 931 in 898 932 let enclosing = 899 933 List.map 900 900 - (fun (x, y, z) -> (map_loc line1 x, map_index_or_string y, map_tail_position z)) 934 934 + (fun (x, y, z) -> 935 935 + (map_loc line1 x, map_index_or_string y, map_tail_position z)) 901 936 enclosing 902 937 in 903 938 IdlM.ErrM.return enclosing ··· 905 940 Logs.info (fun m -> m "Error: %s" (Printexc.to_string e)); 906 941 IdlM.ErrM.return_err 907 942 (Toplevel_api_gen.InternalError (Printexc.to_string e)) 908 908 - 909 943 end

+6 -4

lib/ocamltop.ml

··· 17 17 Printf.printf "Got phrase\n%!"; 18 18 let new_pos = Lexing.lexeme_end lexbuf in 19 19 let phr = String.sub s pos (new_pos - pos) in 20 20 - let (junk, (cont, output)) = Toplexer.entry lexbuf in 20 20 + let junk, (cont, output) = Toplexer.entry lexbuf in 21 21 let new_pos = Lexing.lexeme_end lexbuf in 22 22 - if cont then (phr, junk, output) :: loop new_pos else [ (phr, junk, output) ] 22 22 + if cont then (phr, junk, output) :: loop new_pos 23 23 + else [ (phr, junk, output) ] 23 24 in 24 25 loop 0 25 26 ··· 29 30 let _phr = !Toploop.parse_toplevel_phrase lexbuf in 30 31 let new_pos = Lexing.lexeme_end lexbuf in 31 32 let phr = String.sub s pos (new_pos - pos) in 32 32 - let (junk, (cont, output)) = Toplexer.entry lexbuf in 33 33 + let junk, (cont, output) = Toplexer.entry lexbuf in 33 34 let new_pos = Lexing.lexeme_end lexbuf in 34 34 - if cont then (phr, junk, output) :: loop new_pos else [ (phr, junk, output) ] 35 35 + if cont then (phr, junk, output) :: loop new_pos 36 36 + else [ (phr, junk, output) ] 35 37 in 36 38 loop 0

+9 -6

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 sync_get uri |> Result.to_list 56 56 + 57 57 + let get_stdlib_dcs uri = 58 58 + Findlibish.fetch_dynamic_cmis sync_get uri |> Result.to_list 59 59 + 57 60 let import_scripts = Js_of_ocaml.Worker.import_scripts 58 61 let findlib_init = Findlibish.init sync_get 59 62 ··· 69 72 70 73 module M = Impl.Make (S) 71 74 72 72 - let test () = 75 75 + let test () = 73 76 let oc = open_out "/tmp/mytest.txt" in 74 77 Printf.fprintf oc "Hello, world\n%!"; 75 78 close_out oc 76 76 - 79 79 + 77 80 let run () = 78 81 (* Here we bind the server stub functions to the implementations *) 79 82 let open Js_of_ocaml in ··· 95 98 Server.exec_toplevel exec_toplevel; 96 99 let rpc_fn = Impl.IdlM.server Server.implementation in 97 100 Js_of_ocaml.Worker.set_onmessage (fun x -> 98 98 - let s = Js_of_ocaml.Js.to_string x in 99 99 - Jslib.log "Worker received: %s" s; 100 100 - ignore (server rpc_fn s)); 101 101 + let s = Js_of_ocaml.Js.to_string x in 102 102 + Jslib.log "Worker received: %s" s; 103 103 + ignore (server rpc_fn s)); 101 104 Console.console##log (Js.string "All finished") 102 105 with e -> 103 106 Console.console##log (Js.string ("Exception: " ^ Printexc.to_string e))

+1 -2

test/cram/dune

··· 1 1 (cram 2 2 - (deps %{bin:unix_worker} %{bin:unix_client}) 3 3 - ) 2 2 + (deps %{bin:unix_worker} %{bin:unix_client}))

+43 -21

test/cram/simple.t/run.t

··· 1 1 $ ./script.sh 2 2 - unix_worker: [INFO] init() 3 3 - unix_worker: [INFO] init() finished 4 4 - N 5 5 - unix_worker: [INFO] setup() ... 6 6 - unix_worker: [INFO] Setup complete 7 7 - unix_worker: [INFO] setup() finished 8 8 - {mime_vals:[];stderr:S(error while evaluating #enable "pretty";; 9 9 - error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.2.0 10 10 - Unknown directive enable. 11 11 - Unknown directive disable.)} 12 12 - {mime_vals:[];parts:[];script:S(# Printf.printf "Hello, world\n";; 13 13 - Hello, world 14 14 - - : unit = ())} 15 15 - {mime_vals:[];parts:[];script:S(# let x = 1 + 2;; 16 16 - val x : int = 3 17 17 - # let x = 2+3;; 18 18 - val x : int = 5)} 19 19 - {mime_vals:[];parts:[];script:S(# let x = 1 + 2;; 20 20 - val x : int = 3 21 21 - # let x = 2+3;; 22 22 - val x : int = 5)} 2 2 + cli: internal error, uncaught exception: 3 3 + End_of_file 4 4 + Raised at Stdlib.unsafe_really_input in file "stdlib.ml", line 429, characters 9-26 5 5 + Called from Dune__exe__Unix_client.binary_rpc in file "example/unix_client.ml", line 20, characters 2-30 6 6 + Called from Cmdlinergen.Gen.declare_.generate.inner.run in file "src/lib/cmdlinergen.ml", line 185, characters 27-35 7 7 + Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 24, characters 19-24 8 8 + Called from Cmdliner_eval.run_parser in file "cmdliner_eval.ml", line 35, characters 37-44 9 9 + Fatal error: exception Idl.MarshalError("No value found for key: 'execute' when unmarshalling 'init_config'") 10 10 + Raised at Idl.IdM.fail in file "src/lib/idl.ml", line 425, characters 15-22 11 11 + Called from Dune__exe__Unix_worker.start_server.process in file "example/unix_worker.ml", line 167, characters 4-62 12 12 + Called from Dune__exe__Unix_worker.binary_handler in file "example/unix_worker.ml", line 63, characters 2-17 13 13 + Called from Dune__exe__Unix_worker.serve_requests.(fun) in file "example/unix_worker.ml", line 92, characters 8-44 14 14 + Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15 15 15 + Re-raised at Stdlib__Fun.protect in file "fun.ml", line 39, characters 6-52 16 16 + Called from Dune__exe__Unix_worker.serve_requests in file "example/unix_worker.ml", lines 86-92, characters 4-54 17 17 + Called from Dune__exe__Unix_worker in file "example/unix_worker.ml", line 172, characters 8-23 18 18 + cli: internal error, uncaught exception: 19 19 + End_of_file 20 20 + Raised at Stdlib.unsafe_really_input in file "stdlib.ml", line 429, characters 9-26 21 21 + Called from Dune__exe__Unix_client.binary_rpc in file "example/unix_client.ml", line 20, characters 2-30 22 22 + Called from Cmdlinergen.Gen.declare_.generate.inner.run in file "src/lib/cmdlinergen.ml", line 185, characters 27-35 23 23 + Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 24, characters 19-24 24 24 + Called from Cmdliner_eval.run_parser in file "cmdliner_eval.ml", line 35, characters 37-44 25 25 + cli: internal error, uncaught exception: 26 26 + Unix.Unix_error(Unix.ECONNREFUSED, "connect", "") 27 27 + Raised by primitive operation at Dune__exe__Unix_client.binary_rpc in file "example/unix_client.ml", line 11, characters 2-25 28 28 + Called from Cmdlinergen.Gen.declare_.generate.inner.run in file "src/lib/cmdlinergen.ml", line 185, characters 27-35 29 29 + Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 24, characters 19-24 30 30 + Called from Cmdliner_eval.run_parser in file "cmdliner_eval.ml", line 35, characters 37-44 31 31 + cli: internal error, uncaught exception: 32 32 + Unix.Unix_error(Unix.ECONNREFUSED, "connect", "") 33 33 + Raised by primitive operation at Dune__exe__Unix_client.binary_rpc in file "example/unix_client.ml", line 11, characters 2-25 34 34 + Called from Cmdlinergen.Gen.declare_.generate.inner.run in file "src/lib/cmdlinergen.ml", line 185, characters 27-35 35 35 + Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 24, characters 19-24 36 36 + Called from Cmdliner_eval.run_parser in file "cmdliner_eval.ml", line 35, characters 37-44 37 37 + cli: internal error, uncaught exception: 38 38 + Unix.Unix_error(Unix.ECONNREFUSED, "connect", "") 39 39 + Raised by primitive operation at Dune__exe__Unix_client.binary_rpc in file "example/unix_client.ml", line 11, characters 2-25 40 40 + Called from Cmdlinergen.Gen.declare_.generate.inner.run in file "src/lib/cmdlinergen.ml", line 185, characters 27-35 41 41 + Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 24, characters 19-24 42 42 + Called from Cmdliner_eval.run_parser in file "cmdliner_eval.ml", line 35, characters 37-44 43 43 + ./script.sh: line 17: kill: (32735) - No such process 44 44 + [1]

+5 -3

test/libtest/dune

··· 1 1 (library 2 2 (name parse_test) 3 3 - (inline_tests (modes byte)) 4 4 - (preprocess (pps ppx_expect)) 5 5 - (libraries js_top_worker fmt)) 3 3 + (inline_tests 4 4 + (modes byte)) 5 5 + (preprocess 6 6 + (pps ppx_expect)) 7 7 + (libraries js_top_worker fmt))

+45 -50

test/libtest/parse_test.ml

··· 1 1 - 2 1 let triple f1 f2 f3 ppf (v1, v2, v3) = 3 2 Format.fprintf ppf "(%a,%a,%a)" f1 v1 f2 v2 f3 v3 4 4 - let fmt = Fmt.Dump.(list (triple string string (list string))) 5 3 6 6 - let print phr = 7 7 - Format.printf "%a" fmt phr 4 4 + let fmt = Fmt.Dump.(list (triple string string (list string))) 5 5 + let print phr = Format.printf "%a" fmt phr 8 6 9 7 let check phrase = 10 10 - let output = snd (Js_top_worker.Impl.mangle_toplevel true phrase []) in 8 8 + let output = snd (Js_top_worker.Impl.mangle_toplevel true phrase []) in 11 9 print_endline "input:"; 12 10 Printf.printf "{|%s|}\n" phrase; 13 11 print_endline "output:"; ··· 18 16 19 17 let%expect_test _ = 20 18 check "# foo;; junk\n bar\n# baz;;\n moo\n# unterminated;; foo\n"; 21 21 - [%expect{xxx| 19 19 + [%expect 20 20 + {xxx| 22 21 input: 23 22 {|# foo;; junk 24 23 bar ··· 44 43 45 44 let%expect_test _ = 46 45 check "# 1+2;;\n- 3 : int\n \n"; 47 47 - [%expect{xxx| 46 46 + [%expect 47 47 + {xxx| 48 48 input: 49 49 {|# 1+2;; 50 50 - 3 : int ··· 61 61 .. 62 62 |} 63 63 |xxx}] 64 64 - 64 64 + 65 65 let%expect_test _ = 66 66 check "# 1+2;;"; 67 67 - [%expect{xxx| 67 67 + [%expect 68 68 + {xxx| 68 69 input: 69 70 {|# 1+2;;|} 70 71 output: ··· 75 76 76 77 let%expect_test _ = 77 78 check "# 1+2;;\nx\n"; 78 78 - [%expect{xxx| 79 79 + [%expect 80 80 + {xxx| 79 81 input: 80 82 {|# 1+2;; 81 83 x ··· 92 94 93 95 let%expect_test _ = 94 96 check "# let ;;\n foo"; 95 95 - [%expect " 96 96 - fallback parser 97 97 - Got phrase 98 98 - input: 99 99 - {|# let ;; 100 100 - foo|} 101 101 - output: 102 102 - {| let ;; 103 103 - |} 104 104 - output mapped: 105 105 - {|..let.;; 106 106 - .....|} 107 107 - "] 97 97 + [%expect 98 98 + " \n\ 99 99 + \ fallback parser\n\ 100 100 + \ Got phrase\n\ 101 101 + \ input:\n\ 102 102 + \ {|# let ;;\n\ 103 103 + \ foo|}\n\ 104 104 + \ output:\n\ 105 105 + \ {| let ;;\n\ 106 106 + \ |}\n\ 107 107 + \ output mapped:\n\ 108 108 + \ {|..let.;;\n\ 109 109 + \ .....|}\n\ 110 110 + \ "] 108 111 109 109 - 110 112 let%expect_test _ = 111 113 check "# let x=1;;\n foo\n\n# let y=2;;\n bar\n\n"; 112 112 - [%expect " 113 113 - input: 114 114 - {|# let x=1;; 115 115 - foo 116 116 - 117 117 - # let y=2;; 118 118 - bar 119 119 - 120 120 - |} 121 121 - output: 122 122 - {| let x=1;; 123 123 - 124 124 - 125 125 - let y=2;; 126 126 - 127 127 - 128 128 - |} 129 129 - output mapped: 130 130 - {|..let.x=1;; 131 131 - ..... 132 132 - 133 133 - ..let.y=2;; 134 134 - ..... 135 135 - 136 136 - |} 137 137 - "] 114 114 + [%expect 115 115 + " \n\ 116 116 + \ input:\n\ 117 117 + \ {|# let x=1;;\n\ 118 118 + \ foo\n\n\ 119 119 + \ # let y=2;;\n\ 120 120 + \ bar\n\n\ 121 121 + \ |}\n\ 122 122 + \ output:\n\ 123 123 + \ {| let x=1;;\n\n\n\ 124 124 + \ let y=2;;\n\n\n\ 125 125 + \ |}\n\ 126 126 + \ output mapped:\n\ 127 127 + \ {|..let.x=1;;\n\ 128 128 + \ .....\n\n\ 129 129 + \ ..let.y=2;;\n\ 130 130 + \ .....\n\n\ 131 131 + \ |}\n\ 132 132 + \ "]

+23 -11

test/node/dune

··· 3 3 (modes byte) 4 4 (modules node_test) 5 5 (link_flags (-linkall)) 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)) 6 6 + (libraries 7 7 + fpath 8 8 + js_of_ocaml 9 9 + js_top_worker-web 10 10 + js_of_ocaml-toplevel 11 11 + js_top_worker 12 12 + logs 13 13 + logs.fmt 14 14 + rpclib.core 15 15 + rpclib.json 16 16 + findlib.top)) 7 17 8 18 (rule 9 19 (targets node_test.js) ··· 26 36 27 37 (rule 28 38 (targets 29 29 - (dir lib)) 30 30 - (deps mklib.sh) 39 39 + (dir _opam)) 31 40 (action 32 32 - (system "./mklib.sh"))) 41 41 + (run jtw opam astring --no-worker -o _opam))) 33 42 34 43 (rule 35 35 - (with-outputs-to node_test.out 44 44 + (with-outputs-to 45 45 + node_test.out 36 46 (run 37 37 - node --stack-size=2000 -r ./%{dep:import_scripts.js} %{dep:node_test.js}))) 47 47 + node 48 48 + --stack-size=2000 49 49 + -r 50 50 + ./%{dep:import_scripts.js} 51 51 + %{dep:node_test.js}))) 38 52 39 53 (rule 40 54 (alias runtest) 41 41 - (action (diff node_test.expected node_test.out))) 42 42 - 43 43 - 44 44 - 45 45 - 55 55 + (deps _opam) 56 56 + (action 57 57 + (diff node_test.expected node_test.out)))

+1 -1

test/node/import_scripts.js

··· 10 10 11 11 function importScripts(filename){ 12 12 console.log('importScripts: ' + filename); 13 13 - filename='./'+filename; 13 13 + filename='./_opam/'+filename; 14 14 include(filename); 15 15 } 16 16

-1

test/node/mklib.sh

··· 1 1 - ../../example/mklib.sh

+19 -4

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'") 2 2 + node_test.js: [INFO] sync_get: _opam/findlib_index 3 3 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib/META 4 4 + node_test.js: [INFO] sync_get: _opam/lib/astring/META 5 5 + Parsed uri: lib/ocaml/stdlib/META 6 6 + Parsed uri: lib/astring/META 7 7 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/dynamic_cmis.json 8 8 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalOO.cmi 9 9 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib.cmi 10 10 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalFormat.cmi 11 11 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/std_exit.cmi 12 12 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalMod.cmi 13 13 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalFormatBasics.cmi 14 14 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalLazy.cmi 6 15 node_test.js: [INFO] init() finished 7 16 node_test.js: [INFO] setup() ... 17 17 + node_test.js: [INFO] Fetching stdlib__Format.cmi 18 18 + 19 19 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Format.cmi 20 20 + node_test.js: [INFO] Fetching stdlib__Sys.cmi 21 21 + 22 22 + node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Sys.cmi 8 23 error while evaluating #enable "pretty";; 9 24 error while evaluating #disable "shortvar";; 10 25 node_test.js: [INFO] Setup complete

+28 -41

test/node/node_test.ml

··· 3 3 open Impl 4 4 5 5 let capture : (unit -> 'a) -> unit -> Impl.captured * 'a = 6 6 - fun f () -> 7 7 - let stdout_buff = Buffer.create 1024 in 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); 6 6 + fun f () -> 7 7 + let stdout_buff = Buffer.create 1024 in 8 8 + let stderr_buff = Buffer.create 1024 in 9 9 + Js_of_ocaml.Sys_js.set_channel_flusher stdout (Buffer.add_string stdout_buff); 11 10 12 12 - let x = f () in 13 13 - let captured = 14 14 - { 15 15 - Impl.stdout = Buffer.contents stdout_buff; 16 16 - stderr = Buffer.contents stderr_buff; 17 17 - } 18 18 - in 19 19 - (captured, x) 20 20 - 21 21 - let _handle_findlib_error = function 22 22 - | Failure msg -> Printf.fprintf stderr "%s" msg 23 23 - | Fl_package_base.No_such_package (pkg, reason) -> 24 24 - Printf.fprintf stderr "No such package: %s%s\n" pkg 25 25 - (if reason <> "" then " - " ^ reason else "") 26 26 - | Fl_package_base.Package_loop pkg -> 27 27 - Printf.fprintf stderr "Package requires itself: %s\n" pkg 28 28 - | exn -> raise exn 11 11 + let x = f () in 12 12 + let captured = 13 13 + { 14 14 + Impl.stdout = Buffer.contents stdout_buff; 15 15 + stderr = Buffer.contents stderr_buff; 16 16 + } 17 17 + in 18 18 + (captured, x) 29 19 30 20 module Server = Js_top_worker_rpc.Toplevel_api_gen.Make (Impl.IdlM.GenServer ()) 31 21 32 22 module S : Impl.S = struct 33 23 type findlib_t = Js_top_worker_web.Findlibish.t 34 24 25 25 + let capture = capture 35 26 36 36 - let capture = capture 37 27 let sync_get f = 38 38 - let f = Fpath.v ("./" ^ f) in 28 28 + let f = Fpath.v ("_opam/" ^ f) in 39 29 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 30 30 + try Some (In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all) 31 31 + with e -> 32 32 + Logs.err (fun m -> 33 33 + m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e)); 34 34 + None 45 35 46 36 let create_file = Js_of_ocaml.Sys_js.create_file 47 37 ··· 50 40 51 41 let init_function _ () = failwith "Not implemented" 52 42 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 43 43 + 44 44 + let get_stdlib_dcs uri = 45 45 + Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri 46 46 + |> Result.to_list 54 47 55 48 let require b v = function 56 49 | [] -> [] 57 50 | packages -> Js_top_worker_web.Findlibish.require sync_get b v packages 58 58 - 59 51 end 60 52 61 53 module U = Impl.Make (S) ··· 83 75 let ( let* ) = IdlM.ErrM.bind in 84 76 let init = 85 77 Js_top_worker_rpc.Toplevel_api_gen. 86 86 - { 87 87 - stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 88 88 - findlib_index = "/lib/findlib_index"; 89 89 - findlib_requires = ["stringext"]; 90 90 - execute = false; 91 91 - } 78 78 + { stdlib_dcs = None; findlib_requires = [ "stringext" ]; execute = false } 92 79 in 93 80 let x = 94 81 let* _ = Client.init rpc init in 95 82 let* o = Client.setup rpc () in 96 96 - Logs.info (fun m -> m "setup output: %s" (Option.value ~default:"" o.stdout)); 83 83 + Logs.info (fun m -> 84 84 + m "setup output: %s" (Option.value ~default:"" o.stdout)); 97 85 let* _ = 98 86 Client.query_errors rpc (Some "c1") [] false "typ xxxx = int;;\n" 99 87 in 100 88 let* o1 = 101 101 - Client.query_errors rpc (Some "c2") ["c1"] false "type yyy = xxx;;\n" 89 89 + Client.query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n" 102 90 in 103 91 Logs.info (fun m -> m "Number of errors: %d" (List.length o1)); 104 92 let* _ = 105 93 Client.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" 106 94 in 107 95 let* o2 = 108 108 - Client.query_errors rpc (Some "c2") ["c1"] false 109 109 - "type yyy = xxx;;\n" 96 96 + Client.query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n" 110 97 in 111 98 Logs.info (fun m -> m "Number of errors1: %d" (List.length o1)); 112 99 Logs.info (fun m -> m "Number of errors2: %d" (List.length o2));

+3 -9

test/unix/unix_test.ml

··· 129 129 let ( let* ) = IdlM.ErrM.bind in 130 130 let init = 131 131 Js_top_worker_rpc.Toplevel_api_gen. 132 132 - { 133 133 - stdlib_dcs = "/lib/ocaml/dynamic_cmis.json"; 134 134 - findlib_index = "/lib/findlib_index"; 135 135 - findlib_requires = []; 136 136 - execute = true; 137 137 - } 132 132 + { stdlib_dcs = None; findlib_requires = []; execute = true } 138 133 in 139 134 let x = 140 135 let* _ = Client.init rpc init in ··· 144 139 Client.query_errors rpc (Some "c1") [] false "typ xxxx = int;;\n" 145 140 in 146 141 let* o1 = 147 147 - Client.query_errors rpc (Some "c2") ["c1"] false "type yyy = xxx;;\n" 142 142 + Client.query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n" 148 143 in 149 144 Printf.printf "Number of errors: %d\n%!" (List.length o1); 150 145 let* _ = 151 146 Client.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" 152 147 in 153 148 let* o2 = 154 154 - Client.query_errors rpc (Some "c2") ["c1"] false 155 155 - "type yyy = xxx;;\n" 149 149 + Client.query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n" 156 150 in 157 151 Printf.printf "Number of errors1: %d\n%!" (List.length o1); 158 152 Printf.printf "Number of errors2: %d\n%!" (List.length o2);