Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions engine/evd.ml
Original file line number Diff line number Diff line change
Expand Up @@ -892,6 +892,12 @@ let mem d e = EvMap.mem e d.undf_evars || EvMap.mem e d.defn_evars

let undefined_map d = d.undf_evars

let undefined_evars d = EvMap.domain d.undf_evars

let defined_map d = d.defn_evars

let defined_evars d = EvMap.domain d.defn_evars

let drop_all_defined d = { d with defn_evars = EvMap.empty }

(* spiwack: not clear what folding over an evar_map, for now we shall
Expand Down
9 changes: 9 additions & 0 deletions engine/evd.mli
Original file line number Diff line number Diff line change
Expand Up @@ -276,6 +276,15 @@ val add_quconstraints : evar_map -> Sorts.QUConstraints.t -> evar_map
val undefined_map : evar_map -> undefined evar_info Evar.Map.t
(** Access the undefined evar mapping directly. *)

val undefined_evars : evar_map -> Evar.Set.t
(** Access the set of undefined evars. *)

val defined_map : evar_map -> defined evar_info Evar.Map.t
(** Access the defined evar mapping directly. *)

val defined_evars : evar_map -> Evar.Set.t
(** Access the set of defined evars. *)

val drop_all_defined : evar_map -> evar_map

val drop_new_defined : original:evar_map -> evar_map -> evar_map
Expand Down
16 changes: 16 additions & 0 deletions pretyping/structures.ml
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,10 @@ let projection_nparams cst = (Cmap.find cst !projection_table).nparams

let is_projection cst = Cmap.mem cst !projection_table

let projection_number env cst =
let s = find_from_projection cst in
CList.index (Option.equal (Environ.QConstant.equal env)) (Some cst) (List.map (fun x -> x.proj_body) s.projections) - 1
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
CList.index (Option.equal (Environ.QConstant.equal env)) (Some cst) (List.map (fun x -> x.proj_body) s.projections) - 1
CList.index0 (Option.equal (Environ.QConstant.equal env)) (Some cst)
(List.map (fun x -> x.proj_body) s.projections)


end

(************************************************************************)
Expand Down Expand Up @@ -396,6 +400,18 @@ let is_open_canonical_projection env sigma c =
with Failure _ -> false
with Not_found -> false

let print env sigma s =
let pr_econstr = Termops.Internal.debug_print_constr sigma in
let pr_econstr_list l = Pp.(str "[ " ++ prlist_with_sep (fun () -> str "; ") pr_econstr l ++ str " ]") in
Pp.(str "{ constant = " ++ pr_econstr s.constant ++ cut () ++
str "abstractions_ty = " ++ pr_econstr_list s.abstractions_ty ++ cut () ++
str "body = " ++ pr_econstr s.body ++ cut () ++
str "nparams = " ++ int s.nparams ++ cut () ++
str "params = " ++ pr_econstr_list s.params ++ cut () ++
str "cvalue_abstractions = " ++ pr_opt int s.cvalue_abstraction ++ cut () ++
str "cvalue_arguments = " ++ pr_econstr_list s.cvalue_arguments ++ cut () ++
str "}")

end

module CSTable = struct
Expand Down
4 changes: 4 additions & 0 deletions pretyping/structures.mli
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,8 @@ val projection_nparams : Names.Constant.t -> int

val is_projection : Names.Constant.t -> bool

val projection_number : Environ.env -> Names.Constant.t -> int

end

(** A canonical instance declares "canonical" conversion hints between
Expand Down Expand Up @@ -129,6 +131,8 @@ val find :
val is_open_canonical_projection :
Environ.env -> Evd.evar_map -> EConstr.t -> bool

val print : Environ.env -> Evd.evar_map -> t -> Pp.t

end

(** Low level access to the Canonical Structure database *)
Expand Down