refactor: get rid of stdune from code generator

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: eb2c14ee-02d9-45df-a29a-3d85fca1759b -->

lsp/bin/cinaps.ml

@@ -7,7 +7,7 @@ let preprocess_metamodel =
     method! or_ path (types : Metamodel.type_ list) =
       match
         List.filter_map types ~f:(function
-          | Literal (Record []) -> None
+          | Metamodel.Literal (Record []) -> None
           | _ as t -> Some (self#type_ path t))
       with
       | [] -> assert false
@@ -17,10 +17,13 @@ let preprocess_metamodel =
          | Top (Alias s) when s.name = "TextDocumentContentChangeEvent" ->
            let t =
              let union_fields l1 l2 ~f =
-               let of_map =
-                 String.Map.of_list_map_exn ~f:(fun (x : Metamodel.property) -> x.name, x)
+               let of_map xs =
+                 List.map xs ~f:(fun (x : Metamodel.property) -> x.name, x)
+                 |> String.Map.of_list
                in
-               String.Map.merge (of_map l1) (of_map l2) ~f |> String.Map.values
+               String.Map.merge (of_map l1) (of_map l2) ~f
+               |> String.Map.bindings
+               |> List.map ~f:snd
              in
              union_fields f1 f2 ~f:(fun k t1 t2 ->
                if k = "text"
@@ -81,8 +84,9 @@ let expand_superclasses db (m : Metamodel.t) =
   let structures =
     let uniquify_fields fields =
       List.fold_left fields ~init:String.Map.empty ~f:(fun acc (f : Metamodel.property) ->
-        String.Map.set acc f.name f)
-      |> String.Map.values
+        String.Map.add acc ~key:f.name ~data:f)
+      |> String.Map.bindings
+      |> List.map ~f:snd
     in
     let rec fields_of_type (t : Metamodel.type_) =
       match t with

lsp/bin/dune

@@ -3,7 +3,7 @@
 (test
  (name test_metamodel)
  (modules test_metamodel)
- (libraries stdune yojson lsp_gen)
+ (libraries yojson lsp_gen)
  (deps metamodel/metaModel.json)
  (action
   (run ./test_metamodel.exe %{deps})))
@@ -13,4 +13,4 @@
  (instrumentation
   (backend bisect_ppx))
  (modules :standard \ test_metamodel)
- (libraries stdune dyn pp yojson))
+ (libraries dyn pp yojson))

lsp/bin/import.ml

@@ -1,13 +1,70 @@
-include struct
-  open Stdune
-  module List = List
-  module Id = Id
-  module String = String
-  module Code_error = Code_error
-  module Comparable = Comparable
-  module Top_closure = Top_closure
-  module Poly = Poly
-  module Option = Option
-
-  let sprintf = sprintf
+let sprintf = Printf.sprintf
+
+module Option = struct
+  include Option
+
+  let map t ~f = Option.map f t
+
+  let value_exn = function
+    | None -> assert false
+    | Some s -> s
+  ;;
+end
+
+module List = struct
+  include ListLabels
+
+  type ('a, 'b) skip_or_either =
+    | Skip
+    | Left of 'a
+    | Right of 'b
+
+  let rev_filter_partition_map =
+    let rec loop l accl accr ~f =
+      match l with
+      | [] -> accl, accr
+      | x :: l ->
+        (match f x with
+         | Skip -> loop l accl accr ~f
+         | Left y -> loop l (y :: accl) accr ~f
+         | Right y -> loop l accl (y :: accr) ~f)
+    in
+    fun l ~f -> loop l [] [] ~f
+  ;;
+
+  let filter_partition_map l ~f =
+    let l, r = rev_filter_partition_map l ~f in
+    rev l, rev r
+  ;;
+end
+
+module String = struct
+  include StringLabels
+
+  let to_dyn = Dyn.string
+
+  module Map = struct
+    include MoreLabels.Map.Make (String)
+
+    let of_list_reducei xs ~f =
+      List.fold_left xs ~init:empty ~f:(fun map (k, v) ->
+        update map ~key:k ~f:(function
+          | None -> Some v
+          | Some v' -> Some (f k v v')))
+    ;;
+
+    let of_list_map_exn xs ~f = List.map xs ~f |> of_list
+    let union_exn x y = union ~f:(fun _ _ _ -> assert false) x y
+  end
+end
+
+module Code_error = struct
+  let raise name data =
+    invalid_arg (sprintf "%s %s" name (Dyn.to_string (Dyn.record data)))
+  ;;
+end
+
+module Poly = struct
+  let equal = Stdlib.( = )
+  let compare = Stdlib.compare
 end

lsp/bin/metamodel/metamodel.ml

@@ -1,4 +1,4 @@
-open Stdune
+open Import
 
 type doc =
   { since : string option
@@ -113,7 +113,7 @@ let fields = function
 ;;
 
 let field ?default (name : string) p fields =
-  match List.assoc fields name with
+  match List.assoc_opt name fields with
   | Some f -> p f
   | None ->
     (match default with
@@ -122,7 +122,7 @@ let field ?default (name : string) p fields =
 ;;
 
 let field_o name p fields =
-  match List.assoc fields name with
+  match List.assoc_opt name fields with
   | None -> None
   | Some f -> Some (p f)
 ;;
@@ -137,7 +137,7 @@ let literal lit json = if not (Poly.equal json lit) then error "unexpected liter
 let enum variants json =
   match json with
   | `String s ->
-    (match List.assoc variants s with
+    (match List.assoc_opt s variants with
      | None -> error "not a valid enum value" json
      | Some v -> v)
   | _ -> error "not a valid enum value" json
@@ -370,7 +370,7 @@ module Entity = struct
       String.Map.union_exn structures enumerations |> String.Map.union_exn typeAliases
     ;;
 
-    let find t x = String.Map.find_exn t x
+    let find t x = String.Map.find x t
   end
 end
 

lsp/bin/ocaml/json_gen.ml

@@ -34,7 +34,7 @@ let json_error_pat msg =
 ;;
 
 let is_json_constr (constr : Type.constr) =
-  List.mem [ "String"; "Int"; "Bool" ] constr.name ~equal:String.equal
+  List.mem ~set:[ "String"; "Int"; "Bool" ] constr.name
 ;;
 
 module Name = struct

lsp/bin/ocaml/ml.ml

@@ -409,7 +409,7 @@ module Expr = struct
 
   let pp_constr f { tag; poly; args } =
     let tag =
-      let tag = String.capitalize tag in
+      let tag = String.capitalize_ascii tag in
       Pp.verbatim (if poly then "`" ^ tag else tag)
     in
     match args with

lsp/bin/ocaml/ocaml.ml

@@ -79,9 +79,7 @@ module Expanded = struct
              | None -> init
              | Some data ->
                let new_record = { f with data } in
-               if List.mem ~equal:Poly.equal init new_record
-               then init
-               else new_record :: init)
+               if List.mem ~set:init new_record then init else new_record :: init)
         in
         super#field f ~init
     end
@@ -274,18 +272,18 @@ module Entities = struct
   type t = (Ident.t * Resolved.t) list
 
   let find db e : _ Named.t =
-    match List.assoc db e with
+    match List.assoc_opt e db with
     | Some s -> s
     | None -> Code_error.raise "Entities.find: unable to find" [ "e", Ident.to_dyn e ]
   ;;
 
   let of_map map ts =
-    List.map ts ~f:(fun (r : Resolved.t) -> String.Map.find_exn map r.name, r)
+    List.map ts ~f:(fun (r : Resolved.t) -> String.Map.find r.name map, r)
   ;;
 
   let rev_find (db : t) (resolved : Resolved.t) : Ident.t =
     match
-      List.filter_map db ~f:(fun (id, r) ->
+      List.filter_map db ~f:(fun (id, (r : Resolved.t)) ->
         if r.name = resolved.name then Some id else None)
     with
     | [] -> Code_error.raise "rev_find: resolved not found" []
@@ -327,17 +325,17 @@ end = struct
       [ Prim.Null; String; Bool; Number; Object; List ]
       |> List.map ~f:(fun s -> Resolved.Ident s)
     in
-    fun set -> List.for_all constrs ~f:(fun e -> List.mem set e ~equal:Poly.equal)
+    fun set -> List.for_all constrs ~f:(List.mem ~set)
   ;;
 
   let id = Type.name "Jsonrpc.Id.t"
 
   let is_same_as_id =
-    let sort = List.sort ~compare:Poly.compare in
+    let sort = List.sort ~cmp:Poly.compare in
     let constrs =
       [ Prim.String; Number ] |> List.map ~f:(fun s -> Resolved.Ident s) |> sort
     in
-    fun cs -> List.equal ( = ) constrs (sort cs)
+    fun cs -> List.equal ~eq:( = ) constrs (sort cs)
   ;;
 
   (* Any type that includes null needs to be extracted to be converted to an
@@ -585,7 +583,7 @@ end = struct
         let literal_wrapper =
           match literal_wrapper with
           | None -> []
-          | Some { field_name; literal_value } ->
+          | Some { Mapper.field_name; literal_value } ->
             Json_gen.make_literal_wrapper_conv
               ~field_name
               ~literal_value
@@ -626,7 +624,7 @@ let resolve_typescript (ts : Unresolved.t list) =
   let db = Entities.of_map db ts in
   match
     let idents = new name_idents in
-    Ident.Top_closure.top_closure
+    Ident.top_closure
       ts
       ~key:(fun x -> Entities.rev_find db x)
       ~deps:(fun x -> idents#t x ~init:[] |> List.map ~f:(Entities.find db))
@@ -640,7 +638,7 @@ let resolve_typescript (ts : Unresolved.t list) =
 let of_resolved_typescript db (ts : Resolved.t list) =
   let simple_enums, everything_else =
     List.filter_partition_map ts ~f:(fun (t : Resolved.t) ->
-      if List.mem skipped_ts_decls t.name ~equal:String.equal
+      if List.mem ~set:skipped_ts_decls t.name
       then Skip
       else (
         match t.data with
@@ -650,7 +648,7 @@ let of_resolved_typescript db (ts : Resolved.t list) =
   let simple_enums =
     List.map simple_enums ~f:(fun (t : _ Named.t) ->
       (* "open" enums need an `Other constructor *)
-      let allow_other = List.mem ~equal:String.equal with_custom_values t.name in
+      let allow_other = List.mem ~set:with_custom_values t.name in
       let data =
         List.filter_map t.data ~f:(fun (constr, v) ->
           match (v : Ts_types.Enum.case) with

lsp/bin/typescript/ts_types.ml

@@ -262,7 +262,19 @@ module Unresolved = struct
 end
 
 module Ident = struct
-  module Id = Stdune.Id.Make ()
+  module Id = struct
+    type t = int
+
+    let counter = ref 0
+
+    let gen () =
+      incr counter;
+      !counter
+    ;;
+
+    let compare = Int.compare
+    let to_dyn = Dyn.int
+  end
 
   module T = struct
     type t =
@@ -282,9 +294,44 @@ module Ident = struct
 
   let make name = { name; id = Id.gen () }
 
-  module C = Comparable.Make (T)
-  module Set = C.Set
-  module Top_closure = Top_closure.Make (Set) (Stdune.Monad.Id)
+  module Keys = struct
+    include MoreLabels.Set.Make (T)
+
+    let add x y = add y x
+    let mem x y = mem y x
+  end
+
+  let top_closure ~key ~deps elements =
+    let rec loop res visited elt ~temporarily_marked =
+      let key = key elt in
+      if Keys.mem temporarily_marked key
+      then Error [ elt ]
+      else if not (Keys.mem visited key)
+      then (
+        let visited = Keys.add visited key in
+        let temporarily_marked = Keys.add temporarily_marked key in
+        deps elt
+        |> iter_elts res visited ~temporarily_marked
+        |> function
+        | Error l -> Error (elt :: l)
+        | Ok (res, visited) ->
+          let res = elt :: res in
+          Ok (res, visited))
+      else Ok (res, visited)
+    and iter_elts res visited elts ~temporarily_marked =
+      match elts with
+      | [] -> Ok (res, visited)
+      | elt :: elts ->
+        loop res visited elt ~temporarily_marked
+        |> (function
+         | Error _ as result -> result
+         | Ok (res, visited) -> iter_elts res visited elts ~temporarily_marked)
+    in
+    iter_elts [] Keys.empty elements ~temporarily_marked:Keys.empty
+    |> function
+    | Ok (res, _visited) -> Ok (List.rev res)
+    | Error elts -> Error elts
+  ;;
 end
 
 module Prim = struct
@@ -345,15 +392,15 @@ let subst unresolved =
     method inside s = {<inside = Some s>}
 
     method resolve n =
-      match String.Map.find params n with
+      match String.Map.find_opt n params with
       | Some [] -> assert false
       | Some (x :: _) -> `Resolved x
       | None ->
-        if inside = Some n then `Self else `Unresolved (String.Map.find_exn unresolved n)
+        if inside = Some n then `Self else `Unresolved (String.Map.find n unresolved)
 
     method push x y =
       let params =
-        String.Map.update params x ~f:(function
+        String.Map.update params ~key:x ~f:(function
           | None -> Some [ y ]
           | Some [] -> assert false
           | Some (y' :: xs) -> if y = y' then Some xs else Some (y :: y' :: xs))
@@ -362,9 +409,9 @@ let subst unresolved =
 
     method pop x =
       let params =
-        String.Map.update params x ~f:(function
+        String.Map.update params ~key:x ~f:(function
           | None ->
-            ignore (String.Map.find_exn params x);
+            ignore (String.Map.find x params);
             None
           | Some [] -> assert false
           | Some (_ :: xs) -> Some xs)