diff --git a/src/action.ml b/src/action.ml index f6083123..6255d017 100644 --- a/src/action.ml +++ b/src/action.ml @@ -30,7 +30,7 @@ struct let rec t sexp = let path = Path.t and string = String.t in sum - [ cstr_rest "run" (Program.t @> nil) string (fun prog args -> Run (prog, args)) + [ cstr "run" (Program.t @> rest string) (fun prog args -> Run (prog, args)) ; cstr "chdir" (path @> t @> nil) (fun dn t -> Chdir (dn, t)) ; cstr "setenv" (string @> string @> t @> nil) (fun k v t -> Setenv (k, v, t)) ; cstr "with-stdout-to" (path @> t @> nil) (fun fn t -> Redirect (Stdout, fn, t)) @@ -39,7 +39,7 @@ struct ; cstr "ignore-stdout" (t @> nil) (fun t -> Ignore (Stdout, t)) ; cstr "ignore-stderr" (t @> nil) (fun t -> Ignore (Stderr, t)) ; cstr "ignore-outputs" (t @> nil) (fun t -> Ignore (Outputs, t)) - ; cstr_rest "progn" nil t (fun l -> Progn l) + ; cstr "progn" (rest t) (fun l -> Progn l) ; cstr "echo" (string @> nil) (fun x -> Echo x) ; cstr "cat" (path @> nil) (fun x -> Cat x) ; cstr "copy" (path @> path @> nil) (fun src dst -> Copy (src, dst)) diff --git a/src/jbuild.ml b/src/jbuild.ml index ecd5f483..5286d337 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1265,7 +1265,7 @@ module Stanzas = struct (fun glob -> [Copy_files {add_line_directive = false; glob}]) ; cstr "copy_files#" (Copy_files.v1 @> nil) (fun glob -> [Copy_files {add_line_directive = true; glob}]) - ; cstr_rest_loc "env" nil Env.rule + ; cstr_loc "env" (rest Env.rule) (fun loc rules -> [Env { loc; rules }]) (* Just for validation and error messages *) ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> []) diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index cc42e58a..45103d4f 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -336,35 +336,31 @@ module Of_sexp = struct of_sexp_errorf ~hint:({ on = name ; candidates = state.known}) name_sexp "Unknown field %s" name - type ('a, 'b) rest = - | No_rest : ('a, 'a) rest - | Many : 'a t -> ('a list -> 'b, 'b) rest - module Constructor_args_spec = struct type 'a conv = 'a t type ('a, 'b) t = | Nil : ('a, 'a) t + | Rest : 'a conv -> ('a list -> 'b, 'b) t | Cons : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t - let rec convert : type a b c. (a, b) t -> (b, c) rest -> Ast.t -> Ast.t list -> a -> c - = fun t rest sexp sexps f -> - match t, rest, sexps with - | Nil, No_rest, [] -> f - | Nil, Many _ , [] -> f [] - | Cons _, _, [] -> of_sexp_error sexp "not enough arguments" - | Nil, No_rest, _ :: _ -> of_sexp_error sexp "too many arguments" - | Nil, Many conv, l -> f (List.map l ~f:conv) - | Cons (conv, t), _, s :: sexps -> - convert t rest sexp sexps (f (conv s)) + let rec convert : type a b. (a, b) t -> Ast.t -> Ast.t list -> a -> b + = fun t sexp sexps f -> + match t, sexps with + | Nil, [] -> f + | Rest conv, l -> f (List.map l ~f:conv) + | Cons (conv, t), s :: sexps -> convert t sexp sexps (f (conv s)) + | Cons _, [] -> of_sexp_error sexp "not enough arguments" + | Nil, _ :: _ -> of_sexp_error sexp "too many arguments" end let nil = Constructor_args_spec.Nil let ( @> ) a b = Constructor_args_spec.Cons (a, b) + let rest f = Constructor_args_spec.Rest f let field_multi name ?default args_spec f state = match find_single state name with | Some { values; entry; _ } -> - (Constructor_args_spec.convert args_spec No_rest entry values f, + (Constructor_args_spec.convert args_spec entry values f, consume name state) | None -> match default with @@ -377,7 +373,7 @@ module Of_sexp = struct | None -> acc | Some { values; entry; prev } -> let x = - Constructor_args_spec.convert args_spec No_rest entry values f + Constructor_args_spec.convert args_spec entry values f in loop (x :: acc) prev in @@ -385,10 +381,9 @@ module Of_sexp = struct (res, consume name state) module Constructor_spec = struct - type ('a, 'b, 'c) tuple = + type ('a, 'b) tuple = { name : string ; args : ('a, 'b) Constructor_args_spec.t - ; rest : ('b, 'c) rest ; make : Loc.t -> 'a } @@ -398,8 +393,8 @@ module Of_sexp = struct } type 'a t = - | Tuple : (_, _, 'a) tuple -> 'a t - | Record : 'a record -> 'a t + | Tuple : (_, 'a) tuple -> 'a t + | Record : 'a record -> 'a t let name = function | Tuple x -> x.name @@ -408,9 +403,7 @@ module Of_sexp = struct module C = Constructor_spec let cstr_loc name args make = - C.Tuple { name; args; make; rest = No_rest } - let cstr_rest_loc name args rest make = - C.Tuple { name; args; make; rest = Many rest } + C.Tuple { name; args; make } let cstr_record name parse = C.Record { name; parse } @@ -418,9 +411,6 @@ module Of_sexp = struct let cstr name args make = cstr_loc name args (fun _ -> make) - let cstr_rest name args rest make = - cstr_rest_loc name args rest (fun _ -> make) - let equal_cstr_name a b = Name.compare a b = Eq let find_cstr cstrs sexp name = @@ -441,7 +431,7 @@ module Of_sexp = struct match sexp with | Atom (loc, A s) -> begin match find_cstr cstrs sexp s with - | C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp [] (t.make loc) + | C.Tuple t -> Constructor_args_spec.convert t.args sexp [] (t.make loc) | C.Record _ -> of_sexp_error sexp "'%s' expect arguments" end | Quoted_string _ -> of_sexp_error sexp "Atom expected" @@ -451,7 +441,8 @@ module Of_sexp = struct | Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected" | Atom (_, A s) -> match find_cstr cstrs sexp s with - | C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp args (t.make loc) + | C.Tuple t -> Constructor_args_spec.convert t.args sexp args + (t.make loc) | C.Record r -> record r.parse (List (loc, args)) let enum cstrs sexp = diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index e152d6ae..329355b4 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -129,6 +129,7 @@ module Of_sexp : sig : 'a t -> ('b, 'c) Constructor_args_spec.t -> ('a -> 'b, 'c) Constructor_args_spec.t + val rest : 'a t -> ('a list -> 'b, 'b) Constructor_args_spec.t (** Field that takes multiple values *) val field_multi @@ -147,12 +148,6 @@ module Of_sexp : sig -> 'b list record_parser val cstr : string -> ('a, 'b) Constructor_args_spec.t -> 'a -> 'b Constructor_spec.t - val cstr_rest - : string - -> ('a, 'b list -> 'c) Constructor_args_spec.t - -> 'b t - -> 'a - -> 'c Constructor_spec.t val cstr_record : string -> 'a record_parser -> 'a Constructor_spec.t @@ -162,13 +157,6 @@ module Of_sexp : sig -> (Loc.t -> 'a) -> 'b Constructor_spec.t - val cstr_rest_loc - : string - -> ('a, 'b list -> 'c) Constructor_args_spec.t - -> 'b t - -> (Loc.t -> 'a) - -> 'c Constructor_spec.t - val sum : 'a Constructor_spec.t list -> 'a t