X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_engine%2FgrafiteEngine.ml;h=239d30d2d1480ff0b0c354a757cacbf4105cc058;hb=12f96bd48b460d06f9858a334ee7c52d6831712f;hp=aea900cdf6fac1027f76fa6554f2ee0bd218844b;hpb=a63a5994b882fc391f6ec9b67a83e9777157b1ff;p=helm.git diff --git a/helm/software/components/grafite_engine/grafiteEngine.ml b/helm/software/components/grafite_engine/grafiteEngine.ml index aea900cdf..239d30d2d 100644 --- a/helm/software/components/grafite_engine/grafiteEngine.ml +++ b/helm/software/components/grafite_engine/grafiteEngine.ml @@ -531,6 +531,7 @@ let record_index_obj = ;; let index_obj_for_auto status (uri, height, _, _, kind) = + (*prerr_endline (string_of_int height);*) let mk_item orig_ty spec = let ty,_,_ = NCicMetaSubst.saturate ~delta:max_int [] [] [] orig_ty 0 in let keys = @@ -594,6 +595,36 @@ let index_obj_for_auto status (uri, height, _, _, kind) = status#set_dump dump ;; +let index_eq uri status = + let eq_status = status#eq_cache in + let eq_status1 = NCicParamod.index_obj eq_status uri in + status#set_eq_cache eq_status1 +;; + +let record_index_eq = + let basic_index_eq uri + ~refresh_uri_in_universe + ~refresh_uri_in_term + = index_eq (NCicLibrary.refresh_uri uri) + in + NCicLibrary.Serializer.register#run "index_eq" + object(_ : 'a NCicLibrary.register_type) + method run = basic_index_eq + end +;; + +let index_eq_for_auto status uri = + if NnAuto.is_a_fact_obj status uri then + let newstatus = index_eq uri status in + if newstatus#eq_cache == status#eq_cache then status + else + ((*prerr_endline ("recording " ^ (NUri.string_of_uri uri));*) + let dump = record_index_eq uri :: newstatus#dump + in newstatus#set_dump dump) + else + ((*prerr_endline "Not a fact";*) + status) +;; let basic_eval_add_constraint (u1,u2) status = NCicLibrary.add_constraint status u1 u2 @@ -721,7 +752,7 @@ let eval_ng_punct (_text, _prefix_len, punct) = match punct with | GrafiteAst.Dot _ -> NTactics.dot_tac | GrafiteAst.Semicolon _ -> fun x -> x - | GrafiteAst.Branch _ -> NTactics.branch_tac + | GrafiteAst.Branch _ -> NTactics.branch_tac ~force:false | GrafiteAst.Shift _ -> NTactics.shift_tac | GrafiteAst.Pos (_,l) -> NTactics.pos_tac l | GrafiteAst.Wildcard _ -> NTactics.wildcard_tac @@ -732,6 +763,8 @@ let eval_ng_tac tac = let rec aux f (text, prefix_len, tac) = match tac with | GrafiteAst.NApply (_loc, t) -> NTactics.apply_tac (text,prefix_len,t) + | GrafiteAst.NSmartApply (_loc, t) -> + NnAuto.smart_apply_tac (text,prefix_len,t) | GrafiteAst.NAssert (_loc, seqs) -> NTactics.assert_tac ((List.map @@ -746,7 +779,7 @@ let eval_ng_tac tac = | GrafiteAst.NAuto (_loc, (l,a)) -> NAuto.auto_tac ~params:(List.map (fun x -> "",0,x) l,a) - | GrafiteAst.NBranch _ -> NTactics.branch_tac + | GrafiteAst.NBranch _ -> NTactics.branch_tac ~force:false | GrafiteAst.NCases (_loc, what, where) -> NTactics.cases_tac ~what:(text,prefix_len,what) @@ -759,6 +792,9 @@ let eval_ng_tac tac = NTactics.constructor_tac ?num ~args:(List.map (fun x -> text,prefix_len,x) args) | GrafiteAst.NCut (_loc, t) -> NTactics.cut_tac (text,prefix_len,t) +(*| GrafiteAst.NDiscriminate (_,what) -> NDestructTac.discriminate_tac ~what:(text,prefix_len,what) + | GrafiteAst.NSubst (_,what) -> NDestructTac.subst_tac ~what:(text,prefix_len,what)*) + | GrafiteAst.NDestruct _ -> NDestructTac.destruct_tac | GrafiteAst.NDot _ -> NTactics.dot_tac | GrafiteAst.NElim (_loc, what, where) -> NTactics.elim_tac @@ -775,6 +811,7 @@ let eval_ng_tac tac = ~what:(text,prefix_len,what) name | GrafiteAst.NMerge _ -> NTactics.merge_tac | GrafiteAst.NPos (_,l) -> NTactics.pos_tac l + | GrafiteAst.NPosbyname (_,s) -> NTactics.case_tac s | GrafiteAst.NReduce (_loc, reduction, where) -> NTactics.reduce_tac ~reduction ~where:(text,prefix_len,where) | GrafiteAst.NRewrite (_loc,dir,what,where) -> @@ -846,6 +883,12 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) = let old_status = status in let status = NCicLibrary.add_obj status obj in let status = index_obj_for_auto status obj in + let status = index_eq_for_auto status uri in +(* + try + index_eq uri status + with _ -> prerr_endline "got an exception"; status + in *) (* prerr_endline (NCicPp.ppobj obj); *) HLog.message ("New object: " ^ NUri.string_of_uri uri); (try @@ -868,11 +911,18 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) = List.fold_left (fun (status,uris) boxml -> try - let status,nuris = + let nstatus,nuris = eval_ncommand opts status ("",0,GrafiteAst.NObj (HExtlib.dummy_floc,boxml)) in - status, concat_nuris uris nuris + if nstatus#ng_mode <> `CommandMode then + begin + HLog.error "error in generating projection/eliminator"; + prerr_endline (NCicPp.ppobj nstatus#obj); + nstatus, uris + end + else + nstatus, concat_nuris uris nuris with | MultiPassDisambiguator.DisambiguationError _ | NCicTypeChecker.TypeCheckerFailure _ -> @@ -894,6 +944,7 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) = fst (match menv with [] -> eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc) | _ -> status,`New [])) + (* XXX *) with _ -> HLog.warn "error in generating inversion principle"; let status = status#set_ng_mode `CommandMode in status) status @@ -983,6 +1034,24 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) = [] -> eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc) | _ -> status,`New []) + | GrafiteAst.NDiscriminator (_,_) -> assert false (*(loc, indty) -> + if status#ng_mode <> `CommandMode then + raise (GrafiteTypes.Command_error "Not in command mode") + else + let status = status#set_ng_mode `ProofMode in + let metasenv,subst,status,indty = + GrafiteDisambiguate.disambiguate_nterm None status [] [] [] (text,prefix_len,indty) in + let indtyno, (_,_,tys,_,_) = match indty with + NCic.Const ((NReference.Ref (_,NReference.Ind (_,indtyno,_))) as r) -> + indtyno, NCicEnvironment.get_checked_indtys r + | _ -> prerr_endline ("engine: indty expected... (fix this error message)"); assert false in + let it = List.nth tys indtyno in + let status,obj = NDestructTac.mk_discriminator it status in + let _,_,menv,_,_ = obj in + (match menv with + [] -> eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + | _ -> prerr_endline ("Discriminator: non empty metasenv"); + status, `New []) *) | GrafiteAst.NInverter (loc, name, indty, selection, sort) -> if status#ng_mode <> `CommandMode then raise (GrafiteTypes.Command_error "Not in command mode")