X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=matitaB%2Fcomponents%2Fgrafite_engine%2FgrafiteEngine.ml;h=1aa23421137610ce4943e9159581f35106946582;hb=1d9f316d7e397f52650c37ccc97fada28d293118;hp=7febf874e3a25ac5defb81232663ace8756a3fe2;hpb=cacbe3c6493ddce76c4c13379ade271d8dd172e8;p=helm.git diff --git a/matitaB/components/grafite_engine/grafiteEngine.ml b/matitaB/components/grafite_engine/grafiteEngine.ml index 7febf874e..1aa234211 100644 --- a/matitaB/components/grafite_engine/grafiteEngine.ml +++ b/matitaB/components/grafite_engine/grafiteEngine.ml @@ -44,7 +44,7 @@ let inject_unification_hint = ~alias_only status = if not alias_only then - let t = refresh_uri_in_term (status :> NCic.status) t in + let t = refresh_uri_in_term (status :> NCicEnvironment.status) t in basic_eval_unification_hint (t,n) status else status @@ -79,11 +79,12 @@ let basic_eval_interpretation ~alias_only (dsc, (symbol, args), cic_appl_pattern else status in - let mode = GrafiteAst.WithPreferences (*assert false*) in (* MATITA 1.0 VEDI SOTTO *) let diff = - [DisambiguateTypes.Symbol (symbol, 0), GrafiteAst.Symbol_alias (symbol,0,dsc)] + (* FIXME! the uri should be filled with something meaningful! *) + [DisambiguateTypes.Symbol symbol, + GrafiteAst.Symbol_alias (symbol,None,dsc)] in - GrafiteDisambiguate.set_proof_aliases status ~implicit_aliases:false mode diff + GrafiteDisambiguate.add_to_disambiguation_univ status diff ;; let inject_interpretation = @@ -113,7 +114,8 @@ let eval_interpretation status data= ;; let basic_eval_alias (mode,diff) status = - GrafiteDisambiguate.set_proof_aliases status ~implicit_aliases:false mode diff + prerr_endline "basic_eval_alias"; + GrafiteDisambiguate.add_to_disambiguation_univ status diff ;; let inject_alias = @@ -132,8 +134,14 @@ let eval_alias status data= let basic_eval_input_notation (l1,l2) status = GrafiteParser.extend status l1 (fun env loc -> - NotationPt.AttributedTerm - (`Loc loc,TermContentPres.instantiate_level2 status env l2)) + let rec get_disamb = function + | [] -> Stdpp.dummy_loc,None,None + | (_,(NotationEnv.NoType,NotationEnv.DisambiguationValue dv))::_ -> dv + | _::tl -> get_disamb tl + in + let l2' = TermContentPres.instantiate_level2 status env (get_disamb env) l2 in + prerr_endline ("new l2 ast : " ^ (NotationPp.pp_term status l2')); + NotationPt.AttributedTerm (`Loc loc,l2')) ;; let inject_input_notation = @@ -144,10 +152,10 @@ let inject_input_notation = if not alias_only then let l1 = CicNotationParser.refresh_uri_in_checked_l1_pattern - ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status)) + ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status)) ~refresh_uri_in_reference l1 in let l2 = NotationUtil.refresh_uri_in_term - ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status)) + ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status)) ~refresh_uri_in_reference l2 in basic_eval_input_notation (l1,l2) status @@ -175,10 +183,10 @@ let inject_output_notation = if not alias_only then let l1 = CicNotationParser.refresh_uri_in_checked_l1_pattern - ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status)) + ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status)) ~refresh_uri_in_reference l1 in let l2 = NotationUtil.refresh_uri_in_term - ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status)) + ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status)) ~refresh_uri_in_reference l2 in basic_eval_output_notation (l1,l2) status @@ -198,7 +206,7 @@ let record_index_obj = let aux l ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference ~alias_only status = - let refresh_uri_in_term = refresh_uri_in_term (status:>NCic.status) in + let refresh_uri_in_term = refresh_uri_in_term (status:>NCicEnvironment.status) in if not alias_only then basic_index_obj (List.map @@ -314,7 +322,7 @@ let inject_constraint = (* NCicLibrary.add_constraint adds the constraint to the NCicEnvironment * and also to the storage (for undo/redo). During inclusion of compiled * files the storage must not be touched. *) - NCicEnvironment.add_lt_constraint u1 u2; + NCicEnvironment.add_lt_constraint status u1 u2; status else status @@ -485,13 +493,38 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = GrafiteTypes.Serializer.require ~alias_only ~baseuri ~fname:fullpath status | GrafiteAst.UnificationHint (loc, t, n) -> eval_unification_hint status t n - | GrafiteAst.NCoercion (loc, name, t, ty, source, target) -> + | GrafiteAst.NCoercion (loc, name, None) -> + let status, t, ty, source, target = + let o_t = NotationPt.Ident (name,`Ambiguous) in + let metasenv,subst, status,t = + GrafiteDisambiguate.disambiguate_nterm + status None [] [] [] ("",0,o_t) in + assert( metasenv = [] && subst = []); + let ty = NCicTypeChecker.typeof status [] [] [] t in + let source, target = + let clean = function + | NCic.Appl (NCic.Const _ as r :: l) -> + NotationPt.Appl (NotationPt.NCic r :: + List.map (fun _ -> NotationPt.Implicit `JustOne)l) + | NCic.Const _ as r -> NotationPt.NCic r + | _ -> assert false in + let rec aux = function + | NCic.Prod (_,_, (NCic.Prod _ as rest)) -> aux rest + | NCic.Prod (name, src, tgt) -> (name, clean src), clean tgt + | _ -> assert false in aux ty in + status, o_t, NotationPt.NCic ty, source, target in let status, composites = NCicCoercDeclaration.eval_ncoercion status name t ty source target in let mode = GrafiteAst.WithPreferences in (* MATITA 1.0: fixme *) let aliases = GrafiteDisambiguate.aliases_for_objs status composites in eval_alias status (mode,aliases) - | GrafiteAst.NQed loc -> + | GrafiteAst.NCoercion (loc, name, Some (t, ty, source, target)) -> + let status, composites = + NCicCoercDeclaration.eval_ncoercion status name t ty source target in + let mode = GrafiteAst.WithPreferences in (* MATITA 1.0: fixme *) + let aliases = GrafiteDisambiguate.aliases_for_objs status composites in + eval_alias status (mode,aliases) + | GrafiteAst.NQed (loc,index) -> if status#ng_mode <> `ProofMode then raise (GrafiteTypes.Command_error "Not in proof mode") else @@ -526,7 +559,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let obj = uri,height,[],[],obj_kind in let old_status = status in let status = NCicLibrary.add_obj status obj in - let index_obj = + let index_obj = index && match obj_kind with NCic.Constant (_,_,_,_,(_,`Example,_)) | NCic.Fixpoint (_,_,(_,`Example,_)) -> false @@ -592,14 +625,15 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let _,_,menv,_,_ = invobj in (match menv with [] -> eval_ncommand ~include_paths opts status - ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false)) | _ -> status)) (* XXX *) with _ -> (*HLog.warn "error in generating inversion principle"; *) let status = status#set_ng_mode `CommandMode in status) status (NCic.Prop:: - List.map (fun s -> NCic.Type s) (NCicEnvironment.get_universes ())) + List.map (fun s -> NCic.Type s) + (NCicEnvironment.get_universes status)) | _ -> status in let coercions = @@ -617,7 +651,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = try let metasenv,subst,status,t = GrafiteDisambiguate.disambiguate_nterm status None [] [] [] - ("",0,NotationPt.Ident (name,None)) in + ("",0,NotationPt.Ident (name,`Ambiguous)) in assert (metasenv = [] && subst = []); let status, nuris = NCicCoercDeclaration. @@ -665,7 +699,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let status = status#set_stack ninitial_stack in let status = subst_metasenv_and_fix_names status in let status = status#set_ng_mode `ProofMode in - eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false)) | GrafiteAst.NObj (loc,obj) -> if status#ng_mode <> `CommandMode then raise (GrafiteTypes.Command_error "Not in command mode") @@ -681,7 +715,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let status = status#set_ng_mode `ProofMode in (match nmenv with [] -> - eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,true)) | _ -> status) | GrafiteAst.NDiscriminator (_,_) -> assert false (*(loc, indty) -> if status#ng_mode <> `CommandMode then @@ -708,8 +742,10 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let metasenv,subst,status,sort = match sort with | None -> [],[],status,NCic.Sort NCic.Prop | Some s -> - GrafiteDisambiguate.disambiguate_nterm status None [] [] [] - (text,prefix_len,s) + let metasenv,subst,status,sort = + GrafiteDisambiguate.disambiguate_nterm status None [] [] [] + (text,prefix_len,s) + in metasenv,subst,status,sort in assert (metasenv = []); let sort = NCicReduction.whd status ~subst [] sort in @@ -740,7 +776,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = (match menv with [] -> eval_ncommand ~include_paths opts status - ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false)) | _ -> assert false) | GrafiteAst.NUnivConstraint (loc,u1,u2) -> eval_add_constraint status [`Type,u1] [`Type,u2] @@ -752,6 +788,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = in eval_interpretation status (dsc,(symbol, args),cic_appl_pattern) | GrafiteAst.Notation (loc, dir, l1, associativity, precedence, l2) -> + prerr_endline ("new notation: " ^ (NotationPp.pp_term status l1)); let l1 = CicNotationParser.check_l1_pattern l1 (dir = Some `RightToLeft) precedence associativity @@ -760,8 +797,11 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = if dir <> Some `RightToLeft then eval_input_notation status (l1,l2) else status in + let status = if dir <> Some `LeftToRight then eval_output_notation status (l1,l2) else status + in prerr_endline ("new grammar:\n" ^ (Print_grammar.ebnf_of_term status)); + status | GrafiteAst.Alias (loc, spec) -> let diff = (*CSC: Warning: this code should be factorized with the corresponding @@ -769,10 +809,10 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = match spec with | GrafiteAst.Ident_alias (id,uri) -> [DisambiguateTypes.Id id,spec] - | GrafiteAst.Symbol_alias (symb, instance, desc) -> - [DisambiguateTypes.Symbol (symb,instance),spec] - | GrafiteAst.Number_alias (instance,desc) -> - [DisambiguateTypes.Num instance,spec] + | GrafiteAst.Symbol_alias (symb, uri, desc) -> + [DisambiguateTypes.Symbol symb,spec] + | GrafiteAst.Number_alias (uri,desc) -> + [DisambiguateTypes.Num,spec] in let mode = GrafiteAst.WithPreferences in(*assert false in (* VEDI SOPRA *) MATITA 1.0*) eval_alias status (mode,diff)