X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaEngine.ml;h=4ca54d0e40dbd5d97b3df4596f77e56ff5b8fc76;hb=aca103d3c3d740efcc0bcc2932922cff77facb49;hp=59d1c7b79891464d51348e9136716dadd4fd5303;hpb=716da638633f01d6a5b52c05e0bd6adc86385b60;p=helm.git diff --git a/helm/matita/matitaEngine.ml b/helm/matita/matitaEngine.ml index 59d1c7b79..4ca54d0e4 100644 --- a/helm/matita/matitaEngine.ml +++ b/helm/matita/matitaEngine.ml @@ -40,7 +40,8 @@ let tactic_of_ast = function | TacticAst.Cut (_, term) -> Tactics.cut term | TacticAst.Elim (_, term, _) -> (* TODO Zack implement "using" argument *) - Tactics.elim_intros_simpl term + (* old: Tactics.elim_intros_simpl term *) + Tactics.elim_intros term | TacticAst.ElimType (_, term) -> Tactics.elim_type term | TacticAst.Replace (_, what, with_what) -> Tactics.replace ~what ~with_what | TacticAst.Auto (_,num) -> @@ -55,10 +56,24 @@ let tactic_of_ast = function | TacticAst.Fold of reduction_kind * 'term | TacticAst.Injection of 'ident | TacticAst.LetIn of 'term * 'ident - | TacticAst.Reduce of reduction_kind * 'term pattern * 'ident option | TacticAst.Replace_pattern of 'term pattern * 'term - | TacticAst.Rewrite of direction * 'term * 'ident option *) + | TacticAst.Reduce (_,reduction_kind,opts) -> + let terms, also_in_hypotheses = + match opts with + | Some (l,`Goal) -> Some l, false + | Some (l,`Everywhere) -> Some l, true + | None -> None, false + in + (match reduction_kind with + | `Reduce -> Tactics.reduce ~also_in_hypotheses ~terms + | `Simpl -> Tactics.simpl ~also_in_hypotheses ~terms + | `Whd -> Tactics.whd ~also_in_hypotheses ~terms) + | TacticAst.Rewrite (_,dir,t,ident) -> + if dir = `Left then + EqualityTactics.rewrite_tac ~term:t + else + EqualityTactics.rewrite_back_tac ~term:t | _ -> assert false let eval_tactical status tac = @@ -145,8 +160,11 @@ let eval_command status cmd = CicTypeChecker.typecheck_mutual_inductive_defs uri (types, [], leftno) CicUniv.empty_ugraph in + let status = MatitaSync.add_inductive_def - ~uri ~types ~params:[] ~leftno ~ugraph status; + ~uri ~types ~params:[] ~leftno ~ugraph status + in + {status with proof_status = No_proof } | TacticAst.Theorem (loc, thm_flavour, Some name, ty, None) -> let uri = UriManager.uri_of_string (MatitaMisc.qualify status name ^ ".con") @@ -176,7 +194,8 @@ let eval_command status cmd = "metasenv not empty while giving a definition with body"; let body = CicMetaSubst.apply_subst subst body in let ty = CicMetaSubst.apply_subst subst ty in - MatitaSync.add_constant ~uri ~body ~ty ~ugraph status + let status = MatitaSync.add_constant ~uri ~body ~ty ~ugraph status in + {status with proof_status = No_proof} | TacticAst.Theorem (_, _, None, _, _) -> command_error "The grammas should avoid having unnamed theorems!" | TacticAst.Coercion (loc, term) -> assert false (** TODO *) @@ -200,14 +219,21 @@ let eval_command status cmd = (DisambiguateTypes.Num instance) (DisambiguateChoices.lookup_num_by_dsc desc) status.aliases } -let eval status st = - match st with +let eval_executable status ex = + match ex with | TacticAst.Tactical (_, tac) -> eval_tactical status tac | TacticAst.Command (_, cmd) -> eval_command status cmd | TacticAst.Macro (_, mac) -> command_error (sprintf "The macro %s can't be in a script" (TacticAstPp.pp_macro_cic mac)) +let eval_comment status c = status + +let eval status st = + match st with + | TacticAst.Executable (_,ex) -> eval_executable status ex + | TacticAst.Comment (_,c) -> eval_comment status c + let disambiguate_term status term = let (aliases, metasenv, cic, _) = match @@ -281,10 +307,25 @@ let disambiguate_tactic status = function | TacticAst.Fold of reduction_kind * 'term | TacticAst.Injection of 'ident | TacticAst.LetIn of 'term * 'ident - | TacticAst.Reduce of reduction_kind * 'term pattern * 'ident option | TacticAst.Replace_pattern of 'term pattern * 'term - | TacticAst.Rewrite of direction * 'term * 'ident option *) + | TacticAst.Reduce (loc, reduction_kind, opts) -> + let status, opts = + match opts with + | None -> status, None + | Some (l,pat) -> + let status, l = + List.fold_right (fun t (status,acc) -> + let status',t' = disambiguate_term status t in + status', t'::acc) + l (status,[]) + in + status, Some (l, pat) + in + status, TacticAst.Reduce (loc, reduction_kind, opts) + | TacticAst.Rewrite (loc,dir,t,ident) -> + let status, term = disambiguate_term status t in + status, TacticAst.Rewrite (loc,dir,term,ident) | TacticAst.Intros (loc, num, names) -> status, TacticAst.Intros (loc, num, names) | TacticAst.Auto (loc,num) -> status, TacticAst.Auto (loc,num) @@ -430,8 +471,8 @@ let disambiguate_command status = function status, cmd | TacticAst.Alias _ as x -> status, x -let disambiguate_statement status statement = - match statement with +let disambiguate_executable status ex = + match ex with | TacticAst.Tactical (loc, tac) -> let status, tac = disambiguate_tactical status tac in status, (TacticAst.Tactical (loc, tac)) @@ -442,6 +483,22 @@ let disambiguate_statement status statement = command_error (sprintf ("The engine is not allowed to disambiguate any macro, "^^ "in particular %s") (TacticAstPp.pp_macro_ast mac)) + +let disambiguate_comment status c = + match c with + | TacticAst.Note (loc,n) -> status, TacticAst.Note (loc,n) + | TacticAst.Code (loc,ex) -> + let status, ex = disambiguate_executable status ex in + status, TacticAst.Code (loc,ex) + +let disambiguate_statement status statement = + match statement with + | TacticAst.Comment (loc,c) -> + let status, c = disambiguate_comment status c in + status, TacticAst.Comment (loc,c) + | TacticAst.Executable (loc,ex) -> + let status, ex = disambiguate_executable status ex in + status, TacticAst.Executable (loc,ex) let eval_ast status ast = let status,st = disambiguate_statement status ast in