X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Flibrary%2FlibrarySync.ml;h=c6682bd9100df786a88c71425230f8a219de07ed;hb=84e4ed5e9a09589ac149c6d0d135c226d5b7a5f9;hp=5897d62ba8c81256b3213af333c9a1d0cbf03baa;hpb=2b867cf85544ca5464b261910cc15d3a3a0aefe5;p=helm.git diff --git a/components/library/librarySync.ml b/components/library/librarySync.ml index 5897d62ba..c6682bd91 100644 --- a/components/library/librarySync.ml +++ b/components/library/librarySync.ml @@ -25,6 +25,10 @@ (* $Id$ *) +let object_declaration_hook = ref (fun _ _ -> ());; +let set_object_declaration_hook f = + object_declaration_hook := f + exception AlreadyDefined of UriManager.uri let auxiliary_lemmas_hashtbl = UriManager.UriHashtbl.create 29 @@ -70,24 +74,27 @@ let save_object_to_disk uri obj ugraph univlist = HExtlib.mkdir dir in (* generate annobj, ids_to_inner_sorts and ids_to_inner_types *) - let annobj, innertypes = - if Helm_registry.get_bool "matita.system" then - let annobj, _, _, ids_to_inner_sorts, ids_to_inner_types, _, _ = + let annobj, innertypes, ids_to_inner_sorts, generate_attributes = + if Helm_registry.get_bool "matita.system" && + not (Helm_registry.get_bool "matita.noinnertypes") + then + let annobj, _, _, ids_to_inner_sorts, ids_to_inner_types, _, _ = Cic2acic.acic_object_of_cic_object obj in let innertypesxml = Cic2Xml.print_inner_types uri ~ids_to_inner_sorts ~ids_to_inner_types ~ask_dtd_to_the_getter:false in - annobj, Some innertypesxml + annobj, Some innertypesxml, Some ids_to_inner_sorts, false else let annobj = Cic2acic.plain_acic_object_of_cic_object obj in - annobj, None + annobj, None, None, true in (* prepare XML *) let xml, bodyxml = Cic2Xml.print_object - uri ?ids_to_inner_sorts:None ~ask_dtd_to_the_getter:false annobj + uri ?ids_to_inner_sorts ~ask_dtd_to_the_getter:false + ~generate_attributes annobj in let xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri, xmlunivgraphpath, univgraphuri = @@ -159,6 +166,10 @@ let add_single_obj uri obj refinement_toolkit = try (*3*) let new_stuff = save_object_to_disk uri obj ugraph univlist in + (* EXPERIMENTAL: pretty print the object in natural language *) + (try !object_declaration_hook uri obj + with exc -> + prerr_endline "Error: object_declaration_hook failed"); try HLog.message (Printf.sprintf "%s defined" (UriManager.string_of_uri uri)) @@ -314,13 +325,13 @@ let add_coercion ~add_composites refinement_toolkit uri arity saturations baseuri in let new_coercions = - List.filter (fun (s,t,u,saturations,obj) -> not(already_in_obj s t u obj)) + List.filter (fun (s,t,u,_,obj,_) -> not(already_in_obj s t u obj)) new_coercions in - let composite_uris = List.map (fun (_,_,uri,_,_) -> uri) new_coercions in + let composite_uris = List.map (fun (_,_,uri,_,_,_) -> uri) new_coercions in (* update the DB *) List.iter - (fun (src,tgt,uri,saturations,_) -> + (fun (src,tgt,uri,saturations,_,_) -> CoercDb.add_coercion (src,tgt,uri,saturations)) new_coercions; CoercDb.add_coercion (src_carr, tgt_carr, uri, saturations); @@ -328,9 +339,8 @@ let add_coercion ~add_composites refinement_toolkit uri arity saturations let lemmas = if add_composites then List.fold_left - (fun acc (_,tgt,uri,saturations,obj) -> + (fun acc (_,tgt,uri,saturations,obj,arity) -> add_single_obj uri obj refinement_toolkit; - let arity = match tgt with CoercDb.Fun n -> n | _ -> 0 in (uri,arity,saturations)::acc) [] new_coercions else