From 0f28c8bba05cf6090332c07c918c05759bcd1a33 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 24 Feb 2017 10:49:27 +0000 Subject: [PATCH] Refactor Sexp.of_sexp_error API --- src/jbuild_load.ml | 2 +- src/jbuild_types.ml | 31 +++++++++---------- src/sexp.ml | 74 ++++++++++++++++++++++----------------------- src/sexp.mli | 5 +-- src/sexp_load.ml | 4 +-- 5 files changed, 57 insertions(+), 59 deletions(-) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 88eea83e..6307d223 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -23,7 +23,7 @@ let load ~dir ~visible_packages ~version = | [] -> version | [(v, _)] -> v | _ :: (_, sexp) :: _ -> - of_sexp_error "jbuilder_version specified too many times" sexp + of_sexp_error sexp "jbuilder_version specified too many times" in (version, List.filter_map sexps ~f:(Stanza.select version))) in diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml index 5c4f8efa..79fff5ad 100644 --- a/src/jbuild_types.ml +++ b/src/jbuild_types.ml @@ -10,6 +10,7 @@ open Sexp.Of_sexp type sexp = Sexp.t = Atom of string | List of sexp list let of_sexp_error = Sexp.of_sexp_error +let of_sexp_errorf = Sexp.of_sexp_errorf module Jbuilder_version = struct type t = @@ -26,7 +27,7 @@ module Jbuilder_version = struct end let invalid_module_name sexp = - of_sexp_error "invalid module name" sexp + of_sexp_error sexp "invalid module name" let module_name sexp = match string sexp with @@ -41,7 +42,7 @@ let module_name sexp = let module_names sexp = String_set.of_list (list module_name sexp) let invalid_lib_name sexp = - of_sexp_error "invalid library name" sexp + of_sexp_error sexp "invalid library name" let library_name sexp = match string sexp with @@ -56,16 +57,16 @@ let library_name sexp = let file sexp = match string sexp with | "." | ".." -> - Sexp.of_sexp_error "'.' and '..' are not valid filenames" sexp + of_sexp_error sexp "'.' and '..' are not valid filenames" | fn -> fn let file_in_current_dir sexp = match string sexp with | "." | ".." -> - Sexp.of_sexp_error "'.' and '..' are not valid filenames" sexp + of_sexp_error sexp "'.' and '..' are not valid filenames" | fn -> if Filename.dirname fn <> Filename.current_dir_name then - Sexp.of_sexp_error "file in current directory expected" sexp; + of_sexp_error sexp "file in current directory expected"; fn module Raw_string () : sig @@ -92,7 +93,7 @@ module Pp = struct let t sexp = let s = string sexp in if String.is_prefix s ~prefix:"-" then - of_sexp_error "flag not allowed here" sexp + of_sexp_error sexp "flag not allowed here" else of_string s @@ -133,13 +134,13 @@ module User_action = struct | List [ Atom "chdir"; dir; arg ] -> Chdir (a dir, t a arg) | List [ Atom "setenv"; var; value; arg ] -> Setenv (a var, a value, t a arg) | _ -> - of_sexp_error "\ + of_sexp_error sexp "\ invalid action, expected one of: (run ) (chdir ) (setenv ) -" sexp +" let rec map t ~f = match t with @@ -292,7 +293,7 @@ module Preprocess_map = struct |> function | Ok map -> Per_file map | Error (name, _, _) -> - Sexp.of_sexp_error (sprintf "module %s present in two different sets" name) sexp + of_sexp_error sexp (sprintf "module %s present in two different sets" name) end | sexp -> For_all (Preprocess.t sexp) @@ -343,7 +344,7 @@ module Lib_dep = struct ; file = file sexp } | Atom "->" :: _ | List _ :: _ | [] -> - of_sexp_error "(<[!]libraries>... -> ) expected" sexp + of_sexp_error sexp "(<[!]libraries>... -> ) expected" | Atom s :: l -> let len = String.length s in if len > 0 && s.[0] = '!' then @@ -353,7 +354,7 @@ module Lib_dep = struct loop (Pos s :: acc) l in loop [] l - | sexp -> of_sexp_error "( ) expected" sexp + | sexp -> of_sexp_error sexp "( ) expected" let sexp_of_choice { lits; file } = List (List.fold_right lits ~init:[Atom "->"; Atom file] ~f:(fun lit acc -> @@ -369,8 +370,7 @@ module Lib_dep = struct ; choices = List.map libs ~f:choice } | sexp -> - of_sexp_error " or (select from ) expected" - sexp + of_sexp_error sexp " or (select from ) expected" let to_lib_names = function | Direct s -> [s] @@ -688,7 +688,7 @@ module Provides = struct ; file } | sexp -> - of_sexp_error "[] or [ (file )] expected" sexp + of_sexp_error sexp "[] or [ (file )] expected" let vjs = v1 end @@ -704,9 +704,8 @@ module Install_conf = struct | Atom src -> { src; dst = None } | List [Atom src; Atom "as"; Atom dst] -> { src; dst = Some dst } | _ -> - of_sexp_error + of_sexp_error sexp "invalid format, or ( as ) expected" - sexp type t = { section : Install.Section.t diff --git a/src/sexp.ml b/src/sexp.ml index f56c19db..b404f4b6 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -39,9 +39,10 @@ let locate_in_list ts ~sub ~locs = let locate t ~sub ~locs = locate_in_list [t] ~sub ~locs:[locs] -exception Of_sexp_error of string * t +exception Of_sexp_error of t * string -let of_sexp_error msg t = raise (Of_sexp_error (msg, t)) +let of_sexp_error t msg = raise (Of_sexp_error (t, msg)) +let of_sexp_errorf t fmt = Printf.ksprintf (of_sexp_error t) fmt let must_escape str = let len = String.length str in @@ -93,44 +94,44 @@ module Of_sexp = struct let unit = function | List [] -> () - | sexp -> of_sexp_error "() expected" sexp + | sexp -> of_sexp_error sexp "() expected" let string = function | Atom s -> s - | List _ as sexp -> of_sexp_error "Atom expected" sexp + | List _ as sexp -> of_sexp_error sexp "Atom expected" let int sexp = let s = string sexp in try int_of_string s with _ -> - of_sexp_error "Integer expected" sexp + of_sexp_error sexp "Integer expected" let bool sexp = match string sexp with | "true" -> true | "false" -> false - | _ -> of_sexp_error "'true' or 'false' expected" sexp + | _ -> of_sexp_error sexp "'true' or 'false' expected" let pair fa fb = function | List [a; b] -> (fa a, fb b) - | sexp -> of_sexp_error "S-expression of the form (_ _) expected" sexp + | sexp -> of_sexp_error sexp "S-expression of the form (_ _) expected" let list f = function - | Atom _ as sexp -> of_sexp_error "List expected" sexp + | Atom _ as sexp -> of_sexp_error sexp "List expected" | List l -> List.map l ~f let option f = function | List [] -> None | List [x] -> Some (f x) - | sexp -> of_sexp_error "S-expression of the form () or (_) expected" sexp + | sexp -> of_sexp_error sexp "S-expression of the form () or (_) expected" let string_set sexp = String_set.of_list (list string sexp) let string_map f sexp = match String_map.of_alist (list (pair string f) sexp) with | Ok x -> x | Error (key, _v1, _v2) -> - of_sexp_error (sprintf "key %S present multiple times" key) sexp + of_sexp_error sexp (sprintf "key %S present multiple times" key) type unparsed_field = { value : sexp option @@ -187,19 +188,19 @@ module Of_sexp = struct | Some { value = Some value } -> (value_of_sexp value, consume name state) | Some { value = None } -> - of_sexp_error (Printf.sprintf "field %s needs a value" name) state.record + of_sexp_error state.record (Printf.sprintf "field %s needs a value" name) | None -> match default with | Some v -> (v, add_known name state) | None -> - of_sexp_error (Printf.sprintf "field %s missing" name) state.record + of_sexp_error state.record (Printf.sprintf "field %s missing" name) let field_o name value_of_sexp state = match Name_map.find name state.unparsed with | Some { value = Some value } -> (Some (value_of_sexp value), consume name state) | Some { value = None } -> - of_sexp_error (Printf.sprintf "field %s needs a value" name) state.record + of_sexp_error state.record (Printf.sprintf "field %s needs a value" name) | None -> (None, add_known name state) let field_b name state = @@ -213,7 +214,7 @@ module Of_sexp = struct let make_record_parser_state sexp = match sexp with - | Atom _ -> of_sexp_error "List expected" sexp + | Atom _ -> of_sexp_error sexp "List expected" | List sexps -> let unparsed = List.fold_left sexps ~init:Name_map.empty ~f:(fun acc sexp -> @@ -225,10 +226,10 @@ module Of_sexp = struct | Atom name -> Name_map.add acc ~key:name ~data:{ value = Some value; entry = sexp } | List _ -> - of_sexp_error "Atom expected" name_sexp + of_sexp_error name_sexp "Atom expected" end | _ -> - of_sexp_error "S-expression of the form (_ _) expected" sexp) + of_sexp_error sexp "S-expression of the form (_ _) expected") in { record = sexp ; known = [] @@ -247,9 +248,8 @@ module Of_sexp = struct | List (s :: _) -> s | _ -> assert false in - of_sexp_error - (Printf.sprintf "Unknown field %s%s" name - (hint name state.known)) name_sexp + of_sexp_errorf name_sexp + "Unknown field %s%s" name (hint name state.known) module Constructor_args_spec = struct type 'a conv = 'a t @@ -261,8 +261,8 @@ module Of_sexp = struct = fun t sexp sexps f -> match t, sexps with | [], [] -> f - | _ :: _, [] -> of_sexp_error "not enough arguments" sexp - | [], _ :: _ -> of_sexp_error "too many arguments" sexp + | _ :: _, [] -> of_sexp_error sexp "not enough arguments" + | [], _ :: _ -> of_sexp_error sexp "too many arguments" | conv :: t, s :: sexps -> convert t sexp sexps (f (conv s)) end @@ -307,13 +307,12 @@ module Of_sexp = struct with | Some cstr -> cstr | None -> - of_sexp_error - (sprintf "Unknown constructor %s%s" name - (hint - (String.uncapitalize_ascii name) - (List.map cstrs ~f:(fun (Constructor_spec.T c) -> - String.uncapitalize_ascii c.name))) - ) sexp + of_sexp_errorf sexp + "Unknown constructor %s%s" name + (hint + (String.uncapitalize_ascii name) + (List.map cstrs ~f:(fun (Constructor_spec.T c) -> + String.uncapitalize_ascii c.name))) let sum cstrs sexp = match sexp with @@ -321,17 +320,17 @@ module Of_sexp = struct let (Constructor_spec.T c) = find_cstr cstrs sexp s in Constructor_args_spec.convert c.args sexp [] c.make end - | List [] -> of_sexp_error "non-empty list expected" sexp + | List [] -> of_sexp_error sexp "non-empty list expected" | List (name_sexp :: args) -> match name_sexp with - | List _ -> of_sexp_error "Atom expected" name_sexp + | List _ -> of_sexp_error name_sexp "Atom expected" | Atom s -> let (Constructor_spec.T c) = find_cstr cstrs sexp s in Constructor_args_spec.convert c.args sexp args c.make let enum cstrs sexp = match sexp with - | List _ -> of_sexp_error "Atom expected" sexp + | List _ -> of_sexp_error sexp "Atom expected" | Atom s -> match List.find cstrs ~f:(fun (name, _) -> @@ -339,13 +338,12 @@ module Of_sexp = struct with | Some (_, value) -> value | None -> - of_sexp_error - (sprintf "Unknown value %s%s" s - (hint - (String.uncapitalize_ascii s) - (List.map cstrs ~f:(fun (name, _) -> - String.uncapitalize_ascii name))) - ) sexp + of_sexp_errorf sexp + "Unknown value %s%s" s + (hint + (String.uncapitalize_ascii s) + (List.map cstrs ~f:(fun (name, _) -> + String.uncapitalize_ascii name))) end (* module Both = struct diff --git a/src/sexp.mli b/src/sexp.mli index e2882eb6..d809a21b 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -4,9 +4,10 @@ type t = | Atom of string | List of t list -exception Of_sexp_error of string * t +exception Of_sexp_error of t * string -val of_sexp_error : string -> t -> _ +val of_sexp_error : t -> string -> _ +val of_sexp_errorf : t -> ('a, unit, string, 'b) format4 -> 'a module Locs : sig type t = diff --git a/src/sexp_load.ml b/src/sexp_load.ml index e747ad32..7cb8ea3a 100644 --- a/src/sexp_load.ml +++ b/src/sexp_load.ml @@ -6,7 +6,7 @@ let single fn f = in try f sexp - with Sexp.Of_sexp_error (msg, sub) -> + with Sexp.Of_sexp_error (sub, msg) -> let loc = match Sexp.locate sexp ~sub ~locs with | None -> Loc.in_file fn @@ -21,7 +21,7 @@ let many fn f = in try f sexps - with Sexp.Of_sexp_error (msg, sub) -> + with Sexp.Of_sexp_error (sub, msg) -> let loc = match Sexp.locate_in_list sexps ~sub ~locs with | None -> Loc.in_file fn