diff options
| author | Enrico Tassi | 2013-12-20 17:29:35 +0100 |
|---|---|---|
| committer | Enrico Tassi | 2014-01-04 17:07:15 +0100 |
| commit | 0582c9363fa981798811ff11ef0e8c76c38255f7 (patch) | |
| tree | 2ba490e8ad6424ea86ead50d0c91ba0f7ed0cd8d | |
| parent | 9bb1b959071575074870ba2a11ca79cb52cb7e8b (diff) | |
kernel: save in aux the list of section variables used
This has nothing to do with the kernel itself, but it is
the place where this piece of data is inferred.
| -rw-r--r-- | kernel/term_typing.ml | 25 |
1 files changed, 21 insertions, 4 deletions
diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml index b8c32ffe56..80da457670 100644 --- a/kernel/term_typing.ml +++ b/kernel/term_typing.ml @@ -127,6 +127,14 @@ let global_vars_set_constant_type env = function (fun t c -> Id.Set.union (global_vars_set env t) c)) ctx ~init:Id.Set.empty + +let record_aux env s1 s2 = + let v = + String.concat " " + (List.map (fun (id, _,_) -> Id.to_string id) + (keep_hyps env (Id.Set.union s1 s2))) in + Aux_file.record_in_aux "context_used" v + let build_constant_declaration kn env (def,typ,cst,inline_code,ctx) = let check declared inferred = let mk_set l = List.fold_right Id.Set.add (List.map pi1 l) Id.Set.empty in @@ -136,9 +144,10 @@ let build_constant_declaration kn env (def,typ,cst,inline_code,ctx) = (String.concat ", " (List.map Id.to_string (Id.Set.elements (Idset.diff inferred_set declared_set))))) in (* We try to postpone the computation of used section variables *) - let hyps, def = + let hyps, def = + let context_ids = List.map pi1 (named_context env) in match ctx with - | None when not (List.is_empty (named_context env)) -> + | None when not (List.is_empty context_ids) -> (* No declared section vars, and non-empty section context: we must look at the body NOW, if any *) let ids_typ = global_vars_set_constant_type env typ in @@ -148,9 +157,17 @@ let build_constant_declaration kn env (def,typ,cst,inline_code,ctx) = | OpaqueDef lc -> (* we force so that cst are added to the env immediately after *) ignore(Future.join cst); - global_vars_set env (Lazyconstr.force_opaque (Future.join lc)) in + let vars = + global_vars_set env (Lazyconstr.force_opaque (Future.join lc)) in + if !Flags.compilation_mode = Flags.BuildVo then + record_aux env ids_typ vars; + vars + in keep_hyps env (Idset.union ids_typ ids_def), def - | None -> [], def (* Empty section context: no need to check *) + | None -> + if !Flags.compilation_mode = Flags.BuildVo then + record_aux env Id.Set.empty Id.Set.empty; + [], def (* Empty section context: no need to check *) | Some declared -> (* We use the declared set and chain a check of correctness *) declared, |
