diff options
| author | Hugo Herbelin | 2014-10-23 20:47:29 +0200 |
|---|---|---|
| committer | Hugo Herbelin | 2014-10-24 16:44:48 +0200 |
| commit | 4662a2c92ecfdfb383f504f8c230b6d2f2bb58fc (patch) | |
| tree | 5cf530d41d9e38328af8ed62c9707a8c845d869b | |
| parent | 5eaa183732bade55d2df3a6173c3765745e6eeb7 (diff) | |
Fixing order of hypothesis in goal hypotheses compaction for coqtop.
| -rw-r--r-- | ide/ide_slave.ml | 2 | ||||
| -rw-r--r-- | pretyping/termops.ml | 6 | ||||
| -rw-r--r-- | pretyping/termops.mli | 1 |
3 files changed, 6 insertions, 3 deletions
diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml index a91be2aa44..60dfa894a5 100644 --- a/ide/ide_slave.ml +++ b/ide/ide_slave.ml @@ -180,7 +180,7 @@ let process_goal sigma g = (string_of_ppcmds (pr_var_list_decl min_env sigma d)) in let hyps = List.map process_hyp - (Termops.compact_named_context (Environ.named_context env)) in + (Termops.compact_named_context_reverse (Environ.named_context env)) in { Interface.goal_hyp = hyps; Interface.goal_ccl = ccl; Interface.goal_id = id; } let goals () = diff --git a/pretyping/termops.ml b/pretyping/termops.ml index ee60f60c0e..75c8fb4246 100644 --- a/pretyping/termops.ml +++ b/pretyping/termops.ml @@ -940,7 +940,7 @@ let rec mem_named_context id = function | _ :: sign -> mem_named_context id sign | [] -> false -let compact_named_context sign = +let compact_named_context_reverse sign = let compact l (i1,c1,t1) = match l with | [] -> [[i1],c1,t1] @@ -948,7 +948,9 @@ let compact_named_context sign = if Option.equal Constr.equal c1 c2 && Constr.equal t1 t2 then (i1::l2,c2,t2)::q else ([i1],c1,t1)::l - in List.rev (Context.fold_named_context_reverse compact ~init:[] sign) + in Context.fold_named_context_reverse compact ~init:[] sign + +let compact_named_context sign = List.rev (compact_named_context_reverse sign) let clear_named_body id env = let aux _ = function diff --git a/pretyping/termops.mli b/pretyping/termops.mli index cbb9fb4ebf..cafb6dc10a 100644 --- a/pretyping/termops.mli +++ b/pretyping/termops.mli @@ -216,6 +216,7 @@ val fold_named_context_both_sides : named_context -> init:'a -> 'a val mem_named_context : Id.t -> named_context -> bool val compact_named_context : named_context -> named_list_context +val compact_named_context_reverse : named_context -> named_list_context val clear_named_body : Id.t -> env -> env |