matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Change stamp to use Sexp.t to calculate hash 

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-22 14:41:05 +03:00
parent 214131b27d
commit b8d01a190e
8 changed files with 91 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
src/action.ml
View File

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

2
src/action.mli
View File

@ -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.

2
src/build_system.ml
View File

@ -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

2
src/build_system.mli
View File

@ -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

4
src/inline_tests.ml
View File

@ -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"
; Quoted_string name
~stamp:(List [ Sexp.Atom "ppx-runner"
; Atom name
])
(let module A = Action in
let exe = Path.relative inline_test_dir (name ^ ".exe") in

6
src/preprocessing.ml
View File

@ -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"
; Dsexp.To_sexp.(option string) lib_name
; Path_dsexp.dgen fn
~stamp:(List [ Sexp.Atom "lint"
; Sexp.To_sexp.(option string) lib_name
; Path.sexp_of_t fn
])
in
let lint =

8
src/simple_rules.ml
View File

@ -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
[ Dsexp.unsafe_atom_of_string "user-alias"
; Dune_file.Bindings.dgen Dune_file.Dep_conf.dgen alias_conf.deps
; Dsexp.To_sexp.option Action.Unexpanded.dgen
Sexp.List
[ Sexp.Atom "user-alias"
; Dune_file.Bindings.sexp_of_t Dune_file.Dep_conf.sexp_of_t alias_conf.deps
; Sexp.To_sexp.option Action.Unexpanded.sexp_of_t
(Option.map alias_conf.action ~f:snd)
]
in

2
src/super_context.mli
View File

@ -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