X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_engine%2FgrafiteTypes.ml;h=9fd40b1c463af8c80b80002c4703b81cdbe1c8c8;hb=290350836dd1727b3e3cdd4ee71e666a39cc4a09;hp=83687277965aaa500c390d4fa406efc208045bc2;hpb=42f25c258b0b199ee96dd8eaa3d44c86eb6916ab;p=helm.git diff --git a/helm/software/components/grafite_engine/grafiteTypes.ml b/helm/software/components/grafite_engine/grafiteTypes.ml index 836872779..9fd40b1c4 100644 --- a/helm/software/components/grafite_engine/grafiteTypes.ml +++ b/helm/software/components/grafite_engine/grafiteTypes.ml @@ -45,27 +45,59 @@ type proof_status = * engine. No status entering/exiting the engine could be in it. *) type ng_status = - | ProofMode of NTactics.tac_status - | CommandMode of LexiconEngine.status - -type status = { - moo_content_rev: GrafiteMarshal.moo; - proof_status: proof_status; - objects: UriManager.uri list; - coercions: CoercDb.coerc_db; - universe:Universe.universe; - baseuri: string; - ng_status: ng_status; -} + | ProofMode of NTacStatus.tac_status + | CommandMode of NEstatus.status + +class status = + fun (mcr : GrafiteMarshal.moo) (ps : proof_status) (o : UriManager.uri list) + (c : CoercDb.coerc_db) (ac : AutomationCache.cache) (b : string) + (ns : ng_status) + -> + object + val moo_content_rev = mcr + val proof_status = ps + val objects = o + val coercions = c + val automation_cache = ac + val baseuri = b + val ng_status = ns + method moo_content_rev = moo_content_rev + method set_moo_content_rev v = {< moo_content_rev = v >} + method proof_status = proof_status + method set_proof_status v = {< proof_status = v >} + method objects = objects + method set_objects v = {< objects = v >} + method coercions = coercions + method set_coercions v = {< coercions = v >} + method automation_cache = automation_cache + method set_automation_cache v = {< automation_cache = v >} + method baseuri = baseuri + method set_baseuri v = {< baseuri = v >} + method ng_status = ng_status; + method set_ng_status v = {< ng_status = v >} + end + +let get_estatus x = + match x#ng_status with + | ProofMode t -> (t :> NEstatus.status) + | CommandMode e -> e +;; + +let set_estatus e x = + x#set_ng_status + (match x#ng_status with + ProofMode t -> ProofMode t#set_estatus e + | CommandMode _ -> CommandMode e) +;; let get_current_proof status = - match status.proof_status with + match status#proof_status with | Incomplete_proof { proof = p } -> p | Proof p -> p | _ -> raise (Statement_error "no ongoing proof") let get_proof_metasenv status = - match status.proof_status with + match status#proof_status with | No_proof -> [] | Proof (_, metasenv, _, _, _, _) | Incomplete_proof { proof = (_, metasenv, _, _, _, _) } @@ -73,15 +105,15 @@ let get_proof_metasenv status = metasenv let get_stack status = - match status.proof_status with + match status#proof_status with | Incomplete_proof p -> p.stack | Proof _ -> Continuationals.Stack.empty | _ -> assert false let set_stack stack status = - match status.proof_status with + match status#proof_status with | Incomplete_proof p -> - { status with proof_status = Incomplete_proof { p with stack = stack } } + status#set_proof_status (Incomplete_proof { p with stack = stack }) | Proof _ -> assert (Continuationals.Stack.is_empty stack); status @@ -89,7 +121,7 @@ let set_stack stack status = let set_metasenv metasenv status = let proof_status = - match status.proof_status with + match status#proof_status with | No_proof -> Intermediate metasenv | Incomplete_proof ({ proof = (uri, _, subst, proof, ty, attrs) } as incomplete_proof) -> Incomplete_proof @@ -97,26 +129,26 @@ let set_metasenv metasenv status = | Intermediate _ -> Intermediate metasenv | Proof (_, metasenv', _, _, _, _) -> assert (metasenv = metasenv'); - status.proof_status + status#proof_status in - { status with proof_status = proof_status } + status#set_proof_status proof_status let get_proof_context status goal = - match status.proof_status with + match status#proof_status with | Incomplete_proof { proof = (_, metasenv, _, _, _, _) } -> let (_, context, _) = CicUtil.lookup_meta goal metasenv in context | _ -> [] let get_proof_conclusion status goal = - match status.proof_status with + match status#proof_status with | Incomplete_proof { proof = (_, metasenv, _, _, _, _) } -> let (_, _, conclusion) = CicUtil.lookup_meta goal metasenv in conclusion | _ -> raise (Statement_error "no ongoing proof") let add_moo_content cmds status = - let content = status.moo_content_rev in + let content = status#moo_content_rev in let content' = List.fold_right (fun cmd acc -> @@ -132,62 +164,21 @@ let add_moo_content cmds status = in (* prerr_endline ("new moo content: " ^ String.concat " " (List.map GrafiteAstPp.pp_command content')); *) - { status with moo_content_rev = content' } - -let get_baseuri status = status.baseuri;; - -(* -let get_option status name = - try - StringMap.find name status.options - with Not_found -> raise (Option_error (name, "not found")) - -let set_option status name value = - let types = [ (* no set options defined! *) ] in - let ty_and_mangler = - try List.assoc name types - with Not_found -> - command_error (Printf.sprintf "Unknown option \"%s\"" name) - in - let value = - match ty_and_mangler with - | `String, f -> String (f value) - | `Int, f -> - (try - Int (int_of_string (f value)) - with Failure _ -> - command_error (Printf.sprintf "Not an integer value \"%s\"" value)) - in - { status with options = StringMap.add name value status.options } - + status#set_moo_content_rev content' -let get_string_option status name = - match get_option status name with - | String s -> s - | _ -> raise (Option_error (name, "not a string value")) -*) +let get_baseuri status = status#baseuri;; let dump_status status = HLog.message "status.aliases:\n"; HLog.message "status.proof_status:"; HLog.message - (match status.proof_status with + (match status#proof_status with | No_proof -> "no proof\n" | Incomplete_proof _ -> "incomplete proof\n" | Proof _ -> "proof\n" | Intermediate _ -> "Intermediate\n"); HLog.message "status.options\n"; -(* REMOVEME - StringMap.iter (fun k v -> - let v = - match v with - | String s -> s - | Int i -> string_of_int i - in - HLog.message (k ^ "::=" ^ v)) status.options; -*) HLog.message "status.coercions\n"; HLog.message "status.objects:\n"; List.iter - (fun u -> HLog.message (UriManager.string_of_uri u)) status.objects - + (fun u -> HLog.message (UriManager.string_of_uri u)) status#objects