From de038270f72214b169d056642eb7144a79e6f126 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 7 Jul 2016 04:56:24 +0200 Subject: Unify location handling of error functions. In some cases prior to this patch, there were two cases for the same error function, one taking a location, the other not. We unify them by using an option parameter, in the line with recent changes in warnings and feedback. This implies a bit of clean up in some places, but more importantly, is the preparation for subsequent patches making `Loc.location` opaque, change that could be use to improve modularity and allow a more functional implementation strategy --- for example --- of the beautifier. --- checker/modops.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'checker') diff --git a/checker/modops.ml b/checker/modops.ml index b720fb6213..de1db6e355 100644 --- a/checker/modops.ml +++ b/checker/modops.ml @@ -33,7 +33,7 @@ let error_no_such_label_sub l l1 = Label.to_string l^" is missing in "^l1^".") let error_not_a_module_loc loc s = - user_err_loc (loc,"",str ("\""^Label.to_string s^"\" is not a module")) + user_err ~loc "" (str ("\""^Label.to_string s^"\" is not a module")) let error_not_a_module s = error_not_a_module_loc Loc.ghost s -- cgit v1.2.3 From 543ee0c7ad43874c577416af9f2e5a94d7d1e4d3 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 19 Aug 2016 01:58:04 +0200 Subject: Remove errorlabstrm in favor of user_err As noted by @ppedrot, the first is redundant. The patch is basically a renaming. We didn't make the component optional yet, but this could happen in a future patch. --- checker/check.ml | 12 ++++++------ checker/safe_typing.ml | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) (limited to 'checker') diff --git a/checker/check.ml b/checker/check.ml index 863cf7b2cd..38d2057eb1 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -247,12 +247,12 @@ let locate_qualified_library qid = let error_unmapped_dir qid = let prefix = qid.dirpath in - errorlabstrm "load_absolute_library_from" + user_err "load_absolute_library_from" (str "Cannot load " ++ pr_path qid ++ str ":" ++ spc () ++ str "no physical path bound to" ++ spc () ++ pr_dirlist prefix ++ fnl ()) let error_lib_not_found qid = - errorlabstrm "load_absolute_library_from" + user_err "load_absolute_library_from" (str"Cannot find library " ++ pr_path qid ++ str" in loadpath") let try_locate_absolute_library dir = @@ -313,18 +313,18 @@ let intern_from_file (dir, f) = let () = close_in ch in let ch = open_in_bin f in if not (String.equal (Digest.channel ch pos) checksum) then - errorlabstrm "intern_from_file" (str "Checksum mismatch"); + user_err "intern_from_file" (str "Checksum mismatch"); let () = close_in ch in if dir <> sd.md_name then - errorlabstrm "intern_from_file" + user_err "intern_from_file" (name_clash_message dir sd.md_name f); if tasks <> None || discharging <> None then - errorlabstrm "intern_from_file" + user_err "intern_from_file" (str "The file "++str f++str " contains unfinished tasks"); if opaque_csts <> None then begin Feedback.msg_notice(str " (was a vio file) "); Option.iter (fun (_,_,b) -> if not b then - errorlabstrm "intern_from_file" + user_err "intern_from_file" (str "The file "++str f++str " is still a .vio")) opaque_csts; Validate.validate !Flags.debug Values.v_univopaques opaque_csts; diff --git a/checker/safe_typing.ml b/checker/safe_typing.ml index 11cd742ba4..c0b3a3e734 100644 --- a/checker/safe_typing.ml +++ b/checker/safe_typing.ml @@ -89,6 +89,6 @@ let import file clib univs digest = let unsafe_import file clib univs digest = let env = !genv in if !Flags.debug then check_imports Feedback.msg_warning clib.comp_name env clib.comp_deps - else check_imports (errorlabstrm"unsafe_import") clib.comp_name env clib.comp_deps; + else check_imports (user_err"unsafe_import") clib.comp_name env clib.comp_deps; check_engagement env clib.comp_enga; full_add_module clib.comp_name clib.comp_mod univs digest -- cgit v1.2.3 From fc579fdc83b751a44a18d2373e86ab38806e7306 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 19 Aug 2016 02:35:47 +0200 Subject: Make the user_err header an optional parameter. Suggested by @ppedrot --- checker/check.ml | 12 ++++++------ checker/checker.ml | 4 +++- checker/modops.ml | 2 +- checker/safe_typing.ml | 2 +- 4 files changed, 11 insertions(+), 9 deletions(-) (limited to 'checker') diff --git a/checker/check.ml b/checker/check.ml index 38d2057eb1..8565e96fc9 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -247,12 +247,12 @@ let locate_qualified_library qid = let error_unmapped_dir qid = let prefix = qid.dirpath in - user_err "load_absolute_library_from" + user_err ~hdr:"load_absolute_library_from" (str "Cannot load " ++ pr_path qid ++ str ":" ++ spc () ++ str "no physical path bound to" ++ spc () ++ pr_dirlist prefix ++ fnl ()) let error_lib_not_found qid = - user_err "load_absolute_library_from" + user_err ~hdr:"load_absolute_library_from" (str"Cannot find library " ++ pr_path qid ++ str" in loadpath") let try_locate_absolute_library dir = @@ -313,18 +313,18 @@ let intern_from_file (dir, f) = let () = close_in ch in let ch = open_in_bin f in if not (String.equal (Digest.channel ch pos) checksum) then - user_err "intern_from_file" (str "Checksum mismatch"); + user_err ~hdr:"intern_from_file" (str "Checksum mismatch"); let () = close_in ch in if dir <> sd.md_name then - user_err "intern_from_file" + user_err ~hdr:"intern_from_file" (name_clash_message dir sd.md_name f); if tasks <> None || discharging <> None then - user_err "intern_from_file" + user_err ~hdr:"intern_from_file" (str "The file "++str f++str " contains unfinished tasks"); if opaque_csts <> None then begin Feedback.msg_notice(str " (was a vio file) "); Option.iter (fun (_,_,b) -> if not b then - user_err "intern_from_file" + user_err ~hdr:"intern_from_file" (str "The file "++str f++str " is still a .vio")) opaque_csts; Validate.validate !Flags.debug Values.v_univopaques opaque_csts; diff --git a/checker/checker.ml b/checker/checker.ml index 0c411ae44d..06d0cd1c03 100644 --- a/checker/checker.ml +++ b/checker/checker.ml @@ -213,7 +213,9 @@ let report () = (str "." ++ spc () ++ str "Please report.") let guill s = str "\"" ++ str s ++ str "\"" -let where s = +let where = function +| None -> mt () +| Some s -> if !Flags.debug then (str"in " ++ str s ++ str":" ++ spc ()) else (mt ()) let rec explain_exn = function diff --git a/checker/modops.ml b/checker/modops.ml index de1db6e355..aba9da2fef 100644 --- a/checker/modops.ml +++ b/checker/modops.ml @@ -33,7 +33,7 @@ let error_no_such_label_sub l l1 = Label.to_string l^" is missing in "^l1^".") let error_not_a_module_loc loc s = - user_err ~loc "" (str ("\""^Label.to_string s^"\" is not a module")) + user_err ~loc (str ("\""^Label.to_string s^"\" is not a module")) let error_not_a_module s = error_not_a_module_loc Loc.ghost s diff --git a/checker/safe_typing.ml b/checker/safe_typing.ml index c0b3a3e734..f7cd4d6f68 100644 --- a/checker/safe_typing.ml +++ b/checker/safe_typing.ml @@ -89,6 +89,6 @@ let import file clib univs digest = let unsafe_import file clib univs digest = let env = !genv in if !Flags.debug then check_imports Feedback.msg_warning clib.comp_name env clib.comp_deps - else check_imports (user_err"unsafe_import") clib.comp_name env clib.comp_deps; + else check_imports (user_err (str "unsafe_import")) clib.comp_name env clib.comp_deps; check_engagement env clib.comp_enga; full_add_module clib.comp_name clib.comp_mod univs digest -- cgit v1.2.3