From 7d261ef454e918c70b8fff1dd10bbe0fbdcb57a8 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Tue, 21 Apr 2015 15:54:26 +0200 Subject: Fixing #3376 and #4191 (wrong index of maximally-inserted implicit argument in the presence of let-ins). --- interp/constrintern.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'interp') diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 5151d2a10a..8f0d56c5bd 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -1913,7 +1913,7 @@ let interp_rawcontext_evars env evdref bl = | Some b -> let c = understand_judgment_tcc env evdref b in let d = (na, Some c.uj_val, c.uj_type) in - (push_rel d env, d::params, succ n, impls)) + (push_rel d env, d::params, n, impls)) (env,[],1,[]) (List.rev bl) in (env, par), impls -- cgit v1.2.3 From 16d301bab5b7dec53be4786b3b6815bca54ae539 Mon Sep 17 00:00:00 2001 From: Guillaume Melquiond Date: Thu, 23 Apr 2015 14:55:11 +0200 Subject: 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. --- interp/coqlib.ml | 11 ++++++----- interp/notation.ml | 26 +++++++++++++------------- interp/syntax_def.ml | 2 +- 3 files changed, 20 insertions(+), 19 deletions(-) (limited to 'interp') diff --git a/interp/coqlib.ml b/interp/coqlib.ml index 02504c9202..5ac718e3b0 100644 --- a/interp/coqlib.ml +++ b/interp/coqlib.ml @@ -54,15 +54,15 @@ let gen_reference_in_modules locstr dirs s = match these with | [x] -> x | [] -> - anomaly ~label:locstr (str ("cannot find "^s^ - " in module"^(if List.length dirs > 1 then "s " else " ")) ++ + anomaly ~label:locstr (str "cannot find " ++ str s ++ + str " in module" ++ str (if List.length dirs > 1 then "s " else " ") ++ prlist_with_sep pr_comma pr_dirpath dirs) | l -> anomaly ~label:locstr - (str ("ambiguous name "^s^" can represent ") ++ + (str "ambiguous name " ++ str s ++ str " can represent " ++ prlist_with_sep pr_comma (fun x -> Libnames.pr_path (Nametab.path_of_global x)) l ++ - str (" in module"^(if List.length dirs > 1 then "s " else " ")) ++ + str " in module" ++ str (if List.length dirs > 1 then "s " else " ") ++ prlist_with_sep pr_comma pr_dirpath dirs) let gen_constant_in_modules locstr dirs s = @@ -86,7 +86,8 @@ let check_required_library d = (Loc.ghost,make_qualid (DirPath.make (List.rev prefix)) m) *) (* or failing ...*) - error ("Library "^(DirPath.to_string dir)^" has to be required first.") + errorlabstrm "Coqlib.check_required_library" + (str "Library " ++ str (DirPath.to_string dir) ++ str " has to be required first.") (************************************************************************) (* Specific Coq objects *) diff --git a/interp/notation.ml b/interp/notation.ml index 80db2cb396..555dfa804b 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -91,7 +91,9 @@ let declare_scope scope = (* Flags.if_warn message ("Creating scope "^scope);*) scope_map := String.Map.add scope empty_scope !scope_map -let error_unknown_scope sc = error ("Scope "^sc^" is not declared.") +let error_unknown_scope sc = + errorlabstrm "Notation" + (str "Scope " ++ str sc ++ str " is not declared.") let find_scope scope = try String.Map.find scope !scope_map @@ -186,14 +188,14 @@ let declare_delimiters scope key = | Some oldkey when String.equal oldkey key -> () | Some oldkey -> msg_warning - (strbrk ("Overwriting previous delimiting key "^oldkey^" in scope "^scope)); + (str "Overwriting previous delimiting key " ++ str oldkey ++ str " in scope " ++ str scope); scope_map := String.Map.add scope newsc !scope_map end; try let oldscope = String.Map.find key !delimiters_map in if String.equal oldscope scope then () else begin - msg_warning (strbrk ("Hiding binding of key "^key^" to "^oldscope)); + msg_warning (str "Hiding binding of key " ++ str key ++ str " to " ++ str oldscope); delimiters_map := String.Map.add key scope !delimiters_map end with Not_found -> delimiters_map := String.Map.add key scope !delimiters_map @@ -202,7 +204,7 @@ let find_delimiters_scope loc key = try String.Map.find key !delimiters_map with Not_found -> user_err_loc - (loc, "find_delimiters", str ("Unknown scope delimiting key "^key^".")) + (loc, "find_delimiters", str "Unknown scope delimiting key " ++ str key ++ str ".") (* Uninterpretation tables *) @@ -317,8 +319,7 @@ let check_required_module loc sc (sp,d) = try let _ = Nametab.global_of_path sp in () with Not_found -> user_err_loc (loc,"prim_token_interpreter", - str ("Cannot interpret in "^sc^" without requiring first module " - ^(List.last d)^".")) + str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".") (* Look if some notation or numeral printer in [scope] can be used in the scope stack [scopes], and if yes, using delimiters or not *) @@ -373,10 +374,9 @@ let declare_notation_interpretation ntn scopt pat df = let () = if String.Map.mem ntn sc.notations then let which_scope = match scopt with - | None -> "" - | Some _ -> " in scope " ^ scope in - let message = "Notation " ^ ntn ^ " was already used" ^ which_scope in - msg_warning (strbrk message) + | None -> mt () + | Some _ -> str " in scope " ++ str scope in + msg_warning (str "Notation " ++ str ntn ++ str " was already used" ++ which_scope) in let sc = { sc with notations = String.Map.add ntn (pat,df) sc.notations } in let () = scope_map := String.Map.add scope sc !scope_map in @@ -452,7 +452,7 @@ let interp_notation loc ntn local_scopes = try find_interpretation ntn (find_notation ntn) scopes with Not_found -> user_err_loc - (loc,"",str ("Unknown interpretation for notation \""^ntn^"\".")) + (loc,"",str "Unknown interpretation for notation \"" ++ str ntn ++ str "\".") let uninterp_notations c = List.map_append (fun key -> keymap_find key !notations_key_table) @@ -784,8 +784,8 @@ let pr_scope_classes sc = match l with | [] -> mt () | _ :: l -> - let opt_s = match l with [] -> "" | _ -> "es" in - hov 0 (str ("Bound to class" ^ opt_s) ++ + let opt_s = match l with [] -> mt () | _ -> str "es" in + hov 0 (str "Bound to class" ++ opt_s ++ spc() ++ prlist_with_sep spc pr_scope_class l) ++ fnl() let pr_notation_info prglob ntn c = diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml index 9be7abcfe0..d2709d5e3c 100644 --- a/interp/syntax_def.ml +++ b/interp/syntax_def.ml @@ -99,7 +99,7 @@ let verbose_compat kn def = function | [], NRef r -> str " is " ++ pr_global_env Id.Set.empty r | _ -> str " is a compatibility notation" in - let since = str (" since Coq > " ^ Flags.pr_version v ^ ".") in + let since = str " since Coq > " ++ str (Flags.pr_version v) ++ str "." in act (pr_syndef kn ++ pp_def ++ since) | _ -> () -- cgit v1.2.3 From f19d0c7baf91fb410de77baed391b0a16db9c4e2 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Fri, 1 May 2015 11:33:59 +0200 Subject: Fixing computation of implicit arguments by position in fixpoints (#4217). --- interp/constrintern.ml | 8 ++++---- interp/constrintern.mli | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) (limited to 'interp') diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 8f0d56c5bd..982d9bfe39 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -1893,7 +1893,7 @@ let intern_context global_level env impl_env binders = with InternalizationError (loc,e) -> user_err_loc (loc,"internalize", explain_internalization_error e) -let interp_rawcontext_evars env evdref bl = +let interp_rawcontext_evars env evdref k bl = let (env, par, _, impls) = List.fold_left (fun (env,params,n,impls) (na, k, b, t) -> @@ -1914,11 +1914,11 @@ let interp_rawcontext_evars env evdref bl = let c = understand_judgment_tcc env evdref b in let d = (na, Some c.uj_val, c.uj_type) in (push_rel d env, d::params, n, impls)) - (env,[],1,[]) (List.rev bl) + (env,[],k+1,[]) (List.rev bl) in (env, par), impls -let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) env evdref params = +let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) ?(shift=0) env evdref params = let int_env,bl = intern_context global_level env impl_env params in - let x = interp_rawcontext_evars env evdref bl in + let x = interp_rawcontext_evars env evdref shift bl in int_env, x diff --git a/interp/constrintern.mli b/interp/constrintern.mli index 0d33d43345..4d2c994679 100644 --- a/interp/constrintern.mli +++ b/interp/constrintern.mli @@ -157,7 +157,7 @@ val interp_binder_evars : env -> evar_map ref -> Name.t -> constr_expr -> types (** Interpret contexts: returns extended env and context *) val interp_context_evars : - ?global_level:bool -> ?impl_env:internalization_env -> + ?global_level:bool -> ?impl_env:internalization_env -> ?shift:int -> env -> evar_map ref -> local_binder list -> internalization_env * ((env * rel_context) * Impargs.manual_implicits) -- cgit v1.2.3