Remove dependency to Core_kernel

Core_kernel brings in a lot of bloat for a number of used functions
which is very low.

plotkicadsch.opam

@@ -27,6 +27,5 @@ depends: [
   "git" {>= "2.0.0"}
   "git-unix"
   "base64" {>= "3.0.0"}
-  "core_kernel"
   "cmdliner"
 ]

plotkicadsch/src/dune

@@ -12,7 +12,6 @@
       lwt.unix
       sha
       base64
-      core_kernel
       cmdliner
    )
    (flags (:standard -w -3 -safe-string))

plotkicadsch/src/gitFs.ml

@@ -1,4 +1,4 @@
-open Core_kernel
+open StdLabels
 open Lwt.Infix
 open DiffFs
 exception InternalGitError of string
@@ -11,7 +11,7 @@ let make commitish =
     let rev_parse r =
       SysAbst.pread "git" [|"rev-parse"; r ^ "^{commit}"|]
       >>= fun s ->
-      try Lwt.return @@ Store.Hash.of_hex @@ String.prefix s 40
+      try Lwt.return @@ Store.Hash.of_hex @@ String.sub ~pos:0 s ~len:(min 40 (String.length s))
       with _ -> Lwt.fail (InternalGitError ("cannot parse rev " ^ r))
 
     let label = GitFS commitish
@@ -83,10 +83,13 @@ let make commitish =
       |> List.filter_map ~f:(fun {name; node; _} ->
           if filter name then Some ([name], Store.Hash.to_hex node) else None
         )
+    ;;
 
     let find_dir_local t =
-      let file_list = Store.Value.Tree.to_list t in
-      List.filter ~f:(fun entry -> let open Core_kernel.Poly in entry.perm = `Dir) file_list
+      let open Store.Value.Tree in
+      to_list t
+      |> List.filter ~f:(fun {perm;_} -> perm == `Dir)
+    ;;
 
     let rec recurse_dir ?dirname node pattern =
       let rename name = match dirname with

plotkicadsch/src/kicadDiff.ml

@@ -1,4 +1,4 @@
-open Core_kernel
+open StdLabels
 open Lwt.Infix
 module S = Kicadsch.MakeSchPainter (SvgPainter)
 open Kicadsch.Sigs
@@ -18,6 +18,14 @@ let fs_mod = function
   | GitFS r -> GitFs.make r
   | TrueFS r -> TrueFs.make r
 
+
+let is_suffix ~suffix s =
+  let suff_length = String.length suffix in
+  let s_length = String.length s in
+  (suff_length < s_length) &&
+  (String.equal (String.sub s ~pos:(String.length s - suff_length) ~len:suff_length) suffix)
+;;
+
 module L = Kicadsch.MakeSchPainter(ListPainter.L)
 
 module LP = struct
@@ -33,25 +41,25 @@ module FSPainter (S : SchPainter) (F : Simple_FS) : sig
 
   val context_from : S.schContext Lwt.t -> S.schContext Lwt.t
 end = struct
-  let find_schematics () = F.list_files (String.is_suffix ~suffix:".sch")
+  let find_schematics () = F.list_files (is_suffix ~suffix:".sch")
 
   let process_file initctx filename =
     let parse c l = S.parse_line l c in
     let%lwt init = initctx in
     F.get_content filename
     >|= fun ctt ->
-    let lines = String.split_lines ctt in
+    let lines = String.split_on_char ~sep:'\n' ctt in
     let endctx = List.fold_left ~f:parse ~init lines in
     S.output_context endctx
 
   let find_libs () =
-    F.list_files (String.is_suffix ~suffix:"-cache.lib") >|= List.map ~f:fst
+    F.list_files (is_suffix ~suffix:"-cache.lib") >|= List.map ~f:fst
 
   let read_libs initial_ctx lib_list =
     Lwt_list.fold_left_s
       (fun c l ->
          F.get_content l
-         >|= String.split_lines
+         >|= String.split_on_char ~sep:'\n'
          >|= List.fold_left ~f:(fun ctxt l -> S.add_lib l ctxt) ~init:c )
       initial_ctx lib_list
 
@@ -69,7 +77,7 @@ let intersect_lists l1l l2l =
     ~f:(fun (name2, sha2) ->
         List.exists
           ~f:(fun (name1, sha1) ->
-              List.equal String.equal name1 name2 && not (String.equal sha2 sha1) )
+              not (String.equal sha2 sha1) && (List.length name1 == List.length name2) && (List.for_all2 ~f:String.equal name1 name2))
           l1 )
     l2
   |> List.map ~f:fst
@@ -168,14 +176,13 @@ let internal_diff (d : string) (c : SvgPainter.diff_colors option) (z: string op
       | Format _ -> BB.create ()
 
     let  dispatch_rect (res, acc) elt =
-      let open Float in
       if (BoundingBox.overlap_ratio res elt) > 0.9 then
         BoundingBox.add_rect res elt , acc
       else
           res, elt::acc
 
     let rec aggregate rect rect_list =
-      let result, remaining = List.fold  ~f:dispatch_rect ~init:(rect, []) rect_list in
+      let result, remaining = List.fold_left  ~f:dispatch_rect ~init:(rect, []) rect_list in
       if Int.equal (List.length remaining) (List.length rect_list) then
         result, remaining
       else
@@ -221,8 +228,8 @@ let internal_diff (d : string) (c : SvgPainter.diff_colors option) (z: string op
     rec_draw_difftotal ~prev ~next (new_ctx, new_ctx, new_ctx, out_canevas) []
 
     let display_diff ~from_ctx ~to_ctx (filename:string list) ~keep =
-      let prev = List.sort ~compare from_ctx in
-      let next = List.sort ~compare to_ctx in
+      let prev = List.sort ~cmp:compare from_ctx in
+      let next = List.sort ~cmp:compare to_ctx in
       match
         draw_difftotal ~prev ~next (SvgPainter.get_color_context c z)
       with
@@ -352,7 +359,7 @@ let doit from_fs to_fs file_to_diff differ textdiff libs keep colors zone_color
       let to_list = ToP.find_schematics () in
       intersect_lists from_list to_list
     | Some filename ->
-      let filename_l = String.split ~on:'/' filename in
+      let filename_l = String.split_on_char ~sep:'/' filename in
       Lwt.return [filename_l]
   in
   let preload_libs () =
@@ -384,6 +391,6 @@ let doit from_fs to_fs file_to_diff differ textdiff libs keep colors zone_color
         | GitFs.InternalGitError s ->
           Lwt_io.printf "Git Exception: %s\n" s
         | a ->
-          Lwt_io.printf "Exception %s\n" (Exn.to_string a) )
+          Lwt_io.printf "Exception %s\n" (Printexc.to_string a) )
   in
   Lwt_main.run catch_errors

plotkicadsch/src/plotgitsch.ml

@@ -1,4 +1,4 @@
-open Core_kernel
+open StdLabels
 open KicadDiff
 open Cmdliner
 

plotkicadsch/src/sysAbst.ml

@@ -1,4 +1,4 @@
-open Core_kernel
+open StdLabels
 
 type os = MacOS | Linux | Windows | Cygwin
 
@@ -14,14 +14,17 @@ let process_output_to_string command =
   with End_of_file ->
     let stat = UnixLabels.close_process_in chan in
     (!res, stat)
+;;
 
 let cmd_output command =
   let l, _ = process_output_to_string command in
   l
+;;
 
 let launch_on_windows command =
   let _, s = process_output_to_string ("start " ^ command) in
   Lwt.return s
+;;
 
 let detect_os () : os =
   if Sys.win32 then Windows
@@ -37,21 +40,24 @@ let detect_os () : os =
         Linux
     | _ ->
         failwith "unknown operating system"
+;;
 
 let windows_quote s =
   let open Re in
   replace
     (Posix.compile_pat {|\^|&|\||\(|<|>|})
     ~f:(fun ss -> "^" ^ Group.get ss 0)
     s
+;;
 
 let exec c a =
   match detect_os () with
   | MacOS | Linux ->
       Lwt_process.exec (c, Array.append [|c|] a)
   | Cygwin | Windows ->
       launch_on_windows
-      @@ Array.fold ~f:(fun f g -> f ^ " " ^ windows_quote g) ~init:c a
+      @@ Array.fold_left ~f:(fun f g -> f ^ " " ^ windows_quote g) ~init:c a
+;;
 
 let pread c a =
   match detect_os () with
@@ -60,15 +66,23 @@ let pread c a =
   | Cygwin | Windows ->
       Lwt.return
       @@ cmd_output
-           (Array.fold ~f:(fun f g -> f ^ " " ^ windows_quote g) ~init:c a)
+           (Array.fold_left ~f:(fun f g -> f ^ " " ^ windows_quote g) ~init:c a)
+;;
+
+let rec last_exn = function
+  | [e] -> e
+  | _::tl -> last_exn tl
+  | [] -> raise Not_found
+;;
 
 let build_tmp_svg_name ~keep aprefix aschpath =
-  let aschname = List.last_exn aschpath in
+  let aschname = last_exn aschpath in
   let root_prefix =
     aprefix ^ String.sub aschname ~pos:0 ~len:(String.length aschname - 4)
   in
   if keep then root_prefix ^ ".svg"
   else Stdlib.Filename.temp_file root_prefix ".svg"
+;;
 
 let finalize_tmp_file fnl ~keep =
   match detect_os () with
@@ -81,6 +95,7 @@ let finalize_tmp_file fnl ~keep =
       with _ -> Lwt.return_unit )
   | Cygwin | Windows ->
       Lwt.return_unit
+;;
 
 let default_opener () =
   match detect_os () with

plotkicadsch/src/trueFs.ml

@@ -1,4 +1,4 @@
-open Core_kernel
+open StdLabels
 open Lwt.Infix
 open DiffFs
 
@@ -7,7 +7,16 @@ let make rootname =
 
     let label = TrueFS rootname
 
-    let rootname = String.lstrip ~drop:(Char.equal '/') rootname
+    let lstrip c s =
+      let rec find_non_c c s n =
+        if s.[n] != c then
+          String.sub ~pos:n ~len:(String.length s - n) s
+        else
+          find_non_c c s (n+1)
+      in
+      find_non_c c s 0
+
+    let rootname = lstrip '/' rootname
     let rootlength = (String.length rootname) + 1
 
     let get_content filename =
@@ -38,8 +47,8 @@ let make rootname =
    let list_files pattern =
      let list = dir_contents rootname pattern in
      let file_list = Lwt_list.map_s (fun filename ->
-         let filename = String.drop_prefix  filename rootlength in
-         let file_path = String.split ~on:'/' filename in
+         let filename = String.sub filename ~pos:rootlength ~len:(String.length filename - rootlength) in
+         let file_path = String.split_on_char ~sep:'/' filename in
          hash_file file_path) list in
      file_list
  end