X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2FgTopLevel.ml;h=eeb6053aa2615b86a75efc5723d7193894896f3b;hb=3bb4ce11fb9d4c6375483a80344beb94c4517dd7;hp=e70946564a53b64b1d3b754b0e3b854429210993;hpb=5c796440126e33778e4b3f763ce37b677b378cc5;p=helm.git diff --git a/helm/gTopLevel/gTopLevel.ml b/helm/gTopLevel/gTopLevel.ml index e70946564..eeb6053aa 100644 --- a/helm/gTopLevel/gTopLevel.ml +++ b/helm/gTopLevel/gTopLevel.ml @@ -468,6 +468,12 @@ let qed () = match ProofEngine.get_proof () with None -> assert false | Some (uri,[],bo,ty) -> + let uri = match uri with Some uri -> uri | _ -> assert false in + (* we want to typecheck in the ENV *) + (*let old_working = CicUniv.get_working () in + CicUniv.set_working (CicUniv.get_global ());*) + CicUniv.directly_to_env_begin () ; + prerr_endline "-------------> QED"; if CicReduction.are_convertible [] (CicTypeChecker.type_of_aux' [] [] bo) ty @@ -483,7 +489,16 @@ let qed () = let pathname = pathname_of_annuri (UriManager.buri_of_uri uri) in make_dirs pathname ; save_object_to_disk uri acic ids_to_inner_sorts ids_to_inner_types - pathname + pathname; + (* add the object to the env *) + CicEnvironment.add_type_checked_term uri ( + Cic.Constant ((UriManager.name_of_uri uri),(Some bo),ty,[])); + (* FIXME: the variable list!! *) + (* + CicUniv.qed (); (* now the env has the right constraints *)*) + CicUniv.directly_to_env_end(); + CicUniv.reset_working (); + prerr_endline "-------------> FINE"; end else raise WrongProof @@ -565,8 +580,9 @@ let refresh_proof (output : TermViewer.proof_viewer) = else Hbugs.notify () ; (*CSC: Wrong: [] is just plainly wrong *) - uri, - (Cic.CurrentProof (UriManager.name_of_uri uri, metasenv, bo, ty, [])) + let uri = match uri with Some uri -> uri | _ -> assert false in + (uri, + Cic.CurrentProof (UriManager.name_of_uri uri, metasenv, bo, ty, [])) in ignore (output#load_proof uri currentproof) with @@ -691,7 +707,7 @@ let load_unfinished_proof () = match CicParser.obj_of_xml proof_file_type (Some proof_file) with Cic.CurrentProof (_,metasenv,bo,ty,_) -> typecheck_loaded_proof metasenv bo ty ; - ProofEngine.set_proof (Some (uri, metasenv, bo, ty)) ; + ProofEngine.set_proof (Some (Some uri, metasenv, bo, ty)); refresh_proof output ; set_proof_engine_goal (match metasenv with @@ -1056,7 +1072,7 @@ module DisambiguateCallbacks = interactive_user_uri_choice ~selection_mode ?ok ?enable_button_for_non_vars ~title ~msg let interactive_interpretation_choice = interactive_interpretation_choice - let input_or_locate_uri ~title ?id = input_or_locate_uri ~title + let input_or_locate_uri ~title ?id () = input_or_locate_uri ~title end ;; @@ -1512,7 +1528,7 @@ let new_proof () = let metasenv,expr = !get_metasenv_and_term () in let _ = CicTypeChecker.type_of_aux' metasenv [] expr in ProofEngine.set_proof - (Some (!get_uri (), (1,[],expr)::metasenv, Cic.Meta (1,[]), expr)) ; + (Some (Some (!get_uri ()), (1,[],expr)::metasenv, Cic.Meta (1,[]), expr)); set_proof_engine_goal (Some 1) ; refresh_goals notebook ; refresh_proof output ; @@ -1591,7 +1607,8 @@ let open_ () = let notebook = (rendering_window ())#notebook in try let uri = input_or_locate_uri ~title:"Open" in - CicTypeChecker.typecheck uri ; + ignore(CicTypeChecker.typecheck uri); + (* TASSI: typecheck mette la uri nell'env... cosa fa la open_ ?*) let metasenv,bo,ty = match CicEnvironment.get_cooked_obj uri with Cic.Constant (_,Some bo,ty,_) -> [],bo,ty @@ -1600,7 +1617,7 @@ let open_ () = | Cic.Variable _ | Cic.InductiveDefinition _ -> raise NotADefinition in - ProofEngine.set_proof (Some (uri, metasenv, bo, ty)) ; + ProofEngine.set_proof (Some (Some uri, metasenv, bo, ty)) ; set_proof_engine_goal None ; refresh_goals notebook ; refresh_proof output ;