aboutsummaryrefslogtreecommitdiff
path: root/library/declare.ml
diff options
context:
space:
mode:
authorEnrico Tassi2014-05-19 12:47:36 +0200
committerEnrico Tassi2014-06-08 11:17:05 +0200
commite1ba72037191b1d4be9de8a0a8fc1faa24eeb12c (patch)
tree473bbf9f27b67fc1f33e46d2fa90f3b8c031ca2b /library/declare.ml
parentcaf650182e3b223a51af7197296a5f3513a08611 (diff)
ind_tables: always declare side effects (Closes: HOTT#110)
declare takes care of ignoring side effects that are available in the global environment. This is yet another instance of what the "abominion" (aka abstract) can do: the code was checking for the existence in the environment of the elimination principle, and not regenerating it (nor declaring the corresponding side effect) if the elimination principle is used twice. Of course to functionalize the imperative actions on the environment when two proofs generated by abstract use the same elim principle, such elim principle has to be inlined twice, once in each abstracted proof. In other words, a side effect generated by a tactic inside an abstract is *global* but will be made local, si it must always be declared, no matter what. Now the system works like this: - side effects are always declared, even if a caching mechanism thinks the constant is already there (it can be there, no need to regenerate it but the intent to generate it *must* be declared anyhow) - at Qed time, we filter the list of side effects and decide which ones are really needed to be inlined. bottom line: STOP using abstract.
Diffstat (limited to 'library/declare.ml')
-rw-r--r--library/declare.ml22
1 files changed, 15 insertions, 7 deletions
diff --git a/library/declare.ml b/library/declare.ml
index 4364461ef5..dce346782c 100644
--- a/library/declare.ml
+++ b/library/declare.ml
@@ -208,11 +208,11 @@ let definition_entry ?(opaque=false) ?(inline=false) ?types
let declare_scheme = ref (fun _ _ -> assert false)
let set_declare_scheme f = declare_scheme := f
-let declare_sideff fix_exn se =
+let declare_sideff env fix_exn se =
let cbl, scheme = match se with
| SEsubproof (c, cb) -> [c, cb], None
| SEscheme (cbl, k) ->
- List.map (fun (_,c,cb) -> c,cb) cbl, Some (List.map pi1 cbl,k) in
+ List.map (fun (_,c,cb) -> c,cb) cbl, Some (cbl,k) in
let id_of c = Names.Label.to_id (Names.Constant.label c) in
let pt_opaque_of cb =
match cb with
@@ -243,13 +243,21 @@ let declare_sideff fix_exn se =
cst_kind = Decl_kinds.IsDefinition Decl_kinds.Definition;
cst_locl = true;
} in
+ let exists c =
+ try ignore(Environ.lookup_constant c env); true
+ with Not_found -> false in
let knl =
- List.map (fun (c,cb) ->
- declare_constant_common (id_of c) (cst_of cb)) cbl in
+ CList.map_filter (fun (c,cb) ->
+ if exists c then None
+ else Some (c,declare_constant_common (id_of c) (cst_of cb))) cbl in
match scheme with
| None -> ()
- | Some (inds,kind) ->
- !declare_scheme kind (Array.of_list (List.combine inds knl))
+ | Some (inds_consts,kind) ->
+ !declare_scheme kind (Array.of_list
+ (List.map (fun (c,kn) ->
+ CList.find_map (fun (x,c',_) ->
+ if Constant.equal c c' then Some (x,kn) else None) inds_consts)
+ knl))
let declare_constant ?(internal = UserVerbose) ?(local = false) id (cd, kind) =
let cd = (* We deal with side effects of non-opaque constants *)
@@ -264,7 +272,7 @@ let declare_constant ?(internal = UserVerbose) ?(local = false) id (cd, kind) =
else begin
let seff = Declareops.uniquize_side_effects seff in
Declareops.iter_side_effects
- (declare_sideff (Future.fix_exn_of bo)) seff;
+ (declare_sideff (Global.env ()) (Future.fix_exn_of bo)) seff;
Entries.DefinitionEntry { de with
const_entry_body = Future.chain ~pure:true bo (fun (pt, _) ->
pt, Declareops.no_seff) }