+ (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 apply_tactic tactic status =
+ let status_ref, tactic = disambiguate_tactic status tactic in
+ let proof_status = MatitaMisc.get_proof_status !status_ref in
+ let tactic = tactic_of_ast tactic in
+ (* apply tactic will change the status pointed by status_ref ... *)
+ let (proof, goals) = ProofEngineTypes.apply_tactic tactic proof_status in
+ let dummy = -1 in
+ { !status_ref with
+ proof_status = MatitaTypes.Incomplete_proof (proof,dummy) },
+ goals
+
+module MatitaStatus =
+ struct
+ type input_status = MatitaTypes.status
+ type output_status = MatitaTypes.status * ProofEngineTypes.goal list
+ type tactic = input_status -> output_status
+
+ let focus (status,_) goal =
+ let proof,_ = MatitaMisc.get_proof_status status in
+ {status with proof_status = MatitaTypes.Incomplete_proof (proof,goal)}
+
+ let goals (_,goals) = goals
+
+ let set_goals (status,_) goals = status,goals
+
+ let id_tac status =
+ apply_tactic (GrafiteAst.IdTac DisambiguateTypes.dummy_floc) status
+
+ let mk_tactic tac = tac
+
+ let apply_tactic tac = tac
+
+ end
+
+module MatitaTacticals = Tacticals.Make(MatitaStatus)
+
+let eval_tactical status tac =
+ let rec tactical_of_ast tac =
+ match tac with
+ | GrafiteAst.Tactic (loc, tactic) -> apply_tactic tactic
+ | GrafiteAst.Seq (loc, tacticals) -> (* tac1; tac2; ... *)
+ MatitaTacticals.seq ~tactics:(List.map tactical_of_ast tacticals)
+ | GrafiteAst.Do (loc, num, tactical) ->
+ MatitaTacticals.do_tactic ~n:num ~tactic:(tactical_of_ast tactical)
+ | GrafiteAst.Repeat (loc, tactical) ->
+ MatitaTacticals.repeat_tactic ~tactic:(tactical_of_ast tactical)
+ | GrafiteAst.Then (loc, tactical, tacticals) -> (* tac; [ tac1 | ... ] *)
+ MatitaTacticals.thens ~start:(tactical_of_ast tactical)
+ ~continuations:(List.map tactical_of_ast tacticals)
+ | GrafiteAst.First (loc, tacticals) ->
+ MatitaTacticals.first
+ ~tactics:(List.map (fun t -> "", tactical_of_ast t) tacticals)
+ | GrafiteAst.Try (loc, tactical) ->
+ MatitaTacticals.try_tactic ~tactic:(tactical_of_ast tactical)
+ | GrafiteAst.Solve (loc, tacticals) ->
+ MatitaTacticals.solve_tactics
+ ~tactics:(List.map (fun t -> "",tactical_of_ast t) tacticals)
+ in
+ let status,goals = tactical_of_ast tac status in
+ let proof,_ = MatitaMisc.get_proof_status status in
+ let new_status =
+ match goals with
+ | [] ->
+ let (_,metasenv,_,_) = proof in
+ (match metasenv with
+ | [] -> Proof proof
+ | (ng,_,_)::_ -> Incomplete_proof (proof,ng))
+ | ng::_ -> Incomplete_proof (proof, ng)
+ in
+ { status with proof_status = new_status }
+
+let eval_coercion status coercion =
+ let coer_uri,coer_ty =
+ match coercion with
+ | Cic.Const (uri,_)
+ | Cic.Var (uri,_) ->
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match o with
+ | Cic.Constant (_,_,ty,_,_)
+ | Cic.Variable (_,_,ty,_,_) ->
+ uri,ty
+ | _ -> assert false)
+ | Cic.MutConstruct (uri,t,c,_) ->
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match o with
+ | Cic.InductiveDefinition (l,_,_,_) ->
+ let (_,_,_,cl) = List.nth l t in
+ let (_,cty) = List.nth cl c in
+ uri,cty
+ | _ -> assert false)
+ | _ -> assert false
+ in
+ (* we have to get the source and the tgt type uri
+ * in Coq syntax we have already their names, but
+ * since we don't support Funclass and similar I think
+ * all the coercion should be of the form
+ * (A:?)(B:?)T1->T2
+ * So we should be able to extract them from the coercion type
+ *)
+ let extract_last_two_p ty =
+ let rec aux = function
+ | Cic.Prod( _, src, Cic.Prod (n,t1,t2)) -> aux (Cic.Prod(n,t1,t2))
+ | Cic.Prod( _, src, tgt) -> src, tgt
+ | _ -> assert false
+ in
+ aux ty
+ in
+ let ty_src,ty_tgt = extract_last_two_p coer_ty in
+ let context = [] in
+ let src_uri =
+ let ty_src = CicReduction.whd context ty_src in
+ CicUtil.uri_of_term ty_src
+ in
+ let tgt_uri =
+ let ty_tgt = CicReduction.whd context ty_tgt in
+ CicUtil.uri_of_term ty_tgt
+ in
+ let new_coercions =
+ (* also adds them to the Db *)
+ CoercGraph.close_coercion_graph src_uri tgt_uri coer_uri in
+ let status =
+ List.fold_left (fun s (uri,o,ugraph) -> MatitaSync.add_obj uri o status)
+ status new_coercions in
+ let statement_of name =
+ GrafiteAst.Coercion (DisambiguateTypes.dummy_floc,
+ (CicNotationPt.Ident (name, None)))
+ in
+ let moo_content =
+ statement_of (UriManager.name_of_uri coer_uri) ::
+ (List.map
+ (fun (uri, _, _) ->
+ statement_of (UriManager.name_of_uri uri))
+ new_coercions)
+ in
+ let status = add_moo_content moo_content status in
+ { status with proof_status = No_proof }
+
+let generate_elimination_principles uri status =
+ let elim sort status =
+ try
+ let uri,obj = CicElim.elim_of ~sort uri 0 in
+ MatitaSync.add_obj uri obj status
+ with CicElim.Can_t_eliminate -> status
+ in
+ List.fold_left (fun status sort -> elim sort status) status
+ [ Cic.Prop; Cic.Set; (Cic.Type (CicUniv.fresh ())) ]
+
+let generate_projections uri fields status =
+ let projections = CicRecord.projections_of uri fields in
+ List.fold_left
+ (fun status (uri, name, bo) ->
+ try
+ let ty, ugraph =
+ CicTypeChecker.type_of_aux' [] [] bo CicUniv.empty_ugraph in
+ let attrs = [`Class `Projection; `Generated] in
+ let obj = Cic.Constant (name,Some bo,ty,[],attrs) in
+ MatitaSync.add_obj uri obj status
+ with
+ CicTypeChecker.TypeCheckerFailure s ->
+ MatitaLog.message
+ ("Unable to create projection " ^ name ^ " cause: " ^ s);
+ status
+ | CicEnvironment.Object_not_found uri ->
+ let depend = UriManager.name_of_uri uri in
+ MatitaLog.message
+ ("Unable to create projection " ^ name ^ " because it requires " ^ depend);
+ status
+ ) status projections
+
+(* to avoid a long list of recursive functions *)
+let eval_from_stream_ref = ref (fun _ _ _ -> assert false);;
+
+let disambiguate_obj status obj =
+ let uri =
+ match obj with
+ GrafiteAst.Inductive (_,(name,_,_,_)::_)
+ | GrafiteAst.Record (_,name,_,_) ->
+ Some (UriManager.uri_of_string (MatitaMisc.qualify status name ^ ".ind"))
+ | GrafiteAst.Inductive _ -> assert false
+ | GrafiteAst.Theorem _ -> None in
+ let (aliases, metasenv, cic, _) =
+ singleton
+ (MatitaDisambiguator.disambiguate_obj ~dbd:(MatitaDb.instance ())
+ ~aliases:(status.aliases) ~uri obj)
+ in
+ let proof_status =
+ match status.proof_status with
+ | No_proof -> Intermediate metasenv
+ | Incomplete_proof _
+ | Proof _ -> command_error "imbricated proofs not allowed"
+ | Intermediate _ -> assert false
+ in
+ let status = { status with proof_status = proof_status } in
+ let status = MatitaSync.set_proof_aliases status aliases in
+ status, cic
+
+let disambiguate_command status = function
+ | GrafiteAst.Alias _
+ | GrafiteAst.Default _
+ | GrafiteAst.Drop _
+ | GrafiteAst.Dump _
+ | GrafiteAst.Include _
+ | GrafiteAst.Interpretation _
+ | GrafiteAst.Notation _
+ | GrafiteAst.Qed _
+ | GrafiteAst.Render _
+ | GrafiteAst.Set _ as cmd ->
+ status,cmd
+ | GrafiteAst.Coercion (loc, term) ->
+ let status_ref = ref status in
+ let term = disambiguate_term status_ref term in
+ !status_ref, GrafiteAst.Coercion (loc,term)
+ | GrafiteAst.Obj (loc,obj) ->
+ let status,obj = disambiguate_obj status obj in
+ status, GrafiteAst.Obj (loc,obj)
+
+let make_absolute paths path =
+ if path = "coq.ma" then path
+ else
+ let rec aux = function
+ | [] -> ignore (Unix.stat path); path
+ | p :: tl ->
+ let path = p ^ "/" ^ path in
+ try
+ ignore (Unix.stat path); path
+ with Unix.Unix_error _ -> aux tl
+ in
+ try
+ aux paths
+ with Unix.Unix_error _ as exc -> raise (UnableToInclude path)
+;;
+
+let eval_command opts status cmd =
+ let status,cmd = disambiguate_command status cmd in
+ let cmd,notation_ids' = CicNotation.process_notation cmd in
+ let status =
+ { status with notation_ids = notation_ids' @ status.notation_ids }