Change stamp to use Sexp.t to calculate hash

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/action.ml

@@ -130,59 +130,83 @@ struct
            Diff { optional = false; file1; file2; mode = Binary })
         ])
 
-  let rec dgen =
+  module Make_gen (P : sig
-    let path = Path.dgen and string = String.dgen in
+      type sexp
-    function
+      val atom : string -> sexp
-    | Run (a, xs) -> Dsexp.List (Dsexp.unsafe_atom_of_string "run"
+      val list : sexp list -> sexp
-                                 :: Program.dgen a :: List.map xs ~f:string)
+      val path : Path.t -> sexp
-    | Chdir (a, r) -> List [Dsexp.unsafe_atom_of_string "chdir" ;
+      val string : String.t -> sexp
-                            path a ; dgen r]
+      val program : Program.t -> sexp
-    | Setenv (k, v, r) -> List [Dsexp.unsafe_atom_of_string "setenv" ;
+    end) = struct
-                                string k ; string v ; dgen r]
+    open P
-    | Redirect (outputs, fn, r) ->
+    let rec gen =
-      List [ Dsexp.atom (sprintf "with-%s-to" (Outputs.to_string outputs))
+      function
-           ; path fn
+      | Run (a, xs) ->
-           ; dgen r
+        list (atom "run" :: program a :: List.map xs ~f:string)
-           ]
+      | Chdir (a, r) -> list [atom "chdir" ; path a ; gen r]
-    | Ignore (outputs, r) ->
+      | Setenv (k, v, r) -> list [atom "setenv" ; string k ; string v ; gen r]
-      List [ Dsexp.atom (sprintf "ignore-%s" (Outputs.to_string outputs))
+      | Redirect (outputs, fn, r) ->
-           ; dgen r
+        list [ atom (sprintf "with-%s-to" (Outputs.to_string outputs))
-           ]
+             ; path fn
-    | Progn l -> List (Dsexp.unsafe_atom_of_string "progn"
+             ; gen r
-                       :: List.map l ~f:dgen)
+             ]
-    | Echo xs ->
+      | Ignore (outputs, r) ->
-      List (Dsexp.unsafe_atom_of_string "echo" :: List.map xs ~f:string)
+        list [ atom (sprintf "ignore-%s" (Outputs.to_string outputs))
-    | Cat x -> List [Dsexp.unsafe_atom_of_string "cat"; path x]
+             ; gen r
-    | Copy (x, y) ->
+             ]
-      List [Dsexp.unsafe_atom_of_string "copy"; path x; path y]
+      | Progn l -> list (atom "progn" :: List.map l ~f:gen)
-    | Symlink (x, y) ->
+      | Echo xs ->
-      List [Dsexp.unsafe_atom_of_string "symlink"; path x; path y]
+        list (atom "echo" :: List.map xs ~f:string)
-    | Copy_and_add_line_directive (x, y) ->
+      | Cat x -> list [atom "cat"; path x]
-      List [Dsexp.unsafe_atom_of_string "copy#"; path x; path y]
+      | Copy (x, y) ->
-    | System x -> List [Dsexp.unsafe_atom_of_string "system"; string x]
+        list [atom "copy"; path x; path y]
-    | Bash   x -> List [Dsexp.unsafe_atom_of_string "bash"; string x]
+      | Symlink (x, y) ->
-    | Write_file (x, y) -> List [Dsexp.unsafe_atom_of_string "write-file";
+        list [atom "symlink"; path x; path y]
-                                 path x; string y]
+      | Copy_and_add_line_directive (x, y) ->
-    | Rename (x, y) -> List [Dsexp.unsafe_atom_of_string "rename";
+        list [atom "copy#"; path x; path y]
-                             path x; path y]
+      | System x -> list [atom "system"; string x]
-    | Remove_tree x -> List [Dsexp.unsafe_atom_of_string "remove-tree"; path x]
+      | Bash   x -> list [atom "bash"; string x]
-    | Mkdir x       -> List [Dsexp.unsafe_atom_of_string "mkdir"; path x]
+      | Write_file (x, y) -> list [atom "write-file"; path x; string y]
-    | Digest_files paths -> List [Dsexp.unsafe_atom_of_string "digest-files";
+      | Rename (x, y) -> list [atom "rename"; path x; path y]
-                                  List (List.map paths ~f:path)]
+      | Remove_tree x -> list [atom "remove-tree"; path x]
-    | Diff { optional; file1; file2; mode = Binary} ->
+      | Mkdir x       -> list [atom "mkdir"; path x]
-      assert (not optional);
+      | Digest_files paths -> list [atom "digest-files";
-      List [Dsexp.unsafe_atom_of_string "cmp"; path file1; path file2]
+                                    list (List.map paths ~f:path)]
-    | Diff { optional = false; file1; file2; mode = _ } ->
+      | Diff { optional; file1; file2; mode = Binary} ->
-      List [Dsexp.unsafe_atom_of_string "diff"; path file1; path file2]
+        assert (not optional);
-    | Diff { optional = true; file1; file2; mode = _ } ->
+        list [atom "cmp"; path file1; path file2]
-      List [Dsexp.unsafe_atom_of_string "diff?"; path file1; path file2]
+      | Diff { optional = false; file1; file2; mode = _ } ->
-    | Merge_files_into (srcs, extras, target) ->
+        list [atom "diff"; path file1; path file2]
-      List
+      | Diff { optional = true; file1; file2; mode = _ } ->
-        [ Dsexp.unsafe_atom_of_string "merge-files-into"
+        list [atom "diff?"; path file1; path file2]
-        ; List (List.map ~f:path srcs)
+      | Merge_files_into (srcs, extras, target) ->
-        ; List (List.map ~f:string extras)
+        list
-        ; path target
+          [ atom "merge-files-into"
-        ]
+          ; list (List.map ~f:path srcs)
+          ; list (List.map ~f:string extras)
+          ; path target
+          ]
+  end
+
+  module Dgen = Make_gen(struct
+      type sexp = Dsexp.t
+      let atom = Dsexp.unsafe_atom_of_string
+      let list s = Dsexp.List s
+      let program = Program.dgen
+      let string = String.dgen
+      let path = Path.dgen
+  end)
+  let dgen = Dgen.gen
+
+  module Sexpgen = Make_gen(struct
+      type sexp = Sexp.t
+      let atom a = Sexp.Atom a
+      let list a = Sexp.List a
+      let program s = Dsexp.sexp_of_t (Program.dgen s)
+      let string s = Dsexp.sexp_of_t (String.dgen s)
+      let path s = Dsexp.sexp_of_t (Path.dgen s)
+    end)
+  let sexp_of_t = Sexpgen.gen
 
   let run prog args = Run (prog, args)
   let chdir path t = Chdir (path, t)

src/action.mli

@@ -95,6 +95,8 @@ module Unexpanded : sig
     -> map_exe:(Path.t -> Path.t)
     -> f:(Value.t list option String_with_vars.expander)
     -> Partial.t
+
+  val sexp_of_t : t Sexp.To_sexp.t
 end
 
 (** Infer dependencies and targets.

src/build_system.ml

@@ -1621,7 +1621,7 @@ module Alias = struct
 
   let add_action build_system t ~context ~loc ?(locks=[]) ~stamp action =
     let def = get_alias_def build_system t in
-    def.actions <- { stamp = Digest.string (Dsexp.to_string ~syntax:Dune stamp)
+    def.actions <- { stamp = Digest.string (Sexp.to_string stamp)
                    ; action
                    ; locks
                    ; context

src/build_system.mli

@@ -174,7 +174,7 @@ module Alias : sig
     -> context:Context.t
     -> loc:Loc.t option
     -> ?locks:Path.t list
-    -> stamp:Dsexp.t
+    -> stamp:Sexp.t
     -> (unit, Action.t) Build.t
     -> unit
 end with type build_system := t

src/inline_tests.ml

@@ -261,8 +261,8 @@ include Sub_system.Register_end_point(
       SC.add_alias_action sctx
         ~loc:(Some info.loc)
         (Build_system.Alias.runtest ~dir)
-        ~stamp:(List [ Dsexp.unsafe_atom_of_string "ppx-runner"
+        ~stamp:(List [ Sexp.Atom "ppx-runner"
-                     ; Quoted_string name
+                     ; Atom name
                      ])
         (let module A = Action in
          let exe = Path.relative inline_test_dir (name ^ ".exe") in

src/preprocessing.ml

@@ -463,9 +463,9 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
     let alias = Build_system.Alias.lint ~dir in
     let add_alias fn build =
       SC.add_alias_action sctx alias build
-        ~stamp:(List [ Dsexp.unsafe_atom_of_string "lint"
+        ~stamp:(List [ Sexp.Atom "lint"
-                     ; Dsexp.To_sexp.(option string) lib_name
+                     ; Sexp.To_sexp.(option string) lib_name
-                     ; Path_dsexp.dgen fn
+                     ; Path.sexp_of_t fn
                      ])
     in
     let lint =

src/simple_rules.ml

@@ -90,10 +90,10 @@ let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) =
       Blang.eval_bool blang ~dir ~f
   in
   let stamp =
-    Dsexp.List
+    Sexp.List
-      [ Dsexp.unsafe_atom_of_string "user-alias"
+      [ Sexp.Atom "user-alias"
-      ; Dune_file.Bindings.dgen Dune_file.Dep_conf.dgen alias_conf.deps
+      ; Dune_file.Bindings.sexp_of_t Dune_file.Dep_conf.sexp_of_t alias_conf.deps
-      ; Dsexp.To_sexp.option Action.Unexpanded.dgen
+      ; Sexp.To_sexp.option Action.Unexpanded.sexp_of_t
           (Option.map alias_conf.action ~f:snd)
       ]
   in

src/super_context.mli

@@ -151,7 +151,7 @@ val add_alias_action
   -> Build_system.Alias.t
   -> loc:Loc.t option
   -> ?locks:Path.t list
-  -> stamp:Dsexp.t
+  -> stamp:Sexp.t
   -> (unit, Action.t) Build.t
   -> unit