diff options
Diffstat (limited to 'interp')
| -rw-r--r-- | interp/constrarg.ml | 13 | ||||
| -rw-r--r-- | interp/constrarg.mli | 10 | ||||
| -rw-r--r-- | interp/constrextern.ml | 9 | ||||
| -rw-r--r-- | interp/constrintern.ml | 15 | ||||
| -rw-r--r-- | interp/coqlib.ml | 2 | ||||
| -rw-r--r-- | interp/dumpglob.ml | 7 |
6 files changed, 19 insertions, 37 deletions
diff --git a/interp/constrarg.ml b/interp/constrarg.ml index a67143b00..44623f9c9 100644 --- a/interp/constrarg.ml +++ b/interp/constrarg.ml @@ -22,7 +22,8 @@ let loc_of_or_by_notation f = function let unsafe_of_type (t : argument_type) : ('a, 'b, 'c) Genarg.genarg_type = Obj.magic t -let wit_int_or_var = unsafe_of_type IntOrVarArgType +let wit_int_or_var = + Genarg.make0 ~dyn:(val_tag (topwit Stdarg.wit_int)) None "int_or_var" let wit_intro_pattern : (Constrexpr.constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type = Genarg.make0 None "intropattern" @@ -38,18 +39,17 @@ let wit_ref = Genarg.make0 None "ref" let wit_quant_hyp = Genarg.make0 None "quant_hyp" -let wit_genarg = unsafe_of_type GenArgType - let wit_sort : (glob_sort, glob_sort, sorts) genarg_type = Genarg.make0 None "sort" let wit_constr = unsafe_of_type ConstrArgType -let wit_constr_may_eval = unsafe_of_type ConstrMayEvalArgType +let wit_constr_may_eval = + Genarg.make0 ~dyn:(val_tag (topwit wit_constr)) None "constr_may_eval" let wit_uconstr = Genarg.make0 None "uconstr" -let wit_open_constr = unsafe_of_type OpenConstrArgType +let wit_open_constr = Genarg.make0 ~dyn:(val_tag (topwit wit_constr)) None "open_constr" let wit_constr_with_bindings = Genarg.make0 None "constr_with_bindings" @@ -66,11 +66,14 @@ let wit_clause_dft_concl = (** Register location *) let () = + register_name0 wit_int_or_var "Constrarg.wit_int_or_var"; register_name0 wit_ref "Constrarg.wit_ref"; register_name0 wit_intro_pattern "Constrarg.wit_intro_pattern"; register_name0 wit_tactic "Constrarg.wit_tactic"; register_name0 wit_sort "Constrarg.wit_sort"; register_name0 wit_uconstr "Constrarg.wit_uconstr"; + register_name0 wit_open_constr "Constrarg.wit_open_constr"; + register_name0 wit_constr_may_eval "Constrarg.wit_constr_may_eval"; register_name0 wit_red_expr "Constrarg.wit_red_expr"; register_name0 wit_clause_dft_concl "Constrarg.wit_clause_dft_concl"; register_name0 wit_quant_hyp "Constrarg.wit_quant_hyp"; diff --git a/interp/constrarg.mli b/interp/constrarg.mli index fdeddd66a..0cc111e61 100644 --- a/interp/constrarg.mli +++ b/interp/constrarg.mli @@ -26,7 +26,7 @@ val loc_of_or_by_notation : ('a -> Loc.t) -> 'a or_by_notation -> Loc.t (** {5 Additional generic arguments} *) -val wit_int_or_var : int or_var uniform_genarg_type +val wit_int_or_var : (int or_var, int or_var, int) genarg_type val wit_intro_pattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type @@ -38,8 +38,6 @@ val wit_ref : (reference, global_reference located or_var, global_reference) gen val wit_quant_hyp : quantified_hypothesis uniform_genarg_type -val wit_genarg : (raw_generic_argument, glob_generic_argument, typed_generic_argument) genarg_type - val wit_sort : (glob_sort, glob_sort, sorts) genarg_type val wit_constr : (constr_expr, glob_constr_and_expr, constr) genarg_type @@ -52,17 +50,17 @@ val wit_constr_may_eval : val wit_uconstr : (constr_expr , glob_constr_and_expr, Glob_term.closed_glob_constr) genarg_type val wit_open_constr : - (open_constr_expr, open_glob_constr, Evd.open_constr) genarg_type + (constr_expr, glob_constr_and_expr, constr) genarg_type val wit_constr_with_bindings : (constr_expr with_bindings, glob_constr_and_expr with_bindings, - constr with_bindings Evd.sigma) genarg_type + constr with_bindings delayed_open) genarg_type val wit_bindings : (constr_expr bindings, glob_constr_and_expr bindings, - constr bindings Evd.sigma) genarg_type + constr bindings delayed_open) genarg_type val wit_hyp_location_flag : Locus.hyp_location_flag uniform_genarg_type diff --git a/interp/constrextern.ml b/interp/constrextern.ml index ed85c38de..5c9e80df3 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -462,15 +462,6 @@ let is_needed_for_correct_partial_application tail imp = exception Expl -let params_implicit n impl = - let rec aux n impl = - if n == 0 then true - else match impl with - | [] -> false - | imp :: impl when is_status_implicit imp -> aux (pred n) impl - | _ -> false - in aux n impl - (* Implicit args indexes are in ascending order *) (* inctx is useful only if there is a last argument to be deduced from ctxt *) let explicitize loc inctx impl (cf,f) args = diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 918b75b0c..68bc0b109 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -698,19 +698,6 @@ let intern_var genv (ltacvars,ntnvars) namedctx loc id = (* [id] a goal variable *) GVar (loc,id), [], [], [] -let proj_impls r impls = - let env = Global.env () in - let f (x, l) = x, projection_implicits env r l in - List.map f impls - -let proj_scopes n scopes = - List.skipn_at_least n scopes - -let proj_impls_scopes p impls scopes = - match p with - | Some (r, n) -> proj_impls r impls, proj_scopes n scopes - | None -> impls, scopes - let find_appl_head_data c = match c with | GRef (loc,ref,_) as x -> @@ -1386,7 +1373,7 @@ let internalize globalenv env allow_patvar lvar c = let (env',rbefore) = List.fold_left intern_local_binder (env,[]) before in let ro = f (intern env') in - let n' = Option.map (fun _ -> List.length (List.filter (fun (_,(_,_,b,_)) -> (* remove let-ins *) b = None) rbefore)) n in + let n' = Option.map (fun _ -> List.count (fun (_,(_,_,b,_)) -> (* remove let-ins *) b = None) rbefore) n in n', ro, List.fold_left intern_local_binder (env',rbefore) after in let n, ro, (env',rbl) = diff --git a/interp/coqlib.ml b/interp/coqlib.ml index 5ac718e3b..b309f26cd 100644 --- a/interp/coqlib.ml +++ b/interp/coqlib.ml @@ -87,7 +87,7 @@ let check_required_library d = *) (* or failing ...*) errorlabstrm "Coqlib.check_required_library" - (str "Library " ++ str (DirPath.to_string dir) ++ str " has to be required first.") + (str "Library " ++ pr_dirpath dir ++ str " has to be required first.") (************************************************************************) (* Specific Coq objects *) diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml index c18ceecab..c7d3da653 100644 --- a/interp/dumpglob.ml +++ b/interp/dumpglob.ml @@ -139,12 +139,15 @@ let interval loc = loc1, loc2-1 let dump_ref loc filepath modpath ident ty = - if !glob_output = Feedback then + match !glob_output with + | Feedback -> Pp.feedback (Feedback.GlobRef (loc, filepath, modpath, ident, ty)) - else + | NoGlob -> () + | _ when not (Loc.is_ghost loc) -> let bl,el = interval loc in dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n" bl el filepath modpath ident ty) + | _ -> () let dump_reference loc modpath ident ty = let filepath = Names.DirPath.to_string (Lib.library_dp ()) in |