aboutsummaryrefslogtreecommitdiff
path: root/library/lib.ml
diff options
context:
space:
mode:
authorGuillaume Melquiond2015-04-23 14:55:11 +0200
committerGuillaume Melquiond2015-04-23 16:02:45 +0200
commit16d301bab5b7dec53be4786b3b6815bca54ae539 (patch)
treec595fc1fafd00a08cb91e53002610df867cf5eed /library/lib.ml
parent915c8f15965fe8e7ee9d02a663fd890ef80539ad (diff)
Remove almost all the uses of string concatenation when building error messages.
Since error messages are ultimately passed to Format, which has its own buffers for concatenating strings, using concatenation for preparing error messages just doubles the workload and increases memory pressure.
Diffstat (limited to 'library/lib.ml')
-rw-r--r--library/lib.ml11
1 files changed, 7 insertions, 4 deletions
diff --git a/library/lib.ml b/library/lib.ml
index 9977b66654..81db547efd 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -75,7 +75,8 @@ let classify_segment seg =
| (_,ClosedModule _) :: stk -> clean acc stk
| (_,OpenedSection _) :: _ -> error "there are still opened sections"
| (_,OpenedModule (ty,_,_,_)) :: _ ->
- error ("there are still opened " ^ module_kind ty ^"s")
+ errorlabstrm "Lib.classify_segment"
+ (str "there are still opened " ++ str (module_kind ty) ++ str "s")
| (_,FrozenState _) :: stk -> clean acc stk
in
clean ([],[],[]) (List.rev seg)
@@ -274,7 +275,7 @@ let start_modtype = start_mod true None
let error_still_opened string oname =
let id = basename (fst oname) in
errorlabstrm ""
- (str ("The "^string^" ") ++ pr_id id ++ str " is still opened.")
+ (str "The " ++ str string ++ str " " ++ pr_id id ++ str " is still opened.")
let end_mod is_type =
let oname,fs =
@@ -318,7 +319,8 @@ let end_compilation_checks dir =
try match snd (find_entry_p is_opening_node) with
| OpenedSection _ -> error "There are some open sections."
| OpenedModule (ty,_,_,_) ->
- error ("There are some open "^module_kind ty^"s.")
+ errorlabstrm "Lib.end_compilation_checks"
+ (str "There are some open " ++ str (module_kind ty) ++ str "s.")
| _ -> assert false
with Not_found -> ()
in
@@ -369,7 +371,8 @@ let find_opening_node id =
let oname,entry = find_entry_p is_opening_node in
let id' = basename (fst oname) in
if not (Names.Id.equal id id') then
- error ("Last block to end has name "^(Names.Id.to_string id')^".");
+ errorlabstrm "Lib.find_opening_node"
+ (str "Last block to end has name " ++ pr_id id' ++ str ".");
entry
with Not_found -> error "There is nothing to end."