+ (wanted, hyp_paths ,goal_path)
+
+let disambiguate_reduction_kind aliases_ref = function
+ | `Unfold (Some t) ->
+ let t = disambiguate_lazy_term aliases_ref t in
+ `Unfold (Some t)
+ | `Normalize
+ | `Reduce
+ | `Simpl
+ | `Unfold None
+ | `Whd as kind -> kind
+
+let disambiguate_tactic status tactic =
+ let status_ref = ref status in
+ let tactic =
+ match tactic with
+ | GrafiteAst.Absurd (loc, term) ->
+ let cic = disambiguate_term status_ref term in
+ GrafiteAst.Absurd (loc, cic)
+ | GrafiteAst.Apply (loc, term) ->
+ let cic = disambiguate_term status_ref term in
+ GrafiteAst.Apply (loc, cic)
+ | GrafiteAst.Assumption loc -> GrafiteAst.Assumption loc
+ | GrafiteAst.Auto (loc,depth,width,paramodulation) ->
+ GrafiteAst.Auto (loc,depth,width,paramodulation)
+ | GrafiteAst.Change (loc, pattern, with_what) ->
+ let with_what = disambiguate_lazy_term status_ref with_what in
+ let pattern = disambiguate_pattern status_ref pattern in
+ GrafiteAst.Change (loc, pattern, with_what)
+ | GrafiteAst.Clear (loc,id) -> GrafiteAst.Clear (loc,id)
+ | GrafiteAst.ClearBody (loc,id) -> GrafiteAst.ClearBody (loc,id)
+ | GrafiteAst.Compare (loc,term) ->
+ let term = disambiguate_term status_ref term in
+ GrafiteAst.Compare (loc,term)
+ | GrafiteAst.Constructor (loc,n) -> GrafiteAst.Constructor (loc,n)
+ | GrafiteAst.Contradiction loc -> GrafiteAst.Contradiction loc
+ | GrafiteAst.Cut (loc, ident, term) ->
+ let cic = disambiguate_term status_ref term in
+ GrafiteAst.Cut (loc, ident, cic)
+ | GrafiteAst.DecideEquality loc -> GrafiteAst.DecideEquality loc
+ | GrafiteAst.Decompose (loc, types, what, names) ->
+ let disambiguate types = function
+ | GrafiteAst.Type _ -> assert false
+ | GrafiteAst.Ident id ->
+ (match disambiguate_term status_ref (CicNotationPt.Ident (id, None)) with
+ | Cic.MutInd (uri, tyno, _) ->
+ (GrafiteAst.Type (uri, tyno) :: types)
+ | _ -> raise Disambiguate.NoWellTypedInterpretation)
+ in
+ let types = List.fold_left disambiguate [] types in
+ GrafiteAst.Decompose (loc, types, what, names)
+ | GrafiteAst.Discriminate (loc,term) ->
+ let term = disambiguate_term status_ref term in
+ GrafiteAst.Discriminate(loc,term)
+ | GrafiteAst.Exact (loc, term) ->
+ let cic = disambiguate_term status_ref term in
+ GrafiteAst.Exact (loc, cic)
+ | GrafiteAst.Elim (loc, what, Some using, depth, idents) ->
+ let what = disambiguate_term status_ref what in
+ let using = disambiguate_term status_ref using in
+ GrafiteAst.Elim (loc, what, Some using, depth, idents)
+ | GrafiteAst.Elim (loc, what, None, depth, idents) ->
+ let what = disambiguate_term status_ref what in
+ GrafiteAst.Elim (loc, what, None, depth, idents)
+ | GrafiteAst.ElimType (loc, what, Some using, depth, idents) ->
+ let what = disambiguate_term status_ref what in
+ let using = disambiguate_term status_ref using in
+ GrafiteAst.ElimType (loc, what, Some using, depth, idents)
+ | GrafiteAst.ElimType (loc, what, None, depth, idents) ->
+ let what = disambiguate_term status_ref what in
+ GrafiteAst.ElimType (loc, what, None, depth, idents)
+ | GrafiteAst.Exists loc -> GrafiteAst.Exists loc
+ | GrafiteAst.Fail loc -> GrafiteAst.Fail loc
+ | GrafiteAst.Fold (loc,red_kind, term, pattern) ->
+ let pattern = disambiguate_pattern status_ref pattern in
+ let term = disambiguate_lazy_term status_ref term in
+ let red_kind = disambiguate_reduction_kind status_ref red_kind in
+ GrafiteAst.Fold (loc, red_kind, term, pattern)
+ | GrafiteAst.FwdSimpl (loc, hyp, names) ->
+ GrafiteAst.FwdSimpl (loc, hyp, names)
+ | GrafiteAst.Fourier loc -> GrafiteAst.Fourier loc
+ | GrafiteAst.Generalize (loc,pattern,ident) ->
+ let pattern = disambiguate_pattern status_ref pattern in
+ GrafiteAst.Generalize (loc,pattern,ident)
+ | GrafiteAst.Goal (loc, g) -> GrafiteAst.Goal (loc, g)
+ | GrafiteAst.IdTac loc -> GrafiteAst.IdTac loc
+ | GrafiteAst.Injection (loc, term) ->
+ let term = disambiguate_term status_ref term in
+ GrafiteAst.Injection (loc,term)
+ | GrafiteAst.Intros (loc, num, names) -> GrafiteAst.Intros (loc, num, names)
+ | GrafiteAst.LApply (loc, depth, to_what, what, ident) ->
+ let f term to_what =
+ let term = disambiguate_term status_ref term in
+ term :: to_what
+ in
+ let to_what = List.fold_right f to_what [] in
+ let what = disambiguate_term status_ref what in
+ GrafiteAst.LApply (loc, depth, to_what, what, ident)
+ | GrafiteAst.Left loc -> GrafiteAst.Left loc
+ | GrafiteAst.LetIn (loc, term, name) ->
+ let term = disambiguate_term status_ref term in
+ GrafiteAst.LetIn (loc,term,name)
+ | GrafiteAst.Reduce (loc, red_kind, pattern) ->
+ let pattern = disambiguate_pattern status_ref pattern in
+ let red_kind = disambiguate_reduction_kind status_ref red_kind in
+ GrafiteAst.Reduce(loc, red_kind, pattern)
+ | GrafiteAst.Reflexivity loc -> GrafiteAst.Reflexivity loc
+ | GrafiteAst.Replace (loc, pattern, with_what) ->
+ let pattern = disambiguate_pattern status_ref pattern in
+ let with_what = disambiguate_lazy_term status_ref with_what in
+ GrafiteAst.Replace (loc, pattern, with_what)
+ | GrafiteAst.Rewrite (loc, dir, t, pattern) ->
+ let term = disambiguate_term status_ref t in
+ let pattern = disambiguate_pattern status_ref pattern in
+ GrafiteAst.Rewrite (loc, dir, term, pattern)
+ | GrafiteAst.Right loc -> GrafiteAst.Right loc
+ | GrafiteAst.Ring loc -> GrafiteAst.Ring loc
+ | GrafiteAst.Split loc -> GrafiteAst.Split loc
+ | GrafiteAst.Symmetry loc -> GrafiteAst.Symmetry loc
+ | GrafiteAst.Transitivity (loc, term) ->
+ let cic = disambiguate_term status_ref term in
+ GrafiteAst.Transitivity (loc, cic)
+ in
+ status_ref, tactic
+
+let reorder_metasenv start refine tactic goals current_goal always_opens_a_goal=
+ let module PEH = ProofEngineHelpers in
+ (* phase one calculates:
+ * new_goals_from_refine: goals added by refine
+ * head_goal: the first goal opened by ythe tactic
+ * other_goals: other goals opened by the tactic
+ *)
+ let new_goals_from_refine = PEH.compare_metasenvs start refine in
+ let new_goals_from_tactic = PEH.compare_metasenvs refine tactic in
+ let head_goal, other_goals, goals =
+ match goals with
+ | [] -> None,[],goals
+ | hd::tl ->
+ (* assert (List.mem hd new_goals_from_tactic);
+ * invalidato dalla goal_tac
+ * *)
+ Some hd, List.filter ((<>) hd) new_goals_from_tactic, List.filter ((<>)
+ hd) goals
+ in
+ let produced_goals =
+ match head_goal with
+ | None -> new_goals_from_refine @ other_goals
+ | Some x -> x :: new_goals_from_refine @ other_goals
+ in
+ (* extract the metas generated by refine and tactic *)
+ let metas_for_tactic_head =
+ match head_goal with
+ | None -> []
+ | Some head_goal -> List.filter (fun (n,_,_) -> n = head_goal) tactic in
+ let metas_for_tactic_goals =
+ List.map
+ (fun x -> List.find (fun (metano,_,_) -> metano = x) tactic)
+ goals
+ in
+ let metas_for_refine_goals =
+ List.filter (fun (n,_,_) -> List.mem n new_goals_from_refine) tactic in
+ let produced_metas, goals =
+ let produced_metas =
+ if always_opens_a_goal then
+ metas_for_tactic_head @ metas_for_refine_goals @
+ metas_for_tactic_goals
+ else
+ metas_for_refine_goals @ metas_for_tactic_head @
+ metas_for_tactic_goals
+ in
+ let goals = List.map (fun (metano, _, _) -> metano) produced_metas in
+ produced_metas, goals
+ in
+ (* residual metas, preserving the original order *)
+ let before, after =
+ let rec split e =
+ function
+ | [] -> [],[]
+ | (metano, _, _) :: tl when metano = e ->
+ [], List.map (fun (x,_,_) -> x) tl
+ | (metano, _, _) :: tl -> let b, a = split e tl in metano :: b, a
+ in
+ let find n metasenv =
+ try
+ Some (List.find (fun (metano, _, _) -> metano = n) metasenv)
+ with Not_found -> None
+ in
+ let extract l =
+ List.fold_right
+ (fun n acc ->
+ match find n tactic with
+ | Some x -> x::acc
+ | None -> acc
+ ) l [] in
+ let before_l, after_l = split current_goal start in
+ let before_l =
+ List.filter (fun x -> not (List.mem x produced_goals)) before_l in
+ let after_l =
+ List.filter (fun x -> not (List.mem x produced_goals)) after_l in
+ let before = extract before_l in
+ let after = extract after_l in
+ before, after
+ in
+ (* DEBUG CODE
+ let print_m name metasenv =
+ prerr_endline (">>>>> " ^ name);
+ prerr_endline (CicMetaSubst.ppmetasenv metasenv [])
+ in
+ print_m "BEGIN" start;
+ prerr_endline ("goal was: " ^ string_of_int current_goal);
+ prerr_endline ("and metas from refine are:");
+ List.iter
+ (fun t -> prerr_string (" " ^ string_of_int t))
+ new_goals_from_refine;
+ prerr_endline "";
+ print_m "before" before;
+ print_m "metas_for_tactic_head" metas_for_tactic_head;
+ print_m "metas_for_refine_goals" metas_for_refine_goals;
+ print_m "metas_for_tactic_goals" metas_for_tactic_goals;
+ print_m "after" after;
+ FINE DEBUG CODE *)
+ before @ produced_metas @ after, goals
+
+(* maybe we only need special cases for apply and goal *)
+let classify_tactic tactic =
+ match tactic with
+ (* tactics that can't close the goal (return a goal we want to "select") *)
+ | GrafiteAst.Rewrite _
+ | GrafiteAst.Split _
+ | GrafiteAst.Replace _
+ | GrafiteAst.Reduce _
+ | GrafiteAst.Injection _
+ | GrafiteAst.IdTac _
+ | GrafiteAst.Generalize _
+ | GrafiteAst.Elim _
+ | GrafiteAst.Decompose _ -> true, true
+ (* tactics we don't want to reorder goals. I think only Goal needs this. *)
+ | GrafiteAst.Goal _ -> false, true
+ (* tactics like apply *)
+ | _ -> true, false