refactor(stdune): Add Appendable_list.cons

Signed-off-by: Rudi Grinberg <[email protected]> ps-id: b9901d95-dc30-4bff-a0a7-0776e32a8b38
ocaml · Dec 3, 2022 · 0db5579 · 0db5579
1 parent 65a96bc
commit 0db5579
Show file tree

Hide file tree

Showing 3 changed files with 14 additions and 21 deletions.
diff --git a/otherlibs/stdune/appendable_list.ml b/otherlibs/stdune/appendable_list.ml
@@ -8,6 +8,8 @@ let to_list l = l []
 
 let ( @ ) a b k = a (b k)
 
+let cons x xs = singleton x @ xs
+
 let rec concat l k =
   match l with
   | [] -> k

diff --git a/otherlibs/stdune/appendable_list.mli b/otherlibs/stdune/appendable_list.mli
@@ -9,6 +9,8 @@ val singleton : 'a -> 'a t
 
 val ( @ ) : 'a t -> 'a t -> 'a t
 
+val cons : 'a -> 'a t -> 'a t
+
 val concat : 'a t list -> 'a t
 
 val to_list : 'a t -> 'a list
diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml
@@ -76,14 +76,11 @@ let libs_and_ppx_under_dir sctx ~db ~dir =
                 then
                   match Lib_info.kind info with
                   | Lib_kind.Ppx_rewriter _ | Ppx_deriver _ ->
-                    ( Appendable_list.( @ ) (Appendable_list.singleton lib) acc
-                    , Appendable_list.( @ )
-                        (Appendable_list.singleton
-                           (Lib_info.loc info, Lib_info.name info))
+                    ( Appendable_list.cons lib acc
+                    , Appendable_list.cons
+                        (Lib_info.loc info, Lib_info.name info)
                         pps )
-                  | Normal ->
-                    ( Appendable_list.( @ ) (Appendable_list.singleton lib) acc
-                    , pps )
+                  | Normal -> (Appendable_list.cons lib acc, pps)
                 else (acc, pps))
             | Dune_file.Executables exes -> (
               let* libs =
@@ -119,21 +116,13 @@ let libs_and_ppx_under_dir sctx ~db ~dir =
                   ~f:(fun (acc, pps) lib ->
                     let info = Lib.info lib in
                     match Lib_info.kind info with
-                    | Lib_kind.Ppx_rewriter _ | Ppx_deriver _ ->
+                    | Normal -> Memo.return (Appendable_list.cons lib acc, pps)
+                    | Ppx_rewriter _ | Ppx_deriver _ ->
                       Memo.return
-                        ( Appendable_list.( @ )
-                            (Appendable_list.singleton lib)
-                            acc
-                        , Appendable_list.( @ )
-                            (Appendable_list.singleton
-                               (Lib_info.loc info, Lib_info.name info))
-                            pps )
-                    | Normal ->
-                      Memo.return
-                        ( Appendable_list.( @ )
-                            (Appendable_list.singleton lib)
-                            acc
-                        , pps )))
+                        ( Appendable_list.cons lib acc
+                        , Appendable_list.cons
+                            (Lib_info.loc info, Lib_info.name info)
+                            pps )))
             | _ -> Memo.return (acc, pps)))
     >>| fun (libs, pps) ->
     (Appendable_list.to_list libs, Appendable_list.to_list pps)