Jeremie Dimino
parent
581c63f6ca
commit
e300ca0f16
267
src/action.ml
267
src/action.ml
|
|
@ -29,97 +29,123 @@ let expand_path ~dir ~f template =
|
|||
|> Path.of_string
|
||||
|
||||
module Mini_shexp = struct
|
||||
type ('a, 'path) t =
|
||||
| Run of 'path * 'a list
|
||||
| Chdir of 'path * ('a, 'path) t
|
||||
| Setenv of 'a * 'a * ('a, 'path) t
|
||||
| With_stdout_to of 'path * ('a, 'path) t
|
||||
| Progn of ('a, 'path) t list
|
||||
| Echo of 'a
|
||||
| Create_file of 'path
|
||||
| Cat of 'path
|
||||
| Copy of 'path * 'path
|
||||
| Symlink of 'path * 'path
|
||||
| Copy_and_add_line_directive of 'path * 'path
|
||||
| System of 'a
|
||||
module Ast = struct
|
||||
type ('a, 'path) t =
|
||||
| Run of 'path * 'a list
|
||||
| Chdir of 'path * ('a, 'path) t
|
||||
| Setenv of 'a * 'a * ('a, 'path) t
|
||||
| With_stdout_to of 'path * ('a, 'path) t
|
||||
| Progn of ('a, 'path) t list
|
||||
| Echo of 'a
|
||||
| Create_file of 'path
|
||||
| Cat of 'path
|
||||
| Copy of 'path * 'path
|
||||
| Symlink of 'path * 'path
|
||||
| Copy_and_add_line_directive of 'path * 'path
|
||||
| System of 'a
|
||||
| Bash of 'a
|
||||
|
||||
let rec t a p sexp =
|
||||
sum
|
||||
[ cstr_rest "run" (p @> nil) a (fun prog args -> Run (prog, args))
|
||||
; cstr "chdir" (p @> t a p @> nil) (fun dn t -> Chdir (dn, t))
|
||||
; cstr "setenv" (a @> a @> t a p @> nil) (fun k v t -> Setenv (k, v, t))
|
||||
; cstr "with-stdout-to" (p @> t a p @> nil) (fun fn t -> With_stdout_to (fn, t))
|
||||
; cstr_rest "progn" nil (t a p) (fun l -> Progn l)
|
||||
; cstr "echo" (a @> nil) (fun x -> Echo x)
|
||||
; cstr "cat" (p @> nil) (fun x -> Cat x)
|
||||
; cstr "create-file" (p @> nil) (fun x -> Create_file x)
|
||||
; cstr "copy" (p @> p @> nil) (fun src dst -> Copy (src, dst))
|
||||
let rec t a p sexp =
|
||||
sum
|
||||
[ cstr_rest "run" (p @> nil) a (fun prog args -> Run (prog, args))
|
||||
; cstr "chdir" (p @> t a p @> nil) (fun dn t -> Chdir (dn, t))
|
||||
; cstr "setenv" (a @> a @> t a p @> nil) (fun k v t -> Setenv (k, v, t))
|
||||
; cstr "with-stdout-to" (p @> t a p @> nil) (fun fn t -> With_stdout_to (fn, t))
|
||||
; cstr_rest "progn" nil (t a p) (fun l -> Progn l)
|
||||
; cstr "echo" (a @> nil) (fun x -> Echo x)
|
||||
; cstr "cat" (p @> nil) (fun x -> Cat x)
|
||||
; cstr "create-file" (p @> nil) (fun x -> Create_file x)
|
||||
; cstr "copy" (p @> p @> nil) (fun src dst -> Copy (src, dst))
|
||||
(*
|
||||
(* We don't expose symlink to the user yet since this might complicate things *)
|
||||
; cstr "symlink" (a @> a @> nil) (fun src dst -> Symlink (dst, Cat src))
|
||||
*)
|
||||
; cstr "copy-and-add-line-directive" (p @> p @> nil) (fun src dst ->
|
||||
Copy_and_add_line_directive (src, dst))
|
||||
; cstr "system" (a @> nil) (fun cmd -> System cmd)
|
||||
]
|
||||
sexp
|
||||
(* We don't expose symlink to the user yet since this might complicate things *)
|
||||
; cstr "symlink" (a @> a @> nil) (fun src dst -> Symlink (dst, Cat src))
|
||||
*)
|
||||
; cstr "copy-and-add-line-directive" (p @> p @> nil) (fun src dst ->
|
||||
Copy_and_add_line_directive (src, dst))
|
||||
; cstr "system" (a @> nil) (fun cmd -> System cmd)
|
||||
]
|
||||
sexp
|
||||
|
||||
let rec expand dir t ~f : (string, Path.t) t =
|
||||
match t with
|
||||
| Run (prog, args) ->
|
||||
Run (expand_path ~dir ~f prog,
|
||||
List.map args ~f:(fun arg -> expand_str ~dir ~f arg))
|
||||
| Chdir (fn, t) ->
|
||||
let fn = expand_path ~dir ~f fn in
|
||||
Chdir (fn, expand fn t ~f)
|
||||
| Setenv (var, value, t) ->
|
||||
Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value,
|
||||
expand dir t ~f)
|
||||
| With_stdout_to (fn, t) ->
|
||||
With_stdout_to (expand_path ~dir ~f fn, expand dir t ~f)
|
||||
| Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f))
|
||||
| Echo x -> Echo (expand_str ~dir ~f x)
|
||||
| Cat x -> Cat (expand_path ~dir ~f x)
|
||||
| Create_file x -> Create_file (expand_path ~dir ~f x)
|
||||
| Copy (x, y) ->
|
||||
Copy (expand_path ~dir ~f x, expand_path ~dir ~f y)
|
||||
| Symlink (x, y) ->
|
||||
Symlink (expand_path ~dir ~f x, expand_path ~dir ~f y)
|
||||
| Copy_and_add_line_directive (x, y) ->
|
||||
Copy_and_add_line_directive (expand_path ~dir ~f x, expand_path ~dir ~f y)
|
||||
| System x -> System (expand_str ~dir ~f x)
|
||||
let rec sexp_of_t f g : _ -> Sexp.t = function
|
||||
| Run (a, xs) -> List (Atom "run" :: g a :: List.map xs ~f)
|
||||
| Chdir (a, r) -> List [Atom "chdir" ; g a ; sexp_of_t f g r]
|
||||
| Setenv (k, v, r) -> List [Atom "setenv" ; f k ; f v ; sexp_of_t f g r]
|
||||
| With_stdout_to (fn, r) -> List [Atom "with-stdout-to"; g fn; sexp_of_t f g r]
|
||||
| Progn l -> List (Atom "progn" :: List.map l ~f:(sexp_of_t f g))
|
||||
| Echo x -> List [Atom "echo"; f x]
|
||||
| Cat x -> List [Atom "cat"; g x]
|
||||
| Create_file x -> List [Atom "create-file"; g x]
|
||||
| Copy (x, y) ->
|
||||
List [Atom "copy"; g x; g y]
|
||||
| Symlink (x, y) ->
|
||||
List [Atom "symlink"; g x; g y]
|
||||
| Copy_and_add_line_directive (x, y) ->
|
||||
List [Atom "copy-and-add-line-directive"; g x; g y]
|
||||
| System x -> List [Atom "system"; f x]
|
||||
| Bash x -> List [Atom "bash"; f x]
|
||||
|
||||
let rec fold t ~init:acc ~f =
|
||||
match t with
|
||||
| Run (prog, args) -> List.fold_left args ~init:(f acc prog) ~f
|
||||
| Chdir (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Setenv (var, value, t) -> fold t ~init:(f (f acc var) value) ~f
|
||||
| With_stdout_to (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Progn l -> List.fold_left l ~init:acc ~f:(fun init t -> fold t ~init ~f)
|
||||
| Echo x -> f acc x
|
||||
| Cat x -> f acc x
|
||||
| Create_file x -> f acc x
|
||||
| Copy (x, y) -> f (f acc x) y
|
||||
| Symlink (x, y) -> f (f acc x) y
|
||||
| Copy_and_add_line_directive (x, y) -> f (f acc x) y
|
||||
| System x -> f acc x
|
||||
let rec fold t ~init:acc ~f =
|
||||
match t with
|
||||
| Run (prog, args) -> List.fold_left args ~init:(f acc prog) ~f
|
||||
| Chdir (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Setenv (var, value, t) -> fold t ~init:(f (f acc var) value) ~f
|
||||
| With_stdout_to (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Progn l -> List.fold_left l ~init:acc ~f:(fun init t -> fold t ~init ~f)
|
||||
| Echo x -> f acc x
|
||||
| Cat x -> f acc x
|
||||
| Create_file x -> f acc x
|
||||
| Copy (x, y) -> f (f acc x) y
|
||||
| Symlink (x, y) -> f (f acc x) y
|
||||
| Copy_and_add_line_directive (x, y) -> f (f acc x) y
|
||||
| System x -> f acc x
|
||||
| Bash x -> f acc x
|
||||
end
|
||||
open Ast
|
||||
|
||||
let rec sexp_of_t f g : _ -> Sexp.t = function
|
||||
| Run (a, xs) -> List (Atom "run" :: g a :: List.map xs ~f)
|
||||
| Chdir (a, r) -> List [Atom "chdir" ; g a ; sexp_of_t f g r]
|
||||
| Setenv (k, v, r) -> List [Atom "setenv" ; f k ; f v ; sexp_of_t f g r]
|
||||
| With_stdout_to (fn, r) -> List [Atom "with-stdout-to"; g fn; sexp_of_t f g r]
|
||||
| Progn l -> List (Atom "progn" :: List.map l ~f:(sexp_of_t f g))
|
||||
| Echo x -> List [Atom "echo"; f x]
|
||||
| Cat x -> List [Atom "cat"; g x]
|
||||
| Create_file x -> List [Atom "create-file"; g x]
|
||||
| Copy (x, y) ->
|
||||
List [Atom "copy"; g x; g y]
|
||||
| Symlink (x, y) ->
|
||||
List [Atom "symlink"; g x; g y]
|
||||
| Copy_and_add_line_directive (x, y) ->
|
||||
List [Atom "copy-and-add-line-directive"; g x; g y]
|
||||
| System x -> List [Atom "system"; f x]
|
||||
type t = (string, Path.t) Ast.t
|
||||
let t = Ast.t string Path.t
|
||||
let sexp_of_t = Ast.sexp_of_t Sexp.To_sexp.string Path.sexp_of_t
|
||||
|
||||
module Unexpanded = struct
|
||||
type t = (String_with_vars.t, String_with_vars.t) Ast.t
|
||||
|
||||
let sexp_of_t = Ast.sexp_of_t String_with_vars.sexp_of_t String_with_vars.sexp_of_t
|
||||
|
||||
let t sexp =
|
||||
match sexp with
|
||||
| Atom _ -> Bash (String_with_vars.t sexp)
|
||||
| List _ -> Ast.t String_with_vars.t String_with_vars.t sexp
|
||||
|
||||
let fold_vars t ~init ~f =
|
||||
Ast.fold t ~init ~f:(fun acc pat ->
|
||||
String_with_vars.fold ~init:acc pat ~f)
|
||||
|
||||
let rec expand dir t ~f : (string, Path.t) Ast.t =
|
||||
match t with
|
||||
| Run (prog, args) ->
|
||||
Run (expand_path ~dir ~f prog,
|
||||
List.map args ~f:(fun arg -> expand_str ~dir ~f arg))
|
||||
| Chdir (fn, t) ->
|
||||
let fn = expand_path ~dir ~f fn in
|
||||
Chdir (fn, expand fn t ~f)
|
||||
| Setenv (var, value, t) ->
|
||||
Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value,
|
||||
expand dir t ~f)
|
||||
| With_stdout_to (fn, t) ->
|
||||
With_stdout_to (expand_path ~dir ~f fn, expand dir t ~f)
|
||||
| Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f))
|
||||
| Echo x -> Echo (expand_str ~dir ~f x)
|
||||
| Cat x -> Cat (expand_path ~dir ~f x)
|
||||
| Create_file x -> Create_file (expand_path ~dir ~f x)
|
||||
| Copy (x, y) ->
|
||||
Copy (expand_path ~dir ~f x, expand_path ~dir ~f y)
|
||||
| Symlink (x, y) ->
|
||||
Symlink (expand_path ~dir ~f x, expand_path ~dir ~f y)
|
||||
| Copy_and_add_line_directive (x, y) ->
|
||||
Copy_and_add_line_directive (expand_path ~dir ~f x, expand_path ~dir ~f y)
|
||||
| System x -> System (expand_str ~dir ~f x)
|
||||
| Bash x -> Bash (expand_str ~dir ~f x)
|
||||
end
|
||||
|
||||
open Future
|
||||
|
||||
|
|
@ -204,7 +230,7 @@ module Mini_shexp = struct
|
|||
Printf.fprintf oc "# 1 %S\n" (Path.to_string fn);
|
||||
copy_channels ic oc));
|
||||
return ()
|
||||
| System cmd ->
|
||||
| System cmd -> begin
|
||||
let path, arg, err =
|
||||
Utils.system_shell ~needed_to:"interpret (system ...) actions"
|
||||
in
|
||||
|
|
@ -212,6 +238,11 @@ module Mini_shexp = struct
|
|||
| Some err -> err.fail ()
|
||||
| None ->
|
||||
run ~dir ~env ~env_extra ~stdout_to ~tail path [arg; cmd]
|
||||
end
|
||||
| Bash cmd ->
|
||||
run ~dir ~env ~env_extra ~stdout_to ~tail
|
||||
(Path.absolute "/bin/bash")
|
||||
["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
|
||||
|
||||
and exec_list l ~dir ~env ~env_extra ~stdout_to ~tail =
|
||||
match l with
|
||||
|
|
@ -225,51 +256,10 @@ module Mini_shexp = struct
|
|||
exec_list rest ~dir ~env ~env_extra ~stdout_to ~tail
|
||||
end
|
||||
|
||||
module Desc = struct
|
||||
module Ast = struct
|
||||
type ('a, 'path) t =
|
||||
| Bash of 'a
|
||||
| Shexp of ('a, 'path) Mini_shexp.t
|
||||
|
||||
let t a b sexp =
|
||||
match sexp with
|
||||
| Atom _ -> Bash (a sexp)
|
||||
| List _ -> Shexp (Mini_shexp.t a b sexp)
|
||||
|
||||
let sexp_of_t f g : _ -> Sexp.t = function
|
||||
| Bash a -> List [Atom "bash" ; f a]
|
||||
| Shexp a -> List [Atom "shexp" ; Mini_shexp.sexp_of_t f g a]
|
||||
|
||||
let fold t ~init ~f =
|
||||
match t with
|
||||
| Bash x -> f init x
|
||||
| Shexp x -> Mini_shexp.fold x ~init ~f
|
||||
end
|
||||
|
||||
type t = (string, Path.t) Ast.t
|
||||
let t = Ast.t string Path.t
|
||||
let sexp_of_t = Ast.sexp_of_t Sexp.To_sexp.string Path.sexp_of_t
|
||||
|
||||
module Unexpanded = struct
|
||||
type t = (String_with_vars.t, String_with_vars.t) Ast.t
|
||||
let t = Ast.t String_with_vars.t String_with_vars.t
|
||||
let sexp_of_t = Ast.sexp_of_t String_with_vars.sexp_of_t String_with_vars.sexp_of_t
|
||||
|
||||
let fold_vars t ~init ~f =
|
||||
Ast.fold t ~init ~f:(fun acc pat ->
|
||||
String_with_vars.fold ~init:acc pat ~f)
|
||||
|
||||
let expand dir (t : t) ~f : (_, _) Ast.t =
|
||||
match t with
|
||||
| Bash x -> Bash (expand_str ~dir ~f x)
|
||||
| Shexp x -> Shexp (Mini_shexp.expand dir x ~f)
|
||||
end
|
||||
end
|
||||
|
||||
type t =
|
||||
{ context : Context.t option
|
||||
; dir : Path.t
|
||||
; action : Desc.t
|
||||
; action : Mini_shexp.t
|
||||
}
|
||||
|
||||
let t contexts sexp =
|
||||
|
|
@ -281,16 +271,16 @@ let t contexts sexp =
|
|||
| Some c -> c
|
||||
in
|
||||
record
|
||||
(field_o "context" context >>= fun context ->
|
||||
field "dir" Path.t >>= fun dir ->
|
||||
field "action" Desc.t >>= fun action ->
|
||||
(field_o "context" context >>= fun context ->
|
||||
field "dir" Path.t >>= fun dir ->
|
||||
field "action" Mini_shexp.t >>= fun action ->
|
||||
return { context; dir; action })
|
||||
sexp
|
||||
|
||||
let sexp_of_t { context; dir; action } =
|
||||
let fields : Sexp.t list =
|
||||
[ List [ Atom "dir" ; Path.sexp_of_t dir ]
|
||||
; List [ Atom "action" ; Desc.sexp_of_t action ]
|
||||
[ List [ Atom "dir" ; Path.sexp_of_t dir ]
|
||||
; List [ Atom "action" ; Mini_shexp.sexp_of_t action ]
|
||||
]
|
||||
in
|
||||
let fields =
|
||||
|
|
@ -306,10 +296,5 @@ let exec { action; dir; context } =
|
|||
| None -> Lazy.force Context.initial_env
|
||||
| Some c -> c.env
|
||||
in
|
||||
match action with
|
||||
| Bash cmd ->
|
||||
Future.run Strict ~dir:(Path.to_string dir) ~env
|
||||
"/bin/bash" ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
|
||||
| Shexp shexp ->
|
||||
Mini_shexp.exec shexp ~dir ~env ~env_extra:String_map.empty
|
||||
~stdout_to:None ~tail:true
|
||||
Mini_shexp.exec action ~dir ~env ~env_extra:String_map.empty
|
||||
~stdout_to:None ~tail:true
|
||||
|
|
|
|||
|
|
@ -7,30 +7,21 @@ type var_expansion =
|
|||
| Str of string
|
||||
|
||||
module Mini_shexp : sig
|
||||
type ('a, 'path) t =
|
||||
| Run of 'path * 'a list
|
||||
| Chdir of 'path * ('a, 'path) t
|
||||
| Setenv of 'a * 'a * ('a, 'path) t
|
||||
| With_stdout_to of 'path * ('a, 'path) t
|
||||
| Progn of ('a, 'path) t list
|
||||
| Echo of 'a
|
||||
| Create_file of 'path
|
||||
| Cat of 'path
|
||||
| Copy of 'path * 'path
|
||||
| Symlink of 'path * 'path
|
||||
| Copy_and_add_line_directive of 'path * 'path
|
||||
| System of 'a
|
||||
|
||||
val t : 'a Sexp.Of_sexp.t -> 'b Sexp.Of_sexp.t -> ('a, 'b) t Sexp.Of_sexp.t
|
||||
val sexp_of_t : 'a Sexp.To_sexp.t -> 'b Sexp.To_sexp.t -> ('a, 'b) t Sexp.To_sexp.t
|
||||
end
|
||||
|
||||
module Desc : sig
|
||||
module Ast : sig
|
||||
type ('a, 'path) t =
|
||||
| Bash of 'a
|
||||
| Shexp of ('a, 'path) Mini_shexp.t
|
||||
|
||||
| Run of 'path * 'a list
|
||||
| Chdir of 'path * ('a, 'path) t
|
||||
| Setenv of 'a * 'a * ('a, 'path) t
|
||||
| With_stdout_to of 'path * ('a, 'path) t
|
||||
| Progn of ('a, 'path) t list
|
||||
| Echo of 'a
|
||||
| Create_file of 'path
|
||||
| Cat of 'path
|
||||
| Copy of 'path * 'path
|
||||
| Symlink of 'path * 'path
|
||||
| Copy_and_add_line_directive of 'path * 'path
|
||||
| System of 'a
|
||||
| Bash of 'a
|
||||
val t : 'a Sexp.Of_sexp.t -> 'b Sexp.Of_sexp.t -> ('a, 'b) t Sexp.Of_sexp.t
|
||||
val sexp_of_t : 'a Sexp.To_sexp.t -> 'b Sexp.To_sexp.t -> ('a, 'b) t Sexp.To_sexp.t
|
||||
end
|
||||
|
|
@ -52,7 +43,7 @@ end
|
|||
type t =
|
||||
{ context : Context.t option
|
||||
; dir : Path.t
|
||||
; action : Desc.t
|
||||
; action : Mini_shexp.t
|
||||
}
|
||||
|
||||
val t : Context.t String_map.t -> t Sexp.Of_sexp.t
|
||||
|
|
|
|||
25
src/build.ml
25
src/build.ml
|
|
@ -145,7 +145,7 @@ let run ?(dir=Path.root) ?stdout_to ?context ?(extra_targets=[]) prog args =
|
|||
>>>
|
||||
Targets targets
|
||||
>>^ (fun (prog, args) ->
|
||||
let action : (_, _) Action.Mini_shexp.t = Run (prog, args) in
|
||||
let action : Action.Mini_shexp.t = Run (prog, args) in
|
||||
let action =
|
||||
match stdout_to with
|
||||
| None -> action
|
||||
|
|
@ -154,7 +154,7 @@ let run ?(dir=Path.root) ?stdout_to ?context ?(extra_targets=[]) prog args =
|
|||
{ Action.
|
||||
dir
|
||||
; context
|
||||
; action = Shexp action
|
||||
; action
|
||||
})
|
||||
|
||||
let action ?(dir=Path.root) ?context ~targets action =
|
||||
|
|
@ -162,11 +162,8 @@ let action ?(dir=Path.root) ?context ~targets action =
|
|||
>>^ fun () ->
|
||||
{ Action. context; dir; action }
|
||||
|
||||
let shexp ?dir ?context ~targets shexp =
|
||||
action ?dir ?context ~targets (Shexp shexp)
|
||||
|
||||
let echo fn s =
|
||||
shexp ~targets:[fn] (With_stdout_to (fn, Echo s))
|
||||
action ~targets:[fn] (With_stdout_to (fn, Echo s))
|
||||
|
||||
let echo_dyn fn =
|
||||
Targets [fn]
|
||||
|
|
@ -174,28 +171,22 @@ let echo_dyn fn =
|
|||
{ Action.
|
||||
context = None
|
||||
; dir = Path.root
|
||||
; action = Shexp (With_stdout_to (fn, Echo s))
|
||||
; action = With_stdout_to (fn, Echo s)
|
||||
}
|
||||
|
||||
let copy ~src ~dst =
|
||||
path src >>>
|
||||
shexp ~targets:[dst] (Copy (src, dst))
|
||||
action ~targets:[dst] (Copy (src, dst))
|
||||
|
||||
let symlink ~src ~dst =
|
||||
path src >>>
|
||||
shexp ~targets:[dst] (Symlink (src, dst))
|
||||
action ~targets:[dst] (Symlink (src, dst))
|
||||
|
||||
let create_file fn =
|
||||
shexp ~targets:[fn] (Create_file fn)
|
||||
action ~targets:[fn] (Create_file fn)
|
||||
|
||||
let and_create_file fn =
|
||||
arr (fun (action : Action.t) ->
|
||||
{ action with
|
||||
action =
|
||||
match action.action with
|
||||
| Bash cmd ->
|
||||
let fn = quote_for_shell (Path.to_string fn) in
|
||||
Bash (sprintf "(%s); rm -f %s; touch %s" cmd fn fn)
|
||||
| Shexp shexp ->
|
||||
Shexp (Progn [shexp; Create_file fn])
|
||||
action = Progn [action.action; Create_file fn]
|
||||
})
|
||||
|
|
|
|||
|
|
@ -65,14 +65,7 @@ val action
|
|||
: ?dir:Path.t
|
||||
-> ?context:Context.t
|
||||
-> targets:Path.t list
|
||||
-> Action.Desc.t
|
||||
-> (unit, Action.t) t
|
||||
|
||||
val shexp
|
||||
: ?dir:Path.t
|
||||
-> ?context:Context.t
|
||||
-> targets:Path.t list
|
||||
-> (string, Path.t) Action.Mini_shexp.t
|
||||
-> Action.Mini_shexp.t
|
||||
-> (unit, Action.t) t
|
||||
|
||||
(** Create a file with the given contents. *)
|
||||
|
|
|
|||
|
|
@ -156,7 +156,7 @@ module Build_exec = struct
|
|||
{ Action.
|
||||
context = None
|
||||
; dir = Path.root
|
||||
; action = Shexp (Progn [])
|
||||
; action = Progn []
|
||||
}
|
||||
|
||||
let exec bs t x ~targeting =
|
||||
|
|
|
|||
|
|
@ -241,7 +241,7 @@ module Gen(P : Params) = struct
|
|||
List.map (Lib_db.resolve_selects t ~from:dir lib_deps) ~f:(fun { dst_fn; src_fn } ->
|
||||
let src = Path.relative dir src_fn in
|
||||
let dst = Path.relative dir dst_fn in
|
||||
Build.shexp ~targets:[dst]
|
||||
Build.action ~targets:[dst]
|
||||
(Copy_and_add_line_directive (src, dst)))
|
||||
|
||||
(* Hides [t] so that we don't resolve things statically *)
|
||||
|
|
@ -299,11 +299,8 @@ module Gen(P : Params) = struct
|
|||
let action ?dir ~targets action =
|
||||
Build.action ?dir ~context:ctx ~targets action
|
||||
|
||||
let shexp ?dir ~targets shexp =
|
||||
Build.shexp ?dir ~context:ctx ~targets shexp
|
||||
|
||||
let shexp_context_independent ?dir ~targets shexp =
|
||||
Build.shexp ?dir ~targets shexp
|
||||
let action_context_independent ?dir ~targets shexp =
|
||||
Build.action ?dir ~targets shexp
|
||||
end
|
||||
|
||||
module Alias = struct
|
||||
|
|
@ -1296,14 +1293,14 @@ module Gen(P : Params) = struct
|
|||
|
||||
module Action_interpret : sig
|
||||
val run
|
||||
: Action.Desc.Unexpanded.t
|
||||
: Action.Mini_shexp.Unexpanded.t
|
||||
-> dir:Path.t
|
||||
-> dep_kind:Build.lib_dep_kind
|
||||
-> targets:Path.t list
|
||||
-> deps:Dep_conf.t list
|
||||
-> (unit, Action.t) Build.t
|
||||
end = struct
|
||||
module U = Action.Desc.Unexpanded
|
||||
module U = Action.Mini_shexp.Unexpanded
|
||||
|
||||
type resolved_forms =
|
||||
{ (* Mapping from ${...} forms to their resolutions *)
|
||||
|
|
@ -1425,7 +1422,7 @@ module Gen(P : Params) = struct
|
|||
let action =
|
||||
match alias_conf.action with
|
||||
| None -> Sexp.Atom "none"
|
||||
| Some a -> List [Atom "some" ; Action.Desc.Unexpanded.sexp_of_t a] in
|
||||
| Some a -> List [Atom "some" ; Action.Mini_shexp.Unexpanded.sexp_of_t a] in
|
||||
Sexp.List [deps ; action]
|
||||
|> Sexp.to_string
|
||||
|> Digest.string
|
||||
|
|
|
|||
|
|
@ -546,13 +546,13 @@ module Rule = struct
|
|||
type t =
|
||||
{ targets : string list (** List of files in the current directory *)
|
||||
; deps : Dep_conf.t list
|
||||
; action : Action.Desc.Unexpanded.t
|
||||
; action : Action.Mini_shexp.Unexpanded.t
|
||||
}
|
||||
|
||||
let common =
|
||||
field "targets" (list file_in_current_dir) >>= fun targets ->
|
||||
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
||||
field "action" Action.Desc.Unexpanded.t >>= fun action ->
|
||||
field "action" Action.Mini_shexp.Unexpanded.t >>= fun action ->
|
||||
return { targets; deps; action }
|
||||
|
||||
let v1 = record common
|
||||
|
|
@ -570,11 +570,10 @@ module Rule = struct
|
|||
{ targets = [dst]
|
||||
; deps = [File (str src)]
|
||||
; action =
|
||||
Shexp
|
||||
(Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:ocamllex}",
|
||||
[str "-q"; str "-o"; str "${@}"; str "${<}"])))
|
||||
Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:ocamllex}",
|
||||
[str "-q"; str "-o"; str "${@}"; str "${<}"]))
|
||||
})
|
||||
|
||||
let ocamllex_vjs = ocamllex_v1
|
||||
|
|
@ -586,11 +585,10 @@ module Rule = struct
|
|||
{ targets = [name ^ ".ml"; name ^ ".mli"]
|
||||
; deps = [File (str src)]
|
||||
; action =
|
||||
Shexp
|
||||
(Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:ocamlyacc}",
|
||||
[str "${<}"])))
|
||||
Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:ocamlyacc}",
|
||||
[str "${<}"]))
|
||||
})
|
||||
|
||||
let ocamlyacc_vjs = ocamlyacc_v1
|
||||
|
|
@ -660,13 +658,13 @@ module Alias_conf = struct
|
|||
type t =
|
||||
{ name : string
|
||||
; deps : Dep_conf.t list
|
||||
; action : Action.Desc.Unexpanded.t option
|
||||
; action : Action.Mini_shexp.Unexpanded.t option
|
||||
}
|
||||
|
||||
let common =
|
||||
field "name" string >>= fun name ->
|
||||
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
||||
field_o "action" Action.Desc.Unexpanded.t >>= fun action ->
|
||||
field_o "action" Action.Mini_shexp.Unexpanded.t >>= fun action ->
|
||||
return
|
||||
{ name
|
||||
; deps
|
||||
|
|
|
|||
|
|
@ -57,6 +57,8 @@ let of_string s = of_tokens (Token.tokenise s)
|
|||
|
||||
let t sexp = of_string (Sexp.Of_sexp.string sexp)
|
||||
|
||||
let raw s = [Text s]
|
||||
|
||||
let just_a_var = function
|
||||
| [Var (_, s)] -> Some s
|
||||
| _ -> None
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ val t : t Sexp.Of_sexp.t
|
|||
val sexp_of_t : t -> Sexp.t
|
||||
|
||||
val of_string : string -> t
|
||||
val raw : string -> t
|
||||
|
||||
val just_a_var : t -> string option
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue