X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_engine%2FgrafiteEngine.ml;h=ab98132210238daf670872dacbb356cf6817c9df;hb=3f676ab6acafa32514a44bc84d287f44dbc5389e;hp=f95829797a3c91ea75be791f83fac86d0f16ab03;hpb=137a822662f81efbbeac7ddc833fc9ffe252a70e;p=helm.git diff --git a/helm/software/components/grafite_engine/grafiteEngine.ml b/helm/software/components/grafite_engine/grafiteEngine.ml index f95829797..ab9813221 100644 --- a/helm/software/components/grafite_engine/grafiteEngine.ml +++ b/helm/software/components/grafite_engine/grafiteEngine.ml @@ -68,6 +68,9 @@ let tactic_of_ast status ast = | GrafiteAst.Auto (_,params) -> AutoTactic.auto_tac ~params ~dbd:(LibraryDb.instance ()) ~universe:status.GrafiteTypes.universe + | GrafiteAst.Cases (_, what, names) -> + Tactics.cases_intros ~mk_fresh_name_callback:(namer_of names) + what | GrafiteAst.Change (_, pattern, with_what) -> Tactics.change ~pattern with_what | GrafiteAst.Clear (_,id) -> Tactics.clear id @@ -150,8 +153,8 @@ let tactic_of_ast status ast = | GrafiteAst.Reflexivity _ -> Tactics.reflexivity | GrafiteAst.Replace (_, pattern, with_what) -> Tactics.replace ~pattern ~with_what - | GrafiteAst.Rewrite (_, direction, t, pattern) -> - EqualityTactics.rewrite_tac ~direction ~pattern t + | GrafiteAst.Rewrite (_, direction, t, pattern, names) -> + EqualityTactics.rewrite_tac ~direction ~pattern t names | GrafiteAst.Right _ -> Tactics.right | GrafiteAst.Ring _ -> Tactics.ring | GrafiteAst.Split _ -> Tactics.split @@ -169,6 +172,8 @@ let tactic_of_ast status ast = | GrafiteAst.Bydone (_, t) -> Declarative.bydone ~dbd:(LibraryDb.instance()) ~universe:status.GrafiteTypes.universe t + | GrafiteAst.We_proceed_by_cases_on (_, t, t1) -> + Declarative.we_proceed_by_cases_on t t1 | GrafiteAst.We_proceed_by_induction_on (_, t, t1) -> Declarative.we_proceed_by_induction_on t t1 | GrafiteAst.Byinduction (_, t, id) -> Declarative.byinduction t id @@ -325,7 +330,7 @@ prerr_endline("opened: " ^ String.concat ", " (List.map string_of_int opened)); prerr_endline("closed_goals: " ^ String.concat ", " (List.map string_of_int closed_goals)); *) let proof, opened_goals = if needs_reordering then begin - let uri, metasenv_after_tactic, t, ty = proof in + let uri, metasenv_after_tactic, t, ty, attrs = proof in (* prerr_endline ("goal prima del riordino: " ^ String.concat " " (List.map string_of_int (ProofEngineTypes.goals_of_proof proof))); *) let reordered_metasenv, opened_goals = reorder_metasenv @@ -333,7 +338,7 @@ prerr_endline("closed_goals: " ^ String.concat ", " (List.map string_of_int clos metasenv_after_refinement metasenv_after_tactic opened goal always_opens_a_goal in - let proof' = uri, reordered_metasenv, t, ty in + let proof' = uri, reordered_metasenv, t, ty, attrs in (* prerr_endline ("goal dopo il riordino: " ^ String.concat " " (List.map string_of_int (ProofEngineTypes.goals_of_proof proof'))); *) proof', opened_goals end @@ -418,7 +423,7 @@ type 'a eval_executable = type 'a eval_from_moo = { efm_go: GrafiteTypes.status -> string -> GrafiteTypes.status } -let coercion_moo_statement_of arity uri = +let coercion_moo_statement_of (uri,arity) = GrafiteAst.Coercion (HExtlib.dummy_floc, uri, false, arity) let refinement_toolkit = { @@ -444,16 +449,17 @@ let refinement_toolkit = { RefinementTool.pack_coercion_obj = CicRefine.pack_coercion_obj; } -let eval_coercion status ~add_composites uri arity = +let eval_coercion status ~add_composites uri arity baseuri = let status,compounds = GrafiteSync.add_coercion ~add_composites refinement_toolkit status uri arity + baseuri in let moo_content = - List.map (coercion_moo_statement_of arity) (uri::compounds) + List.map coercion_moo_statement_of ((uri,arity)::compounds) in let status = GrafiteTypes.add_moo_content moo_content status in {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof}, - compounds + List.map fst compounds let eval_tactical ~disambiguate_tactic status tac = let apply_tactic = apply_tactic ~disambiguate_tactic in @@ -596,9 +602,9 @@ let add_coercions_of_record_to_moo obj lemmas status = in let is_a_coercion, arity_coercion = is_a_coercion uri in if is_a_coercion then - Some (uri, coercion_moo_statement_of arity_coercion uri) + Some (uri, coercion_moo_statement_of (uri,arity_coercion)) else if is_a_wanted_coercion then - Some (uri, coercion_moo_statement_of arity_wanted uri) + Some (uri, coercion_moo_statement_of (uri,arity_wanted)) else None) lemmas) @@ -643,6 +649,7 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status status,[] | GrafiteAst.Coercion (loc, uri, add_composites, arity) -> eval_coercion status ~add_composites uri arity + (GrafiteTypes.get_string_option status "baseuri") | GrafiteAst.Default (loc, what, uris) as cmd -> LibraryObjects.set_default what uris; GrafiteTypes.add_moo_content [cmd] status,[] @@ -676,16 +683,16 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status *) status,[] | GrafiteAst.Print (_,"proofterm") -> - let _,_,p,_ = GrafiteTypes.get_current_proof status in + let _,_,p,_, _ = GrafiteTypes.get_current_proof status in print_endline (AutoTactic.pp_proofterm p); status,[] | GrafiteAst.Print (_,_) -> status,[] | GrafiteAst.Qed loc -> - let uri, metasenv, bo, ty = + let uri, metasenv, bo, ty, attrs = match status.GrafiteTypes.proof_status with - | GrafiteTypes.Proof (Some uri, metasenv, body, ty) -> - uri, metasenv, body, ty - | GrafiteTypes.Proof (None, metasenv, body, ty) -> + | GrafiteTypes.Proof (Some uri, metasenv, body, ty, attrs) -> + uri, metasenv, body, ty, attrs + | GrafiteTypes.Proof (None, metasenv, body, ty, attrs) -> raise (GrafiteTypes.Command_error ("Someone allows to start a theorem without giving the "^ "name/uri. This should be fixed!")) @@ -698,10 +705,11 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status (GrafiteTypes.Command_error "Proof not completed! metasenv is not empty!"); let name = UriManager.name_of_uri uri in - let obj = Cic.Constant (name,Some bo,ty,[],[]) in + let obj = Cic.Constant (name,Some bo,ty,[],attrs) in let status, lemmas = add_obj uri obj status in {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof}, + (*CSC: I throw away the arities *) uri::lemmas | GrafiteAst.Relation (loc, id, a, aeq, refl, sym, trans) -> Setoids.add_relation id a aeq refl sym trans; @@ -749,7 +757,7 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status let obj = CicRefine.pack_coercion_obj obj in let metasenv = GrafiteTypes.get_proof_metasenv status in match obj with - | Cic.CurrentProof (_,metasenv',bo,ty,_,_) -> + | Cic.CurrentProof (_,metasenv',bo,ty,_, attrs) -> let name = UriManager.name_of_uri uri in if not(CicPp.check name ty) then HLog.error ("Bad name: " ^ name); @@ -781,7 +789,7 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status ("Theorem already proved: " ^ UriManager.string_of_uri x ^ "\nPlease use a variant.")); end; - let initial_proof = (Some uri, metasenv', bo, ty) in + let initial_proof = (Some uri, metasenv', bo, ty, attrs) in let initial_stack = Continuationals.Stack.of_metasenv metasenv' in { status with GrafiteTypes.proof_status = GrafiteTypes.Incomplete_proof