Compiler: revove --write-shape flag

Author: hhugo

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -65,7 +65,6 @@ type t =
   ; wrap_with_fun : [ `Iife | `Named of string | `Anonymous ]
   ; target_env : Target_env.t
   ; shape_files : string list
-  ; write_shape : bool
   ; (* toplevel *)
     dynlink : bool
   ; linkall : bool
@@ -120,10 +119,6 @@ let options =
     let doc = "load shape file [$(docv)]." in
     Arg.(value & opt_all string [] & info [ "load-shape" ] ~docv:"FILE" ~doc)
   in
-  let write_shape =
-    let doc = "Emit shape files" in
-    Arg.(value & flag & info [ "write-shape" ] ~doc)
-  in
   let input_file =
     let doc =
       "Compile the bytecode program [$(docv)]. "
@@ -328,8 +323,7 @@ let options =
       js_files
       keep_unit_names
       effects
-      shape_files
-      write_shape =
+      shape_files =
     let inline_source_content = not sourcemap_don't_inline_content in
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let runtime_files = js_files in
@@ -401,7 +395,6 @@ let options =
       ; keep_unit_names
       ; effects
       ; shape_files
-      ; write_shape
       }
   in
   let t =
@@ -435,8 +428,7 @@ let options =
       $ js_files
       $ keep_unit_names
       $ effects
-      $ shape_files
-      $ write_shape)
+      $ shape_files)
   in
   Term.ret t
 
@@ -666,7 +658,6 @@ let options_runtime_only =
       ; keep_unit_names = false
       ; effects
       ; shape_files = []
-      ; write_shape = false
       }
   in
   let t =

compiler/bin-js_of_ocaml/cmd_arg.mli

@@ -38,7 +38,6 @@ type t =
       ]
   ; target_env : Target_env.t
   ; shape_files : string list
-  ; write_shape : bool
   ; (* toplevel *)
     dynlink : bool
   ; linkall : bool

compiler/bin-js_of_ocaml/compile.ml

@@ -55,16 +55,7 @@ let output_gen
     if standalone then header ~custom_header fmt;
     if Config.Flag.header () then jsoo_header fmt build_info;
     let sm, shapes = f ~standalone ~shapes:write_shape ~source_map (k, fmt) in
-    (if write_shape
-     then
-       match output_file with
-       | `Stdout -> ()
-       | `Name name ->
-           if false
-           then
-             Shape.Store.save'
-               (Filename.remove_extension name ^ Shape.Store.ext)
-               (StringMap.bindings shapes));
+    StringMap.iter (fun name shape -> Shape.Store.set ~name shape) shapes;
     match source_map, sm with
     | None, _ | _, None -> ()
     | Some { output_file = output; source_map; keep_empty }, Some sm ->
@@ -172,7 +163,6 @@ let run
     ; include_runtime
     ; effects
     ; shape_files
-    ; write_shape
     } =
   let source_map_base =
     Option.map ~f:(fun spec -> spec.Source_map.Encoding_spec.source_map) source_map
@@ -400,7 +390,7 @@ let run
         { code; cmis = StringSet.empty; debug = Parse_bytecode.Debug.default_summary }
       in
       output_gen
-        ~write_shape
+        ~write_shape:false
         ~standalone:true
         ~custom_header
         ~build_info:(Build_info.create `Runtime)
@@ -450,7 +440,7 @@ let run
           in
           if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
           output_gen
-            ~write_shape
+            ~write_shape:false
             ~standalone:true
             ~custom_header
             ~build_info:(Build_info.create `Exe)
@@ -490,7 +480,7 @@ let run
           in
           if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
           output_gen
-            ~write_shape
+            ~write_shape:true
             ~standalone:false
             ~custom_header
             ~build_info:(Build_info.create `Cmo)
@@ -525,7 +515,7 @@ let run
                    failwith "use [-o dirname/] or remove [--keep-unit-names]"
              in
              output_gen
-               ~write_shape
+               ~write_shape:false
                ~standalone:false
                ~custom_header
                ~build_info:(Build_info.create `Runtime)
@@ -562,7 +552,7 @@ let run
                   t1
                   (Ocaml_compiler.Cmo_format.name cmo);
               output_gen
-                ~write_shape
+                ~write_shape:true
                 ~standalone:false
                 ~custom_header
                 ~build_info:(Build_info.create `Cma)
@@ -614,7 +604,7 @@ let run
             , shapes )
           in
           output_gen
-            ~write_shape
+            ~write_shape:true
             ~standalone:false
             ~custom_header
             ~build_info:(Build_info.create `Cma)

compiler/lib/driver.ml

@@ -710,7 +710,6 @@ let full ~shapes ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatte
   let shapes_v = optimized_code.shapes in
   StringMap.iter
     (fun name shape ->
-      Shape.Store.set ~name shape;
       if shapes
       then
         Pretty_print.string

compiler/lib/parse_bytecode.ml

@@ -585,7 +585,6 @@ module State = struct
     ; globals : globals
     ; immutable : unit Code.Var.Hashtbl.t
     ; module_or_not : Ocaml_compiler.module_or_not Ident.Tbl.t
-    ; includes : string list
     }
 
   let fresh_var state =
@@ -670,7 +669,7 @@ module State = struct
 
   let pop_handler state = { state with handlers = List.tl state.handlers }
 
-  let initial includes g immutable =
+  let initial g immutable =
     { accu = Unset
     ; stack = []
     ; env = [||]
@@ -679,7 +678,6 @@ module State = struct
     ; globals = g
     ; immutable
     ; module_or_not = Ident.Tbl.create 0
-    ; includes
     }
 
   let rec print_stack f l =
@@ -829,7 +827,7 @@ let get_global state instrs i =
             (match g.named_value.(i) with
             | None -> ()
             | Some name -> (
-                match Shape.Store.load ~name ~paths:state.includes with
+                match Shape.Store.load ~name with
                 | None -> ()
                 | Some shape -> Shape.State.assign x shape));
             x, state, instrs
@@ -2548,9 +2546,9 @@ type one =
   ; debug : Debug.summary
   }
 
-let parse_bytecode ~includes code globals debug_data =
+let parse_bytecode code globals debug_data =
   let immutable = Code.Var.Hashtbl.create 0 in
-  let state = State.initial includes globals immutable in
+  let state = State.initial globals immutable in
   Code.Var.reset ();
   let blocks', joins = Blocks.analyse code in
   Shape.State.reset ();
@@ -2730,7 +2728,7 @@ let from_exe
     Ocaml_compiler.Symtable.GlobalMap.iter symbols ~f:(fun id n ->
         globals.named_value.(n) <- Some (Ocaml_compiler.Symtable.Global.name id);
         globals.is_exported.(n) <- true);
-  let p = parse_bytecode ~includes code globals debug_data in
+  let p = parse_bytecode code globals debug_data in
   (* register predefined exception *)
   let body =
     List.fold_left predefined_exceptions ~init:[] ~f:(fun body (i, name) ->
@@ -2860,7 +2858,7 @@ let from_bytes ~prims ~debug (code : bytecode) =
     t
   in
   let globals = make_globals 0 [||] prims in
-  let p = parse_bytecode ~includes:[] code globals debug_data in
+  let p = parse_bytecode code globals debug_data in
   let gdata = Var.fresh_n "global_data" in
   let need_gdata = ref false in
   let find_name i =
@@ -2992,7 +2990,7 @@ module Reloc = struct
     globals
 end
 
-let from_compilation_units ~includes ~include_cmis ~debug_data l =
+let from_compilation_units ~includes:_ ~include_cmis ~debug_data l =
   let reloc = Reloc.create () in
   List.iter l ~f:(fun (compunit, code) -> Reloc.step1 reloc compunit code);
   List.iter l ~f:(fun (compunit, code) -> Reloc.step2 reloc compunit code);
@@ -3001,7 +2999,7 @@ let from_compilation_units ~includes ~include_cmis ~debug_data l =
     let l = List.map l ~f:(fun (_, c) -> Bytes.to_string c) in
     String.concat ~sep:"" l
   in
-  let prog = parse_bytecode ~includes code globals debug_data in
+  let prog = parse_bytecode code globals debug_data in
   let gdata = Var.fresh_n "global_data" in
   let need_gdata = ref false in
   let body =

compiler/lib/shape.ml

@@ -28,8 +28,6 @@ type t =
       ; res : t
       }
 
-type shape = t
-
 let rec equal a b =
   match a, b with
   | Top, Top -> true
@@ -127,89 +125,23 @@ let of_string (s : string) =
   parse_shape ()
 
 module Store = struct
-  let ext = ".jsoo-shape"
-
-  let filename ~dir ~name = Filename.concat dir (name ^ ext)
-
   let t = String.Hashtbl.create 17
 
-  let loaded = String.Hashtbl.create 17
-
   let set ~name shape = String.Hashtbl.replace t name shape
 
   let get ~name = String.Hashtbl.find_opt t name
 
-  let magic = "JsooShape000"
-
   let load' fn =
-    let ic = open_in_bin fn in
-    let m = really_input_string ic (String.length magic) in
-    if String.equal m magic
-    then (
-      let shapes : (string * shape) list = Marshal.from_channel ic in
-      close_in ic;
-      List.iter shapes ~f:(fun (name, shape) -> set ~name shape))
-    else (
-      close_in ic;
-      let l = file_lines_bin fn in
-      List.iter l ~f:(fun s ->
-          match String.drop_prefix ~prefix:"//#shape: " s with
-          | None -> ()
-          | Some name_n_shape -> (
-              match String.lsplit2 name_n_shape ~on:':' with
-              | None -> ()
-              | Some (name, shape) -> set ~name (of_string shape))))
-
-  let load ~name ~paths =
-    if String.Hashtbl.mem t name
-    then get ~name
-    else if not (Config.Flag.load_shapes_auto ())
-    then None
-    else
-      match Fs.find_in_path paths (filename ~dir:"." ~name) with
-      | Some f ->
-          load' f;
-          get ~name
-      | None ->
-          let rec scan : _ -> shape option = function
-            | [] -> None
-            | dir :: xs -> (
-                let l =
-                  Sys.readdir dir
-                  |> Array.to_list
-                  |> List.sort ~cmp:String.compare
-                  |> List.map ~f:(fun n -> Filename.concat dir n)
-                in
-                match
-                  List.find_map l ~f:(fun s ->
-                      if Filename.check_suffix s ext && not (String.Hashtbl.mem loaded s)
-                      then (
-                        load' s;
-                        String.Hashtbl.add loaded s ();
-                        match get ~name with
-                        | None -> None
-                        | Some shape -> Some (s, shape))
-                      else None)
-                with
-                | None -> scan xs
-                | Some (fn, shape) ->
-                    Format.eprintf "Shape: %s loaded from %s\n" name fn;
-                    Some shape)
-          in
-          scan paths
-
-  let save' fn (l : (string * shape) list) =
-    let oc = open_out_bin fn in
-    output_string oc magic;
-    Marshal.to_channel oc l [];
-    close_out oc
-
-  let save ~name ~dir =
-    match get ~name with
-    | None -> failwith (Printf.sprintf "Don't know any shape for %s" name)
-    | Some shape ->
-        let fn = filename ~dir ~name in
-        save' fn [ name, shape ]
+    let l = file_lines_bin fn in
+    List.iter l ~f:(fun s ->
+        match String.drop_prefix ~prefix:"//#shape: " s with
+        | None -> ()
+        | Some name_n_shape -> (
+            match String.lsplit2 name_n_shape ~on:':' with
+            | None -> ()
+            | Some (name, shape) -> set ~name (of_string shape)))
+
+  let load ~name = if String.Hashtbl.mem t name then get ~name else None
 end
 
 module State = struct

compiler/lib/shape.mli

@@ -35,19 +35,13 @@ val equal : t -> t -> bool
 val merge : t -> t -> t
 
 module Store : sig
-  val ext : string
-
   val set : name:string -> t -> unit
 
   val get : name:string -> t option
 
   val load' : string -> unit
 
-  val load : name:string -> paths:string list -> t option
-
-  val save : name:string -> dir:string -> unit
-
-  val save' : string -> (string * t) list -> unit
+  val load : name:string -> t option
 end
 
 module State : sig