-matita : current version: 0.99.3
+matita : current version: 0.99.4
matitaB: new version: 0.5.8
helm : old version: 0.5.8 with additional material
--- /dev/null
+S components/*
+S matita
+
+B components/*
+B matita
+
+PKG lablgtk3 helm-content helm-ng_disambiguation helm-content_pres helm-ng_extraction helm-disambiguation helm-ng_kernel helm-extlib helm-ng_library helm-getter helm-ng_paramodulation helm-grafite helm-ng_refiner helm-grafite_engine helm-ng_tactics helm-grafite_parser helm-registry helm-library helm-syntax_extensions helm-logger helm-thread helm-ng_cic_content helm-xml
+
+FLG -rectypes
dist_export: dist/configure
rm -rf $(DISTDIR)
mkdir $(DISTDIR)
- svn export components $(DISTDIR)/components
- svn export matita $(DISTDIR)/matita
+ git archive matita-lablgtk3 components | tar -x -C $(DISTDIR)
+ git archive matita-lablgtk3 matita | tar -x -C $(DISTDIR)
(cd $(DISTDIR) && find . -name .depend -exec rm \{\} \;)
(cd $(DISTDIR) && find . -name .depend.opt -exec rm \{\} \;)
(cd $(DISTDIR) && rm -rf $(CLEAN_ON_DIST))
-requires="helm-content helm-syntax_extensions camlp5.gramlib ulex08 helm-grafite"
+requires="helm-content helm-syntax_extensions camlp5.gramlib ulex-camlp5 helm-grafite"
version="0.0.1"
archive(byte)="content_pres.cma"
archive(native)="content_pres.cmxa"
-requires="helm-grafite ulex08 helm-ng_disambiguation helm-ng_library helm-content_pres"
+requires="helm-grafite ulex-camlp5 helm-ng_disambiguation helm-ng_library helm-content_pres"
version="0.0.1"
archive(byte)="grafite_parser.cma"
archive(native)="grafite_parser.cmxa"
PREPROCOPTIONS = -pp camlp5o
SYNTAXOPTIONS = -syntax camlp5o
PREREQ =
-OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -thread -rectypes $(ANNOTOPTION)
+OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -thread -rectypes $(ANNOTOPTION) -w @A-52-4-34-37-45-9-44-48-6-32-20-58-7-57-3 # -57-3 for ocaml 4.0.5
OCAMLDEBUGOPTIONS = -g
#OCAML_PROF=p -p a
OCAMLARCHIVEOPTIONS =
| ty, _ -> raise (Type_mismatch (name, ty))
let opt_binding_some (n, (ty, v)) = (n, (OptType ty, OptValue (Some v)))
-let opt_binding_none (n, (ty, v)) = (n, (OptType ty, OptValue None))
+let opt_binding_none (n, (ty, _v)) = (n, (OptType ty, OptValue None))
let opt_binding_of_name (n, ty) = (n, (OptType ty, OptValue None))
let list_binding_of_name (n, ty) = (n, (ListType ty, ListValue []))
let opt_declaration (n, ty) = (n, OptType ty)
(match typ with None -> "" | Some t -> sprintf " return %s" (pp_term t))
(pp_patterns status patterns)
| Ast.Cast (t1, t2) -> sprintf "(%s: %s)" (pp_term ~pp_parens:true t1) (pp_term ~pp_parens:true t2)
- | Ast.LetIn ((var,t2), t1, t3) ->
+ | Ast.LetIn ((var,_t2), t1, t3) ->
(* let t2 = match t2 with None -> Ast.Implicit | Some t -> t in *)
sprintf "let %s \\def %s in %s" (pp_term var)
(* (pp_term ~pp_parens:true t2) *)
| Ast.NumVar s -> "number " ^ s
| Ast.IdentVar s -> "ident " ^ s
| Ast.TermVar (s,Ast.Self _) -> s
- | Ast.TermVar (s,Ast.Level l) -> "term " ^string_of_int l
- | Ast.Ascription (t, n) -> assert false
+ | Ast.TermVar (_s,Ast.Level l) -> "term " ^string_of_int l
+ | Ast.Ascription (_t, _n) -> assert false
| Ast.FreshVar n -> "fresh " ^ n
let _pp_term = ref (pp_term ~pp_parens:false)
| Ast.Ascription (t, s) -> Ast.Ascription (k t, s)
let variables_of_term t =
- let rec vars = ref [] in
+ let vars = ref [] in
let add_variable v =
if List.mem v !vars then ()
else vars := v :: !vars
List.map aux (variables_of_term t)
let keywords_of_term t =
- let rec keywords = ref [] in
+ let keywords = ref [] in
let add_keyword k = keywords := k :: !keywords in
let rec aux = function
| Ast.AttributedTerm (_, t) -> aux t
| Ast.AttributedTerm (_, term) -> strip_attributes term
| Ast.Magic m -> Ast.Magic (visit_magic strip_attributes m)
| Ast.Variable _ as t -> t
- | t -> assert false
+ | _t -> assert false
in
visit_ast ~special_k strip_attributes t
| _ -> []
let meta_names_of_term term =
- let rec names = ref [] in
+ let names = ref [] in
let add_name n =
if List.mem n !names then ()
else names := n :: !names
| Ast.AttributedTerm (_, term) -> aux term
| Ast.Appl terms -> List.iter aux terms
| Ast.Binder (_, _, body) -> aux body
- | Ast.Case (term, indty, outty_opt, patterns) ->
+ | Ast.Case (term, _indty, outty_opt, patterns) ->
aux term ;
aux_opt outty_opt ;
List.iter aux_branch patterns
aux term
and aux_pattern =
function
- Ast.Pattern (head, _, vars) -> List.iter aux_capture_var vars
+ Ast.Pattern (_head, _, vars) -> List.iter aux_capture_var vars
| Ast.Wildcard -> ()
and aux_substs substs = List.iter (fun (_, term) -> aux term) substs
and aux_meta_substs meta_substs = List.iter aux_opt meta_substs
| _ -> assert false
in
match term with
- | Ast.Symbol (s, instance) -> Ast.Symbol (s, fresh_instance ())
- | Ast.Num (s, instance) -> Ast.Num (s, fresh_instance ())
+ | Ast.Symbol (s, _instance) -> Ast.Symbol (s, fresh_instance ())
+ | Ast.Num (s, _instance) -> Ast.Num (s, fresh_instance ())
| t -> visit_ast ~special_k freshen_term t
let freshen_obj obj =
IMPLEMENTATION_FILES = \
$(INTERFACE_FILES:%.mli=%.ml)
-cicNotationPres.cmi: OCAMLOPTIONS += -rectypes
-cicNotationPres.cmo: OCAMLOPTIONS += -rectypes
-cicNotationPres.cmx: OCAMLOPTIONS += -rectypes
-
all:
clean:
LOCAL_LINKOPTS = -package helm-content_pres -linkpkg
cicNotationLexer.cmo: OCAMLC = $(OCAMLC_P4)
-cicNotationParser.cmo: OCAMLC = $(OCAMLC_P4)
+cicNotationParser.cmo: OCAMLC = $(OCAMLC_P4) -w -27
cicNotationLexer.cmx: OCAMLOPT = $(OCAMLOPT_P4)
-cicNotationParser.cmx: OCAMLOPT = $(OCAMLOPT_P4)
+cicNotationParser.cmx: OCAMLOPT = $(OCAMLOPT_P4) -w -27
cicNotationLexer.ml.annot: OCAMLC = $(OCAMLC_P4)
cicNotationParser.ml.annot: OCAMLC = $(OCAMLC_P4)
# soon as we have ocaml 3.09 everywhere and "loc" occurrences are replaced by
# "_loc" occurrences
UTF8DIR := $(shell $(OCAMLFIND) query helm-syntax_extensions)
-ULEXDIR := $(shell $(OCAMLFIND) query ulex08)
+ULEXDIR := $(shell $(OCAMLFIND) query ulex-camlp5)
MY_SYNTAXOPTIONS = -pp "camlp5o -I $(UTF8DIR) -I $(ULEXDIR) pa_extend.cmo pa_ulex.cma pa_unicode_macro.cma -loc loc"
cicNotationLexer.cmo: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
cicNotationParser.cmo: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
let spacing = want_spacing attrs in
let children' = List.map aux_box children in
(fun size ->
- let (size', renderings) as res =
+ let (size', _renderings) as res =
render_row max_size spacing children'
in
if size' <= size then (* children fit in a row *)
res
else (* break needed, re-render using a Box.V *)
aux_box (Box.V (attrs, children)) size)
- | Box.V (attrs, []) -> assert false
- | Box.V (attrs, [child]) -> aux_box child
+ | Box.V (_attrs, []) -> assert false
+ | Box.V (_attrs, [child]) -> aux_box child
| Box.V (attrs, hd :: tl) ->
let indent = want_indent attrs in
let hd_f = aux_box hd in
in
let rows = hd_rendering @ List.concat tl_renderings in
max_len rows, rows)
- | Box.HOV (attrs, []) -> assert false
- | Box.HOV (attrs, [child]) -> aux_box child
+ | Box.HOV (_attrs, []) -> assert false
+ | Box.HOV (_attrs, [child]) -> aux_box child
| Box.HOV (attrs, children) ->
let spacing = want_spacing attrs in
let indent = want_indent attrs in
let href =
try
let _,_,href =
- List.find (fun (ns,na,value) -> ns = Some "xlink" && na = "href") attrs
+ List.find (fun (ns,na,_value) -> ns = Some "xlink" && na = "href") attrs
in
Some href
with Not_found -> None in
in
fixed_rendering href s
| Pres.Mspace _ -> fixed_rendering href string_space
- | Pres.Mrow (attrs, children) ->
+ | Pres.Mrow (_attrs, children) ->
let children' = List.map aux_mpres children in
(fun size -> render_row size false children')
| Pres.Mfrac (_, m, n) ->
and aux_magic magic =
match magic with
| Ast.Opt p ->
- let p_bindings, p_atoms, p_names, p_action = inner_pattern p in
- let action (env_opt : NotationEnv.t option) (loc : Ast.location) =
+ let _p_bindings, p_atoms, p_names, p_action = inner_pattern p in
+ let action (env_opt : NotationEnv.t option) (_loc : Ast.location) =
match env_opt with
| Some env -> List.map Env.opt_binding_some env
| None -> List.map Env.opt_binding_of_name p_names
(* $Id$ *)
-open Printf
-
module Ast = NotationPt
module Mpres = Mpresentation
match t with
| Mpresentation.Mobject (_, box) ->
mpres_of_box (Box.H ([], [ open_box_paren; box; closed_box_paren ]))
- | mpres -> Mpresentation.Mrow ([], [open_paren; t; closed_paren])
+ | _mpres -> Mpresentation.Mrow ([], [open_paren; t; closed_paren])
end else
((*prerr_endline ("NOT adding parens around: "^
BoxPp.render_to_string (function x::_->x|_->assert false)
| t ->
prerr_endline ("unexpected ast: " ^ NotationPp.pp_term status t);
assert false
- and aux_attributes xmlattrs mathonly xref prec t =
+ and aux_attributes _xmlattrs mathonly _xref prec t =
let reset = ref false in
let inferred_level = ref None in
let expected_level = ref None in
in
(* prerr_endline (NotationPp.pp_term t); *)
aux_attribute t
- and aux_literal xmlattrs xref prec l =
+ and aux_literal xmlattrs xref _prec l =
let attrs = make_href xmlattrs xref in
(match l with
| `Symbol s -> Mpres.Mo (attrs, to_unicode s)
let make_arg_for_apply is_first arg row =
let res =
match arg with
- Con.Aux n -> assert false
+ Con.Aux _n -> assert false
| Con.Premise prem ->
let name =
(match prem.Con.premise_binder with
(match p.Con.premise_binder with
| None -> assert false; (* unnamed hypothesis ??? *)
| Some s -> B.Text([],s))
- | err -> assert false) in
+ | _err -> assert false) in
(match conclude.Con.conclude_conclusion with
None ->
B.b_h [] [B.b_kw "by"; B.b_space; arg]
- | Some c ->
+ | Some _c ->
B.b_h [] [B.b_kw "by"; B.b_space; arg]
)
else if conclude.Con.conclude_method = "Intros+LetTac" then
(match conclude.Con.conclude_args with
- [Con.ArgProof p] ->
+ [Con.ArgProof _p] ->
(match conclude.Con.conclude_args with
[Con.ArgProof p] ->
proof2pres0 term2pres ?skip_initial_lambdas_internal true p false
and arg2pres term2pres =
function
Con.Aux n -> B.b_kw ("aux " ^ n)
- | Con.Premise prem -> B.b_kw "premise"
- | Con.Lemma lemma -> B.b_kw "lemma"
+ | Con.Premise _prem -> B.b_kw "premise"
+ | Con.Lemma _lemma -> B.b_kw "lemma"
| Con.Term (_,t) -> term2pres t
| Con.ArgProof p -> proof2pres0 term2pres true p false
- | Con.ArgMethod s -> B.b_kw "method"
+ | Con.ArgMethod _s -> B.b_kw "method"
and case term2pres conclude =
let proof_conclusion =
let case_on =
let case_arg =
(match arg with
- Con.Aux n -> B.b_kw "an aux???"
+ Con.Aux _n -> B.b_kw "an aux???"
| Con.Premise prem ->
(match prem.Con.premise_binder with
None -> B.b_kw "previous"
| Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
| Con.Term (_,t) ->
term2pres t
- | Con.ArgProof p -> B.b_kw "a proof???"
- | Con.ArgMethod s -> B.b_kw "a method???")
+ | Con.ArgProof _p -> B.b_kw "a proof???"
+ | Con.ArgMethod _s -> B.b_kw "a method???")
in
(make_concl "we proceed by cases on" case_arg) in
let to_prove =
let induction_on =
let arg =
(match inductive_arg with
- Con.Aux n -> B.b_kw "an aux???"
+ Con.Aux _n -> B.b_kw "an aux???"
| Con.Premise prem ->
(match prem.Con.premise_binder with
None -> B.b_kw "previous"
| Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
| Con.Term (_,t) ->
term2pres t
- | Con.ArgProof p -> B.b_kw "a proof???"
- | Con.ArgMethod s -> B.b_kw "a method???") in
+ | Con.ArgProof _p -> B.b_kw "a proof???"
+ | Con.ArgMethod _s -> B.b_kw "a method???") in
(make_concl "we proceed by induction on" arg) in
let to_prove =
B.H ([], [make_concl "to prove" proof_conclusion ; B.Text([],".")]) in
| Some t -> term2pres t) in
let case_arg =
(match conclude.Con.conclude_args with
- [Con.Aux(n);_;case_arg] -> case_arg
+ [Con.Aux(_n);_;case_arg] -> case_arg
| _ -> assert false;
(*
List.map (ContentPp.parg 0) conclude.Con.conclude_args;
assert false *)) in
let arg =
(match case_arg with
- Con.Aux n -> assert false
+ Con.Aux _n -> assert false
| Con.Premise prem ->
(match prem.Con.premise_binder with
None -> [B.b_kw "Contradiction, hence"]
and andind term2pres conclude =
let proof,case_arg =
(match conclude.Con.conclude_args with
- [Con.Aux(n);_;Con.ArgProof proof;case_arg] -> proof,case_arg
+ [Con.Aux(_n);_;Con.ArgProof proof;case_arg] -> proof,case_arg
| _ -> assert false;
(*
List.map (ContentPp.parg 0) conclude.Con.conclude_args;
assert false *)) in
let arg =
(match case_arg with
- Con.Aux n -> assert false
+ Con.Aux _n -> assert false
| Con.Premise prem ->
(match prem.Con.premise_binder with
None -> []
B.Object([], P.Mi([],lemma.Con.lemma_name))]
| _ -> assert false) in
match proof.Con.proof_context with
- `Hypothesis hyp1::`Hypothesis hyp2::tl ->
+ `Hypothesis hyp1::`Hypothesis hyp2::_tl ->
let preshyp1 =
B.H ([],
[B.Text([],"(");
and exists term2pres conclude =
let proof =
(match conclude.Con.conclude_args with
- [Con.Aux(n);_;Con.ArgProof proof;_] -> proof
+ [Con.Aux(_n);_;Con.ArgProof proof;_] -> proof
| _ -> assert false;
(*
List.map (ContentPp.parg 0) conclude.Con.conclude_args;
assert false *)) in
match proof.Con.proof_context with
- `Declaration decl::`Hypothesis hyp::tl
- | `Hypothesis decl::`Hypothesis hyp::tl ->
+ `Declaration decl::`Hypothesis hyp::_tl
+ | `Hypothesis decl::`Hypothesis hyp::_tl ->
let presdecl =
B.H ([],
[(B.b_kw "let");
let nobj2pres0
?skip_initial_lambdas ?(skip_thm_and_qed=false) term2pres
- (id,metasenv,obj : NotationPt.term Content.cobj)
+ (_id,metasenv,obj : NotationPt.term Content.cobj)
=
match obj with
| `Def (Content.Const, thesis, `Proof p) ->
(* $Id$ *)
-open Printf
-
module Ast = NotationPt
module Env = NotationEnv
-module Pp = NotationPp
module Util = NotationUtil
let get_tag term0 =
Ast.Variable (Ast.TermVar (name,Ast.Level 0))
in
let rec aux = function
- | Ast.AttributedTerm (_, t) -> assert false
+ | Ast.AttributedTerm (_, _t) -> assert false
| Ast.Literal _
| Ast.Layout _ -> assert false
| Ast.Variable v -> Ast.Variable v
*)
and compile_magic = function
- | Ast.Fold (kind, p_base, names, p_rec) ->
+ | Ast.Fold (_kind, p_base, names, p_rec) ->
let p_rec_decls = Env.declarations_of_term p_rec in
(* LUCA: p_rec_decls should not contain "names" *)
let acc_name = try List.hd names with Failure _ -> assert false in
let rec aux term =
match compiled_rec term with
| None -> aux_base term
- | Some (env', ctors', _) ->
+ | Some (env', _ctors', _) ->
begin
let acc = Env.lookup_term env' acc_name in
let env'' = Env.remove_name env' acc_name in
| Some (env', ctors', 0) ->
let env' =
List.map
- (fun (name, (ty, v)) as binding ->
+ (fun (name, (_ty, _v)) as binding ->
if List.exists (fun (name', _) -> name = name') p_opt_decls
then Env.opt_binding_some binding
else binding)
let add_level_info prec t = Ast.AttributedTerm (`Level prec, t)
-let rec top_pos t = add_level_info ~-1 t
+let top_pos t = add_level_info ~-1 t
let rec remove_level_info =
function
Ast.AttributedTerm (attr, subst_singleton pos env t)
| t -> NotationUtil.group (subst pos env t)
and subst pos env = function
- | Ast.AttributedTerm (attr, t) ->
+ | Ast.AttributedTerm (_attr, t) ->
(* prerr_endline ("loosing attribute " ^ NotationPp.pp_attribute attr); *)
subst pos env t
| Ast.Variable var ->
| Ast.Literal l as t ->
let t = add_idrefs idrefs t in
(match l with
- | `Keyword k -> [ add_keyword_attrs t ]
+ | `Keyword _k -> [ add_keyword_attrs t ]
| _ -> [ t ])
| Ast.Layout l -> [ Ast.Layout (subst_layout pos env l) ]
| t -> [ NotationUtil.visit_ast (subst_singleton pos env) t ]
in
let rec aux env term =
match term with
- | Ast.AttributedTerm (a, term) -> (*Ast.AttributedTerm (a, *)aux env term
+ | Ast.AttributedTerm (_a, term) -> (*Ast.AttributedTerm (a, *)aux env term
| Ast.Appl terms -> Ast.Appl (List.map (aux env) terms)
| Ast.Binder (binder, var, body) ->
Ast.Binder (binder, aux_capture_var env var, aux env body)
Ast.Pattern (head, hrefs, vars) ->
Ast.Pattern (head, hrefs, List.map (aux_capture_var env) vars)
| Ast.Wildcard -> Ast.Wildcard
- and aux_definition env (params, var, term, i) =
- (List.map (aux_capture_var env) params, aux_capture_var env var, aux env term, i)
+ (*and aux_definition env (params, var, term, i) =
+ (List.map (aux_capture_var env) params, aux_capture_var env var, aux env term, i)*)
and aux_substs env substs =
List.map (fun (name, term) -> (name, aux env term)) substs
and aux_meta_substs env meta_substs = List.map (aux_opt env) meta_substs
| Ast.TermVar (name,(Ast.Level l|Ast.Self l)) ->
Ast.AttributedTerm (`Level l,Env.lookup_term env name)
| Ast.FreshVar name -> Ast.Ident (lookup_fresh_name name, None)
- | Ast.Ascription (term, name) -> assert false
+ | Ast.Ascription (_term, _name) -> assert false
and aux_magic env = function
| Ast.Default (some_pattern, none_pattern) ->
let some_pattern_names = NotationUtil.names_of_term some_pattern in
| _ -> assert false
in
instantiate_fold_right env)
- | Ast.If (_, p_true, p_false) as t ->
+ | Ast.If (_, _p_true, _p_false) as t ->
aux env (NotationUtil.find_branch (Ast.Magic t))
| Ast.Fail -> assert false
| _ -> assert false
type domain = domain_tree list
and domain_tree = Node of Stdpp.location list * domain_item * domain
-let mono_uris_callback ~selection_mode ?ok
- ?(enable_button_for_non_vars = true) ~title ~msg ~id =
+let mono_uris_callback ~selection_mode:_ ?ok:(_)
+ ?enable_button_for_non_vars:(_ = true) ~title:(_) ~msg:(_) ~id:(_) =
if Helm_registry.get_opt_default Helm_registry.get_bool ~default:true
"matita.auto_disambiguation"
then
let interactive_user_uri_choice = !_choose_uris_callback
let interactive_interpretation_choice interp = !_choose_interp_callback interp
-let input_or_locate_uri ~(title:string) ?id () = None
+let input_or_locate_uri ~title:(_:string) ?id:(_) () = None
(* Zack: I try to avoid using this callback. I therefore assume that
* the presence of an identifier that can't be resolved via "locate"
* query is a syntax error *)
match snd (mk_choice (Environment.find item env)), arg with
`Num_interp f, `Num_arg n -> f n
| `Sym_interp f, `Args l -> f l
- | `Sym_interp f, `Num_arg n -> (* Implicit number! *) f []
+ | `Sym_interp f, `Num_arg _n -> (* Implicit number! *) f []
| _,_ -> assert false
with Not_found ->
failwith ("Domain item not found: " ^
let find_in_context name context =
let rec aux acc = function
| [] -> raise Not_found
- | Some hd :: tl when hd = name -> acc
+ | Some hd :: _tl when hd = name -> acc
| _ :: tl -> aux (acc + 1) tl
in
aux 1 context
| _ :: tl -> get_first_constructor tl in
let do_branch =
function
- Ast.Pattern (head, _, args), term ->
+ Ast.Pattern (_head, _, args), term ->
let (term_context, args_domain) =
List.fold_left
(fun (cont, dom) (name, typ) ->
| Ast.NRef _ -> []
| Ast.NCic _ -> []
| Ast.Implicit _ -> []
- | Ast.Num (num, i) -> [ Node ([loc], Num i, []) ]
- | Ast.Meta (index, local_context) ->
+ | Ast.Num (_num, i) -> [ Node ([loc], Num i, []) ]
+ | Ast.Meta (_index, local_context) ->
List.fold_left
(fun dom term -> dom @ domain_of_term_option ~loc ~context term)
[] local_context
(fun (context,res) (name,ty,_,_) ->
Some name::context, res @ domain_of_term context ty
) (context_w_types,[]) fields)
- | Ast.LetRec (kind, defs, _) ->
+ | Ast.LetRec (_kind, defs, _) ->
let add_defs context =
List.fold_left
(fun acc (_, (var, _), _, _) -> string_of_name var :: acc
(match elt with
Symbol (symb',_) when symb = symb' -> true
| _ -> false)
- | Num i ->
+ | Num _i ->
(match elt with
Num _ -> true
| _ -> false)
let aliases, todo_dom =
let rec aux (aliases,acc) = function
| [] -> aliases, acc
- | (Node (locs, item,extra) as node) :: tl ->
+ | Node (locs, item,extra) :: tl ->
let choices = lookup_choices item in
if List.length choices = 0 then
(* Quick failure *)
let find k env =
match k with
- Symbol (sym,n) ->
+ Symbol (sym,_n) ->
(try find k env
with Not_found -> find (Symbol (sym,0)) env)
- | Num n ->
+ | Num _n ->
(try find k env
with Not_found -> find (Num 0) env)
| _ -> find k env
(* $Id$ *)
-open Printf
-
let debug = ref false;;
let debug_print s =
if !debug then prerr_endline (Lazy.force s) else ();;
let try_pass (fresh_instances, (_, aliases, universe), use_coercions) =
f ~fresh_instances ~aliases ~universe ~use_coercions thing
in
- let set_aliases (instances,(use_mono_aliases,_,_),_) (_, user_asked as res) =
+ let set_aliases (_instances,(use_mono_aliases,_,_),_) (_, user_asked as res) =
if use_mono_aliases then
drop_aliases ~minimize_instances:true ~description_of_alias res (* one shot aliases *)
else if user_asked then
(* the equivalent of skip, but on the index, thus the list of trees
that are rooted just after the term represented by the tree root
are returned (we are skipping the root) *)
- let skip_root = function DiscriminationTree.Node (value, map) ->
- let rec get n = function DiscriminationTree.Node (v, m) as tree ->
+ let skip_root = function DiscriminationTree.Node (_value, map) ->
+ let rec get n = function DiscriminationTree.Node (_v, m) as tree ->
if n = 0 then [tree] else
PSMap.fold (fun k v res -> (get (n-1 + arity_of k) v) @ res) m []
in
match tree, path with
| DiscriminationTree.Node (Some s, _), [] -> s
| DiscriminationTree.Node (None, _), [] -> A.empty
- | DiscriminationTree.Node (_, map), Variable::path when unif ->
+ | DiscriminationTree.Node (_, _map), Variable::path when unif ->
List.fold_left A.union A.empty
(List.map (retrieve path) (skip_root tree))
| DiscriminationTree.Node (_, map), node::path ->
(List.map
(fun s, w ->
HExtlib.filter_map (fun x ->
- try Some (x, w + snd (List.find (fun (s,w) -> A.mem x s) l2))
+ try Some (x, w + snd (List.find (fun (s,_w) -> A.mem x s) l2))
with Not_found -> None)
(A.elements s))
l1)
match tree, path with
| DiscriminationTree.Node (Some s, _), [] -> S.singleton (s, n)
| DiscriminationTree.Node (None, _), [] -> S.empty
- | DiscriminationTree.Node (_, map), Variable::path when unif ->
+ | DiscriminationTree.Node (_, _map), Variable::path when unif ->
List.fold_left S.union S.empty
(List.map (retrieve n path) (skip_root tree))
| DiscriminationTree.Node (_, map), node::path ->
in
aux
-let rec list_findopt f l =
+let list_findopt f l =
let rec aux k = function
| [] -> None
| x::tl ->
let rec aux acc n l =
match n, l with
| 0, _ -> List.rev acc, l
- | n, [] -> raise (Failure "HExtlib.split_nth")
+ | _, [] -> raise (Failure "HExtlib.split_nth")
| n, hd :: tl -> aux (hd :: acc) (n - 1) tl in
aux [] n l
let list_last l =
let l = List.rev l in
- try List.hd l with exn -> raise (Failure "HExtlib.list_last")
+ try List.hd l with _ -> raise (Failure "HExtlib.list_last")
;;
let rec list_assoc_all a = function
let input_all ic =
let size = 10240 in
let buf = Buffer.create size in
- let s = String.create size in
+ let s = Bytes.create size in
(try
while true do
let bytes = input ic s 0 size in
if bytes = 0 then raise End_of_file
- else Buffer.add_substring buf s 0 bytes
+ else Buffer.add_subbytes buf s 0 bytes
done
with End_of_file -> ());
Buffer.contents buf
(* $Id$ *)
-open Printf
-
type log_tag = [ `Debug | `Error | `Message | `Warning ]
type log_callback = log_tag -> string -> unit
HExtlib.chmod 0o664 fname
let expect ic fname s =
- let len = String.length s in
- let buf = String.create len in
+ let len = Bytes.length s in
+ let buf = Bytes.create len in
really_input ic buf 0 len;
if buf <> s then raise (Corrupt_file fname)
if fmt' <> Hashtbl.hash fmt then raise (Format_mismatch fname);
let version' = input_binary_int ic in (* field 2 *)
if version' <> version then raise (Version_mismatch fname);
- expect ic fname fmt; (* field 3 *)
- expect ic fname (string_of_int version); (* field 4 *)
+ expect ic fname (Bytes.of_string fmt); (* field 3 *)
+ expect ic fname (Bytes.of_string (string_of_int version)); (* field 4 *)
let checksum' = input_binary_int ic in (* field 5 *)
let marshalled' = HExtlib.input_all ic in (* field 6 *)
if checksum' <> Hashtbl.hash marshalled' then
(* $Id$ *)
-open Printf
-
type pattern_kind = Variable | Constructor
type tag_t = int
| _ -> kfail () (*CSC: was assert false, but it did happen*))
let success_closure ksucc =
- (fun matched_terms constructors terms ->
+ (fun matched_terms constructors _terms ->
(* prerr_endline "success_closure"; *)
ksucc matched_terms constructors)
in
traverse [] t
- let rec fold f t acc =
+ let fold f t acc =
let rec traverse revp t acc = match t with
| Node (None,m) ->
M.fold (fun x -> traverse (x::revp)) m acc
(* Remote interface: getter methods implemented using a remote getter *)
(* <TODO> *)
-let getxml_remote uri = not_implemented "getxml_remote"
-let getxslt_remote uri = not_implemented "getxslt_remote"
-let getdtd_remote uri = not_implemented "getdtd_remote"
+let getxml_remote _uri = not_implemented "getxml_remote"
+let getxslt_remote _uri = not_implemented "getxslt_remote"
+let getdtd_remote _uri = not_implemented "getdtd_remote"
let clean_cache_remote () = not_implemented "clean_cache_remote"
let list_servers_remote () = not_implemented "list_servers_remote"
-let add_server_remote ~logger ~position name =
+let add_server_remote ~logger:_ ~position:_ _name =
not_implemented "add_server_remote"
-let remove_server_remote ~logger position =
+let remove_server_remote ~logger:_ _position =
not_implemented "remove_server_remote"
let getalluris_remote () = not_implemented "getalluris_remote"
-let ls_remote lsuri = not_implemented "ls_remote"
-let exists_remote uri = not_implemented "exists_remote"
+let ls_remote _lsuri = not_implemented "ls_remote"
+let exists_remote _uri = not_implemented "exists_remote"
(* </TODO> *)
let resolve_remote ~writable uri =
| Exception e -> raise e
| Resolved url -> url
-let deref_index_theory ~local uri =
+let deref_index_theory ~local:_ uri =
(* if Http_getter_storage.exists ~local (uri ^ xml_suffix) then uri *)
if is_theory_uri uri && Filename.basename uri = "index.theory" then
strip_trailing_slash (Filename.dirname uri) ^ theory_suffix
| s when Pcre.pmatch ~rex:body_ann_RE s -> (true, No, Ann, No)
| s when Pcre.pmatch ~rex:proof_tree_RE s -> (false, No, No, Yes)
| s when Pcre.pmatch ~rex:proof_tree_ann_RE s -> (true, No, No, Ann)
- | s -> no_flags
+ | _s -> no_flags
in
Hashtbl.replace tbl basepart (oldflags ++ newflags)
end
Cic_uri (Theory (Pcre.replace ~pat:"^theory:" uri))
| uri -> raise (Invalid_URI uri)
-let patch_xsl ?(via_http = true) () =
+let patch_xsl ?via_http:(_ = true) () =
fun line ->
let mk_patch_fun tag line =
Pcre.replace
| (None, None) -> []
in
Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
- Http_daemon.send_headers headers outchan;
+ Http_daemon.send_headers ~headers outchan;
Http_daemon.send_CRLF outchan
end;
match gunzip, patch_fun with
let msg = "[HTTP-Getter] " ^ s in
match (!logfile, !logchan) with
| None, _ -> prerr_endline msg
- | Some fname, Some oc ->
+ | Some _fname, Some oc ->
output_string oc msg;
output_string oc "\n";
flush oc
let file_scheme_prefix = "file://"
let trailing_dot_gz_RE = Pcre.regexp "\\.gz$" (* for g{,un}zip *)
-let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$"
+(*let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$"*)
let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://"
let file_scheme_RE = Pcre.regexp ~flags:[`CASELESS] ("^" ^ file_scheme_prefix)
let dir_sep_RE = Pcre.regexp "/"
with Not_found -> None
let bufsiz = 16384 (* for file system I/O *)
-let tcp_bufsiz = 4096 (* for TCP I/O *)
+(*let tcp_bufsiz = 4096 (* for TCP I/O *)*)
let fold_file f init fname =
let ic = open_in fname in
let iter_file_data f fname =
let ic = open_in fname in
- let buf = String.create iter_buf_size in
+ let buf = Bytes.create iter_buf_size in
try
while true do
let bytes = input ic buf 0 iter_buf_size in
if bytes = 0 then raise End_of_file;
- f (String.sub buf 0 bytes)
+ f (Bytes.to_string (Bytes.sub buf 0 bytes))
done
with End_of_file -> close_in ic
let ic = open_in src in
try
let oc = open_out dst in
- let buf = String.create bufsiz in
+ let buf = Bytes.create bufsiz in
(try
while true do
let bytes = input ic buf 0 bufsiz in
(let oc =
open_out (match output with Some f -> f | None -> Filename.basename url)
in
- Http_user_agent.get_iter (fun data -> output_string oc data) url;
+ Http_user_agent.get_iter (fun data -> output_bytes oc data) url;
close_out oc)
| scheme -> (* unsupported scheme *)
failwith ("Http_getter_misc.wget: unsupported scheme: " ^ scheme)
Http_getter_logger.log ~level:3
(sprintf "gzipping %s (keep: %b, output: %s)" fname keep output);
let (ic, oc) = (open_in fname, Gzip.open_out output) in
- let buf = String.create bufsiz in
+ let buf = Bytes.create bufsiz in
(try
while true do
let bytes = input ic buf 0 bufsiz in
try
let ic = Gzip.open_in_chan zic in
let oc = open_out output in
- let buf = String.create bufsiz in
+ let buf = Bytes.create bufsiz in
(try
while true do
let bytes = Gzip.input ic buf 0 bufsiz in
let fname = Pcre.replace ~rex:file_scheme_RE url in
try
let size = (Unix.stat fname).Unix.st_size in
- let buf = String.create size in
+ let buf = Bytes.create size in
let ic = open_in fname in
really_input ic buf 0 size ;
close_in ic;
- Some buf
+ Some (Bytes.to_string buf)
with Unix.Unix_error (Unix.ENOENT, "stat", _) -> None
end else (* other URL, pass it to Http_user_agent *)
try
let temp_file_of_uri uri =
let flat_string s s' c =
- let cs = String.copy s in
+ let cs = Bytes.of_string s in
for i = 0 to (String.length s) - 1 do
if String.contains s' s.[i] then cs.[i] <- c
done;
- cs
+ Bytes.to_string cs
in
let user = try Unix.getlogin () with _ -> "" in
Filename.open_temp_file (user ^ flat_string uri ".-=:;!?/&" '_') ""
(******************************* HELPERS **************************************)
-let trailing_slash_RE = Pcre.regexp "/$"
+(*let trailing_slash_RE = Pcre.regexp "/$"*)
let relative_RE_raw = "(^[^/]+(/[^/]+)*/?$)"
let relative_RE = Pcre.regexp relative_RE_raw
let file_scheme_RE_raw = "(^file://)"
let lookup uri =
let matches =
HExtlib.filter_map
- (fun (rex, _, l, _ as entry) ->
+ (fun (rex, _, _l, _ as entry) ->
try
let got = Pcre.extract ~full_match:true ~rex uri in
Some (entry, String.length got.(0))
let get_and_save url dest_filename =
let out_channel = open_out dest_filename in
(try
- Http_user_agent.get_iter (output_string out_channel) url;
+ Http_user_agent.get_iter (output_bytes out_channel) url;
with exn ->
close_out out_channel;
Sys.remove dest_filename;
let get_and_save_to_tmp url =
let flat_string s s' c =
- let cs = String.copy s in
+ let cs = Bytes.of_string s in
for i = 0 to (String.length s) - 1 do
if String.contains s' s.[i] then cs.[i] <- c
done;
- cs
+ Bytes.to_string cs
in
let user = try Unix.getlogin () with _ -> "" in
let tmp_file =
type auto_params = nterm list option * (string*string) list
+type just = [`Term of nterm | `Auto of auto_params]
+
type ntactic =
| NApply of loc * nterm
| NSmartApply of loc * nterm
| NAssumption of loc
| NRepeat of loc * ntactic
| NBlock of loc * ntactic list
+ (* Declarative langauge *)
+ (* Not the best idea to use a string directly, an abstract type for identifiers would be better *)
+ | Assume of loc * string * nterm (* loc, identifier, type *)
+ | Suppose of loc * nterm * string (* loc, assumption, identifier *)
+ | By_just_we_proved of loc * just * nterm * string option (* loc, justification, conclusion, identifier *)
+ | We_need_to_prove of loc * nterm * string option (* loc, newconclusion, identifier *)
+ | BetaRewritingStep of loc * nterm
+ | Bydone of loc * just
+ | ExistsElim of loc * just * string * nterm * nterm * string
+ | AndElim of loc * just * nterm * string * nterm * string
+ | RewritingStep of
+ loc * nterm * [ `Term of nterm | `Auto of auto_params | `Proof | `SolveWith of nterm ] * bool (* last step*)
+ | Obtain of
+ loc * string * nterm
+ | Conclude of
+ loc * nterm
+ | Thesisbecomes of loc * nterm
+ | We_proceed_by_induction_on of loc * nterm * nterm
+ | We_proceed_by_cases_on of loc * nterm * nterm
+ | Byinduction of loc * nterm * string
+ | Case of loc * string * (string * nterm) list
+ (* This is a debug tactic to print the stack to stdout, can be safely removed *)
+ | PrintStack of loc
type nmacro =
| NCheck of loc * nterm
(* Copyright (C) 2004, HELM Team.
- *
+ *
* This file is part of HELM, an Hypertextual, Electronic
* Library of Mathematics, developed at the Computer Science
* Department, University of Bologna, Italy.
- *
+ *
* HELM is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
- *
+ *
* HELM is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* along with HELM; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston,
* MA 02111-1307, USA.
- *
+ *
* For details, see the HELM World-Wide-Web page,
* http://helm.cs.unibo.it/
*)
let tactic_terminator = tactical_terminator
let command_terminator = tactical_terminator
-let pp_tactic_pattern status ~map_unicode_to_tex (what, hyp, goal) =
- if what = None && hyp = [] && goal = None then "" else
+let pp_tactic_pattern status ~map_unicode_to_tex (what, hyp, goal) =
+ if what = None && hyp = [] && goal = None then "" else
let what_text =
match what with
| None -> ""
in
Printf.sprintf "%sin %s%s" what_text hyp_text goal_text
+let pp_auto_params params status =
+ match params with
+ | (None,flags) -> String.concat " " (List.map (fun a,b -> a ^ "=" ^ b) flags)
+ | (Some l,flags) -> (String.concat "," (List.map (NotationPp.pp_term status) l)) ^
+ String.concat " " (List.map (fun a,b -> a ^ "=" ^ b) flags)
+;;
+
+let pp_just status just =
+ match just with
+ `Term term -> "using (" ^ NotationPp.pp_term status term ^ ") "
+ | `Auto params ->
+ match params with
+ | (None,[]) -> ""
+ | params -> "by " ^ pp_auto_params params status ^ " "
+;;
+
let rec pp_ntactic status ~map_unicode_to_tex =
let pp_tactic_pattern = pp_tactic_pattern ~map_unicode_to_tex in
function
| NApply (_,t) -> "@" ^ NotationPp.pp_term status t
- | NSmartApply (_,t) -> "fixme"
+ | NSmartApply (_,_t) -> "fixme"
| NAuto (_,(None,flgs)) ->
"nautobatch" ^
String.concat " " (List.map (fun a,b -> a ^ "=" ^ b) flgs)
"nautobatch" ^ " by " ^
(String.concat "," (List.map (NotationPp.pp_term status) l)) ^
String.concat " " (List.map (fun a,b -> a ^ "=" ^ b) flgs)
- | NCases (_,what,where) -> "ncases " ^ NotationPp.pp_term status what ^
+ | NCases (_,what,_where) -> "ncases " ^ NotationPp.pp_term status what ^
"...to be implemented..." ^ " " ^ "...to be implemented..."
| NConstructor (_,None,l) -> "@ " ^
String.concat " " (List.map (NotationPp.pp_term status) l)
| NConstructor (_,Some x,l) -> "@" ^ string_of_int x ^ " " ^
String.concat " " (List.map (NotationPp.pp_term status) l)
| NCase1 (_,n) -> "*" ^ n ^ ":"
- | NChange (_,what,wwhat) -> "nchange " ^ "...to be implemented..." ^
+ | NChange (_,_what,wwhat) -> "nchange " ^ "...to be implemented..." ^
" with " ^ NotationPp.pp_term status wwhat
| NCut (_,t) -> "ncut " ^ NotationPp.pp_term status t
(*| NDiscriminate (_,t) -> "ndiscriminate " ^ NotationPp.pp_term status t
| NSubst (_,t) -> "nsubst " ^ NotationPp.pp_term status t *)
| NClear (_,l) -> "nclear " ^ String.concat " " l
- | NDestruct (_,dom,skip) -> "ndestruct ..."
- | NElim (_,what,where) -> "nelim " ^ NotationPp.pp_term status what ^
+ | NDestruct (_,_dom,_skip) -> "ndestruct ..."
+ | NElim (_,what,_where) -> "nelim " ^ NotationPp.pp_term status what ^
"...to be implemented..." ^ " " ^ "...to be implemented..."
| NId _ -> "nid"
| NIntro (_,n) -> "#" ^ n
| NIntros (_,l) -> "#" ^ String.concat " " l
- | NInversion (_,what,where) -> "ninversion " ^ NotationPp.pp_term status what ^
+ | NInversion (_,what,_where) -> "ninversion " ^ NotationPp.pp_term status what ^
"...to be implemented..." ^ " " ^ "...to be implemented..."
| NLApply (_,t) -> "lapply " ^ NotationPp.pp_term status t
| NRewrite (_,dir,n,where) -> "nrewrite " ^
| NPosbyname (_, s) -> s ^ ":"
| NWildcard _ -> "*:"
| NMerge _ -> "]"
- | NFocus (_,l) ->
- Printf.sprintf "focus %s"
+ | NFocus (_,l) ->
+ Printf.sprintf "focus %s"
(String.concat " " (List.map string_of_int l))
| NUnfocus _ -> "unfocus"
| NSkip _ -> "skip"
| NTry (_,tac) -> "ntry " ^ pp_ntactic status ~map_unicode_to_tex tac
| NAssumption _ -> "nassumption"
- | NBlock (_,l) ->
+ | NBlock (_,l) ->
"(" ^ String.concat " " (List.map (pp_ntactic status ~map_unicode_to_tex) l)^ ")"
| NRepeat (_,t) -> "nrepeat " ^ pp_ntactic status ~map_unicode_to_tex t
+ | Assume (_, ident, term) -> "assume " ^ ident ^ ":(" ^ (NotationPp.pp_term status term) ^ ")"
+ | Suppose (_,term,ident) -> "suppose (" ^ (NotationPp.pp_term status term) ^ ") (" ^ ident ^ ") "
+ | By_just_we_proved (_, just, term1, ident) -> pp_just status just ^ " we proved (" ^
+ (NotationPp.pp_term status term1) ^ ")" ^ (match ident with
+ None -> "" | Some ident -> "(" ^ident^ ")")
+ | We_need_to_prove (_,term,ident) -> "we need to prove (" ^ (NotationPp.pp_term status term) ^ ") " ^
+ (match ident with None -> "" | Some id -> "(" ^ id ^ ")")
+ | BetaRewritingStep (_,t) -> "that is equivalent to (" ^ (NotationPp.pp_term status t) ^ ")"
+ | Bydone (_, just) -> pp_just status just ^ "done"
+ | ExistsElim (_, just, ident, term, term1, ident1) -> pp_just status just ^ "let " ^ ident ^ ": ("
+ ^ (NotationPp.pp_term status term) ^ ") such that (" ^ (NotationPp.pp_term status term1) ^ ") (" ^ ident1 ^ ")"
+ | AndElim (_, just, term1, ident1, term2, ident2) -> pp_just status just ^ " we have (" ^
+ (NotationPp.pp_term status term1) ^ ") (" ^ ident1 ^ ") " ^ "and (" ^ (NotationPp.pp_term status
+ term2)
+ ^ ") (" ^ ident2 ^ ")"
+ | Thesisbecomes (_, t) -> "the thesis becomes (" ^ (NotationPp.pp_term status t) ^ ")"
+ | RewritingStep (_, rhs, just, cont) ->
+ "= (" ^
+ (NotationPp.pp_term status rhs) ^ ")" ^
+ (match just with
+ | `Auto params -> let s = pp_auto_params params status in
+ if s <> "" then " by " ^ s
+ else ""
+ | `Term t -> " exact (" ^ (NotationPp.pp_term status t) ^ ")"
+ | `Proof -> " proof"
+ | `SolveWith t -> " using (" ^ (NotationPp.pp_term status t) ^ ")"
+ )
+ ^ (if cont then " done" else "")
+ | Obtain (_,id,t1) -> "obtain (" ^ id ^ ")" ^ " (" ^ (NotationPp.pp_term status t1) ^ ")"
+ | Conclude (_,t1) -> "conclude (" ^ (NotationPp.pp_term status t1) ^ ")"
+ | We_proceed_by_cases_on (_, term, term1) -> "we proceed by cases on (" ^ NotationPp.pp_term
+ status term ^ ") to prove (" ^ NotationPp.pp_term status term1 ^ ")"
+ | We_proceed_by_induction_on (_, term, term1) -> "we proceed by induction on (" ^
+ NotationPp.pp_term status term ^ ") to prove (" ^ NotationPp.pp_term status term1 ^ ")"
+ | Byinduction (_, term, ident) -> "by induction hypothesis we know (" ^ NotationPp.pp_term status
+ term ^ ") (" ^ ident ^ ")"
+ | Case (_, id, args) ->
+ "case " ^ id ^
+ String.concat " "
+ (List.map (function (id,term) -> "(" ^ id ^ ": (" ^ NotationPp.pp_term status term ^ "))")
+ args)
+ | PrintStack _ -> "print_stack"
;;
let pp_nmacro status = function
| NCheck (_, term) -> Printf.sprintf "ncheck %s" (NotationPp.pp_term status term)
| Screenshot (_, name) -> Printf.sprintf "screenshot \"%s\"" name
+ | NAutoInteractive _
+ | NIntroGuess _ -> assert false (* TODO *)
;;
let pp_l1_pattern = NotationPp.pp_term
desc
| Number_alias (instance,desc) ->
sprintf "alias num (instance %d) = \"%s\"." instance desc
-
+
let pp_associativity = function
| Gramext.LeftA -> "left associative"
| Gramext.RightA -> "right associative"
let pp_argument_pattern = function
| NotationPt.IdentArg (eta_depth, name) ->
let eta_buf = Buffer.create 5 in
- for i = 1 to eta_depth do
+ for _i = 1 to eta_depth do
Buffer.add_string eta_buf "\\eta."
done;
sprintf "%s%s" (Buffer.contents eta_buf) name
-let pp_interpretation dsc symbol arg_patterns cic_appl_pattern =
+let pp_interpretation dsc symbol arg_patterns cic_appl_pattern =
sprintf "interpretation \"%s\" '%s %s = %s."
dsc symbol
(String.concat " " (List.map pp_argument_pattern arg_patterns))
(NotationPp.pp_cic_appl_pattern cic_appl_pattern)
-
+
let pp_dir_opt = function
| None -> ""
| Some `LeftToRight -> "> "
| Some `RightToLeft -> "< "
-let pp_notation status dir_opt l1_pattern assoc prec l2_pattern =
+let pp_notation status dir_opt l1_pattern assoc prec l2_pattern =
sprintf "notation %s\"%s\" %s %s for %s."
(pp_dir_opt dir_opt)
(pp_l1_pattern status l1_pattern)
(pp_l2_pattern status l2_pattern)
let pp_ncommand status = function
- | UnificationHint (_,t, n) ->
+ | UnificationHint (_,t, n) ->
"unification hint " ^ string_of_int n ^ " " ^ NotationPp.pp_term status t
| NDiscriminator (_,_)
| NInverter (_,_,_,_,_)
| NUnivConstraint (_) -> "not supported"
| NCoercion (_) -> "not supported"
- | NObj (_,obj,index) ->
- (if not index then "-" else "") ^
+ | NObj (_,obj,index) ->
+ (if not index then "-" else "") ^
NotationPp.pp_obj (NotationPp.pp_term status) obj
| NQed (_,true) -> "qed"
| NQed (_,false) -> "qed-"
- | NCopy (_,name,uri,map) ->
- "copy " ^ name ^ " from " ^ NUri.string_of_uri uri ^ " with " ^
- String.concat " and "
- (List.map
- (fun (a,b) -> NUri.string_of_uri a ^ " ↦ " ^ NUri.string_of_uri b)
+ | NCopy (_,name,uri,map) ->
+ "copy " ^ name ^ " from " ^ NUri.string_of_uri uri ^ " with " ^
+ String.concat " and "
+ (List.map
+ (fun (a,b) -> NUri.string_of_uri a ^ " ↦ " ^ NUri.string_of_uri b)
map)
| Include (_,mode,path) -> (* not precise, since path is absolute *)
if mode = WithPreferences then
| Notation (_, dir_opt, l1_pattern, assoc, prec, l2_pattern) ->
pp_notation status dir_opt l1_pattern assoc prec l2_pattern
;;
-
+
let pp_executable status ~map_unicode_to_tex =
function
| NMacro (_, macro) -> pp_nmacro status macro ^ "."
| NTactic (_,tacl) ->
String.concat " " (List.map (pp_ntactic status ~map_unicode_to_tex) tacl)
| NCommand (_, cmd) -> pp_ncommand status cmd ^ "."
-
+
let pp_comment status ~map_unicode_to_tex =
function
| Note (_,"") -> Printf.sprintf "\n"
let pp_statement status =
function
- | Executable (_, ex) -> pp_executable status ex
+ | Executable (_, ex) -> pp_executable status ex
| Comment (_, c) -> pp_comment status c
let inject_unification_hint =
let basic_eval_unification_hint (t,n)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term ~refresh_uri_in_reference:_
~alias_only status
=
if not alias_only then
let inject_interpretation =
let basic_eval_interpretation (dsc, (symbol, args), cic_appl_pattern)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_ ~refresh_uri_in_reference:_
~alias_only
=
let rec refresh =
;;
let inject_alias =
- let basic_eval_alias (mode,diff) ~refresh_uri_in_universe ~refresh_uri_in_term
- ~refresh_uri_in_reference ~alias_only =
+ let basic_eval_alias (mode,diff) ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_
+ ~refresh_uri_in_reference:_ ~alias_only:_ =
basic_eval_alias (mode,diff)
in
GrafiteTypes.Serializer.register#run "alias" basic_eval_alias
let inject_input_notation =
let basic_eval_input_notation (l1,l2)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term ~refresh_uri_in_reference
~alias_only status
=
if not alias_only then
let inject_output_notation =
let basic_eval_output_notation (l1,l2)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term ~refresh_uri_in_reference
~alias_only status
=
if not alias_only then
;;
let record_index_obj =
- let aux l ~refresh_uri_in_universe
- ~refresh_uri_in_term ~refresh_uri_in_reference ~alias_only status
+ 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
if not alias_only then
let inject_extract_obj =
let basic_extract_obj info
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
- ~alias_only status
+ ~refresh_uri_in_universe:__ ~refresh_uri_in_term:_ ~refresh_uri_in_reference
+ ~alias_only:_ status
=
let info= NCicExtraction.refresh_uri_in_info ~refresh_uri_in_reference info in
status#set_extraction_db
let inject_extract_ocaml_obj =
let basic_extract_ocaml_obj info
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
- ~alias_only status
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_ ~refresh_uri_in_reference
+ ~alias_only:_ status
=
let info= OcamlExtractionTable.refresh_uri_in_info ~refresh_uri_in_reference ~refresh_uri:NCicLibrary.refresh_uri info in
status#set_ocaml_extraction_db
let record_index_eq =
let basic_index_eq uri
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_ ~refresh_uri_in_reference:_
~alias_only status
= if not alias_only then index_eq false (NCicLibrary.refresh_uri uri) status
else
let inject_constraint =
let basic_eval_add_constraint (acyclic,u1,u2)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe ~refresh_uri_in_term:_ ~refresh_uri_in_reference:_
~alias_only status
=
if not alias_only then
;;
let eval_ng_tac tac =
+ let just_to_tacstatus_just just text prefix_len =
+ match just with
+ | `Term t -> `Term (text,prefix_len,t)
+ | `Auto (l,params) ->
+ (
+ match l with
+ | None -> `Auto (None,params)
+ | Some l -> `Auto (Some (List.map (fun t -> (text,prefix_len,t)) l),params)
+ )
+ | _ -> assert false
+ in
let rec aux f (text, prefix_len, tac) =
match tac with
| GrafiteAst.NApply (_loc, t) -> NTactics.apply_tac (text,prefix_len,t)
NTactics.block_tac (List.map (fun x -> aux f (text,prefix_len,x)) l)
|GrafiteAst.NRepeat (_,tac) ->
NTactics.repeat_tac (f f (text, prefix_len, tac))
+ |GrafiteAst.Assume (_,id,t) -> Declarative.assume id (text,prefix_len,t)
+ |GrafiteAst.Suppose (_,t,id) -> Declarative.suppose (text,prefix_len,t) id
+ |GrafiteAst.By_just_we_proved (_,j,t1,s) -> Declarative.by_just_we_proved
+ (just_to_tacstatus_just j text prefix_len) (text,prefix_len,t1) s
+ |GrafiteAst.We_need_to_prove (_, t, id) -> Declarative.we_need_to_prove (text,prefix_len,t) id
+ |GrafiteAst.BetaRewritingStep (_, t) -> Declarative.beta_rewriting_step (text,prefix_len,t)
+ | GrafiteAst.Bydone (_, j) -> Declarative.bydone (just_to_tacstatus_just j text prefix_len)
+ | GrafiteAst.ExistsElim (_, just, id1, t1, t2, id2) ->
+ Declarative.existselim (just_to_tacstatus_just just text prefix_len) id1 (text,prefix_len,t1)
+ (text,prefix_len,t2) id2
+ | GrafiteAst.AndElim(_,just,t1,id1,t2,id2) -> Declarative.andelim (just_to_tacstatus_just just
+ text prefix_len) (text,prefix_len,t1) id1 (text,prefix_len,t2) id2
+ | GrafiteAst.Thesisbecomes (_, t1) -> Declarative.thesisbecomes (text,prefix_len,t1)
+ | GrafiteAst.RewritingStep (_,rhs,just,cont) ->
+ Declarative.rewritingstep (text,prefix_len,rhs)
+ (match just with
+ `Term _
+ | `Auto _ -> just_to_tacstatus_just just text prefix_len
+ |`Proof -> `Proof
+ |`SolveWith t -> `SolveWith (text,prefix_len,t)
+ )
+ cont
+ | GrafiteAst.Obtain (_,id,t1) ->
+ Declarative.obtain id (text,prefix_len,t1)
+ | GrafiteAst.Conclude (_,t1) ->
+ Declarative.conclude (text,prefix_len,t1)
+ | GrafiteAst.We_proceed_by_cases_on (_, t, t1) ->
+ Declarative.we_proceed_by_cases_on (text,prefix_len,t) (text,prefix_len,t1)
+ | GrafiteAst.We_proceed_by_induction_on (_, t, t1) ->
+ Declarative.we_proceed_by_induction_on (text,prefix_len,t) (text,prefix_len,t1)
+ | GrafiteAst.Byinduction (_, t, id) -> Declarative.byinduction (text,prefix_len,t) id
+ | GrafiteAst.Case (_,id,params) -> Declarative.case id params
+ | GrafiteAst.PrintStack (_) -> Declarative.print_stack
in
aux aux tac (* trick for non uniform recursion call *)
;;
let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
match cmd with
- | GrafiteAst.Include (loc, mode, fname) ->
+ | GrafiteAst.Include (_loc, mode, fname) ->
let _root, baseuri, fullpath, _rrelpath =
Librarian.baseuri_of_script ~include_paths fname in
let baseuri = NUri.uri_of_string baseuri in
~alias_only ~baseuri ~fname:fullpath status in
OcamlExtraction.print_open status
(NCicLibrary.get_transitively_included status)
- | GrafiteAst.UnificationHint (loc, t, n) -> eval_unification_hint status t n
+ | GrafiteAst.UnificationHint (_loc, t, n) -> eval_unification_hint status t n
| GrafiteAst.NCoercion (loc, name, compose, None) ->
let status, t, ty, source, target =
let o_t = NotationPt.Ident (name,None) in
GrafiteAst.NCoercion (loc, name, compose, Some (t, ty, source, target))
in
eval_ncommand ~include_paths opts status (text,prefix_len,cmd)
- | GrafiteAst.NCoercion (loc, name, compose, Some (t, ty, source, target)) ->
+ | GrafiteAst.NCoercion (_loc, name, compose, Some (t, ty, source, target)) ->
let status, composites =
NCicCoercDeclaration.eval_ncoercion status name compose 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) ->
+ | GrafiteAst.NQed (_loc,index) ->
if status#ng_mode <> `ProofMode then
raise (GrafiteTypes.Command_error "Not in proof mode")
else
- let uri,height,menv,subst,obj_kind = status#obj in
+ let uri,_height,menv,subst,obj_kind = status#obj in
if menv <> [] then
raise
(GrafiteTypes.Command_error"You can't Qed an incomplete theorem")
let status = match nobj with
NCic.Inductive (is_ind,leftno,itl,_) ->
List.fold_left (fun status it ->
- (let _,ind_name,ty,cl = it in
+ (let _,ind_name,_ty,_cl = it in
List.fold_left
(fun status outsort ->
let status = status#set_ng_mode `ProofMode in
| _ -> status
in
let status = match nobj with
- NCic.Inductive (is_ind,leftno,itl,_) ->
+ NCic.Inductive (_is_ind,leftno,itl,_) ->
(* first leibniz *)
let status' = List.fold_left
(fun status it ->
- let _,ind_name,ty,cl = it in
+ let _,ind_name,_ty,_cl = it in
let status = status#set_ng_mode `ProofMode in
try
(let status,invobj =
(* then JMeq *)
List.fold_left
(fun status it ->
- let _,ind_name,ty,cl = it in
+ let _,ind_name,_ty,_cl = it in
let status = status#set_ng_mode `ProofMode in
try
(let status,invobj =
exn ->
NCicLibrary.time_travel old_status;
raise exn)
- | GrafiteAst.NCopy (log,tgt,src_uri, map) ->
+ | GrafiteAst.NCopy (_loc,tgt,src_uri, map) ->
if status#ng_mode <> `CommandMode then
raise (GrafiteTypes.Command_error "Not in command mode")
else
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,false))
- | GrafiteAst.NObj (loc,obj,index) ->
+ | GrafiteAst.NObj (_loc,obj,index) ->
if status#ng_mode <> `CommandMode then
raise (GrafiteTypes.Command_error "Not in command mode")
else
let status,obj =
GrafiteDisambiguate.disambiguate_nobj status
~baseuri:status#baseuri (text,prefix_len,obj) in
- let uri,height,nmenv,nsubst,nobj = obj in
+ let _uri,_height,nmenv,_nsubst,_nobj = obj in
let ninitial_stack = Continuationals.Stack.of_nmetasenv nmenv in
let status = status#set_obj obj in
let status = status#set_stack ninitial_stack in
eval_ncommand ~include_paths opts status
("",0,GrafiteAst.NQed(Stdpp.dummy_loc,index))
| _ -> status)
- | GrafiteAst.NDiscriminator (loc, indty) ->
+ | GrafiteAst.NDiscriminator (_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 =
+ let _metasenv,_subst,status,indty =
GrafiteDisambiguate.disambiguate_nterm status `XTNone [] [] [] (text,prefix_len,indty) in
let indtyno, (_,_,tys,_,_),leftno = match indty with
NCic.Const ((NReference.Ref (_,NReference.Ind (_,indtyno,leftno))) as r) ->
[] -> eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false))
| _ -> prerr_endline ("Discriminator: non empty metasenv");
status)
- | GrafiteAst.NInverter (loc, name, indty, selection, sort) ->
+ | GrafiteAst.NInverter (_loc, name, indty, selection, sort) ->
if status#ng_mode <> `CommandMode then
raise (GrafiteTypes.Command_error "Not in command mode")
else
"ninverter: found target %s, which is not a sort"
(status#ppterm ~metasenv ~subst ~context:[] sort))) in
let status = status#set_ng_mode `ProofMode in
- let metasenv,subst,status,indty =
+ let _metasenv,_subst,status,indty =
GrafiteDisambiguate.disambiguate_nterm status `XTNone [] [] subst
(text,prefix_len,indty) in
let indtyno,(_,leftno,tys,_,_) =
eval_ncommand ~include_paths opts status
("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false))
| _ -> assert false)
- | GrafiteAst.NUnivConstraint (loc,acyclic,u1,u2) ->
+ | GrafiteAst.NUnivConstraint (_loc,acyclic,u1,u2) ->
eval_add_constraint status acyclic [`Type,u1] [`Type,u2]
(* ex lexicon commands *)
- | GrafiteAst.Interpretation (loc, dsc, (symbol, args), cic_appl_pattern) ->
+ | GrafiteAst.Interpretation (_loc, dsc, (symbol, args), cic_appl_pattern) ->
let cic_appl_pattern =
GrafiteDisambiguate.disambiguate_cic_appl_pattern status args
cic_appl_pattern
in
eval_interpretation status (dsc,(symbol, args),cic_appl_pattern)
- | GrafiteAst.Notation (loc, dir, l1, associativity, precedence, l2) ->
+ | GrafiteAst.Notation (_loc, dir, l1, associativity, precedence, l2) ->
let l1 =
CicNotationParser.check_l1_pattern
l1 (dir = Some `RightToLeft) precedence associativity
in
if dir <> Some `LeftToRight then eval_output_notation status (l1,l2)
else status
- | GrafiteAst.Alias (loc, spec) ->
+ | GrafiteAst.Alias (_loc, spec) ->
let diff =
(*CSC: Warning: this code should be factorized with the corresponding
code in DisambiguatePp *)
match spec with
- | GrafiteAst.Ident_alias (id,uri) ->
+ | GrafiteAst.Ident_alias (id,_uri) ->
[DisambiguateTypes.Id id,spec]
- | GrafiteAst.Symbol_alias (symb, instance, desc) ->
+ | GrafiteAst.Symbol_alias (symb, instance, _desc) ->
[DisambiguateTypes.Symbol (symb,instance),spec]
- | GrafiteAst.Number_alias (instance,desc) ->
+ | GrafiteAst.Number_alias (instance,_desc) ->
[DisambiguateTypes.Num instance,spec]
in
let mode = GrafiteAst.WithPreferences in(*assert false in (* VEDI SOPRA *) MATITA 1.0*)
eval_alias status (mode,diff)
;;
-let eval_comment opts status (text,prefix_len,c) = status
+let eval_comment _opts status (_text,_prefix_len,_c) = status
let rec eval_executable ~include_paths opts status (text,prefix_len,ex) =
match ex with
aux 0 [] ty
in
let status, tgt, arity =
- let metasenv,subst,status,tgt =
+ let _metasenv,subst,status,tgt =
GrafiteDisambiguate.disambiguate_nterm
status `XTSort [] [] [] ("",0,tgt) in
let tgt = NCicUntrusted.apply_subst status subst [] tgt in
exception Stop;;
-let close_graph name t s d to_s from_d p a status =
+let close_graph _name t s d to_s from_d _p a status =
let c =
List.find
(function (_,_,NCic.Appl (x::_),_,_) -> x = t | _ -> assert false)
let pos =
match p with
| NCic.Meta (p,_) -> pos_in_list p (List.map fst metasenv)
- | t -> raise Stop
+ | _t -> raise Stop
in
let ty = NCicTypeChecker.typeof status ~metasenv:[] ~subst:[] [] bo in
let src,tgt = src_tgt_of_ty_cpos_arity status ty pos arity in
let d = refresh_uri_in_term d in
basic_index_ncoercion (name,compose,t,s,d,p,a)
in
- let aux_l l ~refresh_uri_in_universe ~refresh_uri_in_term
- ~refresh_uri_in_reference ~alias_only status
+ let aux_l l ~refresh_uri_in_universe:_ ~refresh_uri_in_term
+ ~refresh_uri_in_reference:_ ~alias_only status
=
if not alias_only then
List.fold_right (aux ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status))) l status
# soon as we have ocaml 3.09 everywhere and "loc" occurrences are replaced by
# "_loc" occurrences
UTF8DIR = $(shell $(OCAMLFIND) query helm-syntax_extensions)
-ULEXDIR = $(shell $(OCAMLFIND) query ulex08)
+ULEXDIR = $(shell $(OCAMLFIND) query ulex-camlp5)
MY_SYNTAXOPTIONS = -pp "camlp5o -I $(UTF8DIR) -I $(ULEXDIR) pa_extend.cmo pa_ulex.cma pa_unicode_macro.cma -loc loc"
grafiteParser.cmo: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
grafiteParser.cmx: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
depend.opt: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
# </cross>
#
-grafiteParser.cmo: OCAMLC = $(OCAMLC_P4)
-grafiteParser.cmx: OCAMLOPT = $(OCAMLOPT_P4)
+grafiteParser.cmo: OCAMLC = $(OCAMLC_P4) -w -27
+grafiteParser.cmx: OCAMLOPT = $(OCAMLOPT_P4) -w -27
include ../../Makefile.defs
include ../Makefile.common
type by_continuation =
BYC_done
- | BYC_weproved of N.term * string option * N.term option
- | BYC_letsuchthat of string * N.term * string * N.term
+ | BYC_weproved of N.term * string option
+ | BYC_letsuchthat of string * N.term * N.term * string
| BYC_wehaveand of string * N.term * string * N.term
let mk_parser statement lstatus =
| SYMBOL "#"; SYMBOL "_" -> G.NTactic(loc,[ G.NIntro (loc,"_")])
| SYMBOL "*" -> G.NTactic(loc,[ G.NCase1 (loc,"_")])
| SYMBOL "*"; "as"; n=IDENT -> G.NTactic(loc,[ G.NCase1 (loc,n)])
+ | IDENT "assume" ; id = IDENT; SYMBOL ":"; t = tactic_term -> G.NTactic (loc,[G.Assume (loc,id,t)])
+ | IDENT "suppose" ; t = tactic_term ; LPAREN ; id = IDENT ; RPAREN -> G.NTactic (loc,[G.Suppose (loc,t,id)])
+ | "let"; name = IDENT ; SYMBOL <:unicode<def>> ; t = tactic_term ->
+ G.NTactic(loc,[G.NLetIn (loc,(None,[],Some N.UserInput),t,name)])
+ | just =
+ [ IDENT "using"; t=tactic_term -> `Term t
+ | params = auto_params ->
+ let just,params = params in
+ `Auto
+ (match just with
+ | None -> (None,params)
+ | Some (`Univ univ) -> (Some univ,params)
+ (* `Trace behaves exaclty like None for the moment being *)
+ | Some (`Trace) -> (None,params)
+ )
+ ];
+ cont=by_continuation -> G.NTactic (loc,[
+ (match cont with
+ BYC_done -> G.Bydone (loc, just)
+ | BYC_weproved (ty,id) ->
+ G.By_just_we_proved(loc, just, ty, id)
+ | BYC_letsuchthat (id1,t1,t2,id2) ->
+ G.ExistsElim (loc, just, id1, t1, t2, id2)
+ | BYC_wehaveand (id1,t1,id2,t2) ->
+ G.AndElim (loc, just, t1, id1, t2, id2))
+ ])
+ | IDENT "we" ; IDENT "need" ; "to" ; IDENT "prove" ; t = tactic_term ; id = OPT [ LPAREN ; id = IDENT ; RPAREN -> id ] ->
+ G.NTactic (loc,[G.We_need_to_prove (loc, t, id)])
+ | IDENT "that" ; IDENT "is" ; IDENT "equivalent" ; "to" ; t = tactic_term -> G.NTactic(loc,[G.BetaRewritingStep (loc,t)])
+ | IDENT "the" ; IDENT "thesis" ; IDENT "becomes" ; t1=tactic_term -> G.NTactic (loc,[G.Thesisbecomes(loc,t1)])
+ | IDENT "we" ; IDENT "proceed" ; IDENT "by" ; IDENT "cases" ; "on" ; t=tactic_term ; "to" ; IDENT "prove" ; t1=tactic_term ->
+ G.NTactic (loc,[G.We_proceed_by_cases_on (loc, t, t1)])
+ | IDENT "we" ; IDENT "proceed" ; IDENT "by" ; IDENT "induction" ; "on" ; t=tactic_term ; "to" ; IDENT "prove" ; t1=tactic_term ->
+ G.NTactic (loc,[G.We_proceed_by_induction_on (loc, t, t1)])
+ | IDENT "by" ; IDENT "induction" ; IDENT "hypothesis" ; IDENT "we" ; IDENT "know" ; t=tactic_term ; LPAREN ; id = IDENT ; RPAREN ->
+ G.NTactic (loc,[G.Byinduction(loc, t, id)])
+ | IDENT "case" ; id = IDENT ; params=LIST0[LPAREN ; i=IDENT ;
+ SYMBOL":" ; t=tactic_term ; RPAREN -> i,t] ->
+ G.NTactic (loc,[G.Case(loc,id,params)])
+ | IDENT "print_stack" -> G.NTactic (loc,[G.PrintStack loc])
+ (* DO NOT FACTORIZE with the two following, camlp5 sucks*)
+(*
+ | IDENT "conclude";
+ termine = tactic_term;
+ SYMBOL "=" ;
+ t1=tactic_term ;
+ t2 =
+ [ IDENT "using"; t=tactic_term -> `Term t
+ | IDENT "using"; IDENT "once"; term=tactic_term -> `SolveWith term
+ | IDENT "proof" -> `Proof
+ | params = auto_params -> `Auto
+ (
+ let just,params = params in
+ match just with
+ | None -> (None,params)
+ | Some (`Univ univ) -> (Some univ,params)
+ (* `Trace behaves exaclty like None for the moment being *)
+ | Some (`Trace) -> (None,params)
+ )
+ ];
+ cont = rewriting_step_continuation ->
+ G.NTactic (loc,[G.RewritingStep(loc, Some (None,termine), t1, t2, cont)])
+ | IDENT "obtain" ; name = IDENT;
+ termine = tactic_term;
+ SYMBOL "=" ;
+ t1=tactic_term ;
+ t2 =
+ [ IDENT "using"; t=tactic_term -> `Term t
+ | IDENT "using"; IDENT "once"; term=tactic_term -> `SolveWith term
+ | IDENT "proof" -> `Proof
+ | params = auto_params -> `Auto
+ (
+ let just,params = params in
+ match just with
+ | None -> (None,params)
+ | Some (`Univ univ) -> (Some univ,params)
+ (* `Trace behaves exaclty like None for the moment being *)
+ | Some (`Trace) -> (None,params)
+ )
+ ];
+ cont = rewriting_step_continuation ->
+ G.NTactic(loc,[G.RewritingStep(loc, Some (Some name,termine), t1, t2, cont)])
+*)
+ | IDENT "obtain" ; name = IDENT;
+ termine = tactic_term ->
+ G.NTactic(loc,[G.Obtain(loc, name, termine)])
+ | IDENT "conclude" ; termine = tactic_term ->
+ G.NTactic(loc,[G.Conclude(loc, termine)])
+ | SYMBOL "=" ;
+ t1=tactic_term ;
+ t2 =
+ [ IDENT "using"; t=tactic_term -> `Term t
+ | IDENT "using"; IDENT "once"; term=tactic_term -> `SolveWith term
+ | IDENT "proof" -> `Proof
+ | params = auto_params -> `Auto
+ (
+ let just,params = params in
+ match just with
+ | None -> (None,params)
+ | Some (`Univ univ) -> (Some univ,params)
+ (* `Trace behaves exaclty like None for the moment being *)
+ | Some (`Trace) -> (None,params)
+ )
+ ];
+ cont = rewriting_step_continuation ->
+ G.NTactic(loc,[G.RewritingStep(loc, t1, t2, cont)])
]
];
auto_fixed_param: [
]
];
-(* MATITA 1.0
by_continuation: [
- [ WEPROVED; ty = tactic_term ; LPAREN ; id = IDENT ; RPAREN ; t1 = OPT [IDENT "that" ; IDENT "is" ; IDENT "equivalent" ; "to" ; t2 = tactic_term -> t2] -> BYC_weproved (ty,Some id,t1)
- | WEPROVED; ty = tactic_term ; t1 = OPT [IDENT "that" ; IDENT "is" ; IDENT "equivalent" ; "to" ; t2 = tactic_term -> t2] ;
- "done" -> BYC_weproved (ty,None,t1)
+ [ WEPROVED; ty = tactic_term ; id = OPT [ LPAREN ; id = IDENT ; RPAREN -> id] -> BYC_weproved (ty,id)
| "done" -> BYC_done
| "let" ; id1 = IDENT ; SYMBOL ":" ; t1 = tactic_term ;
IDENT "such" ; IDENT "that" ; t2=tactic_term ; LPAREN ;
- id2 = IDENT ; RPAREN -> BYC_letsuchthat (id1,t1,id2,t2)
+ id2 = IDENT ; RPAREN -> BYC_letsuchthat (id1,t1,t2,id2)
| WEHAVE; t1=tactic_term ; LPAREN ; id1=IDENT ; RPAREN ;"and" ; t2=tactic_term ; LPAREN ; id2=IDENT ; RPAREN ->
BYC_wehaveand (id1,t1,id2,t2)
]
];
-*)
-(* MATITA 1.0
+
rewriting_step_continuation : [
[ "done" -> true
| -> false
]
];
-*)
+
(* MATITA 1.0
atomic_tactical:
[ "sequence" LEFTA
count_brothers t > 1
let visit_description desc fmt self =
- let skip s = true in
+ let skip _s = true in
let inline s = List.mem s [ "int" ] in
let rec visit_entry e ?level todo is_son =
(fun x -> Sself :: x) (flatten_tree suff) @ flatten_tree pref)
todo is_son
- and visit_tree name t todo is_son =
+ and visit_tree name t todo _is_son =
if List.for_all (List.for_all is_symbol_dummy) t then todo else (
Format.fprintf fmt "@[<v>";
(match name with
let path = absolutize path in
let paths = List.rev (Str.split (Str.regexp "/") path) in
let rec build = function
- | he::tl as l -> ("/" ^ String.concat "/" (List.rev l) ^ "/") :: build tl
+ | _he::tl as l -> ("/" ^ String.concat "/" (List.rev l) ^ "/") :: build tl
| [] -> ["/"]
in
let paths = List.map HExtlib.normalize_path (build paths) in
let find_root_for ~include_paths file =
let include_paths = "" :: Sys.getcwd () :: include_paths in
- let rec find_path_for file =
+ let find_path_for file =
try HExtlib.find_in include_paths file
with Failure "find_in" ->
HLog.error ("We are in: " ^ Sys.getcwd ());
(* $Id$ *)
-open Printf
-
let debug = false
let debug_prerr = if debug then prerr_endline else ignore
-module HGT = Http_getter_types;;
-module HG = Http_getter;;
+(*module HGT = Http_getter_types;;*)
+(*module HG = Http_getter;;*)
(*module UM = UriManager;;*)
-let decompile = ref (fun ~baseuri -> assert false);;
+let decompile = ref (fun ~baseuri:_ -> assert false);;
let set_decompile_cb f = decompile := f;;
(*
;;
*)
-let rec close_db cache_of_processed_baseuri uris next =
+let close_db _cache_of_processed_baseuri uris _next =
uris (* MATITA 1.0 *)
;;
-let clean_baseuris ?(verbose=true) buris =
+let clean_baseuris ?verbose:(_=true) _buris =
(* MATITA 1.0 *) () (*
let cache_of_processed_baseuri = Hashtbl.create 1024 in
let buris = List.map Http_getter_misc.strip_trailing_slash buris in
type logger_fun = ?append_NL:bool -> html_msg -> unit
-let rec string_of_html_tag =
+let string_of_html_tag =
let rec aux indent =
let indent_str = String.make indent ' ' in
function
List.fold_right (fun idref t -> Ast.AttributedTerm (`IdRef idref, t))
let instantiate32 idrefs env symbol args =
- let rec instantiate_arg = function
+ let instantiate_arg = function
| Ast.IdentArg (n, name) ->
let t =
try List.assoc name env
| NCic.Lambda (n,s,t) ->
idref (Ast.Binder (`Lambda,(Ast.Ident (n,None), Some (k ~context s)),
k ~context:((n,NCic.Decl s)::context) t))
- | NCic.LetIn (n,s,ty,NCic.Rel 1) ->
+ | NCic.LetIn (_n,s,ty,NCic.Rel 1) ->
idref (Ast.Cast (k ~context ty, k ~context s))
| NCic.LetIn (n,s,ty,t) ->
idref (Ast.LetIn ((Ast.Ident (n,None), Some (k ~context s)), k ~context
in
let rec eat_branch n ctx ty pat =
match (ty, pat) with
- | NCic.Prod (name, s, t), _ when n > 0 ->
+ | NCic.Prod (_name, _s, t), _ when n > 0 ->
eat_branch (pred n) ctx t pat
| NCic.Prod (_, _, t), NCic.Lambda (name, s, t') ->
let cv, rhs = eat_branch 0 ((name,NCic.Decl s)::ctx) t t' in
) context ([],[]))
;;
-let nmap_sequent0 status ~idref ~metasenv ~subst (i,(n,context,ty)) =
+let nmap_sequent0 status ~idref ~metasenv ~subst (i,(_n,context,ty)) =
let module K = Content in
let nast_of_cic =
nast_of_cic1 status ~idref ~output_type:`Term ~metasenv ~subst in
res
;;
-let build_def_item seed context metasenv id n t ty =
+let build_def_item seed _context _metasenv id n t ty =
let module K = Content in
(*
try
K.inductive_constructors = build_constructors seed cl
}
in
-let build_fixpoint b seed =
+let build_fixpoint _b seed =
fun (_,n,_,ty,t) ->
let t = nast_of_cic ~context:[] t in
let ty = nast_of_cic ~context:[] ty in
let eval_with_new_aliases status f =
let status =
status#set_disambiguate_db { status#disambiguate_db with new_aliases = [] } in
- let res = f status in
- let new_aliases = status#disambiguate_db.new_aliases in
- new_aliases,res
+ let new_status = f status in
+ let new_aliases = new_status#disambiguate_db.new_aliases in
+ new_aliases,new_status
;;
let dump_aliases out msg status =
let desc,f = DisambiguateChoices.nlookup_num_by_dsc dsc in
desc, `Num_interp
(fun num -> match f with `Num_interp f -> f num | _ -> assert false)
- | GrafiteAst.Ident_alias (name, uri) ->
+ | GrafiteAst.Ident_alias (_name, uri) ->
uri, `Sym_interp
(fun l->assert(l = []);
let nref = NReference.reference_of_string uri in
;;
let nlookup_in_library
- interactive_user_uri_choice input_or_locate_uri item
+ _interactive_user_uri_choice _input_or_locate_uri item
=
match item with
| DisambiguateTypes.Id id ->
(wanted, hyp_paths, goal_path)
;;
-let disambiguate_reduction_kind text prefix_len = function
- | `Unfold (Some t) -> assert false (* MATITA 1.0 *)
+let disambiguate_reduction_kind _text _prefix_len = function
+ | `Unfold (Some _t) -> assert false (* MATITA 1.0 *)
| `Normalize
| `Simpl
| `Unfold None
end
val eval_with_new_aliases:
- #status as 'status -> ('status -> 'a) ->
+ #status as 'status -> ('status -> (#status as 'a)) ->
(DisambiguateTypes.domain_item * GrafiteAst.alias_spec) list * 'a
val set_proof_aliases:
-common.cmo : ocamlExtractionTable.cmi mlutil.cmi miniml.cmo coq.cmi \
- common.cmi
-common.cmx : ocamlExtractionTable.cmx mlutil.cmx miniml.cmx coq.cmx \
- common.cmi
-common.cmi : ocamlExtractionTable.cmi mlutil.cmi miniml.cmo coq.cmi
+common.cmo : ocamlExtractionTable.cmi mlutil.cmi coq.cmi common.cmi
+common.cmx : ocamlExtractionTable.cmx mlutil.cmx coq.cmx common.cmi
+common.cmi : ocamlExtractionTable.cmi coq.cmi
coq.cmo : coq.cmi
coq.cmx : coq.cmi
coq.cmi :
common.cmi extraction.cmi
extraction.cmx : ocamlExtractionTable.cmx mlutil.cmx miniml.cmx coq.cmx \
common.cmx extraction.cmi
-extraction.cmi : ocamlExtractionTable.cmi miniml.cmo coq.cmi
+extraction.cmi : ocamlExtractionTable.cmi miniml.cmo
miniml.cmo : coq.cmi
miniml.cmx : coq.cmx
mlutil.cmo : ocamlExtractionTable.cmi miniml.cmo coq.cmi mlutil.cmi
-common.cmx : ocamlExtractionTable.cmx mlutil.cmx miniml.cmx coq.cmx \
- common.cmi
-common.cmi : ocamlExtractionTable.cmi mlutil.cmi miniml.cmx coq.cmi
+common.cmx : ocamlExtractionTable.cmx mlutil.cmx coq.cmx common.cmi
+common.cmi : ocamlExtractionTable.cmi coq.cmi
coq.cmx : coq.cmi
coq.cmi :
extraction.cmx : ocamlExtractionTable.cmx mlutil.cmx miniml.cmx coq.cmx \
common.cmx extraction.cmi
-extraction.cmi : ocamlExtractionTable.cmi miniml.cmx coq.cmi
+extraction.cmi : ocamlExtractionTable.cmi miniml.cmx
miniml.cmx : coq.cmx
mlutil.cmx : ocamlExtractionTable.cmx miniml.cmx coq.cmx mlutil.cmi
mlutil.cmi : ocamlExtractionTable.cmi miniml.cmx coq.cmi
miniml.ml $(INTERFACE_FILES:%.mli=%.ml)
EXTRA_OBJECTS_TO_INSTALL =
EXTRA_OBJECTS_TO_CLEAN =
-%.cmo: OCAMLOPTIONS += -w Ae
-%.cmi: OCAMLOPTIONS += -w Ae
-%.cmx: OCAMLOPTIONS += -w Ae
include ../../Makefile.defs
include ../Makefile.common
open Coq
open OcamlExtractionTable
-open Miniml
+(*open Miniml*)
open Mlutil
(*s Some pretty-print utility functions. *)
if id = "" then "x" else
if id.[0] = '_' then lowercase_id (String.sub id 1 (String.length id - 1)) else
if is_invalid_id id then lowercase_id ("x" ^ id) else
- String.uncapitalize id
+ String.uncapitalize_ascii id
let rec uppercase_id id =
if id = "" then "T" else
if id.[0] = '_' then uppercase_id (String.sub id 1 (String.length id - 1)) else
if is_invalid_id id then uppercase_id ("x" ^ id) else
- String.capitalize id
+ String.capitalize_ascii id
type kind = Term | Type | Cons
NUri.name_of_uri uri
| _ -> NCicPp.r2s status true r
-let maybe_capitalize b n = if b then String.capitalize n else n
+let maybe_capitalize b n = if b then String.capitalize_ascii n else n
let modname_of_filename status capitalize name =
try
status, maybe_capitalize capitalize name
with Not_found ->
let globs = Idset.elements (get_modnames status) in
- let s = next_ident_away (String.uncapitalize name) globs in
+ let s = next_ident_away (String.uncapitalize_ascii name) globs in
let status = add_modname status s in
let status = add_modname_for_filename status name s in
status, maybe_capitalize capitalize s
(*i $Id: common.mli 14641 2011-11-06 11:59:10Z herbelin $ i*)
open Coq
-open Miniml
-open Mlutil
+(**open Miniml
+open Mlutil*)
open OcamlExtractionTable
(** By default, in module Format, you can do horizontal placing of blocks
numpart (n-1) n'
else if code_of_0 <= c && c <= code_of_9 then
numpart (n-1) (n-1)
- else if skip_quote & (c = Char.code '\'' || c = Char.code '_') then
+ else if skip_quote && (c = Char.code '\'' || c = Char.code '_') then
numpart (n-1) (n-1)
else
n'
let forget_subscript id =
let numstart = cut_ident false id in
- let newid = String.make (numstart+1) '0' in
+ let newid = Bytes.make (numstart+1) '0' in
String.blit id 0 newid 0 numstart;
- newid
+ Bytes.to_string newid
(* Namegen.ml *)
add (carrypos-1)
end
else begin
- let newid = String.copy id in
- String.fill newid (carrypos+1) (len-1-carrypos) '0';
+ let newid = Bytes.of_string id in
+ Bytes.fill newid (carrypos+1) (len-1-carrypos) '0';
newid.[carrypos] <- Char.chr (Char.code c + 1);
- newid
+ Bytes.to_string newid
end
else begin
- let newid = id^"0" in
+ let newid = Bytes.of_string (id^"0") in
if carrypos < len-1 then begin
- String.fill newid (carrypos+1) (len-1-carrypos) '0';
+ Bytes.fill newid (carrypos+1) (len-1-carrypos) '0';
newid.[carrypos+1] <- '1'
end;
- newid
+ Bytes.to_string newid
end
in add (len-1)
if Array.length v1 == 0 then
[| |]
else begin
- let res = Array.create (Array.length v1) (f v1.(0) v2.(0)) in
+ let res = Array.make (Array.length v1) (f v1.(0) v2.(0)) in
for i = 1 to pred (Array.length v1) do
res.(i) <- f v1.(i) v2.(i)
done;
let n = String.index s '\n' in
String.sub s 0 n, Some (String.sub s (n+1) (String.length s - n - 1))
with Not_found -> s,None in
- com_if ft (Lazy.lazy_from_val());
+ com_if ft (Lazy.from_val());
(* let s1 =
if String.length s1 <> 0 && s1.[0] = ' ' then
(Format.pp_print_space ft (); String.sub s1 1 (String.length s1 - 1))
in
let rec pp_cmd = function
| Ppcmd_print(n,s) ->
- com_if ft (Lazy.lazy_from_val()); Format.pp_print_as ft n s
+ com_if ft (Lazy.from_val()); Format.pp_print_as ft n s
| Ppcmd_box(bty,ss) -> (* Prevent evaluation of the stream! *)
- com_if ft (Lazy.lazy_from_val());
+ com_if ft (Lazy.from_val());
pp_open_box bty ;
if not (Format.over_max_boxes ()) then Stream.iter pp_cmd ss;
Format.pp_close_box ft ()
- | Ppcmd_open_box bty -> com_if ft (Lazy.lazy_from_val()); pp_open_box bty
+ | Ppcmd_open_box bty -> com_if ft (Lazy.from_val()); pp_open_box bty
| Ppcmd_close_box -> Format.pp_close_box ft ()
| Ppcmd_close_tbox -> Format.pp_close_tbox ft ()
| Ppcmd_white_space n ->
- com_if ft (Lazy.lazy_from_fun (fun()->Format.pp_print_break ft n 0))
+ com_if ft (Lazy.from_fun (fun()->Format.pp_print_break ft n 0))
| Ppcmd_print_break(m,n) ->
- com_if ft (Lazy.lazy_from_fun(fun()->Format.pp_print_break ft m n))
+ com_if ft (Lazy.from_fun(fun()->Format.pp_print_break ft m n))
| Ppcmd_set_tab -> Format.pp_set_tab ft ()
| Ppcmd_print_tbreak(m,n) ->
- com_if ft (Lazy.lazy_from_fun(fun()->Format.pp_print_tbreak ft m n))
+ com_if ft (Lazy.from_fun(fun()->Format.pp_print_tbreak ft m n))
| Ppcmd_force_newline ->
com_brk ft; Format.pp_force_newline ft ()
| Ppcmd_print_if_broken ->
- com_if ft (Lazy.lazy_from_fun(fun()->Format.pp_print_if_newline ft ()))
+ com_if ft (Lazy.from_fun(fun()->Format.pp_print_if_newline ft ()))
| Ppcmd_comment i ->
let coms = split_com [] [] i !comments in
(* Format.pp_open_hvbox ft 0;*)
(* Enriching a exception message *)
-let rec handle_exn _r _n _fn_name = function x -> x
+let handle_exn _r _n _fn_name = function x -> x
(*CSC: only for pretty printing
| MLexn s ->
(try Scanf.sscanf s "UNBOUND %d"
(* [decomp_lams_eta env c t] finds the number [n] of products in the type [t],
and decompose the term [c] in [n] lambdas, with eta-expansion if needed. *)
-let rec decomp_lams_eta_n n m status context c t =
+let decomp_lams_eta_n n m status context c t =
let rels = fst (splay_prod_n status context n t) in
let rels',c = decompose_lam c in
let d = n - m in
(*s Extraction from Coq terms to Miniml. *)
-open Coq
open Miniml
-open OcamlExtractionTable
val extract:
#OcamlExtractionTable.status as 'status -> NCic.obj ->
let clean_free mle =
let rem = ref Metaset.empty
and add = ref Metaset.empty in
- let clean m = match m.contents with
+ let clean m = match m.Miniml.contents with
| None -> ()
| Some u -> rem := Metaset.add m !rem; add := find_free !add u
in
(*s What are the type variables occurring in [t]. *)
-let intset_union_map_list f l =
- List.fold_left (fun s t -> Intset.union s (f t)) Intset.empty l
+(*let intset_union_map_list f l =
+ List.fold_left (fun s t -> Intset.union s (f t)) Intset.empty l*)
-let intset_union_map_array f a =
- Array.fold_left (fun s t -> Intset.union s (f t)) Intset.empty a
+(*let intset_union_map_array f a =
+ Array.fold_left (fun s t -> Intset.union s (f t)) Intset.empty a*)
-let rec type_listvar = function
+(*let rec type_listvar = function
| Tmeta {contents = Some t} -> type_listvar t
| Tvar i | Tvar' i -> Intset.singleton i
| Tarr (a,b) -> Intset.union (type_listvar a) (type_listvar b)
| Tglob (_,l) -> intset_union_map_list type_listvar l
- | _ -> Intset.empty
+ | _ -> Intset.empty*)
(*s From [a -> b -> c] to [[a;b],c]. *)
(*s Number of occurences of [Rel k] (resp. [Rel 1]) in [t]. *)
-let nb_occur_k k t =
+(*let nb_occur_k k t =
let cpt = ref 0 in
ast_iter_rel (fun i -> if i = k then incr cpt) t;
- !cpt
+ !cpt*)
-let nb_occur t = nb_occur_k 1 t
+(*let nb_occur t = nb_occur_k 1 t*)
(* Number of occurences of [Rel 1] in [t], with special treatment of match:
occurences in different branches aren't added, but we rather use max. *)
| 0 -> a
| n -> many_lams id (MLlam (id,a)) (pred n)
-let anonym_lams a n = many_lams anonymous a n
+(*let anonym_lams a n = many_lams anonymous a n*)
let anonym_tmp_lams a n = many_lams (Tmp anonymous_name) a n
let dummy_lams a n = many_lams Dummy a n
(*s Computes an eta-reduction. *)
-let eta_red e =
+(*let eta_red e =
let ids,t = collect_lams e in
let n = List.length ids in
if n = 0 then e
if test_eta_args_lift 0 p args && not (ast_occurs_itvl 1 p body)
then named_lams ids (ast_lift (-p) body)
else e
- | _ -> e
+ | _ -> e*)
(*s Computes all head linear beta-reductions possible in [(t a)].
Non-linear head beta-redex become let-in. *)
-let rec linear_beta_red a t = match a,t with
+(*let rec linear_beta_red a t = match a,t with
| [], _ -> t
| a0::a, MLlam (id,t) ->
(match nb_occur_match t with
| _ ->
let a = List.map (ast_lift 1) a in
MLletin (id, a0, linear_beta_red a t))
- | _ -> MLapp (t, a)
+ | _ -> MLapp (t, a)*)
-let rec tmp_head_lams = function
+(*let rec tmp_head_lams = function
| MLlam (id, t) -> MLlam (tmp_id id, tmp_head_lams t)
- | e -> e
+ | e -> e*)
(*s Applies a substitution [s] of constants by their body, plus
linear beta reductions at modified positions.
reduction (this helps the inlining of recursors).
*)
-let rec ast_glob_subst _s _t = assert false (*CSC: reimplement match t with
+let ast_glob_subst _s _t = assert false (*CSC: reimplement match t with
| MLapp ((MLglob ((ConstRef kn) as refe)) as f, a) ->
let a = List.map (fun e -> tmp_head_lams (ast_glob_subst s e)) a in
(try linear_beta_red a (Refmap'.find refe s)
let is_exn = function MLexn _ -> true | _ -> false
-let rec permut_case_fun br _acc =
+let permut_case_fun br _acc =
let nb = ref max_int in
Array.iter (fun (_,_,t) ->
let ids, c = collect_lams t in
(* Utility functions used in the decision of inlining. *)
-let rec ml_size = function
+(*let rec ml_size = function
| MLapp(t,l) -> List.length l + ml_size t + ml_size_list l
| MLlam(_,t) -> 1 + ml_size t
| MLcons(_,_,l) -> ml_size_list l
and ml_size_list l = List.fold_left (fun a t -> a + ml_size t) 0 l
-and ml_size_array l = Array.fold_left (fun a t -> a + ml_size t) 0 l
+and ml_size_array l = Array.fold_left (fun a t -> a + ml_size t) 0 l*)
-let is_fix = function MLfix _ -> true | _ -> false
+(*let is_fix = function MLfix _ -> true | _ -> false*)
-let rec is_constr = function
+(*let rec is_constr = function
| MLcons _ -> true
| MLlam(_,t) -> is_constr t
- | _ -> false
+ | _ -> false*)
(*s Strictness *)
it begins by at least one non-strict lambda, since the corresponding
argument to [t] might be unevaluated in the expanded code. *)
-exception Toplevel
+(*exception Toplevel*)
-let lift n l = List.map ((+) n) l
+(*let lift n l = List.map ((+) n) l*)
-let pop n l = List.map (fun x -> if x<=n then raise Toplevel else x-n) l
+(*let pop n l = List.map (fun x -> if x<=n then raise Toplevel else x-n) l*)
(* This function returns a list of de Bruijn indices of non-strict variables,
or raises [Toplevel] if it has an internal non-strict variable.
variable to the candidates? We use this flag to check only the external
lambdas, those that will correspond to arguments. *)
-let rec non_stricts add cand = function
+(*let rec non_stricts add cand = function
| MLlam (_id,t) ->
let cand = lift 1 cand in
let cand = if add then 1::cand else cand in
let n = List.length i in
let cand = lift n cand in
let cand = pop n (non_stricts add cand t) in
- Sort.merge (<=) cand c) [] v
+ List.merge (-) cand c) [] v
(* [merge] may duplicates some indices, but I don't mind. *)
| MLmagic t ->
non_stricts add cand t
| _ ->
- cand
+ cand*)
(* The real test: we are looking for internal non-strict variables, so we start
with no candidates, and the only positive answer is via the [Toplevel]
exception. *)
-let is_not_strict t =
+(*let is_not_strict t =
try let _ = non_stricts true [] t in false
- with Toplevel -> true
+ with Toplevel -> true*)
(*s Inlining decision *)
restriction for the moment.
*)
-let inline_test _r _t =
+(*let inline_test _r _t =
(*CSC:if not (auto_inline ()) then*) false
(*
else
let t1 = eta_red t in
let t2 = snd (collect_lams t1) in
not (is_fix t2) && ml_size t < 12 && is_not_strict t
-*)
+*)*)
(*CSC: (not) reimplemented
let con_of_string s =
]
Cset_env.empty*)
-let manual_inline = function (*CSC:
+(*let manual_inline = function (*CSC:
| ConstRef c -> Cset_env.mem c manual_inline_set
- |*) _ -> false
+ |*) _ -> false*)
(* If the user doesn't say he wants to keep [t], we inline in two cases:
\begin{itemize}
(fun p1 n ->
HExtlib.map_option (fun (_,k) ->
(*CSC: BUG here, clashes*)
- String.uncapitalize (fst n),k) p1)
+ String.uncapitalize_ascii (fst n),k) p1)
ctx0 ctx
in
let bo = typ_of status ~metasenv ctx bo in
fun x -> g (f x)
;;
-let curry f x y =
+(*let curry f x y =
f (x, y)
-;;
+;;*)
let uncurry f (x, y) =
f x y
;;
-let rec char_list_of_string s =
+let char_list_of_string s =
let l = String.length s in
let rec aux buffer s =
function
| [] -> s
| x::xs ->
if x < String.length s then
- let c = Char.uppercase (String.get s x) in
- let _ = String.set s x c in
+ let c = Char.uppercase_ascii (String.get s x) in
+ let b = Bytes.of_string s in
+ let _ = Bytes.set b x c in
+ let s = Bytes.to_string b in
capitalize_marked_positions s xs
else
capitalize_marked_positions s xs
let idiomatic_haskell_type_name_of_string =
contract_underscores_and_capitalise |>
- String.capitalize
+ String.capitalize_ascii
;;
let idiomatic_haskell_term_name_of_string =
contract_underscores_and_capitalise |>
- String.uncapitalize
+ String.uncapitalize_ascii
;;
let classify_reference status ref =
) il)
(* inductive and records missing *)
-let rec infos_of (info,_,obj_kind) =
+let infos_of (info,_,obj_kind) =
info @
match obj_kind with
LetRec l -> List.concat (List.map (fun (infos,_,_) -> infos) l)
(*s Pretty-printing of types. [par] is a boolean indicating whether parentheses
are needed or not. *)
-let rec pp_type status par vl t =
+let pp_type status par vl t =
let rec pp_rec status par = function
| Tmeta _ | Tvar' _ | Taxiom -> assert false
| Tvar i -> (try status,pp_tvar (List.nth vl (pred i))
nCicReduction.cmx : nReference.cmx nCicUtils.cmx nCicSubstitution.cmx \
nCicEnvironment.cmx nCic.cmx nCicReduction.cmi
nCicReduction.cmi : nCic.cmo
-nCicSubstitution.cmo : nReference.cmi nCicUtils.cmi nCic.cmo \
- nCicSubstitution.cmi
-nCicSubstitution.cmx : nReference.cmx nCicUtils.cmx nCic.cmx \
- nCicSubstitution.cmi
+nCicSubstitution.cmo : nCicUtils.cmi nCic.cmo nCicSubstitution.cmi
+nCicSubstitution.cmx : nCicUtils.cmx nCic.cmx nCicSubstitution.cmi
nCicSubstitution.cmi : nCic.cmo
nCicTypeChecker.cmo : nUri.cmi nReference.cmi nCicUtils.cmi \
nCicSubstitution.cmi nCicReduction.cmi nCicEnvironment.cmi nCic.cmo \
nCicUntrusted.cmx : nReference.cmx nCicUtils.cmx nCicSubstitution.cmx \
nCicReduction.cmx nCicEnvironment.cmx nCic.cmx nCicUntrusted.cmi
nCicUntrusted.cmi : nCic.cmo
-nCicUtils.cmo : nReference.cmi nCic.cmo nCicUtils.cmi
-nCicUtils.cmx : nReference.cmx nCic.cmx nCicUtils.cmi
+nCicUtils.cmo : nCic.cmo nCicUtils.cmi
+nCicUtils.cmx : nCic.cmx nCicUtils.cmi
nCicUtils.cmi : nCic.cmo
nReference.cmo : nUri.cmi nReference.cmi
nReference.cmx : nUri.cmx nReference.cmi
nCicReduction.cmx : nReference.cmx nCicUtils.cmx nCicSubstitution.cmx \
nCicEnvironment.cmx nCic.cmx nCicReduction.cmi
nCicReduction.cmi : nCic.cmx
-nCicSubstitution.cmx : nReference.cmx nCicUtils.cmx nCic.cmx \
- nCicSubstitution.cmi
+nCicSubstitution.cmx : nCicUtils.cmx nCic.cmx nCicSubstitution.cmi
nCicSubstitution.cmi : nCic.cmx
nCicTypeChecker.cmx : nUri.cmx nReference.cmx nCicUtils.cmx \
nCicSubstitution.cmx nCicReduction.cmx nCicEnvironment.cmx nCic.cmx \
nCicUntrusted.cmx : nReference.cmx nCicUtils.cmx nCicSubstitution.cmx \
nCicReduction.cmx nCicEnvironment.cmx nCic.cmx nCicUntrusted.cmi
nCicUntrusted.cmi : nCic.cmx
-nCicUtils.cmx : nReference.cmx nCic.cmx nCicUtils.cmi
+nCicUtils.cmx : nCic.cmx nCicUtils.cmi
nCicUtils.cmi : nCic.cmx
nReference.cmx : nUri.cmx nReference.cmi
nReference.cmi : nUri.cmi
nCic.ml $(INTERFACE_FILES:%.mli=%.ml)
EXTRA_OBJECTS_TO_INSTALL =
EXTRA_OBJECTS_TO_CLEAN =
-%.cmo: OCAMLOPTIONS += -w Ae
-%.cmi: OCAMLOPTIONS += -w Ae
-%.cmx: OCAMLOPTIONS += -w Ae
include ../../Makefile.defs
include ../Makefile.common
exception AssertFailure of string Lazy.t;;
let debug = ref false;;
-let pp m = if !debug then prerr_endline (Lazy.force m) else ();;
+(*let pp m = if !debug then prerr_endline (Lazy.force m) else ();;*)
module type Strategy = sig
type stack_term
(* $Id$ *)
module C = NCic
-module Ref = NReference
-
-let debug_print = fun _ -> ();;
let lift_from status ?(no_implicit=true) k n =
let rec liftaux k = function
let indent = ref 0;;
let debug = true;;
-let logger =
+let _logger =
let do_indent () = String.make !indent ' ' in
(function
| `Start_type_checking s ->
(* $Id$ *)
module C = NCic
-module Ref = NReference
exception Subst_not_found of int
exception Meta_not_found of int
$(INTERFACE_FILES:%.mli=%.ml)
EXTRA_OBJECTS_TO_INSTALL =
EXTRA_OBJECTS_TO_CLEAN =
-%.cmo: OCAMLOPTIONS += -w Ae
-%.cmi: OCAMLOPTIONS += -w Ae
-%.cmx: OCAMLOPTIONS += -w Ae
all:
%: %.ml $(PACKAGE).cma
foUtils.cmo : terms.cmi orderings.cmi foSubst.cmi foUtils.cmi
foUtils.cmx : terms.cmx orderings.cmx foSubst.cmx foUtils.cmi
foUtils.cmi : terms.cmi orderings.cmi
-index.cmo : terms.cmi pp.cmi orderings.cmi foUtils.cmi foUnif.cmi index.cmi
-index.cmx : terms.cmx pp.cmx orderings.cmx foUtils.cmx foUnif.cmx index.cmi
+index.cmo : terms.cmi orderings.cmi foUtils.cmi index.cmi
+index.cmx : terms.cmx orderings.cmx foUtils.cmx index.cmi
index.cmi : terms.cmi orderings.cmi
nCicBlob.cmo : terms.cmi foUtils.cmi nCicBlob.cmi
nCicBlob.cmx : terms.cmx foUtils.cmx nCicBlob.cmi
nCicProof.cmo : terms.cmi pp.cmi nCicBlob.cmi foSubst.cmi nCicProof.cmi
nCicProof.cmx : terms.cmx pp.cmx nCicBlob.cmx foSubst.cmx nCicProof.cmi
nCicProof.cmi : terms.cmi
-orderings.cmo : terms.cmi pp.cmi foSubst.cmi orderings.cmi
-orderings.cmx : terms.cmx pp.cmx foSubst.cmx orderings.cmi
+orderings.cmo : terms.cmi foSubst.cmi orderings.cmi
+orderings.cmx : terms.cmx foSubst.cmx orderings.cmi
orderings.cmi : terms.cmi
paramod.cmo : terms.cmi superposition.cmi pp.cmi orderings.cmi index.cmi \
- foUtils.cmi foUnif.cmi paramod.cmi
+ foUtils.cmi paramod.cmi
paramod.cmx : terms.cmx superposition.cmx pp.cmx orderings.cmx index.cmx \
- foUtils.cmx foUnif.cmx paramod.cmi
+ foUtils.cmx paramod.cmi
paramod.cmi : terms.cmi orderings.cmi
pp.cmo : terms.cmi pp.cmi
pp.cmx : terms.cmx pp.cmi
foUnif.cmi : terms.cmi orderings.cmi
foUtils.cmx : terms.cmx orderings.cmx foSubst.cmx foUtils.cmi
foUtils.cmi : terms.cmi orderings.cmi
-index.cmx : terms.cmx pp.cmx orderings.cmx foUtils.cmx foUnif.cmx index.cmi
+index.cmx : terms.cmx orderings.cmx foUtils.cmx index.cmi
index.cmi : terms.cmi orderings.cmi
nCicBlob.cmx : terms.cmx foUtils.cmx nCicBlob.cmi
nCicBlob.cmi : terms.cmi
nCicParamod.cmi : terms.cmi
nCicProof.cmx : terms.cmx pp.cmx nCicBlob.cmx foSubst.cmx nCicProof.cmi
nCicProof.cmi : terms.cmi
-orderings.cmx : terms.cmx pp.cmx foSubst.cmx orderings.cmi
+orderings.cmx : terms.cmx foSubst.cmx orderings.cmi
orderings.cmi : terms.cmi
paramod.cmx : terms.cmx superposition.cmx pp.cmx orderings.cmx index.cmx \
- foUtils.cmx foUnif.cmx paramod.cmi
+ foUtils.cmx paramod.cmi
paramod.cmi : terms.cmi orderings.cmi
pp.cmx : terms.cmx pp.cmi
pp.cmi : terms.cmi
Subst.build_subst i t subst
| Terms.Var i, t when occurs_check subst i t ->
raise (UnificationFailure (lazy "Inference.unification.unif"))
- | Terms.Var i, t when (List.mem i locked_vars) ->
+ | Terms.Var i, _t when (List.mem i locked_vars) ->
raise (UnificationFailure (lazy "Inference.unification.unif"))
| Terms.Var i, t -> Subst.build_subst i t subst
| t, Terms.Var i when occurs_check subst i t ->
raise (UnificationFailure (lazy "Inference.unification.unif"))
- | t, Terms.Var i when (List.mem i locked_vars) ->
+ | _t, Terms.Var i when (List.mem i locked_vars) ->
raise (UnificationFailure (lazy "Inference.unification.unif"))
| t, Terms.Var i -> Subst.build_subst i t subst
| Terms.Node l1, Terms.Node l2 -> (
in
match s, t with
| s, t when U.eq_foterm s t -> subst
- | Terms.Var i, Terms.Var j
+ | Terms.Var i, Terms.Var _j
when (not (List.exists (fun (_,k) -> k=t) subst)) ->
let subst = Subst.build_subst i t subst in
subst
module Index(B : Orderings.Blob) = struct
module U = FoUtils.Utils(B)
- module Unif = FoUnif.Founif(B)
- module Pp = Pp.Pp(B)
+ (*module Unif = FoUnif.Founif(B)*)
+ (*module Pp = Pp.Pp(B)*)
module ClauseOT =
struct
let path_string_of =
let rec aux arity = function
| Terms.Leaf a -> [Constant (a, arity)]
- | Terms.Var i -> (* assert (arity = 0); *) [Variable]
+ | Terms.Var _i -> (* assert (arity = 0); *) [Variable]
(* FIXME : should this be allowed or not ?
| Terms.Node (Terms.Var _::_) ->
assert false *)
op t l (Terms.Left2Right, c)
| (_,Terms.Equation (_,r,_,Terms.Lt),_,_) as c ->
op t r (Terms.Right2Left, c)
- | (_,Terms.Equation (l,r,_,Terms.Incomparable),vl,_) as c ->
+ | (_,Terms.Equation (l,r,_,Terms.Incomparable),_vl,_) as c ->
op (op t l (Terms.Left2Right, c))
r (Terms.Right2Left, c)
- | (_,Terms.Equation (l,r,_,Terms.Invertible),vl,_) as c ->
+ | (_,Terms.Equation (l,_r,_,Terms.Invertible),_vl,_) as c ->
op t l (Terms.Left2Right, c)
- | (_,Terms.Equation (_,r,_,Terms.Eq),_,_) -> assert false
+ | (_,Terms.Equation (_,_r,_,Terms.Eq),_,_) -> assert false
| (_,Terms.Predicate p,_,_) as c ->
op t p (Terms.Nodir, c)
;;
| NReference.Fix(_,_,h) -> h
| _ -> 0
-external old_hash_param :
- int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc";;
+ external old_hash_param :
+ int -> int -> 'a -> int = "caml_hash_univ_param" (*[@@noalloc]*);;
-let old_hash = old_hash_param 10 100;;
+ let old_hash = old_hash_param 10 100;;
let compare_refs (NReference.Ref (u1,r1)) (NReference.Ref (u2,r2)) =
let x = height_of_ref r2 - height_of_ref r1 in
NCicMetaSubst.saturate status ~delta:0 metasenv subst context
ty 0
in match hty with
- | NCic.Appl (eq ::tl) when eq = CB.eqP -> true
+ | NCic.Appl (eq ::_) when eq = CB.eqP -> true
| _ -> false
;;
NCic.Implicit `Term; eq; NCic.Implicit `Term];
;;
- let trans eq p =
+ let trans eq _p =
let u= NUri.uri_of_string "cic:/matita/ng/properties/relations/trans.con" in
let u = NReference.reference_of_spec u (NReference.Fix(0,1,3)) in
NCic.Appl[NCic.Const u; NCic.Implicit `Type; NCic.Implicit `Term;
List.fold_left
(fun (i,acc) t ->
i+1,
- let f = extract status amount vl f in
+ let _f = extract status amount vl f in
if i = n then
let imp = NCic.Implicit `Term in
NCic.Appl (dag::imp::imp::imp(* f *)::imp::imp::
let module Pp = Pp.Pp(NCicBlob)
in
let module Subst = FoSubst in
- let compose subst1 subst2 =
+ (*let compose subst1 subst2 =
let s1 = List.map (fun (x,t) -> (x, Subst.apply_subst subst2 t)) subst1 in
let s2 = List.filter (fun (m,_) -> not (List.mem_assoc m s1)) subst2
in s1 @ s2
- in
+ in*)
let position i l =
let rec aux = function
| [] -> assert false
- | (j,_) :: tl when i = j -> 1
+ | (j,_) :: _ when i = j -> 1
| _ :: tl -> 1 + aux tl
in
aux l
(* prerr_endline (if ongoal then "on goal" else "not on goal");
prerr_endline (Pp.pp_substitution subst); *)
(* let subst = if ongoal then res_subst else subst in *)
- let id, id1,(lit,vl,proof) =
+ let id, id1,(lit,vl,_proof) =
if ongoal then
let lit,vl,proof = get_literal id1 in
id1,id,(Subst.apply_subst res_subst lit,
if var1 = var2 then
let diffs = (w1 - w2) + diffs in
let r = Pervasives.compare w1 w2 in
- let lt = lt or (r < 0) in
- let gt = gt or (r > 0) in
+ let lt = lt || (r < 0) in
+ let gt = gt || (r > 0) in
if lt && gt then XINCOMPARABLE else
aux hdiff (lt, gt) diffs tl1 tl2
else if var1 < var2 then
let name = "nrkbo"
include B
- module Pp = Pp.Pp(B)
+ (*module Pp = Pp.Pp(B)*)
let eq_foterm = eq_foterm B.eq;;
in
match s, t with
| s, t when eq_foterm s t -> subst
- | Terms.Var i, Terms.Var j
+ | Terms.Var i, Terms.Var _j
when (not (List.exists (fun (_,k) -> k=t) subst)) ->
let subst = FoSubst.build_subst i t subst in
subst
let name = "kbo"
include B
- module Pp = Pp.Pp(B)
+ (*module Pp = Pp.Pp(B)*)
let eq_foterm = eq_foterm B.eq;;
let name = "lpo"
include B
- module Pp = Pp.Pp(B)
+ (*module Pp = Pp.Pp(B)*)
let eq_foterm = eq_foterm B.eq;;
(* $Id: orderings.ml 9869 2009-06-11 22:52:38Z denes $ *)
let print s = prerr_endline (Lazy.force s) ;;
-let noprint s = ();;
+let noprint _s = ();;
let debug = noprint;;
let monster = 100;;
module Paramod (B : Orderings.Blob) = struct
module Pp = Pp.Pp (B)
- module FU = FoUnif.Founif(B)
+ (*module FU = FoUnif.Founif(B)*)
module IDX = Index.Index(B)
module Sup = Superposition.Superposition(B)
module Utils = FoUtils.Utils(B)
debug (lazy("Last chance " ^ string_of_float
(Unix.gettimeofday())));
let actives_l, active_t = actives in
- let passive_t,wset,_ = passives in
+ let passive_t,_wset,_ = passives in
let _ = noprint
(lazy
("Actives :" ^ (String.concat ";\n"
let newstatus =
List.fold_left
(fun acc g ->
- let bag,maxvar,actives,passives,g_actives,g_passives = acc in
- let g_passives =
+ let _bag,_maxvar,_actives,_passives,_g_actives,g_passives = acc in
+ let _g_passives =
remove_passive_goal g_passives g in
let current = snd g in
let _ =
let l =
let rec traverse ongoal (accg,acce) i =
match Terms.get_from_bag i bag with
- | (id,_,_,Terms.Exact _),_,_ ->
+ | (_id,_,_,Terms.Exact _),_,_ ->
if ongoal then [i],acce else
if (List.mem i acce) then accg,acce else accg,acce@[i]
| (_,_,_,Terms.Step (_,i1,i2,_,_,_)),_,_ ->
;;
let demod s goal =
- let bag,maxvar,actives,passives,g_actives,g_passives = s in
- let (bag,maxvar), g = mk_goal (bag,maxvar) goal in
+ let bag,maxvar,actives,_passives,_g_actives,_g_passives = s in
+ let (bag,_maxvar), g = mk_goal (bag,maxvar) goal in
let bag, ((i,_,_,_) as g1) = Sup.demodulate bag g (snd actives) in
if g1 = g then GaveUp else compute_result bag i []
(*
let fast_eq_check s goal =
let (_,_,_,_,_,g_passives) as s = initialize_goal s goal in
- if is_passive_g_set_empty g_passives then Error "not an equation"
+ if is_passive_g_set_empty g_passives then (Error "not an equation" : szsontology)
else
try
goal_narrowing 0 2 None s
let nparamod ~useage ~max_steps ?timeout s goal =
let bag,maxvar,actives,passives,g_actives,g_passives
= initialize_goal s goal in
- if is_passive_g_set_empty g_passives then Error "not an equation"
+ if is_passive_g_set_empty g_passives then (Error "not an equation" : szsontology)
else
try given_clause ~useage ~noinfer:false
bag maxvar 0 0 max_steps timeout actives passives g_actives g_passives
Format.fprintf f "%d: Exact (" eq;
pp_foterm f t;
Format.fprintf f ")@;";
- | Terms.Step (rule,eq1,eq2,dir,pos,subst) ->
+ | Terms.Step (rule,eq1,eq2,dir,_pos,_subst) ->
Format.fprintf f "%d: %s("
eq (string_of_rule rule);
Format.fprintf f "|%d with %d dir %s))" eq1 eq2
else
dependencies op tl acc
else dependencies op tl acc
- | ((Terms.Node (Terms.Leaf op1::t) as x),y)
- | (y,(Terms.Node (Terms.Leaf op1::t) as x)) when leaf_count x > leaf_count y ->
+ | ((Terms.Node (Terms.Leaf op1::_t) as x),y)
+ | (y,(Terms.Node (Terms.Leaf op1::_t) as x)) when leaf_count x > leaf_count y ->
let rec term_leaves = function
| Terms.Node l -> List.fold_left (fun acc x -> acc @ (term_leaves x)) [] l
| Terms.Leaf x -> [x]
| Terms.Leaf _ as t ->
let bag,subst,t,id = f bag t pos ctx id in
assert (subst=[]); bag,t,id
- | Terms.Var i as t ->
+ | Terms.Var _ as t ->
let t= Subst.apply_subst subst t in
bag,t,id
| Terms.Node (hd::l) ->
(IDX.DT.retrieve_generalizations table) subterm
in
list_first
- (fun (dir, (id,lit,vl,_)) ->
+ (fun (dir, (id,lit,_vl,_)) ->
match lit with
| Terms.Predicate _ -> assert false
| Terms.Equation (l,r,_,o) ->
(IDX.DT.retrieve_generalizations table) subterm
in
list_first
- (fun (dir, ((id,lit,vl,_) as c)) ->
+ (fun (dir, ((id,lit,_vl,_) as c)) ->
debug (lazy("candidate: "
^ Pp.pp_unit_clause c));
match lit with
(bag,subst,newside,id)
;;
- let rec demodulate bag (id, literal, vl, pr) table =
+ let demodulate bag (id, literal, vl, _pr) table =
debug (lazy ("demodulate " ^ (string_of_int id)));
match literal with
| Terms.Predicate t -> (* assert false *)
let is_identity_goal = function
| _, Terms.Equation (_,_,_,Terms.Eq), _, _ -> Some []
- | _, Terms.Equation (l,r,_,_), vl, proof ->
+ | _, Terms.Equation (l,r,_,_), _vl, _proof ->
(try Some (Unif.unification (* vl *) [] l r)
with FoUnif.UnificationFailure _ -> None)
| _, Terms.Predicate _, _, _ -> assert false
let f b c =
let id, dir, l, r, vl =
match c with
- | (d, (id,Terms.Equation (l,r,ty,_),vl,_))-> id, d, l, r, vl
+ | (d, (id,Terms.Equation (l,r,_ty,_),vl,_))-> id, d, l, r, vl
|_ -> assert false
in
let reverse = (dir = Terms.Left2Right) = b in
let rec orphan_murder bag acc i =
match Terms.get_from_bag i bag with
| (_,_,_,Terms.Exact _),discarded,_ -> (discarded,acc)
- | (_,_,_,Terms.Step (_,i1,i2,_,_,_)),true,_ -> (true,acc)
+ | (_,_,_,Terms.Step (_,_i1,_i2,_,_,_)),true,_ -> (true,acc)
| (_,_,_,Terms.Step (_,i1,i2,_,_,_)),false,_ ->
if (List.mem i acc) then (false,acc)
else match orphan_murder bag acc i1 with
match simplify ctable maxvar bag c with
|bag,None -> (bag,alist,atable)
(* an active clause as been discarded *)
- |bag,Some c1 ->
+ |bag,Some _c1 ->
bag, c :: alist, IDX.index_unit_clause atable c)
(bag,[],IDX.DT.empty) alist
in
else match (is_identity_goal clause) with
| Some subst -> raise (Success (bag,maxvar,clause,subst))
| None ->
- let (id,lit,vl,_) = clause in
+ let (_id,lit,vl,_) = clause in
(* this optimization makes sense only if we demodulated, since in
that case the clause should have been turned into an identity *)
if (vl = [] && not(no_demod))
(* =================== inference ===================== *)
(* this is OK for both the sup_left and sup_right inference steps *)
- let superposition table varlist subterm pos context =
+ let superposition table _varlist subterm pos context =
let cands = IDX.DT.retrieve_unifiables table subterm in
HExtlib.filter_map
- (fun (dir, (id,lit,vl,_ (*as uc*))) ->
+ (fun (dir, (id,lit,_vl,_ (*as uc*))) ->
match lit with
| Terms.Predicate _ -> assert false
| Terms.Equation (l,r,_,o) ->
$(INTERFACE_FILES:%.mli=%.ml)
EXTRA_OBJECTS_TO_INSTALL =
EXTRA_OBJECTS_TO_CLEAN =
-%.cmo: OCAMLOPTIONS += -w Ae
-%.cmi: OCAMLOPTIONS += -w Ae
-%.cmx: OCAMLOPTIONS += -w Ae
include ../../Makefile.defs
include ../Makefile.common
(fun () -> incr maxmeta; !maxmeta),
(fun () -> !maxmeta),
(fun () -> pushedmetas := !maxmeta::!pushedmetas; maxmeta := 0),
- (fun () -> match !pushedmetas with [] -> assert false | hd::tl -> pushedmetas := tl)
+ (fun () -> match !pushedmetas with [] -> assert false | _hd::tl -> pushedmetas := tl)
;;
exception NotFound of [`NotInTheList | `NotWellTyped];;
raise (NotFound `NotWellTyped)
| TypeNotGood
| NCicTypeChecker.AssertFailure _
- | NCicReduction.AssertFailure _
- | NCicTypeChecker.TypeCheckerFailure _ ->
+ | NCicReduction.AssertFailure _ ->
raise (NotFound `NotWellTyped))
with NotFound reason ->
(* This is the case where we fail even first order unification. *)
(* $Id: cicUtil.ml 10153 2009-07-28 15:17:51Z sacerdot $ *)
-exception Meta_not_found of int
-exception Subst_not_found of int
+(*exception Meta_not_found of int
+exception Subst_not_found of int*)
(* syntactic_equality up to the *)
(* distinction between fake dependent products *)
pp (lazy "WWW: trying coercions -- inner check");
match infty, expty, t with
(* `XTSort|`XTProd|`XTInd + Match not implemented *)
- | _,`XTSome expty, C.Match (Ref.Ref (_,Ref.Ind (_,tyno,leftno)) as r,outty,m,pl) ->
+ | _,`XTSome expty, C.Match (Ref.Ref (_,Ref.Ind (_,_tyno,_leftno)) as r,outty,m,pl) ->
(*{{{*) pp (lazy "CASE");
(* {{{ helper functions *)
let get_cl_and_left_p refit outty =
match refit with
- | Ref.Ref (uri, Ref.Ind (_,tyno,leftno)) ->
+ | Ref.Ref (_uri, Ref.Ind (_,tyno,_leftno)) ->
let _, leftno, itl, _, _ = NCicEnvironment.get_checked_indtys status r in
let _, _, ty, cl = List.nth itl tyno in
- let constructorsno = List.length cl in
+ (*let constructorsno = List.length cl in*)
let count_pis t =
let rec aux ctx t =
match NCicReduction.whd status ~subst ~delta:max_int ctx t with
(NCicSubstitution.lift status 1 mty) (NCicSubstitution.lift status 1 m) tgt
in
C.Prod (name, src, t), k
- | C.Const (Ref.Ref (_,Ref.Ind (_,_,leftno)) as r) ->
+ | C.Const (Ref.Ref (_,Ref.Ind (_,_,_leftno)) as r) ->
let k =
let k = C.Const(Ref.mk_constructor i r) in
NCicUntrusted.mk_appl k par
(NCicReduction.head_beta_reduce status ~delta:max_int
(NCicUntrusted.mk_appl outty [k])))),[mty,m,mty,k]
| C.Appl (C.Const (Ref.Ref (_,Ref.Ind (_,_,leftno)) as r)::pl) ->
- let left_p,right_p = HExtlib.split_nth leftno pl in
- let has_rights = right_p <> [] in
+ let left_p,_right_p = HExtlib.split_nth leftno pl in
+ (*let has_rights = right_p <> [] in*)
let k =
let k = C.Const(Ref.mk_constructor i r) in
NCicUntrusted.mk_appl k (left_p@par)
in (* }}} end helper functions *)
(* constructors types with left params already instantiated *)
let outty = NCicUntrusted.apply_subst status subst context outty in
- let cl, left_p, leftno,rno =
+ let cl, _left_p, leftno,rno =
get_cl_and_left_p r outty
in
let right_p, mty =
pp (lazy ("LAM: coerced = " ^ status#ppterm ~metasenv ~subst ~context coerced));
metasenv, subst, coerced, expty (*}}}*)
| _ -> raise exc
- with exc2 ->
+ with _ ->
let expty =
match expty with
`XTSome expty -> expty
let rec aux context (metasenv,subst) = function
| C.Meta _ -> metasenv, subst
| C.Implicit _ -> metasenv, subst
- | C.Appl (C.Rel i :: args) as t
+ | C.Appl (C.Rel i :: args)
when i > List.length context - len ->
let lefts, _ = HExtlib.split_nth leftno args in
let ctxlen = List.length context in
end
;;
-let pp_hint t p =
- let context, t =
+let pp_hint _t _p =
+(* let context, t =
let rec aux ctx = function
| NCic.Prod (name, ty, rest) -> aux ((name, NCic.Decl ty) :: ctx) rest
| t -> ctx, t
in
let buff = Buffer.create 100 in
let fmt = Format.formatter_of_buffer buff in
-(*
F.fprintf "@[<hov>"
F.fprintf "@[<hov>"
(* pp_ctx [] context *)
(HintSet.elements dataset);
);
List.iter (fun x, l -> Pp.node x ~attrs:["label",l] fmt) !nodes;
- List.iter (fun x, y, l, _, _ ->
+ List.iter (fun x, y, _l, _, _ ->
Pp.raw (Printf.sprintf "%s -- %s [ label=\"%s\" ];\n" x y "?") fmt)
!edges;
edges := List.sort (fun (_,_,_,p1,_) (_,_,_,p2,_) -> p1 - p2) !edges;
- List.iter (fun x, y, _, p, l -> pp_hint l p) !edges;
+ List.iter (fun _x, _y, _, p, l -> pp_hint l p) !edges;
;;
continuationals.cmo : continuationals.cmi
continuationals.cmx : continuationals.cmi
continuationals.cmi :
+declarative.cmo : nnAuto.cmi nTactics.cmi nTacStatus.cmi nCicElim.cmi \
+ continuationals.cmi declarative.cmi
+declarative.cmx : nnAuto.cmx nTactics.cmx nTacStatus.cmx nCicElim.cmx \
+ continuationals.cmx declarative.cmi
+declarative.cmi : nnAuto.cmi nTacStatus.cmi
nCicElim.cmo : nCicElim.cmi
nCicElim.cmx : nCicElim.cmi
nCicElim.cmi :
continuationals.cmx : continuationals.cmi
continuationals.cmi :
+declarative.cmx : nnAuto.cmx nTactics.cmx nTacStatus.cmx nCicElim.cmx \
+ continuationals.cmx declarative.cmi
+declarative.cmi : nnAuto.cmi nTacStatus.cmi
nCicElim.cmx : nCicElim.cmi
nCicElim.cmi :
nCicTacReduction.cmx : nCicTacReduction.cmi
nCicElim.mli \
nTactics.mli \
nnAuto.mli \
+ declarative.mli \
nDestructTac.mli \
nInversion.mli
type goal = int
+type parameters = (string * string) list
+
module Stack =
struct
type switch = Open of goal | Closed of goal
type locator = int * switch
type tag = [ `BranchTag | `FocusTag | `NoTag ]
- type entry = locator list * locator list * locator list * tag
+ type entry = locator list * locator list * locator list * tag * parameters
type t = entry list
- let empty = [ [], [], [], `NoTag ]
+ let empty = [ [], [], [], `NoTag , []]
let fold ~env ~cont ~todo init stack =
let rec aux acc depth =
function
| [] -> acc
- | (locs, todos, conts, tag) :: tl ->
+ | (locs, todos, conts, tag, _p) :: tl ->
let acc = List.fold_left (fun acc -> env acc depth tag) acc locs in
let acc = List.fold_left (fun acc -> cont acc depth tag) acc conts in
let acc = List.fold_left (fun acc -> todo acc depth tag) acc todos in
let map ~env ~cont ~todo =
let depth = ref ~-1 in
List.map
- (fun (s, t, c, tag) ->
+ (fun (s, t, c, tag, p) ->
incr depth;
let d = !depth in
- env d tag s, todo d tag t, cont d tag c, tag)
+ env d tag s, todo d tag t, cont d tag c, tag, p)
let is_open = function _, Open _ -> true | _ -> false
let close = function n, Open g -> n, Closed g | l -> l
let rec find_goal =
function
| [] -> raise (Failure "Continuationals.find_goal")
- | (l :: _, _ , _ , _) :: _ -> goal_of_loc l
- | ( _ , _ , l :: _, _) :: _ -> goal_of_loc l
- | ( _ , l :: _, _ , _) :: _ -> goal_of_loc l
+ | (l :: _, _ , _ , _, _) :: _ -> goal_of_loc l
+ | ( _ , _ , l :: _, _, _) :: _ -> goal_of_loc l
+ | ( _ , l :: _, _ , _, _) :: _ -> goal_of_loc l
| _ :: tl -> find_goal tl
let is_empty =
function
| [] -> assert false
- | [ [], [], [], `NoTag ] -> true
+ | [ [], [], [], `NoTag , _] -> true
| _ -> false
let of_nmetasenv metasenv =
let goals = List.map (fun (g, _) -> g) metasenv in
- [ zero_pos goals, [], [], `NoTag ]
+ [ zero_pos goals, [], [], `NoTag , []]
let head_switches =
function
- | (locs, _, _, _) :: _ -> List.map switch_of_loc locs
+ | (locs, _, _, _, _) :: _ -> List.map switch_of_loc locs
| [] -> assert false
let head_goals =
function
- | (locs, _, _, _) :: _ -> List.map goal_of_loc locs
+ | (locs, _, _, _, _) :: _ -> List.map goal_of_loc locs
| [] -> assert false
let head_tag =
function
- | (_, _, _, tag) :: _ -> tag
+ | (_, _, _, tag, _) :: _ -> tag
| [] -> assert false
let shift_goals =
function
- | _ :: (locs, _, _, _) :: _ -> List.map goal_of_loc locs
+ | _ :: (locs, _, _, _, _) :: _ -> List.map goal_of_loc locs
| [] -> assert false
| _ -> []
let pp_loc (i, s) = string_of_int i ^ pp_switch s in
let pp_env env = sprintf "[%s]" (String.concat ";" (List.map pp_loc env)) in
let pp_tag = function `BranchTag -> "B" | `FocusTag -> "F" | `NoTag -> "N" in
- let pp_stack_entry (env, todo, cont, tag) =
- sprintf "(%s, %s, %s, %s)" (pp_env env) (pp_env todo) (pp_env cont)
- (pp_tag tag)
+ let pp_par = function [] -> "" | _ as l -> List.fold_left (fun acc (k,v) -> acc ^ "K: " ^ k ^ " V: " ^ v ^ "; ") "" l in
+ let pp_stack_entry (env, todo, cont, tag, parameters) =
+ sprintf "(%s, %s, %s, %s, %s)" (pp_env env) (pp_env todo) (pp_env cont)
+ (pp_tag tag) (pp_par parameters)
in
String.concat " :: " (List.map pp_stack_entry stack)
end
let ostatus, stack =
match cmd, stack with
| _, [] -> assert false
- | Tactical tac, (g, t, k, tag) :: s ->
+ | Tactical tac, (g, t, k, tag, p) :: s ->
(* COMMENTED OUT TO ALLOW PARAMODULATION TO DO A
* auto paramodulation.try assumption.
* EVEN IF NO GOALS ARE LEFT OPEN BY AUTO.
debug_print (lazy ("closed: "
^ String.concat " " (List.map string_of_int gcn)));
let stack =
- (zero_pos gon, t @~- gcn, k @~- gcn, tag) :: deep_close gcn s
+ (zero_pos gon, t @~- gcn, k @~- gcn, tag, p) :: deep_close gcn s
in
sn, stack
- | Dot, ([], _, [], _) :: _ ->
+ | Dot, ([], _, [], _, _) :: _ ->
(* backward compatibility: do-nothing-dot *)
new_stack stack
- | Dot, (g, t, k, tag) :: s ->
+ | Dot, (g, t, k, tag, p) :: s ->
(match filter_open g, k with
- | loc :: loc_tl, _ -> new_stack (([ loc ], t, loc_tl @+ k, tag) :: s)
+ | loc :: loc_tl, _ -> new_stack (([ loc ], t, loc_tl @+ k, tag, p) :: s)
| [], loc :: k ->
assert (is_open loc);
- new_stack (([ loc ], t, k, tag) :: s)
+ new_stack (([ loc ], t, k, tag, p) :: s)
| _ -> fail (lazy "can't use \".\" here"))
| Semicolon, _ -> new_stack stack
- | Branch, (g, t, k, tag) :: s ->
+ | Branch, (g, t, k, tag, p) :: s ->
(match init_pos g with
| [] | [ _ ] -> fail (lazy "too few goals to branch");
| loc :: loc_tl ->
new_stack
- (([ loc ], [], [], `BranchTag) :: (loc_tl, t, k, tag) :: s))
- | Shift, (g, t, k, `BranchTag) :: (g', t', k', tag) :: s ->
+ (([ loc ], [], [], `BranchTag, []) :: (loc_tl, t, k, tag,p) :: s))
+ | Shift, (g, t, k, `BranchTag, p) :: (g', t', k', tag, p') :: s ->
(match g' with
| [] -> fail (lazy "no more goals to shift")
| loc :: loc_tl ->
new_stack
- (([ loc ], t @+ filter_open g @+ k, [],`BranchTag)
- :: (loc_tl, t', k', tag) :: s))
+ (([ loc ], t @+ filter_open g @+ k, [],`BranchTag, p)
+ :: (loc_tl, t', k', tag, p') :: s))
| Shift, _ -> fail (lazy "can't shift goals here")
- | Pos i_s, ([ loc ], t, [],`BranchTag) :: (g', t', k', tag) :: s
+ | Pos i_s, ([ loc ], t, [],`BranchTag, p) :: (g', t', k', tag, p') :: s
when is_fresh loc ->
let l_js = List.filter (fun (i, _) -> List.mem i i_s) ([loc] @+ g') in
new_stack
- ((l_js, t , [],`BranchTag)
- :: (([ loc ] @+ g') @- l_js, t', k', tag) :: s)
+ ((l_js, t , [],`BranchTag, p)
+ :: (([ loc ] @+ g') @- l_js, t', k', tag, p') :: s)
| Pos _, _ -> fail (lazy "can't use relative positioning here")
- | Wildcard, ([ loc ] , t, [], `BranchTag) :: (g', t', k', tag) :: s
+ | Wildcard, ([ loc ] , t, [], `BranchTag, p) :: (g', t', k', tag, p') :: s
when is_fresh loc ->
new_stack
- (([loc] @+ g', t, [], `BranchTag)
- :: ([], t', k', tag) :: s)
+ (([loc] @+ g', t, [], `BranchTag, p)
+ :: ([], t', k', tag, p') :: s)
| Wildcard, _ -> fail (lazy "can't use wildcard here")
- | Merge, (g, t, k,`BranchTag) :: (g', t', k', tag) :: s ->
- new_stack ((t @+ filter_open g @+ g' @+ k, t', k', tag) :: s)
+ | Merge, (g, t, k,`BranchTag,_) :: (g', t', k', tag,p') :: s ->
+ new_stack ((t @+ filter_open g @+ g' @+ k, t', k', tag, p') :: s)
| Merge, _ -> fail (lazy "can't merge goals here")
| Focus [], _ -> assert false
| Focus gs, s ->
if not (List.exists (fun l -> goal_of_loc l = g) stack_locs) then
fail (lazy (sprintf "goal %d not found (or closed)" g)))
gs;
- new_stack ((zero_pos gs, [], [], `FocusTag) :: deep_close gs s)
- | Unfocus, ([], [], [], `FocusTag) :: s -> new_stack s
+ new_stack ((zero_pos gs, [], [], `FocusTag, []) :: deep_close gs s)
+ | Unfocus, ([], [], [], `FocusTag, _) :: s -> new_stack s
| Unfocus, _ -> fail (lazy "can't unfocus, some goals are still open")
in
debug_print (lazy (sprintf "EVAL CONT %s -> %s" (pp_t cmd) (pp stack)));
(** {2 Goal stack} *)
+(* Key value pairs *)
+type parameters = (string * string) list
+
module Stack:
sig
type switch = Open of goal | Closed of goal
type locator = int * switch
type tag = [ `BranchTag | `FocusTag | `NoTag ]
- type entry = locator list * locator list * locator list * tag
+ type entry = locator list * locator list * locator list * tag * parameters
type t = entry list
val empty: t
--- /dev/null
+(* Copyright (C) 2019, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+*)
+
+open Continuationals.Stack
+module Ast = NotationPt
+open NTactics
+open NTacStatus
+
+type just = [ `Term of NTacStatus.tactic_term | `Auto of NnAuto.auto_params ]
+
+let mk_just status goal =
+ function
+ `Auto (l,params) -> NnAuto.auto_lowtac ~params:(l,params) status goal
+ | `Term t -> apply_tac t
+
+exception NotAProduct
+exception FirstTypeWrong
+exception NotEquivalentTypes
+
+let extract_first_goal_from_status status =
+ let s = status#stack in
+ match s with
+ | [] -> fail (lazy "There's nothing to prove")
+ | (g1, _, _k, _tag1, _) :: _tl ->
+ let goals = filter_open g1 in
+ match goals with
+ [] -> fail (lazy "No goals under focus")
+ | loc::_tl ->
+ let goal = goal_of_loc (loc) in
+ goal ;;
+
+let extract_conclusion_type status goal =
+ let gty = get_goalty status goal in
+ let ctx = ctx_of gty in
+ term_of_cic_term status gty ctx
+;;
+
+let alpha_eq_tacterm_kerterm ty t status goal =
+ let gty = get_goalty status goal in
+ let ctx = ctx_of gty in
+ let status,cicterm = disambiguate status ctx ty `XTNone (*(`XTSome (mk_cic_term ctx t))*) in
+ let (_,_,metasenv,subst,_) = status#obj in
+ let status,ty = term_of_cic_term status cicterm ctx in
+ if NCicReduction.alpha_eq status metasenv subst ctx t ty then
+ true
+ else
+ false
+;;
+
+let are_convertible ty1 ty2 status goal =
+ let gty = get_goalty status goal in
+ let ctx = ctx_of gty in
+ let status,cicterm1 = disambiguate status ctx ty1 `XTNone in
+ let status,cicterm2 = disambiguate status ctx ty2 `XTNone in
+ NTacStatus.are_convertible status ctx cicterm1 cicterm2
+
+let clear_volatile_params_tac status =
+ match status#stack with
+ [] -> fail (lazy "Empty stack")
+ | (g,t,k,tag,p)::tl ->
+ let rec remove_volatile = function
+ [] -> []
+ | (k,_v as hd')::tl' ->
+ let re = Str.regexp "volatile_.*" in
+ if Str.string_match re k 0 then
+ remove_volatile tl'
+ else
+ hd'::(remove_volatile tl')
+ in
+ let newp = remove_volatile p in
+ status#set_stack ((g,t,k,tag,newp)::tl)
+;;
+
+let add_parameter_tac key value status =
+ match status#stack with
+ [] -> status
+ | (g,t,k,tag,p) :: tl -> status#set_stack ((g,t,k,tag,(key,value)::p)::tl)
+;;
+
+
+(* LCF-like tactic that checks whether the conclusion of the sequent of the given goal is a product, checks that
+ the type of the conclusion's bound variable is the same as t1 and then uses an exact_tac with
+ \lambda id: t1. ?. If a t2 is given it checks that t1 ~_{\beta} t2 and uses and exact_tac with \lambda id: t2. ?
+*)
+let lambda_abstract_tac id t1 status goal =
+ match extract_conclusion_type status goal with
+ | status,NCic.Prod (_,t,_) ->
+ if alpha_eq_tacterm_kerterm t1 t status goal then
+ let (_,_,t1) = t1 in
+ block_tac [exact_tac ("",0,(Ast.Binder (`Lambda,(Ast.Ident (id,None),Some t1),Ast.Implicit
+ `JustOne))); clear_volatile_params_tac;
+ add_parameter_tac "volatile_newhypo" id] status
+ else
+ raise FirstTypeWrong
+ | _ -> raise NotAProduct
+
+let assume name ty status =
+ let goal = extract_first_goal_from_status status in
+ try lambda_abstract_tac name ty status goal
+ with
+ | NotAProduct -> fail (lazy "You can't assume without an universal quantification")
+ | FirstTypeWrong -> fail (lazy "The assumed type is wrong")
+ | NotEquivalentTypes -> fail (lazy "The two given types are not equivalent")
+;;
+
+let suppose t1 id status =
+ let goal = extract_first_goal_from_status status in
+ try lambda_abstract_tac id t1 status goal
+ with
+ | NotAProduct -> fail (lazy "You can't suppose without a logical implication")
+ | FirstTypeWrong -> fail (lazy "The supposed proposition is different from the premise")
+ | NotEquivalentTypes -> fail (lazy "The two given propositions are not equivalent")
+;;
+
+let assert_tac t1 t2 status goal continuation =
+ let status,t = extract_conclusion_type status goal in
+ if alpha_eq_tacterm_kerterm t1 t status goal then
+ match t2 with
+ | None -> continuation
+ | Some t2 ->
+ let _status,res = are_convertible t1 t2 status goal in
+ if res then continuation
+ else
+ raise NotEquivalentTypes
+ else
+ raise FirstTypeWrong
+
+let branch_dot_tac status =
+ match status#stack with
+ ([],t,k,tag,p) :: tl ->
+ if List.length t > 0 then
+ status#set_stack (([List.hd t],List.tl t,k,tag,p)::tl)
+ else
+ status
+ | _ -> status
+;;
+
+let status_parameter key status =
+ match status#stack with
+ [] -> ""
+ | (_g,_t,_k,_tag,p)::_ -> try List.assoc key p with _ -> ""
+;;
+
+let beta_rewriting_step t status =
+ let ctx = status_parameter "volatile_context" status in
+ if ctx <> "beta_rewrite" then
+ (
+ let newhypo = status_parameter "volatile_newhypo" status in
+ if newhypo = "" then
+ fail (lazy "Invalid use of 'that is equivalent to'")
+ else
+ change_tac ~where:("",0,(None,[newhypo,Ast.UserInput],None)) ~with_what:t status
+ )
+ else
+ change_tac ~where:("",0,(None,[],Some
+ Ast.UserInput)) ~with_what:t status
+;;
+
+let done_continuation status =
+ let rec continuation l =
+ match l with
+ [] -> []
+ | (_,t,_,tag,p)::tl ->
+ if tag = `BranchTag then
+ if List.length t > 0 then
+ let continue =
+ let ctx =
+ try List.assoc "context" p
+ with Not_found -> ""
+ in
+ ctx <> "induction" && ctx <> "cases"
+ in
+ if continue then [clear_volatile_params_tac;branch_dot_tac] else
+ [clear_volatile_params_tac]
+ else
+ [merge_tac] @ (continuation tl)
+ else
+ []
+ in
+ continuation status#stack
+;;
+
+let bydone just status =
+ let goal = extract_first_goal_from_status status in
+ let continuation = done_continuation status in
+ let l = [mk_just status goal just] @ continuation in
+ block_tac l status
+;;
+
+let push_goals_tac status =
+ match status#stack with
+ [] -> fail (lazy "Error pushing goals")
+ | (g1,t1,k1,tag1,p1) :: (g2,t2,k2,tag2,p2) :: tl ->
+ if List.length g2 > 0 then
+ status#set_stack ((g1,t1 @+ g2,k1,tag1,p1) :: ([],t2,k2,tag2,p2) :: tl)
+ else status (* Nothing to push *)
+ | _ -> status
+
+let we_need_to_prove t id status =
+ let goal = extract_first_goal_from_status status in
+ match id with
+ | None ->
+ (
+ try assert_tac t None status goal (add_parameter_tac "volatile_context" "beta_rewrite" status)
+ with
+ | FirstTypeWrong -> fail (lazy "The given proposition is not the same as the conclusion")
+ )
+ | Some id ->
+ (
+ block_tac [clear_volatile_params_tac; cut_tac t; branch_tac; shift_tac; intro_tac id; merge_tac; branch_tac;
+ push_goals_tac; add_parameter_tac "volatile_context" "beta_rewrite"
+ ] status
+ )
+;;
+
+let by_just_we_proved just ty id status =
+ let goal = extract_first_goal_from_status status in
+ let just = mk_just status goal just in
+ match id with
+ | None ->
+ assert_tac ty None status goal (block_tac [clear_volatile_params_tac; add_parameter_tac
+ "volatile_context" "beta_rewrite"] status)
+ | Some id ->
+ (
+ block_tac [cut_tac ty; branch_tac; just; shift_tac; intro_tac id; merge_tac;
+ clear_volatile_params_tac; add_parameter_tac "volatile_newhypo" id] status
+ )
+;;
+
+let existselim just id1 t1 t2 id2 status =
+ let goal = extract_first_goal_from_status status in
+ let (_,_,t1) = t1 in
+ let (_,_,t2) = t2 in
+ let just = mk_just status goal just in
+ (block_tac [
+ cut_tac ("",0,(Ast.Appl [Ast.Ident ("ex",None); t1; Ast.Binder (`Lambda,(Ast.Ident
+ (id1,None), Some t1),t2)]));
+ branch_tac ~force:false;
+ just;
+ shift_tac;
+ case1_tac "_";
+ intros_tac ~names_ref:(ref []) [id1;id2];
+ merge_tac;
+ clear_volatile_params_tac
+ ]) status
+;;
+
+let andelim just t1 id1 t2 id2 status =
+ let goal = extract_first_goal_from_status status in
+ let (_,_,t1) = t1 in
+ let (_,_,t2) = t2 in
+ let just = mk_just status goal just in
+ (block_tac [
+ cut_tac ("",0,(Ast.Appl [Ast.Ident ("And",None); t1 ; t2]));
+ branch_tac ~force:false;
+ just;
+ shift_tac;
+ case1_tac "_";
+ intros_tac ~names_ref:(ref []) [id1;id2];
+ merge_tac;
+ clear_volatile_params_tac
+ ]) status
+;;
+
+let type_of_tactic_term status ctx t =
+ let status,cicterm = disambiguate status ctx t `XTNone in
+ let (_,cicty) = typeof status ctx cicterm in
+ cicty
+
+let swap_first_two_goals_tac status =
+ let gstatus =
+ match status#stack with
+ | [] -> assert false
+ | (g,t,k,tag,p) :: s ->
+ match g with
+ | (loc1) :: (loc2) :: tl ->
+ ([loc2;loc1] @+ tl,t,k,tag,p) :: s
+ | _ -> assert false
+ in
+ status#set_stack gstatus
+
+let thesisbecomes t1 = we_need_to_prove t1 None
+;;
+
+let obtain id t1 status =
+ let goal = extract_first_goal_from_status status in
+ let cicgty = get_goalty status goal in
+ let ctx = ctx_of cicgty in
+ let cicty = type_of_tactic_term status ctx t1 in
+ let _,ty = term_of_cic_term status cicty ctx in
+ let (_,_,t1) = t1 in
+ block_tac [ cut_tac ("",0,(Ast.Appl [Ast.Ident ("eq",None); Ast.NCic ty; t1; Ast.Implicit
+ `JustOne]));
+ swap_first_two_goals_tac;
+ branch_tac; shift_tac; shift_tac; intro_tac id; merge_tac; branch_tac; push_goals_tac;
+ add_parameter_tac "volatile_context" "rewrite"
+ ]
+ status
+;;
+
+let conclude t1 status =
+ let goal = extract_first_goal_from_status status in
+ let cicgty = get_goalty status goal in
+ let ctx = ctx_of cicgty in
+ let _,gty = term_of_cic_term status cicgty ctx in
+ match gty with
+ (* The first term of this Appl should probably be "eq" *)
+ NCic.Appl [_;_;plhs;_] ->
+ if alpha_eq_tacterm_kerterm t1 plhs status goal then
+ add_parameter_tac "volatile_context" "rewrite" status
+ else
+ fail (lazy "The given conclusion is different from the left-hand side of the current conclusion")
+ | _ -> fail (lazy "Your conclusion needs to be an equality")
+;;
+
+let rewritingstep rhs just last_step status =
+ let ctx = status_parameter "volatile_context" status in
+ if ctx = "rewrite" then
+ (
+ let goal = extract_first_goal_from_status status in
+ let cicgty = get_goalty status goal in
+ let ctx = ctx_of cicgty in
+ let _,gty = term_of_cic_term status cicgty ctx in
+ let cicty = type_of_tactic_term status ctx rhs in
+ let _,ty = term_of_cic_term status cicty ctx in
+ let just' = (* Extraction of the ""justification"" from the ad hoc justification *)
+ match just with
+ `Auto (univ, params) ->
+ let params =
+ if not (List.mem_assoc "timeout" params) then
+ ("timeout","3")::params
+ else params
+ in
+ let params' =
+ if not (List.mem_assoc "paramodulation" params) then
+ ("paramodulation","1")::params
+ else params
+ in
+ if params = params' then NnAuto.auto_lowtac ~params:(univ, params) status goal
+ else
+ first_tac [NnAuto.auto_lowtac ~params:(univ, params) status goal; NnAuto.auto_lowtac
+ ~params:(univ, params') status goal]
+ | `Term just -> apply_tac just
+ | `SolveWith term -> NnAuto.demod_tac ~params:(Some [term], ["all","1";"steps","1"; "use_ctx","false"])
+ | `Proof -> id_tac
+ in
+ let plhs,prhs,prepare =
+ match gty with (* Extracting the lhs and rhs of the previous equality *)
+ NCic.Appl [_;_;plhs;prhs] -> plhs,prhs,(fun continuation -> continuation status)
+ | _ -> fail (lazy "You are not building an equaility chain")
+ in
+ let continuation =
+ if last_step then
+ let todo = [just'] @ (done_continuation status) in
+ block_tac todo
+ else
+ let (_,_,rhs) = rhs in
+ block_tac [apply_tac ("",0,Ast.Appl [Ast.Ident ("trans_eq",None); Ast.NCic ty; Ast.NCic plhs;
+ rhs; Ast.NCic prhs]); branch_tac; just'; merge_tac]
+ in
+ prepare continuation
+ )
+ else
+ fail (lazy "You are not building an equality chain")
+;;
+
+let rec pp_metasenv_names (metasenv:NCic.metasenv) =
+ match metasenv with
+ [] -> ""
+ | hd :: tl ->
+ let n,conj = hd in
+ let meta_attrs,_,_ = conj in
+ let rec find_name_aux meta_attrs = match meta_attrs with
+ [] -> "Anonymous"
+ | hd :: tl -> match hd with
+ `Name n -> n
+ | _ -> find_name_aux tl
+ in
+ let name = find_name_aux meta_attrs
+ in
+ "[Goal: " ^ (string_of_int n) ^ ", Name: " ^ name ^ "]; " ^ (pp_metasenv_names tl)
+;;
+
+let print_goals_names_tac s (status:#NTacStatus.tac_status) =
+ let (_,_,metasenv,_,_) = status#obj in
+ prerr_endline (s ^" -> Metasenv: " ^ (pp_metasenv_names metasenv)); status
+
+(* Useful as it does not change the order in the list *)
+let rec list_change_assoc k v = function
+ [] -> []
+ | (k',_v' as hd) :: tl -> if k' = k then (k',v) :: tl else hd :: (list_change_assoc k v tl)
+;;
+
+let add_names_to_goals_tac (cl:NCic.constructor list ref) (status:#NTacStatus.tac_status) =
+ let add_name_to_goal name goal metasenv =
+ let (mattrs,ctx,t) = try List.assoc goal metasenv with _ -> assert false in
+ let mattrs = (`Name name) :: (List.filter (function `Name _ -> false | _ -> true) mattrs) in
+ let newconj = (mattrs,ctx,t) in
+ list_change_assoc goal newconj metasenv
+ in
+ let new_goals =
+ (* It's important that this tactic is called before branching and right after the creation of
+ * the new goals, when they are still under focus *)
+ match status#stack with
+ [] -> fail (lazy "Can not add names to an empty stack")
+ | (g,_,_,_,_) :: _tl ->
+ let rec sublist n = function
+ [] -> []
+ | hd :: tl -> if n = 0 then [] else hd :: (sublist (n-1) tl)
+ in
+ List.map (fun _,sw -> goal_of_switch sw) (sublist (List.length !cl) g)
+ in
+ let rec add_names_to_goals g cl metasenv =
+ match g,cl with
+ [],[] -> metasenv
+ | hd::tl, (_,consname,_)::tl' ->
+ add_names_to_goals tl tl' (add_name_to_goal consname hd metasenv)
+ | _,_ -> fail (lazy "There are less goals than constructors")
+ in
+ let (olduri,oldint,metasenv,oldsubst,oldkind) = status#obj in
+ let newmetasenv = add_names_to_goals new_goals !cl metasenv
+ in status#set_obj(olduri,oldint,newmetasenv,oldsubst,oldkind)
+;;
+(*
+ let (olduri,oldint,metasenv,oldsubst,oldkind) = status#obj in
+ let remove_name_from_metaattrs =
+ List.filter (function `Name _ -> false | _ -> true) in
+ let rec add_names_to_metasenv cl metasenv =
+ match cl,metasenv with
+ [],_ -> metasenv
+ | hd :: tl, mhd :: mtl ->
+ let _,consname,_ = hd in
+ let gnum,conj = mhd in
+ let mattrs,ctx,t = conj in
+ let mattrs = [`Name consname] @ (remove_name_from_metaattrs mattrs)
+ in
+ let newconj = mattrs,ctx,t in
+ let newmeta = gnum,newconj in
+ newmeta :: (add_names_to_metasenv tl mtl)
+ | _,[] -> assert false
+ in
+ let newmetasenv = add_names_to_metasenv !cl metasenv in
+ status#set_obj (olduri,oldint,newmetasenv,oldsubst,oldkind)
+*)
+
+let unfocus_branch_tac status =
+ match status#stack with
+ [] -> status
+ | (g,t,k,tag,p) :: tl -> status#set_stack (([],g @+ t,k,tag,p)::tl)
+;;
+
+let we_proceed_by_induction_on t1 t2 status =
+ let goal = extract_first_goal_from_status status in
+ let txt,len,t1 = t1 in
+ let t1 = txt, len, Ast.Appl [t1; Ast.Implicit `Vector] in
+ let indtyinfo = ref None in
+ let sort = ref (NCic.Rel 1) in
+ let cl = ref [] in (* this is a ref on purpose, as the block of code after sort_of_goal_tac in
+ block_tac acts as a block of asynchronous code, in which cl gets modified with the info retrieved
+ with analize_indty_tac, and later used to label each new goal with a costructor name. Using a
+ plain list this doesn't seem to work, as add_names_to_goals_tac would immediately act on an empty
+ list, instead of acting on the list of constructors *)
+ try
+ assert_tac t2 None status goal (block_tac [
+ analyze_indty_tac ~what:t1 indtyinfo;
+ sort_of_goal_tac sort;
+ (fun status ->
+ let ity = HExtlib.unopt !indtyinfo in
+ let NReference.Ref (uri, _) = ref_of_indtyinfo ity in
+ let name =
+ NUri.name_of_uri uri ^ "_" ^
+ snd (NCicElim.ast_of_sort
+ (match !sort with NCic.Sort x -> x | _ -> assert false))
+ in
+ let eliminator =
+ let l = [Ast.Ident (name,None)] in
+ (* Generating an implicit for each argument of the inductive type, plus one the
+ * predicate, plus an implicit for each constructor of the inductive type *)
+ let l = l @ HExtlib.mk_list (Ast.Implicit `JustOne) (ity.leftno+1+ity.consno) in
+ let _,_,t1 = t1 in
+ let l = l @ [t1] in
+ Ast.Appl l
+ in
+ cl := ity.cl;
+ exact_tac ("",0,eliminator) status);
+ add_names_to_goals_tac cl;
+ branch_tac;
+ push_goals_tac;
+ unfocus_branch_tac;
+ add_parameter_tac "context" "induction"
+ ] status)
+ with
+ | FirstTypeWrong -> fail (lazy "What you want to prove is different from the conclusion")
+;;
+
+let we_proceed_by_cases_on ((txt,len,ast1) as t1) t2 status =
+ let goal = extract_first_goal_from_status status in
+ let npt1 = txt, len, Ast.Appl [ast1; Ast.Implicit `Vector] in
+ let indtyinfo = ref None in
+ let cl = ref [] in
+ try
+ assert_tac t2 None status goal (block_tac [
+ analyze_indty_tac ~what:npt1 indtyinfo;
+ cases_tac ~what:t1 ~where:("",0,(None,[],Some
+ Ast.UserInput));
+ (
+ fun status ->
+ let ity = HExtlib.unopt !indtyinfo in
+ cl := ity.cl; add_names_to_goals_tac cl status
+ );
+ branch_tac; push_goals_tac;
+ unfocus_branch_tac;
+ add_parameter_tac "context" "cases"
+ ] status)
+ with
+ | FirstTypeWrong -> fail (lazy "What you want to prove is different from the conclusion")
+;;
+
+let byinduction t1 id status =
+ let ctx = status_parameter "context" status in
+ if ctx <> "induction" then fail (lazy "You can't use this tactic outside of an induction context")
+ else suppose t1 id status
+;;
+
+let name_of_conj conj =
+ let mattrs,_,_ = conj in
+ let rec search_name mattrs =
+ match mattrs with
+ [] -> "Anonymous"
+ | hd::tl ->
+ match hd with
+ `Name n -> n
+ | _ -> search_name tl
+ in
+ search_name mattrs
+
+let rec loc_of_goal goal l =
+ match l with
+ [] -> fail (lazy "Reached the end")
+ | hd :: tl ->
+ let _,sw = hd in
+ let g = goal_of_switch sw in
+ if g = goal then hd
+ else loc_of_goal goal tl
+;;
+
+let has_focused_goal status =
+ match status#stack with
+ [] -> false
+ | ([],_,_,_,_) :: _tl -> false
+ | _ -> true
+;;
+
+let focus_on_case_tac case status =
+ let (_,_,metasenv,_,_) = status#obj in
+ let rec goal_of_case case metasenv =
+ match metasenv with
+ [] -> fail (lazy "The given case does not exist")
+ | (goal,conj) :: tl ->
+ if name_of_conj conj = case then goal
+ else goal_of_case case tl
+ in
+ let goal_to_focus = goal_of_case case metasenv in
+ let gstatus =
+ match status#stack with
+ [] -> fail (lazy "There is nothing to prove")
+ | (g,t,k,tag,p) :: s ->
+ let loc =
+ try
+ loc_of_goal goal_to_focus t
+ with _ -> fail (lazy "The given case is not part of the current induction/cases analysis
+ context")
+ in
+ let curloc = if has_focused_goal status then
+ let goal = extract_first_goal_from_status status in
+ [loc_of_goal goal g]
+ else []
+ in
+ (((g @- curloc) @+ [loc]),(curloc @+ (t @- [loc])),k,tag,p) :: s
+ in
+ status#set_stack gstatus
+;;
+
+let case id l status =
+ let ctx = status_parameter "context" status in
+ if ctx <> "induction" && ctx <> "cases" then fail (lazy "You can't use case outside of an
+ induction/cases analysis context")
+else
+ (
+ if has_focused_goal status then fail (lazy "Finish the current case before switching")
+ else
+ (
+(*
+ let goal = extract_first_goal_from_status status in
+ let (_,_,metasenv,_,_) = status#obj in
+ let conj = NCicUtils.lookup_meta goal metasenv in
+ let name = name_of_conj conj in
+*)
+ let continuation =
+ let rec aux l =
+ match l with
+ [] -> [id_tac]
+ | (id,ty)::tl ->
+ (try_tac (assume id ("",0,ty))) :: (aux tl)
+ in
+ aux l
+ in
+(* if name = id then block_tac continuation status *)
+(* else *)
+ block_tac ([focus_on_case_tac id] @ continuation) status
+ )
+ )
+;;
+
+let print_stack status = prerr_endline ("PRINT STACK: " ^ (pp status#stack)); id_tac status ;;
+
+(* vim: ts=2: sw=0: et:
+ * *)
--- /dev/null
+(* Copyright (C) 2019, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+type just = [ `Term of NTacStatus.tactic_term | `Auto of NnAuto.auto_params ]
+
+val assume : string -> NTacStatus.tactic_term -> 's NTacStatus.tactic
+val suppose : NTacStatus.tactic_term -> string -> 's NTacStatus.tactic
+val we_need_to_prove : NTacStatus.tactic_term -> string option -> 's NTacStatus.tactic
+val beta_rewriting_step : NTacStatus.tactic_term -> 's NTacStatus.tactic
+val bydone : just -> 's NTacStatus.tactic
+val by_just_we_proved : just -> NTacStatus.tactic_term -> string option -> 's NTacStatus.tactic
+val andelim : just -> NTacStatus.tactic_term -> string -> NTacStatus.tactic_term -> string -> 's
+NTacStatus.tactic
+val existselim : just -> string -> NTacStatus.tactic_term -> NTacStatus.tactic_term -> string -> 's
+NTacStatus.tactic
+val thesisbecomes : NTacStatus.tactic_term -> 's NTacStatus.tactic
+val rewritingstep : NTacStatus.tactic_term -> [ `Term of NTacStatus.tactic_term | `Auto of NnAuto.auto_params
+ | `Proof | `SolveWith of NTacStatus.tactic_term ] ->
+ bool (* last step *) -> 's NTacStatus.tactic
+val we_proceed_by_cases_on: NTacStatus.tactic_term -> NTacStatus.tactic_term -> 's NTacStatus.tactic
+val we_proceed_by_induction_on: NTacStatus.tactic_term -> NTacStatus.tactic_term -> 's NTacStatus.tactic
+val byinduction: NTacStatus.tactic_term -> string -> 's NTacStatus.tactic
+val case: string -> (string*NotationPt.term) list -> 's NTacStatus.tactic
+val obtain: string -> NTacStatus.tactic_term -> 's NTacStatus.tactic
+val conclude: NTacStatus.tactic_term -> 's NTacStatus.tactic
+val print_stack : 's NTacStatus.tactic
let p_name = mk_id "Q_" in
let params,ty = NCicReduction.split_prods status ~subst:[] [] leftno ty in
let params = List.rev_map (function name,_ -> mk_id name) params in
- let args,sort = NCicReduction.split_prods status ~subst:[] [] (-1) ty in
+ let args,_sort = NCicReduction.split_prods status ~subst:[] [] (-1) ty in
let args = List.rev_map (function name,_ -> mk_id name) args in
let rec_arg = mk_id (fresh_name ()) in
let mk_prods =
List.map
(function (_,name,ty) ->
let _,ty = NCicReduction.split_prods status ~subst:[] [] leftno ty in
- let cargs,ty= my_split_prods status ~subst:[] [] (-1) ty in
+ let cargs,_ty= my_split_prods status ~subst:[] [] (-1) ty in
let cargs_recargs_nih =
List.fold_left
(fun (acc,nih) -> function
in
let rec eat_branch n rels ty pat =
match (ty, pat) with
- | NCic.Prod (name, s, t), _ when n > 0 ->
+ | NCic.Prod (_name, _s, t), _ when n > 0 ->
eat_branch (pred n) rels t pat
| NCic.Prod (_, _, t), NCic.Lambda (name, s, t') ->
let cv, rhs = eat_branch 0 ((mk_id name)::rels) t t' in
let nargs it nleft consno =
pp (lazy (Printf.sprintf "nargs %d %d" nleft consno));
- let _,indname,_,cl = it in
+ let _,_indname,_,cl = it in
let _,_,t_k = List.nth cl consno in
List.length (arg_list nleft t_k) ;;
NotationPt.Theorem
(name, principle, Some (NotationPt.Implicit (`Tagged "inv")), attrs))
in
- let uri,height,nmenv,nsubst,nobj = theorem in
+ let _uri,_height,nmenv,_nsubst,_nobj = theorem in
let ninitial_stack = Continuationals.Stack.of_nmetasenv nmenv in
let status = status#set_obj theorem in
let status = status#set_stack ninitial_stack in
let status = subst_metasenv_and_fix_names status in
(* PHASE 3: we finally prove the discrimination principle *)
- let dbranch it ~use_jmeq leftno consno =
+ let dbranch it ~use_jmeq:__ leftno consno =
let refl_id = mk_sym "refl" in
pp (lazy (Printf.sprintf "dbranch %d %d" leftno consno));
let nlist = HExtlib.list_seq 0 (nargs it leftno consno) in
else
let gen_tac x =
(fun s ->
- let x' = String.concat " " x in
+ (*let x' = String.concat " " x in*)
let x = List.map mk_id x in
(* let s = NTactics.print_tac false ("@generalize " ^ x') s in *)
generalize0_tac x s) in
| _ -> status, `NonEq
in match kind with
| `Identity ->
- let status, goalty = term_of_cic_term status (get_goalty status goal) ctx in
+ let status, _goalty = term_of_cic_term status (get_goalty status goal) ctx in
status, Some (List.length ctx - i), kind
| `Cycle | `Blob | `NonEq -> aux (i+1) (* XXX: skip cyclic/blob equations for now *)
| _ ->
let rec mk_arrows ~jmeq xs ys selection target =
match selection,xs,ys with
[],[],[] -> target
- | false :: l,x::xs,y::ys -> mk_arrows ~jmeq xs ys l target
+ | false :: l,_x::xs,_y::ys -> mk_arrows ~jmeq xs ys l target
| true :: l,x::xs,y::ys when jmeq ->
NotationPt.Binder (`Forall, (mk_id "_",
Some (mk_appl [mk_sym "jmsimeq" ;
status#set_obj(u,h,NCicUntrusted.apply_subst_metasenv status subst metasenv,subst,o)
;;
-let mk_inverter ~jmeq name is_ind it leftno ?selection outsort (status: #NCic.status) baseuri =
+let mk_inverter ~jmeq name _is_ind it leftno ?selection outsort (status: #NCic.status) baseuri =
pp (lazy ("leftno = " ^ string_of_int leftno));
let _,ind_name,ty,cl = it in
pp (lazy ("arity: " ^ status#ppterm ~metasenv:[] ~subst:[] ~context:[] ty));
in (hypaux 1 ncons)
in
- let outsort, suffix = NCicElim.ast_of_sort outsort in
+ let outsort, _suffix = NCicElim.ast_of_sort outsort in
let theorem =
mk_prods xs
(NotationPt.Binder (`Forall, (mk_id "Hterm", Some (mk_appl (List.map mk_id (ind_name::xs)))),
NotationPt.Theorem
(name,theorem, Some (NotationPt.Implicit (`Tagged "inv")), attrs))
in
- let uri,height,nmenv,nsubst,nobj = theorem in
+ let _uri,_height,nmenv,_nsubst,_nobj = theorem in
let ninitial_stack = Continuationals.Stack.of_nmetasenv nmenv in
let status = status#set_obj theorem in
let status = status#set_stack ninitial_stack in
let mk_inverter name is_ind it leftno ?selection outsort status baseuri =
try mk_inverter ~jmeq:true name is_ind it leftno ?selection outsort status baseuri
- with NTacStatus.Error (s,_) ->
+ with NTacStatus.Error (_s,_) ->
mk_inverter ~jmeq:false name is_ind it leftno ?selection outsort status baseuri
;;
let mk_cic_term c t = c,t ;;
let ppterm (status:#pstatus) t =
- let uri,height,metasenv,subst,obj = status#obj in
+ let _uri,_height,metasenv,subst,_obj = status#obj in
let context,t = t in
status#ppterm ~metasenv ~subst ~context t
;;
let ppcontext (status: #pstatus) c =
- let uri,height,metasenv,subst,obj = status#obj in
+ let _uri,_height,metasenv,subst,_obj = status#obj in
status#ppcontext ~metasenv ~subst c
;;
let ppterm_and_context (status: #pstatus) t =
- let uri,height,metasenv,subst,obj = status#obj in
+ let _uri,_height,metasenv,subst,_obj = status#obj in
let context,t = t in
status#ppcontext ~metasenv ~subst context ^ "\n ⊢ "^
status#ppterm ~metasenv ~subst ~context t
;;
-let relocate status destination (source,t as orig) =
+let relocate status destination (source,_t as orig) =
pp(lazy("relocate:\n" ^ ppterm_and_context status orig));
pp(lazy("relocate in:\n" ^ ppcontext status destination));
let rc =
compute_ops (e::ctx) (cl1,cl2)
else
[ `Delift ctx; `Lift (List.rev ex) ]
- | (n1, NCic.Def (b1,t1) as e)::cl1 as ex, (n2, NCic.Decl t2)::cl2 ->
+ | (n1, NCic.Def (_b1,t1) as e)::cl1 as ex, (n2, NCic.Decl t2)::cl2 ->
if n1 = n2 &&
NCicReduction.are_convertible status ctx ~subst ~metasenv t1 t2 then
compute_ops (e::ctx) (cl1,cl2)
else
[ `Delift ctx; `Lift (List.rev ex) ]
- | (n1, NCic.Decl _)::cl1 as ex, (n2, NCic.Def _)::cl2 ->
+ | (_n1, NCic.Decl _)::_cl1 as ex, (_n2, NCic.Def _)::_cl2 ->
[ `Delift ctx; `Lift (List.rev ex) ]
| _::_ as ex, [] -> [ `Lift (List.rev ex) ]
| [], _::_ -> [ `Delift ctx ]
status, (ctx, t)
;;
+let are_convertible status ctx a b =
+ let status, (_,a) = relocate status ctx a in
+ let status, (_,b) = relocate status ctx b in
+ let _n,_h,metasenv,subst,_o = status#obj in
+ let res = NCicReduction.are_convertible status metasenv subst ctx a b in
+ status, res
+;;
+let are_convertible a b c d = wrap "are_convertible" (are_convertible a b c) d;;
+
let unify status ctx a b =
let status, (_,a) = relocate status ctx a in
let status, (_,b) = relocate status ctx b in
else
let _,_,_,subst,_ = status#obj in
match t with
- | NCic.Meta (i,lc) when List.mem_assoc i subst ->
+ | NCic.Meta (i,_lc) when List.mem_assoc i subst ->
let _,_,t,_ = NCicUtils.lookup_subst i subst in
aux ctx (status,already_found) t
| NCic.Meta _ -> (status,already_found),t
let _,_,_,cl = List.nth tl i in
let consno = List.length cl in
let left, right = HExtlib.split_nth lno args in
- status, (ref, consno, left, right)
+ status, (ref, consno, left, right, cl)
;;
let apply_subst status ctx t =
val analyse_indty:
#pstatus as 'status -> cic_term ->
- 'status * (NReference.reference * int * NCic.term list * NCic.term list)
+ 'status * (NReference.reference * int * NCic.term list * NCic.term list * NCic.constructor list)
val ppterm: #pstatus -> cic_term -> string
val ppcontext: #pstatus -> NCic.context -> string
val normalize:
#pstatus as 'status -> ?delta:int -> NCic.context -> cic_term ->
'status * cic_term
+val are_convertible:
+ #pstatus as 'status -> NCic.context -> cic_term -> cic_term -> 'status * bool
val typeof:
#pstatus as 'status -> NCic.context -> cic_term -> 'status * cic_term
val unify:
let gstatus =
match status#stack with
| [] -> assert false
- | ([], _, [], _) :: _ as stack ->
+ | ([], _, [], _, _) :: _ as stack ->
(* backward compatibility: do-nothing-dot *)
stack
- | (g, t, k, tag) :: s ->
+ | (g, t, k, tag, p) :: s ->
match filter_open g, k with
| loc :: loc_tl, _ ->
- (([ loc ], t, loc_tl @+ k, tag) :: s)
+ (([ loc ], t, loc_tl @+ k, tag, p) :: s)
| [], loc :: k ->
assert (is_open loc);
- (([ loc ], t, k, tag) :: s)
+ (([ loc ], t, k, tag, p) :: s)
| _ -> fail (lazy "can't use \".\" here")
in
status#set_stack gstatus
let gstatus =
match status#stack with
| [] -> assert false
- | (g, t, k, tag) :: s ->
+ | (g, t, k, tag, p) :: s ->
match init_pos g with (* TODO *)
| [] -> fail (lazy "empty goals")
- | [_] when (not force) -> fail (lazy "too few goals to branch")
+ | [_] when (not force) -> fail (lazy "too few goals to branch")
| loc :: loc_tl ->
- ([ loc ], [], [], `BranchTag) :: (loc_tl, t, k, tag) :: s
+ ([ loc ], [], [], `BranchTag, []) :: (loc_tl, t, k, tag, p) :: s
in
status#set_stack gstatus
;;
let shift_tac status =
let gstatus =
match status#stack with
- | (g, t, k, `BranchTag) :: (g', t', k', tag) :: s ->
+ | (g, t, k, `BranchTag, p) :: (g', t', k', tag, p') :: s ->
(match g' with
| [] -> fail (lazy "no more goals to shift")
| loc :: loc_tl ->
- (([ loc ], t @+ filter_open g @+ k, [],`BranchTag)
- :: (loc_tl, t', k', tag) :: s))
+ (([ loc ], t @+ filter_open g @+ k, [],`BranchTag, p)
+ :: (loc_tl, t', k', tag, p') :: s))
| _ -> fail (lazy "can't shift goals here")
in
status#set_stack gstatus
let gstatus =
match status#stack with
| [] -> assert false
- | ([ loc ], t, [],`BranchTag) :: (g', t', k', tag) :: s
+ | ([ loc ], t, [],`BranchTag, p) :: (g', t', k', tag, p') :: s
when is_fresh loc ->
let l_js = List.filter (fun (i, _) -> List.mem i i_s) ([loc] @+ g') in
- ((l_js, t , [],`BranchTag)
- :: (([ loc ] @+ g') @- l_js, t', k', tag) :: s)
+ ((l_js, t , [],`BranchTag, p)
+ :: (([ loc ] @+ g') @- l_js, t', k', tag, p') :: s)
| _ -> fail (lazy "can't use relative positioning here")
in
status#set_stack gstatus
let gstatus =
match status#stack with
| [] -> assert false
- | ([ loc ], t, [],`BranchTag) :: (g', t', k', tag) :: s
+ | ([ loc ], t, [],`BranchTag, p) :: (g', t', k', tag, p') :: s
when is_fresh loc ->
let l_js =
List.filter
match NCicUtils.lookup_meta (goal_of_loc curloc) metasenv with
attrs,_,_ when List.mem (`Name lab) attrs -> true
| _ -> false) ([loc] @+ g') in
- ((l_js, t , [],`BranchTag)
- :: (([ loc ] @+ g') @- l_js, t', k', tag) :: s)
+ ((l_js, t , [],`BranchTag, p)
+ :: (([ loc ] @+ g') @- l_js, t', k', tag, p') :: s)
| _ -> fail (lazy "can't use relative positioning here")
in
status#set_stack gstatus
let gstatus =
match status#stack with
| [] -> assert false
- | ([ loc ] , t, [], `BranchTag) :: (g', t', k', tag) :: s
+ | ([ loc ] , t, [], `BranchTag, p) :: (g', t', k', tag, p') :: s
when is_fresh loc ->
- (([loc] @+ g', t, [], `BranchTag) :: ([], t', k', tag) :: s)
+ (([loc] @+ g', t, [], `BranchTag, p) :: ([], t', k', tag, p') :: s)
| _ -> fail (lazy "can't use wildcard here")
in
status#set_stack gstatus
let gstatus =
match status#stack with
| [] -> assert false
- | (g, t, k,`BranchTag) :: (g', t', k', tag) :: s ->
- ((t @+ filter_open g @+ g' @+ k, t', k', tag) :: s)
+ | (g, t, k,`BranchTag, _) :: (g', t', k', tag, p) :: s ->
+ ((t @+ filter_open g @+ g' @+ k, t', k', tag, p) :: s)
| _ -> fail (lazy "can't merge goals here")
in
status#set_stack gstatus
if not (List.exists (fun l -> goal_of_loc l = g) stack_locs) then
fail (lazy (sprintf "goal %d not found (or closed)" g)))
gs;
- (zero_pos gs, [], [], `FocusTag) :: deep_close gs s
+ (zero_pos gs, [], [], `FocusTag, []) :: deep_close gs s
in
status#set_stack gstatus
;;
let gstatus =
match status#stack with
| [] -> assert false
- | (g, [], [], `FocusTag) :: s when filter_open g = [] -> s
+ | (g, [], [], `FocusTag, _) :: s when filter_open g = [] -> s
| _ as s -> fail (lazy ("can't unfocus, some goals are still open:\n"^
Continuationals.Stack.pp s))
in
let gstatus =
match status#stack with
| [] -> assert false
- | (gl, t, k, tag) :: s ->
+ | (gl, t, k, tag, p) :: s ->
let gl = List.map switch_of_loc gl in
if List.exists (function Open _ -> true | Closed _ -> false) gl then
fail (lazy "cannot skip an open goal")
else
- ([],t,k,tag) :: s
+ ([],t,k,tag,p) :: s
in
status#set_stack gstatus
;;
;;
let exec tac (low_status : #lowtac_status) g =
- let stack = [ [0,Open g], [], [], `NoTag ] in
+ let stack = [ [0,Open g], [], [], `NoTag, [] ] in
let status = change_stack_type low_status stack in
let status = tac status in
(low_status#set_pstatus status)#set_obj status#obj
let distribute_tac tac (status : #tac_status) =
match status#stack with
| [] -> assert false
- | (g, t, k, tag) :: s ->
+ | (g, t, k, tag, p) :: s ->
debug_print (lazy ("context length " ^string_of_int (List.length g)));
let rec aux s go gc =
function
debug_print (lazy ("closed: "
^ String.concat " " (List.map string_of_int gcn)));
let stack =
- (zero_pos gon, t @~- gcn, k @~- gcn, tag) :: deep_close gcn s
+ (zero_pos gon, t @~- gcn, k @~- gcn, tag, p) :: deep_close gcn s
in
((status#set_stack stack)#set_obj(sn:>lowtac_status)#obj)#set_pstatus sn
;;
let find_in_context name context =
let rec aux acc = function
| [] -> raise Not_found
- | (hd,_) :: tl when hd = name -> acc
+ | (hd,_) :: _ when hd = name -> acc
| _ :: tl -> aux (acc + 1) tl
in
aux 1 context
leftno: int;
consno: int;
reference: NReference.reference;
+ cl: NCic.constructor list;
}
;;
let goalty = get_goalty status goal in
let status, what = disambiguate status (ctx_of goalty) what `XTInd in
let status, ty_what = typeof status (ctx_of what) what in
- let status, (r,consno,lefts,rights) = analyse_indty status ty_what in
+ let _status, (r,consno,lefts,rights,cl) = analyse_indty status ty_what in
let leftno = List.length lefts in
let rightno = List.length rights in
indtyref := Some {
rightno = rightno; leftno = leftno; consno = consno; reference = r;
+ cl = cl;
};
exec id_tac orig_status goal)
;;
status)
;;
+let pp_ref reference =
+ let NReference.Ref (uri,spec) = reference in
+ let nstring = NUri.string_of_uri uri in
+ (*"Shareno: " ^ (string_of_int nuri) ^*) "Uri: " ^ nstring ^
+ (match spec with
+ | NReference.Decl -> "Decl"
+ | NReference.Def n -> "Def " ^ (string_of_int n)
+ | NReference.Fix (n1,n2,n3) -> "Fix " ^ (string_of_int n1) ^ " " ^ (string_of_int n2) ^ " " ^ (string_of_int n3)(* fixno, recparamno, height *)
+ | NReference.CoFix n -> "CoFix " ^ (string_of_int n)
+ | NReference.Ind (b,n1,n2) -> "Ind " ^ (string_of_bool b) ^ " " ^ (string_of_int n1) ^ " " ^ (string_of_int n2)(* inductive, indtyno, leftno *)
+ | NReference.Con (n1,n2,n3) -> "Con " ^ (string_of_int n1) ^ " " ^ (string_of_int n2) ^ " " ^ (string_of_int n3)(* indtyno, constrno, leftno *)
+ ) ;;
+
+let pp_cl cl =
+ let rec pp_aux acc =
+ match acc with
+ | [] -> ""
+ | (_,consname,_) :: tl -> consname ^ ", " ^ pp_aux tl
+ in
+ pp_aux cl
+;;
+
+let pp_indtyinfo ity = "leftno: " ^ (string_of_int ity.leftno) ^ ", consno: " ^ (string_of_int
+ ity.consno) ^ ", rightno: " ^
+ (string_of_int ity.rightno) ^ ", reference: " ^ (pp_ref ity.reference) ^ ",
+ cl: " ^ (pp_cl ity.cl);;
+
let elim_tac ~what:(txt,len,what) ~where =
let what = txt, len, Ast.Appl [what; Ast.Implicit `Vector] in
let indtyinfo = ref None in
let gty = get_goalty status goal in
let status, what = disambiguate status (ctx_of gty) what `XTInd in
let status, ty = typeof status (ctx_of what) what in
- let status, (ref, consno, _, _) = analyse_indty status ty in
+ let status, (ref, consno, _, _,_) = analyse_indty status ty in
let status, what = term_of_cic_term status what (ctx_of gty) in
let t =
NCic.Match (ref,NCic.Implicit `Term, what,
let constructor_tac ?(num=1) ~args = distribute_tac (fun status goal ->
let gty = get_goalty status goal in
- let status, (r,consno,_,_) = analyse_indty status gty in
+ let status, (r,consno,_,_,_) = analyse_indty status gty in
if num < 1 || num > consno then fail (lazy "Non existant constructor");
let ref = NReference.mk_constructor num r in
let t =
let assert_tac seqs status =
match status#stack with
| [] -> assert false
- | (g,_,_,_) :: s ->
+ | (g,_,_,_,_) :: _s ->
assert (List.length g = List.length seqs);
(match seqs with
[] -> id_tac
val print_tac: bool -> string -> 's NTacStatus.tactic
+val id_tac: 's NTacStatus.tactic
val dot_tac: 's NTacStatus.tactic
val branch_tac: ?force:bool -> 's NTacStatus.tactic
val shift_tac: 's NTacStatus.tactic
(*(NTacStatus.tac_status -> 'c #NTacStatus.status) ->
(#NTacStatus.tac_status as 'f) -> 'f*)
-type indtyinfo
+(* type indtyinfo *)
+type indtyinfo = {
+ rightno: int;
+ leftno: int;
+ consno: int;
+ reference: NReference.reference;
+ cl: NCic.constructor list;
+ }
val ref_of_indtyinfo : indtyinfo -> NReference.reference
val inversion_tac:
what:NTacStatus.tactic_term -> where:NTacStatus.tactic_pattern ->
's NTacStatus.tactic
+
+val exact_tac: NTacStatus.tactic_term -> 's NTacStatus.tactic
+val first_tac: 's NTacStatus.tactic list -> 's NTacStatus.tactic
+val sort_of_goal_tac: NCic.term ref -> 's NTacStatus.tactic
let print ?(depth=0) s =
prerr_endline (String.make (2*depth) ' '^Lazy.force s)
-let noprint ?(depth=0) _ = ()
+let noprint ?depth:(_=0) _ = ()
let debug_print = noprint
open Continuationals.Stack
let toref f tbl t =
match t with
| Ast.NRef n ->
- f tbl n
+ f tbl n
| Ast.NCic _ (* local candidate *)
| _ -> ()
else true
with Not_found -> true
-let print_stat status tbl =
+let print_stat _status tbl =
let l = RefHash.fold (fun a v l -> (a,v)::l) tbl [] in
let relevance v = float !(v.uses) /. float !(v.nominations) in
let vcompare (_,v1) (_,v2) =
"; uses = " ^ (string_of_int !(v.uses)) ^
"; nom = " ^ (string_of_int !(v.nominations)) in
lazy ("\n\nSTATISTICS:\n" ^
- String.concat "\n" (List.map vstring l))
+ String.concat "\n" (List.map vstring l))
(* ======================= utility functions ========================= *)
module IntSet = Set.Make(struct type t = int let compare = compare end)
debug_print (lazy ("refining: "^(status#ppterm ctx subst metasenv pt)));
let stamp = Unix.gettimeofday () in
let metasenv, subst, pt, pty =
- (* NCicRefiner.typeof status
+ (* NCicRefiner.typeof status
(* (status#set_coerc_db NCicCoercion.empty_db) *)
metasenv subst ctx pt None in
debug_print (lazy ("refined: "^(status#ppterm ctx subst metasenv pt)));
NCicRefiner.RefineFailure msg
| NCicRefiner.Uncertain msg ->
debug_print (lazy ("WARNING U: refining in fast_eq_check failed\n" ^
- snd (Lazy.force msg) ^
- "\n in the environment\n" ^
- status#ppmetasenv subst metasenv)); None
+ snd (Lazy.force msg) ^
+ "\n in the environment\n" ^
+ status#ppmetasenv subst metasenv)); None
| NCicRefiner.AssertFailure msg ->
debug_print (lazy ("WARNING F: refining in fast_eq_check failed" ^
Lazy.force msg ^
- "\n in the environment\n" ^
- status#ppmetasenv subst metasenv)); None
+ "\n in the environment\n" ^
+ status#ppmetasenv subst metasenv)); None
| Sys.Break as e -> raise e
| _ -> None
in
| Error _ -> debug_print (lazy ("no paramod proof found"));[]
;;
-let index_local_equations eq_cache status =
+let index_local_equations eq_cache ?(flag=false) status =
+ if flag then
+ NCicParamod.empty_state
+ else begin
noprint (lazy "indexing equations");
let open_goals = head_goals status#stack in
let open_goal = List.hd open_goals in
| NCicTypeChecker.TypeCheckerFailure _
| NCicTypeChecker.AssertFailure _ -> eq_cache)
eq_cache ctx
+ end
;;
-let index_local_equations2 eq_cache status open_goal lemmas nohyps =
+let index_local_equations2 eq_cache status open_goal lemmas ?flag:(_=false) nohyps =
noprint (lazy "indexing equations");
let eq_cache,lemmas =
match lemmas with
eq_cache lemmas
;;
-let fast_eq_check_tac ~params s =
+let fast_eq_check_tac ~params:_ s =
let unit_eq = index_local_equations s#eq_cache s in
dist_fast_eq_check unit_eq s
;;
| s::_ -> s
;;
-let paramod_tac ~params s =
+let paramod_tac ~params:_ s =
let unit_eq = index_local_equations s#eq_cache s in
NTactics.distribute_tac (paramod unit_eq) s
;;
(fun ty ctx_entry ->
match ctx_entry with
| name, NCic.Decl t -> NCic.Prod(name,t,ty)
- | name, NCic.Def(bo, _) -> NCicSubstitution.subst status bo ty)
+ | _name, NCic.Def(bo, _) -> NCicSubstitution.subst status bo ty)
;;
let args_for_context ?(k=1) ctx =
List.fold_left
(fun (n,l) ctx_entry ->
match ctx_entry with
- | name, NCic.Decl t -> n+1,NCic.Rel(n)::l
- | name, NCic.Def(bo, _) -> n+1,l)
+ | _name, NCic.Decl _t -> n+1,NCic.Rel(n)::l
+ | _name, NCic.Def(_bo, _) -> n+1,l)
(k,[]) ctx in
args
List.fold_left
(fun (metasenv,subst) (i,(iattr,ctx,ty)) ->
let ikind = NCicUntrusted.kind_of_meta iattr in
- let metasenv,j,instance,ty =
+ let metasenv,_j,instance,ty =
NCicMetaSubst.mk_meta ~attrs:iattr
metasenv ctx ~with_type:ty ikind in
let s_entry = i,(iattr, ctx, instance, ty) in
*)
let metasenv = NCicUntrusted.sort_metasenv status subst metasenv in
List.fold_left
- (fun (subst,objs) (i,(iattr,ctx,ty)) ->
+ (fun (subst,objs) (i,(_iattr,ctx,ty)) ->
let ty = NCicUntrusted.apply_subst status subst ctx ty in
let ctx =
NCicUntrusted.apply_subst_context status ~fix_projections:true
subst ctx in
- let (uri,_,_,_,obj) as okind =
+ let (uri,_,_,_,_obj) as okind =
constant_for_meta status ctx ty i in
try
NCicEnvironment.check_and_add_obj status okind;
| _ -> let args =
List.map (NCicSubstitution.subst_meta status lc) args in
NCic.Appl(NCic.Rel k::args))
- | NCic.Meta (j,lc) as m ->
+ | NCic.Meta (_j,lc) as m ->
(match lc with
_,NCic.Irl _ -> m
| n,NCic.Ctx l ->
let close_wrt_metasenv status subst =
List.fold_left
- (fun ty (i,(iattr,ctx,mty)) ->
+ (fun ty (i,(_iattr,ctx,mty)) ->
let mty = NCicUntrusted.apply_subst status subst ctx mty in
let ctx =
NCicUntrusted.apply_subst_context status ~fix_projections:true
NCicMetaSubst.saturate status ~delta:height metasenv subst ctx ty 0 in
match ty with
| NCic.Const(NReference.Ref (_,NReference.Def _) as nre)
- when nre<>nref ->
- let _, _, bo, _, _, _ = NCicEnvironment.get_checked_def status nre in
- aux metasenv bo (args@moreargs)
+ when nre<>nref ->
+ let _, _, bo, _, _, _ = NCicEnvironment.get_checked_def status nre in
+ aux metasenv bo (args@moreargs)
| NCic.Appl(NCic.Const(NReference.Ref (_,NReference.Def _) as nre)::tl)
- when nre<>nref ->
- let _, _, bo, _, _, _ = NCicEnvironment.get_checked_def status nre in
- aux metasenv (NCic.Appl(bo::tl)) (args@moreargs)
+ when nre<>nref ->
+ let _, _, bo, _, _, _ = NCicEnvironment.get_checked_def status nre in
+ aux metasenv (NCic.Appl(bo::tl)) (args@moreargs)
| _ -> ty,metasenv,(args@moreargs)
in
aux metasenv ty []
let smart_apply t unit_eq status g =
- let n,h,metasenv,subst,o = status#obj in
- let gname, ctx, gty = List.assoc g metasenv in
+ let n,h,metasenv,_subst,o = status#obj in
+ let _gname, ctx, gty = List.assoc g metasenv in
(* let ggty = mk_cic_term context gty in *)
let status, t = disambiguate status ctx t `XTNone in
let status,t = term_of_cic_term status t ctx in
match gty with
| NCic.Const(nref)
| NCic.Appl(NCic.Const(nref)::_) ->
- saturate_to_ref status metasenv subst ctx nref ty
+ saturate_to_ref status metasenv subst ctx nref ty
| _ ->
- NCicMetaSubst.saturate status metasenv subst ctx ty 0 in
+ NCicMetaSubst.saturate status metasenv subst ctx ty 0 in
let metasenv,j,inst,_ = NCicMetaSubst.mk_meta metasenv ctx `IsTerm in
let status = status#set_obj (n,h,metasenv,subst,o) in
let pterm = if args=[] then t else
debug_print(lazy("ritorno da fast_eq_check"));
res
with
- | NCicEnvironment.ObjectNotFound s as e ->
+ | NCicEnvironment.ObjectNotFound _s as e ->
raise (Error (lazy "eq_coerc non yet defined",Some e))
| Error _ as e -> debug_print (lazy "error"); raise e
(* FG: for now we catch TypeCheckerFailure; to be understood *)
do_types : bool; (* solve goals in Type *)
last : bool; (* last goal: take first solution only *)
candidates: Ast.term list option;
+ local_candidates: bool;
maxwidth : int;
maxsize : int;
maxdepth : int;
let add_to_trace status ~depth cache t =
match t with
| Ast.NRef _ ->
- debug_print ~depth (lazy ("Adding to trace: " ^ NotationPp.pp_term status t));
- {cache with trace = t::cache.trace}
+ debug_print ~depth (lazy ("Adding to trace: " ^ NotationPp.pp_term status t));
+ {cache with trace = t::cache.trace}
| Ast.NCic _ (* local candidate *)
| _ -> (*not an application *) cache
let pptrace status tr =
(lazy ("Proof Trace: " ^ (String.concat ";"
- (List.map (NotationPp.pp_term status) tr))))
+ (List.map (NotationPp.pp_term status) tr))))
(* not used
let remove_from_trace cache t =
match t with
| Ast.NRef _ ->
- (match cache.trace with
- | _::tl -> {cache with trace = tl}
+ (match cache.trace with
+ | _::tl -> {cache with trace = tl}
| _ -> assert false)
| Ast.NCic _ (* local candidate *)
| _ -> (*not an application *) cache *)
unit_eq = unit_eq;
trace = trace}
-let only signature _context candidate = true
+let only _signature _context _candidate = true
(*
(* TASSI: nel trie ci mettiamo solo il body, non il ty *)
let candidate_ty =
let ty = NCicTypeChecker.typeof status subst metasenv ctx t in
let res = branch status (mk_cic_term ctx ty) in
noprint (lazy ("branch factor for: " ^ (ppterm status ct) ^ " = "
- ^ (string_of_int res)));
+ ^ (string_of_int res)));
res
in
let candidates = List.map (fun t -> branch t,t) candidates in
List.sort (fun (a,_) (b,_) -> a - b) candidates in
let candidates = List.map snd candidates in
noprint (lazy ("candidates =\n" ^ (String.concat "\n"
- (List.map (NotationPp.pp_term status) candidates))));
+ (List.map (NotationPp.pp_term status) candidates))));
candidates
let sort_new_elems l =
if level = 0 then []
else match gs with
| [] -> assert false
- | (g,_,_,_)::s ->
+ | (g,_,_,_,_)::s ->
let is_open = function
| (_,Continuationals.Stack.Open i) -> Some i
| (_,Continuationals.Stack.Closed _) -> None
in
- HExtlib.filter_map is_open g @ stack_goals (level-1) s
+ HExtlib.filter_map is_open g @ stack_goals (level-1) s
;;
let open_goals level status = stack_goals level status#stack
;;
-let try_candidate ?(smart=0) flags depth status eq_cache ctx t =
+let try_candidate ?(smart=0) _flags depth status eq_cache _ctx t =
try
- let old_og_no = List.length (open_goals (depth+1) status) in
+ (*let old_og_no = List.length (open_goals (depth+1) status) in*)
debug_print ~depth (lazy ("try " ^ (string_of_int smart) ^ " : "
^ (NotationPp.pp_term status) t));
let status =
(* some flexibility *)
if og_no - old_og_no > res then
(debug_print (lazy ("branch factor for: " ^ (ppterm status cict) ^ " = "
- ^ (string_of_int res) ^ " vs. " ^ (string_of_int og_no)));
+ ^ (string_of_int res) ^ " vs. " ^ (string_of_int og_no)));
debug_print ~depth (lazy "strange application"); None)
else
*) (incr candidate_no; Some ((!candidate_no,t),status))
- with Error (msg,exn) -> debug_print ~depth (lazy "failed"); None
+ with Error _ -> debug_print ~depth (lazy "failed"); None
;;
let sort_of status subst metasenv ctx t =
let perforate_small status subst metasenv context t =
let rec aux = function
| NCic.Appl (hd::tl) ->
- let map t =
- let s = sort_of status subst metasenv context t in
- match s with
- | NCic.Sort(NCic.Type [`Type,u])
- when u=type0 -> NCic.Meta (0,(0,NCic.Irl 0))
- | _ -> aux t
- in
- NCic.Appl (hd::List.map map tl)
+ let map t =
+ let s = sort_of status subst metasenv context t in
+ match s with
+ | NCic.Sort(NCic.Type [`Type,u])
+ when u=type0 -> NCic.Meta (0,(0,NCic.Irl 0))
+ | _ -> aux t
+ in
+ NCic.Appl (hd::List.map map tl)
| t -> t
in
aux t
cands, diff more_cands cands
;;
-let get_candidates ?(smart=true) ~pfailed depth flags status cache signature gty =
+let is_a_needed_uri s =
+ s = "cic:/matita/basics/logic/eq.ind" ||
+ s = "cic:/matita/basics/logic/sym_eq.con" ||
+ s = "cic:/matita/basics/logic/trans_eq.con" ||
+ s = "cic:/matita/basics/logic/eq_f3.con" ||
+ s = "cic:/matita/basics/logic/eq_f2.con" ||
+ s = "cic:/matita/basics/logic/eq_f.con"
+
+let get_candidates ?(smart=true) ~pfailed depth flags status cache _signature gty =
let universe = status#auto_cache in
let _,_,metasenv,subst,_ = status#obj in
let context = ctx_of gty in
let _, raw_gty = term_of_cic_term status gty context in
- let is_prod, is_eq =
- let status, t = term_of_cic_term status gty context in
- let t = NCicReduction.whd status subst context t in
- match t with
- | NCic.Prod _ -> true, false
- | _ -> false, NCicParamod.is_equation status metasenv subst context t
+ let is_prod, _is_eq =
+ let status, t = term_of_cic_term status gty context in
+ let t = NCicReduction.whd status subst context t in
+ match t with
+ | NCic.Prod _ -> true, false
+ | _ -> false, NCicParamod.is_equation status metasenv subst context t
in
debug_print ~depth (lazy ("gty:" ^ NTacStatus.ppterm status gty));
let is_eq =
let raw_weak_gty, weak_gty =
if smart then
match raw_gty with
- | NCic.Appl _
- | NCic.Const _
- | NCic.Rel _ ->
+ | NCic.Appl _
+ | NCic.Const _
+ | NCic.Rel _ ->
let raw_weak =
perforate_small status subst metasenv context raw_gty in
let weak = mk_cic_term context raw_weak in
noprint ~depth (lazy ("weak_gty:" ^ NTacStatus.ppterm status weak));
Some raw_weak, Some (weak)
- | _ -> None,None
+ | _ -> None,None
else None,None
in
(* we now compute global candidates *)
let global_cands, smart_global_cands =
- let mapf s =
- let to_ast = function
- | NCic.Const r when true
- (*is_relevant statistics r*) -> Some (Ast.NRef r)
- (* | NCic.Const _ -> None *)
- | _ -> assert false in
- HExtlib.filter_map
- to_ast (NDiscriminationTree.TermSet.elements s) in
- let g,l =
- get_cands
- (NDiscriminationTree.DiscriminationTree.retrieve_unifiables universe)
- NDiscriminationTree.TermSet.diff
- NDiscriminationTree.TermSet.empty
- raw_gty raw_weak_gty in
- mapf g, mapf l in
+ let mapf s =
+ let to_ast = function
+ | NCic.Const r when true
+ (*is_relevant statistics r*) -> Some (Ast.NRef r)
+ (* | NCic.Const _ -> None *)
+ | _ -> assert false in
+ HExtlib.filter_map
+ to_ast (NDiscriminationTree.TermSet.elements s) in
+ let g,l =
+ get_cands
+ (NDiscriminationTree.DiscriminationTree.retrieve_unifiables universe)
+ NDiscriminationTree.TermSet.diff
+ NDiscriminationTree.TermSet.empty
+ raw_gty raw_weak_gty in
+ mapf g, mapf l
+ in
+ let global_cands,smart_global_cands =
+ if flags.local_candidates then global_cands,smart_global_cands
+ else let filter = List.filter (function Ast.NRef NReference.Ref (uri,_) -> is_a_needed_uri
+ (NUri.string_of_uri
+ uri) | _ -> false)
+ in filter global_cands,filter smart_global_cands
+ in
(* we now compute local candidates *)
let local_cands,smart_local_cands =
let mapf s =
let to_ast t =
- let _status, t = term_of_cic_term status t context
- in Ast.NCic t in
- List.map to_ast (Ncic_termSet.elements s) in
+ let _status, t = term_of_cic_term status t context
+ in Ast.NCic t in
+ List.map to_ast (Ncic_termSet.elements s) in
let g,l =
get_cands
- (fun ty -> search_in_th ty cache)
- Ncic_termSet.diff Ncic_termSet.empty gty weak_gty in
- mapf g, mapf l in
+ (fun ty -> search_in_th ty cache)
+ Ncic_termSet.diff Ncic_termSet.empty gty weak_gty in
+ mapf g, mapf l
+ in
+ let local_cands,smart_local_cands =
+ if flags.local_candidates then local_cands,smart_local_cands
+ else let filter = List.filter (function Ast.NRef NReference.Ref (uri,_) -> is_a_needed_uri
+ (NUri.string_of_uri
+ uri) | _ -> false)
+ in filter local_cands,filter smart_local_cands
+ in
(* we now splits candidates in facts or not facts *)
let test = is_a_fact_ast status subst metasenv context in
let by,given_candidates =
let status, t = term_of_cic_term status gty context in
let t = NCicReduction.whd status subst context t in
match t with
- | NCic.Prod _ -> true, false
- | _ -> false, NCicParamod.is_equation status metasenv subst context t
+ | NCic.Prod _ -> true, false
+ | _ -> false, NCicParamod.is_equation status metasenv subst context t
in
debug_print ~depth (lazy (string_of_bool is_eq));
(* new *)
flags status tcache signature gty
in
let sm = if is_eq || is_prod then 0 else 2 in
- let sm1 = if flags.last then 2 else 0 in
+ (*let sm1 = if flags.last then 2 else 0 in *)
let maxd = (depth + 1 = flags.maxdepth) in
let try_candidates only_one sm acc candidates =
List.fold_left
NCicMetaSubst.mk_meta
metasenv ctx ~with_type:implication `IsType in
let status = status#set_obj (n,h,metasenv,subst,obj) in
- let status = status#set_stack [([1,Open j],[],[],`NoTag)] in
+ let status = status#set_stack [([1,Open j],[],[],`NoTag,[])] in
try
let status = NTactics.intro_tac "foo" status in
let status =
let intro ~depth status facts name =
let status = NTactics.intro_tac name status in
- let _, ctx, ngty = current_goal status in
+ let _, ctx, _ngty = current_goal status in
let t = mk_cic_term ctx (NCic.Rel 1) in
let status, keys = keys_of_term status t in
let facts = List.fold_left (add_to_th t) facts keys in
| _ -> status, facts
;;
-let intros ~depth status cache =
+let intros ~depth status ?(use_given_only=false) cache =
match is_prod status with
| `Inductive _
| `Some _ ->
- let trace = cache.trace in
+ let trace = cache.trace in
let status,facts =
intros_facts ~depth status cache.facts
in
[(0,Ast.Ident("__intros",None)),status], cache
else
(* we reindex the equation from scratch *)
- let unit_eq = index_local_equations status#eq_cache status in
+ let unit_eq = index_local_equations status#eq_cache status ~flag:use_given_only in
let status = NTactics.merge_tac status in
[(0,Ast.Ident("__intros",None)),status],
init_cache ~facts ~unit_eq () ~trace
| _ -> false
;;
-let do_something signature flags status g depth gty cache =
+let do_something signature flags status g depth gty ?(use_given_only=false) cache =
(* if the goal is meta we close it with I:True. This should work
thanks to the toplogical sorting of goals. *)
if is_meta status gty then
let s = NTactics.apply_tac ("",0,t) status in
[(0,t),s], cache
else
- let l0, cache = intros ~depth status cache in
+ let l0, cache = intros ~depth status cache ~use_given_only in
if l0 <> [] then l0, cache
else
(* whd *)
let gstatus =
match status#stack with
| [] -> assert false
- | (goals, t, k, tag) :: s ->
+ | (goals, t, k, tag, p) :: s ->
let g = head_goals status#stack in
let sortedg =
(List.rev (MS.topological_sort g (deps status))) in
let sorted_goals =
List.map (fun i -> List.find (is_it i) goals) sortedg
in
- (sorted_goals, t, k, tag) :: s
+ (sorted_goals, t, k, tag, p) :: s
in
status#set_stack gstatus
;;
let gstatus =
match status#stack with
| [] -> assert false
- | (g, t, k, tag) :: s ->
+ | (g, t, k, tag, p) :: s ->
let is_open = function
| (_,Continuationals.Stack.Open _) -> true
| (_,Continuationals.Stack.Closed _) -> false
in
let g' = List.filter is_open g in
- (g', t, k, tag) :: s
+ (g', t, k, tag, p) :: s
in
status#set_stack gstatus
;;
let rec slice level gs =
if level = 0 then [],[],gs else
match gs with
- | [] -> assert false
- | (g, t, k, tag) :: s ->
+ | [] -> assert false
+ | (g, t, k, tag,p) :: s ->
let f,o,gs = slice (level-1) s in
let f1,o1 = List.partition in_focus g
in
- (f1,[],[],`BranchTag)::f, (o1, t, k, tag)::o, gs
+ (f1,[],[],`BranchTag, [])::f, (o1, t, k, tag, p)::o, gs
in
let gstatus =
let f,o,s = slice level status#stack in f@o@s
let move_to_side level status =
match status#stack with
| [] -> assert false
- | (g,_,_,_)::tl ->
+ | (g,_,_,_,_)::tl ->
let is_open = function
| (_,Continuationals.Stack.Open i) -> Some i
| (_,Continuationals.Stack.Closed _) -> None
in
let others = menv_closure status (stack_goals (level-1) tl) in
List.for_all (fun i -> IntSet.mem i others)
- (HExtlib.filter_map is_open g)
+ (HExtlib.filter_map is_open g)
-let top_cache ~depth top status cache =
+let top_cache ~depth:_ top status ?(use_given_only=false) cache =
if top then
- let unit_eq = index_local_equations status#eq_cache status in
+ let unit_eq = index_local_equations status#eq_cache status ~flag:use_given_only in
{cache with unit_eq = unit_eq}
else cache
-let rec auto_clusters ?(top=false)
- flags signature cache depth status : unit =
+let rec auto_clusters ?(top=false) flags signature cache depth ?(use_given_only=false) status : unit =
debug_print ~depth (lazy ("entering auto clusters at depth " ^
- (string_of_int depth)));
+ (string_of_int depth)));
debug_print ~depth (pptrace status cache.trace);
(* ignore(Unix.select [] [] [] 0.01); *)
let status = clean_up_tac status in
let status = NTactics.merge_tac status in
let cache =
let l,tree = cache.under_inspection in
- match l with
- | [] -> cache (* possible because of intros that cleans the cache *)
- | a::tl -> let tree = rm_from_th a tree a in
- {cache with under_inspection = tl,tree}
+ match l with
+ | [] -> cache (* possible because of intros that cleans the cache *)
+ | a::tl -> let tree = rm_from_th a tree a in
+ {cache with under_inspection = tl,tree}
in
- auto_clusters flags signature cache (depth-1) status
+ auto_clusters flags signature cache (depth-1) status ~use_given_only
else if List.length goals < 2 then
- let cache = top_cache ~depth top status cache in
- auto_main flags signature cache depth status
+ let cache = top_cache ~depth top status cache ~use_given_only in
+ auto_main flags signature cache depth status ~use_given_only
else
let all_goals = open_goals (depth+1) status in
debug_print ~depth (lazy ("goals = " ^
(fun gl ->
if List.length gl > flags.maxwidth then
begin
- debug_print ~depth (lazy "FAIL GLOBAL WIDTH");
- HLog.warn (sprintf "global width (%u) exceeded: %u"
- flags.maxwidth (List.length gl));
- raise (Gaveup cache.failures)
- end else ()) classes;
+ debug_print ~depth (lazy "FAIL GLOBAL WIDTH");
+ HLog.warn (sprintf "global width (%u) exceeded: %u"
+ flags.maxwidth (List.length gl));
+ raise (Gaveup cache.failures)
+ end else ()) classes;
if List.length classes = 1 then
let flags =
{flags with last = (List.length all_goals = 1)} in
- (* no need to cluster *)
- let cache = top_cache ~depth top status cache in
- auto_main flags signature cache depth status
+ (* no need to cluster *)
+ let cache = top_cache ~depth top status cache ~use_given_only in
+ auto_main flags signature cache depth status ~use_given_only
else
let classes = if top then List.rev classes else classes in
debug_print ~depth
let flags =
{flags with last = (List.length gl = 1)} in
let lold = List.length status#stack in
- debug_print ~depth (lazy ("stack length = " ^
- (string_of_int lold)));
+ debug_print ~depth (lazy ("stack length = " ^
+ (string_of_int lold)));
let fstatus = deep_focus_tac (depth+1) gl status in
- let cache = top_cache ~depth top fstatus cache in
+ let cache = top_cache ~depth top fstatus cache ~use_given_only in
try
debug_print ~depth (lazy ("focusing on" ^
String.concat "," (List.map string_of_int gl)));
- auto_main flags signature cache depth fstatus; assert false
+ auto_main flags signature cache depth fstatus ~use_given_only; assert false
with
| Proved(status,trace) ->
- let status = NTactics.merge_tac status in
- let cache = {cache with trace = trace} in
- let lnew = List.length status#stack in
- assert (lold = lnew);
- (status,cache,true)
+ let status = NTactics.merge_tac status in
+ let cache = {cache with trace = trace} in
+ let lnew = List.length status#stack in
+ assert (lold = lnew);
+ (status,cache,true)
| Gaveup failures when top ->
let cache = {cache with failures = failures} in
(status,cache,b)
(status,cache,false) classes
in
let rec final_merge n s =
- if n = 0 then s else final_merge (n-1) (NTactics.merge_tac s)
+ if n = 0 then s else final_merge (n-1) (NTactics.merge_tac s)
in let status = final_merge depth status
in if b then raise (Proved(status,cache.trace)) else raise (Gaveup cache.failures)
and
(* BRAND NEW VERSION *)
-auto_main flags signature cache depth status: unit =
+auto_main flags signature cache depth ?(use_given_only=false) status: unit=
debug_print ~depth (lazy "entering auto main");
debug_print ~depth (pptrace status cache.trace);
debug_print ~depth (lazy ("stack length = " ^
- (string_of_int (List.length status#stack))));
+ (string_of_int (List.length status#stack))));
(* ignore(Unix.select [] [] [] 0.01); *)
let status = sort_tac (clean_up_tac status) in
let goals = head_goals status#stack in
| a::tl -> let tree = rm_from_th a tree a in
{cache with under_inspection = tl,tree}
in
- auto_clusters flags signature cache (depth-1) status
- | orig::_ ->
+ auto_clusters flags signature cache (depth-1) status ~use_given_only
+ | _orig::_ ->
if depth > 0 && move_to_side depth status
then
let status = NTactics.merge_tac status in
| a::tl -> let tree = rm_from_th a tree a in
{cache with under_inspection = tl,tree}
in
- auto_clusters flags signature cache (depth-1) status
+ auto_clusters flags signature cache (depth-1) status ~use_given_only
else
let ng = List.length goals in
(* moved inside auto_clusters *)
if ng > flags.maxwidth then begin
debug_print ~depth (lazy "FAIL LOCAL WIDTH");
- HLog.warn (sprintf "local width (%u) exceeded: %u"
- flags.maxwidth ng);
- raise (Gaveup cache.failures)
+ HLog.warn (sprintf "local width (%u) exceeded: %u"
+ flags.maxwidth ng);
+ raise (Gaveup cache.failures)
end else if depth = flags.maxdepth then
- raise (Gaveup cache.failures)
+ raise (Gaveup cache.failures)
else
let status = NTactics.branch_tac ~force:true status in
let g,gctx, gty = current_goal status in
(* for efficiency reasons, in this case we severely cripple the
search depth *)
(debug_print ~depth (lazy ("RAISING DEPTH TO " ^ string_of_int (depth+1)));
- auto_main flags signature cache (depth+1) status)
+ auto_main flags signature cache (depth+1) status ~use_given_only)
(* check for loops *)
else if is_subsumed depth false status closegty (snd cache.under_inspection) then
(debug_print ~depth (lazy "SUBSUMED");
(debug_print ~depth (lazy "ALREADY MET");
raise (Gaveup cache.failures))
else
- let new_sig = height_of_goal g status in
+ let new_sig = height_of_goal g status in
if new_sig < signature then
- (debug_print ~depth (lazy ("news = " ^ (string_of_int new_sig)));
- debug_print ~depth (lazy ("olds = " ^ (string_of_int signature))));
+ (debug_print ~depth (lazy ("news = " ^ (string_of_int new_sig)));
+ debug_print ~depth (lazy ("olds = " ^ (string_of_int signature))));
let alternatives, cache =
- do_something signature flags status g depth gty cache in
+ do_something signature flags status g depth gty cache ~use_given_only in
let loop_cache =
if flags.last then
- let l,tree = cache.under_inspection in
- let l,tree = closegty::l, add_to_th closegty tree closegty in
+ let l,tree = cache.under_inspection in
+ let l,tree = closegty::l, add_to_th closegty tree closegty in
{cache with under_inspection = l,tree}
else cache in
let failures =
List.fold_left
(fun allfailures ((_,t),status) ->
debug_print ~depth
- (lazy ("(re)considering goal " ^
- (string_of_int g) ^" : "^ppterm status gty));
+ (lazy ("(re)considering goal " ^
+ (string_of_int g) ^" : "^ppterm status gty));
debug_print (~depth:depth)
(lazy ("Case: " ^ NotationPp.pp_term status t));
let depth,cache =
- if t=Ast.Ident("__whd",None) ||
+ if t=Ast.Ident("__whd",None) ||
t=Ast.Ident("__intros",None)
then depth, cache
- else depth+1,loop_cache in
- let cache = add_to_trace status ~depth cache t in
+ else depth+1,loop_cache in
+ let cache = add_to_trace status ~depth cache t in
let cache = {cache with failures = allfailures} in
- try
- auto_clusters flags signature cache depth status;
+ try
+ auto_clusters flags signature cache depth status ~use_given_only;
assert false;
- with Gaveup fail ->
- debug_print ~depth (lazy "Failed");
- fail)
- cache.failures alternatives in
+ with Gaveup fail ->
+ debug_print ~depth (lazy "Failed");
+ fail)
+ cache.failures alternatives in
let failures =
if flags.last then
let newfail =
add_to_th newfail failures closegty
else failures in
debug_print ~depth (lazy "no more candidates");
- raise (Gaveup failures)
+ raise (Gaveup failures)
;;
let int name l def =
(* filtering facts *)
in List.filter
(fun t ->
- match t with
- | Ast.NRef (NReference.Ref (u,_)) -> not (is_a_fact_obj s u)
- | _ -> false) trace
+ match t with
+ | Ast.NRef (NReference.Ref (u,_)) -> not (is_a_fact_obj s u)
+ | _ -> false) trace
;;
-let auto_tac ~params:(univ,flags) ?(trace_ref=ref []) status =
+(*CSC: TODO
+
+- auto_params e' una high tactic che prende in input i parametri e poi li
+ processa nel contesto vuoto calcolando i candidate
+
+- astrarla su una auto_params' che prende in input gia' i candidate e un
+ nuovo parametro per evitare il calcolo dei candidate locali che invece
+ diventano vuoti (ovvero: non usare automaticamente tutte le ipotesi, bensi'
+ nessuna)
+
+- reimplementi la auto_params chiamando la auto_params' con il flag a
+ false e il vecchio codice per andare da parametri a candiddati
+ OVVERO: usa tutti le ipotesi locali + candidati globali
+
+- crei un nuovo entry point lowtac che calcola i candidati usando il contesto
+ corrente e poi fa exec della auto_params' con i candidati e il flag a true
+ OVVERO: usa solo candidati globali che comprendono ipotesi locali
+*)
+
+type auto_params = NTacStatus.tactic_term list option * (string * string) list
+
+(*let auto_tac ~params:(univ,flags) ?(trace_ref=ref []) status =*)
+let auto_tac' candidates ~local_candidates ?(use_given_only=false) flags ?(trace_ref=ref []) status =
let oldstatus = status in
let status = (status:> NTacStatus.tac_status) in
let goals = head_goals status#stack in
(NDiscriminationTree.TermSet.elements t))
)));
*)
- let candidates =
- match univ with
- | None -> None
- | Some l ->
- let to_Ast t =
-(* FG: `XTSort here? *)
- let status, res = disambiguate status [] t `XTNone in
- let _,res = term_of_cic_term status res (ctx_of res)
- in Ast.NCic res
- in Some (List.map to_Ast l)
- in
let depth = int "depth" flags 3 in
let size = int "size" flags 10 in
let width = int "width" flags 4 (* (3+List.length goals)*) in
let flags = {
last = true;
candidates = candidates;
+ local_candidates = local_candidates;
maxwidth = width;
maxsize = size;
maxdepth = depth;
let _ = debug_print (lazy("\n\nRound "^string_of_int x^"\n")) in
let flags = { flags with maxdepth = x }
in
- try auto_clusters (~top:true) flags signature cache 0 status;assert false
+ try auto_clusters (~top:true) flags signature cache 0 status ~use_given_only;assert false
(*
try auto_main flags signature cache 0 status;assert false
*)
| Gaveup _ -> up_to (x+1) y
| Proved (s,trace) ->
debug_print (lazy ("proved at depth " ^ string_of_int x));
- List.iter (toref incr_uses statistics) trace;
+ List.iter (toref incr_uses statistics) trace;
let trace = cleanup_trace s trace in
- let _ = debug_print (pptrace status trace) in
+ let _ = debug_print (pptrace status trace) in
let stack =
match s#stack with
- | (g,t,k,f) :: rest -> (filter_open g,t,k,f):: rest
+ | (g,t,k,f,p) :: rest -> (filter_open g,t,k,f,p):: rest
| _ -> assert false
in
let s = s#set_stack stack in
s
;;
+let candidates_from_ctx univ ctx status =
+ match univ with
+ | None -> None
+ | Some l ->
+ let to_Ast t =
+ (* FG: `XTSort here? *)
+ let status, res = disambiguate status ctx t `XTNone in
+ let _,res = term_of_cic_term status res (ctx_of res)
+ in Ast.NCic res
+ in Some (List.map to_Ast l)
+(* FG: adding these lemmas to (List.map to_Ast l) slows auto very much in some cases
+ @ [Ast.Ident("refl",None); Ast.Ident("sym_eq",None);
+ Ast.Ident("trans_eq",None); Ast.Ident("eq_f",None);
+ Ast.Ident("eq_f2",None); Ast.Ident("eq_f3",None);
+ Ast.Ident("rewrite_r",None); Ast.Ident("rewrite_l",None)
+ ]
+*)
+
+let auto_lowtac ~params:(univ,flags) status goal =
+ let gty = get_goalty status goal in
+ let ctx = ctx_of gty in
+ let candidates = candidates_from_ctx univ ctx status in
+ auto_tac' candidates ~local_candidates:true ~use_given_only:false flags ~trace_ref:(ref [])
+
+let auto_tac ~params:(univ,flags) ?(trace_ref=ref []) status =
+ let candidates = candidates_from_ctx univ [] status in
+ auto_tac' candidates ~local_candidates:true ~use_given_only:false flags ~trace_ref status
+
let auto_tac ~params:(_,flags as params) ?trace_ref =
if List.mem_assoc "demod" flags then
demod_tac ~params
\ / This software is distributed as is, NO WARRANTY.
V_______________________________________________________________ *)
+type auto_params = NTacStatus.tactic_term list option * (string * string) list
+
val is_a_fact_obj:
#NTacStatus.pstatus -> NUri.uri -> bool
-val fast_eq_check_tac:
- params:(NTacStatus.tactic_term list option * (string * string) list) ->
- 's NTacStatus.tactic
+val fast_eq_check_tac: params:auto_params -> 's NTacStatus.tactic
-val paramod_tac:
- params:(NTacStatus.tactic_term list option * (string * string) list) ->
- 's NTacStatus.tactic
+val paramod_tac: params:auto_params -> 's NTacStatus.tactic
-val demod_tac:
- params:(NTacStatus.tactic_term list option* (string * string) list) ->
- 's NTacStatus.tactic
+val demod_tac: params:auto_params -> 's NTacStatus.tactic
val smart_apply_tac:
NTacStatus.tactic_term -> 's NTacStatus.tactic
val auto_tac:
- params:(NTacStatus.tactic_term list option * (string * string) list) ->
+ params:auto_params ->
?trace_ref:NotationPt.term list ref ->
's NTacStatus.tactic
+val auto_lowtac: params:auto_params -> #NTacStatus.pstatus -> int -> 's NTacStatus.tactic
+
val keys_of_type:
(#NTacStatus.pstatus as 'a) ->
NTacStatus.cic_term -> 'a * NTacStatus.cic_term list
String.sub s 0 prefix_len = prefix
with Invalid_argument _ -> false
-let hashtbl_keys tbl = Hashtbl.fold (fun k _ acc -> k :: acc) tbl []
+(*let hashtbl_keys tbl = Hashtbl.fold (fun k _ acc -> k :: acc) tbl []*)
let hashtbl_pairs tbl = Hashtbl.fold (fun k v acc -> (k,v) :: acc) tbl []
(** </helpers> *)
let interpolated_key_rex = Str.regexp ("\\$(" ^ valid_key_rex_raw ^ ")")
let dot_rex = Str.regexp "\\."
let spaces_rex = Str.regexp "[ \t\n\r]+"
-let heading_spaces_rex = Str.regexp "^[ \t\n\r]+"
+(*let heading_spaces_rex = Str.regexp "^[ \t\n\r]+"*)
let margin_blanks_rex =
Str.regexp "^\\([ \t\n\r]*\\)\\([^ \t\n\r]*\\)\\([ \t\n\r]*\\)$"
let strip_blanks s = Str.global_replace margin_blanks_rex "\\2" s
-let split s =
+(*let split s =
(* trailing blanks are removed per default by split *)
- Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s)
-let merge l = String.concat " " l
+ Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s)*)
+(*let merge l = String.concat " " l*)
let handle_type_error f x =
try f x with exn -> raise (Type_error (Printexc.to_string exn))
| _ -> raise (Type_error "not a quad")
(* escapes for xml configuration file *)
-let (escape, unescape) =
+(*let (escape, unescape) =
let (in_enc, out_enc) = (`Enc_utf8, `Enc_utf8) in
(Netencoding.Html.encode ~in_enc ~out_enc (),
- Netencoding.Html.decode ~in_enc ~out_enc ~entity_base:`Xml ())
+ Netencoding.Html.decode ~in_enc ~out_enc ~entity_base:`Xml ())*)
let key_is_valid key =
if not (Str.string_match valid_key_rex key 0) then
let unset registry = Hashtbl.remove registry
-let env_var_of_key s = String.uppercase (Str.global_replace dot_rex "_" s)
+let env_var_of_key s = String.uppercase_ascii (Str.global_replace dot_rex "_" s)
let singleton = function
| [] ->
pp_r m s
| [< >] -> ()
and print_spaces m =
- for i = 1 to m do f " " done
+ for _i = 1 to m do f " " done
in
pp_r 0 strm
;;
;;
let pp_to_gzipchan strm oc =
- pp_gen (fun s -> Gzip.output oc s 0 (String.length s)) strm
+ pp_gen (fun s -> Gzip.output oc (Bytes.of_string s) 0 (String.length s)) strm
;;
(** pretty printer to string *)
aux (`Channel ic);
close_in ic
| `Gzip_channel ic ->
- let buf = String.create gzip_bufsize in
+ let buf = Bytes.create gzip_bufsize in
(try
while true do
let bytes = Gzip.input ic buf 0 gzip_bufsize in
if bytes = 0 then raise End_of_file;
- parse_fun (String.sub buf 0 bytes)
+ parse_fun (Bytes.to_string (Bytes.sub buf 0 bytes))
done
with End_of_file -> final expat_parser)
| `Gzip_file fname ->
DEBUG_DEFAULT="true"
DEFAULT_DBHOST="mysql://mowgli.cs.unibo.it"
RT_BASE_DIR_DEFAULT="`pwd`/matita"
-MATITA_VERSION="0.99.3"
+MATITA_VERSION="0.99.4"
DISTRIBUTED="yes" # "yes" for distributed tarballs
# End of distribution settings
else
AC_MSG_ERROR(could not find ocamlfind)
fi
-AC_CHECK_PROG(HAVE_LABLGLADECC, lablgladecc2, yes, no)
+AC_CHECK_PROG(HAVE_LABLGLADECC, lablgladecc3, yes, no)
if test $HAVE_LABLGLADECC = "yes"; then
- LABLGLADECC="lablgladecc2"
+ LABLGLADECC="lablgladecc3"
else
- AC_MSG_ERROR(could not find lablgladecc2)
+ AC_MSG_ERROR(could not find lablgladecc3)
fi
AC_CHECK_PROG(HAVE_CAMLP5O, camlp5o, yes, no)
if test $HAVE_CAMLP5O = "yes"; then
# look for METAS dir
LIBSPATH="`pwd`/components"
-OCAMLPATH="$LIBSPATH/METAS"
+OCAMLPATHL="$LIBSPATH/METAS"
+OCAMLPATH="$OCAMLPATHL:$OCAMLPATH"
# creating META.*
echo -n "creating METAs ... "
-for f in $OCAMLPATH/meta.*.src; do
+for f in $OCAMLPATHL/meta.*.src; do
basename=`basename $f`
metaname=`echo $basename | sed 's/meta\.\(.*\)\.src/\1/'`
dirname=`echo $metaname | sed 's/^helm-//'`
- metafile="$OCAMLPATH/META.$metaname"
+ metafile="$OCAMLPATHL/META.$metaname"
cp $f $metafile
echo "directory=\"$LIBSPATH/$dirname\"" >> $metafile
done
# (libs) findlib requisites
+#gdome2 \
+#mysql \
FINDLIB_LIBSREQUIRES="\
expat \
-gdome2 \
http \
-lablgtk2 \
-lablgtk2.sourceview2 \
-mysql \
+pcre \
+str \
+unix \
+lablgtk3 \
+lablgtk3-sourceview3 \
netstring \
-ulex08 \
+ulex-camlp5 \
zip \
"
# (Matita) findlib requisites
+#lablgtk3.glade \
FINDLIB_COMREQUIRES="\
helm-disambiguation \
helm-grafite \
"
FINDLIB_REQUIRES="\
$FINDLIB_CREQUIRES \
-lablgtk2.glade \
-lablgtk2.sourceview2 \
+lablgtk3-sourceview3 \
"
+
for r in $FINDLIB_LIBSREQUIRES $FINDLIB_REQUIRES
do
AC_MSG_CHECKING(for $r ocaml library)
lablGraphviz.cmx : lablGraphviz.cmi
lablGraphviz.cmi :
matita.cmo : predefined_virtuals.cmi matitaScript.cmi matitaMisc.cmi \
- matitaInit.cmi matitaGui.cmi matitaGtkMisc.cmi buildTimeConf.cmo \
- applyTransformation.cmi
+ matitaInit.cmi matitaGui.cmi buildTimeConf.cmo applyTransformation.cmi
matita.cmx : predefined_virtuals.cmx matitaScript.cmx matitaMisc.cmx \
- matitaInit.cmx matitaGui.cmx matitaGtkMisc.cmx buildTimeConf.cmx \
- applyTransformation.cmx
+ matitaInit.cmx matitaGui.cmx buildTimeConf.cmx applyTransformation.cmx
matitaEngine.cmo : applyTransformation.cmi matitaEngine.cmi
matitaEngine.cmx : applyTransformation.cmx matitaEngine.cmi
matitaEngine.cmi : applyTransformation.cmi
matitaExcPp.cmi :
matitaGeneratedGui.cmo :
matitaGeneratedGui.cmx :
-matitaGtkMisc.cmo : matitaTypes.cmi matitaGeneratedGui.cmo buildTimeConf.cmo \
+matitaGtkMisc.cmo : matitaGeneratedGui.cmo buildTimeConf.cmo \
matitaGtkMisc.cmi
-matitaGtkMisc.cmx : matitaTypes.cmx matitaGeneratedGui.cmx buildTimeConf.cmx \
+matitaGtkMisc.cmx : matitaGeneratedGui.cmx buildTimeConf.cmx \
matitaGtkMisc.cmi
matitaGtkMisc.cmi : matitaGeneratedGui.cmo
matitaGui.cmo : matitaTypes.cmi matitaScript.cmi matitaMisc.cmi \
matitaMathView.cmx matitaGuiTypes.cmi matitaGtkMisc.cmx \
matitaGeneratedGui.cmx matitaExcPp.cmx buildTimeConf.cmx matitaGui.cmi
matitaGui.cmi : matitaGuiTypes.cmi
+matitaGuiInit.cmo :
+matitaGuiInit.cmx :
matitaGuiTypes.cmi : matitaGeneratedGui.cmo applyTransformation.cmi
matitaInit.cmo : matitaExcPp.cmi buildTimeConf.cmo matitaInit.cmi
matitaInit.cmx : matitaExcPp.cmx buildTimeConf.cmx matitaInit.cmi
lablGraphviz.cmx : lablGraphviz.cmi
lablGraphviz.cmi :
matita.cmx : predefined_virtuals.cmx matitaScript.cmx matitaMisc.cmx \
- matitaInit.cmx matitaGui.cmx matitaGtkMisc.cmx buildTimeConf.cmx \
- applyTransformation.cmx
+ matitaInit.cmx matitaGui.cmx buildTimeConf.cmx applyTransformation.cmx
matitaEngine.cmx : applyTransformation.cmx matitaEngine.cmi
matitaEngine.cmi : applyTransformation.cmi
matitaExcPp.cmx : matitaEngine.cmx matitaExcPp.cmi
matitaExcPp.cmi :
matitaGeneratedGui.cmx :
-matitaGtkMisc.cmx : matitaTypes.cmx matitaGeneratedGui.cmx buildTimeConf.cmx \
+matitaGtkMisc.cmx : matitaGeneratedGui.cmx buildTimeConf.cmx \
matitaGtkMisc.cmi
matitaGtkMisc.cmi : matitaGeneratedGui.cmx
matitaGui.cmx : matitaTypes.cmx matitaScript.cmx matitaMisc.cmx \
matitaMathView.cmx matitaGuiTypes.cmi matitaGtkMisc.cmx \
matitaGeneratedGui.cmx matitaExcPp.cmx buildTimeConf.cmx matitaGui.cmi
matitaGui.cmi : matitaGuiTypes.cmi
+matitaGuiInit.cmx :
matitaGuiTypes.cmi : matitaGeneratedGui.cmx applyTransformation.cmi
matitaInit.cmx : matitaExcPp.cmx buildTimeConf.cmx matitaInit.cmi
matitaInit.cmi :
ANNOTOPTION =
endif
-OCAML_FLAGS = -pp $(CAMLP5O) -rectypes $(ANNOTOPTION)
+OCAML_FLAGS = -pp $(CAMLP5O) -rectypes $(ANNOTOPTION) -w @A-52-4-34-37-45-9-44-48-6-32-20-58-7
OCAMLDEP_FLAGS = -pp $(CAMLP5O)
PKGS = -package "$(MATITA_REQUIRES)"
CPKGS = -package "$(MATITA_CREQUIRES)"
matitaclean.mli \
$(NULL)
# objects for matita (GTK GUI)
-ML = buildTimeConf.ml matitaGeneratedGui.ml $(MLI:%.mli=%.ml)
+ML = buildTimeConf.ml matitaGuiInit.ml matitaGeneratedGui.ml $(MLI:%.mli=%.ml)
# objects for matitac (batch compiler)
CML = buildTimeConf.ml $(CMLI:%.mli=%.ml)
MAINCML = $(MAINCMLI:%.mli=%.ml)
matitaclean.opt: matitac.opt
$(H)test -f $@ || ln -s $< $@
-matitaGeneratedGui.ml: matita.glade.utf8
+matitaGeneratedGui.ml: matita.ui
$(H)$(LABLGLADECC) -embed $< > matitaGeneratedGui.ml
-matita.glade.utf8: matita.glade
- $(H)xmllint --encode UTF8 $< > $@
.PHONY: clean
clean:
.PHONY: distclean
distclean: clean
$(H)$(MAKE) -C dist/ clean
- $(H)rm -f matitaGeneratedGui.ml matitaGeneratedGui.mli
$(H)rm -f buildTimeConf.ml
$(H)rm -f matita.glade.bak matita.gladep.bak
$(H)rm -f matita.conf.xml.sample
# {{{ Distribution stuff
-dist_pre: matitaGeneratedGui.ml
+dist_pre:
$(MAKE) -C dist/ dist_pre
WHERE = $(DESTDIR)/$(RT_BASE_DIR)
Content2pres.ncontext2pres
((new NCicPp.status)#ppcontext ~metasenv ~subst)
-let ntxt_of_cic_subst ~map_unicode_to_tex size status ~metasenv ?use_subst subst =
+let ntxt_of_cic_subst ~map_unicode_to_tex:_ _size _status ~metasenv ?use_subst subst =
[],
"<<<high level printer for subst not implemented; low-level printing:>>>\n" ^
(new NCicPp.status)#ppsubst ~metasenv ?use_subst subst
object(self)
inherit Interpretations.status
inherit TermContentPres.status
- method ppterm ~context ~subst ~metasenv ?margin ?inside_fix t =
+ method ppterm ~context ~subst ~metasenv ?margin:(_) ?inside_fix:(_) t =
snd (ntxt_of_cic_term ~map_unicode_to_tex:false 80 self ~metasenv ~subst
~context t)
- method ppcontext ?sep ~subst ~metasenv context =
+ method ppcontext ?sep:(_) ~subst ~metasenv context =
snd (ntxt_of_cic_context ~map_unicode_to_tex:false 80 self ~metasenv ~subst
context)
method ppobj obj =
snd (ntxt_of_cic_object ~map_unicode_to_tex:false 80 self obj)
end
+
+let notation_pp_term status term =
+ let to_pres = Content2pres.nterm2pres ?prec:None in
+ let content = term in
+ let size = 80 in
+ let ids_to_nrefs = Hashtbl.create 1 in
+ let pres = to_pres status ~ids_to_nrefs content in
+ let pres = CicNotationPres.mpres_of_box pres in
+ BoxPp.render_to_string ~map_unicode_to_tex:(Helm_registry.get_bool "matita.paste_unicode_as_tex")
+ (function x::_ -> x | _ -> assert false) size pres
+
+let _ = NotationPp.set_pp_term (fun status y -> snd (notation_pp_term (Obj.magic status) y))
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/lists/list.ma".
+
+axiom alpha : Type[0].
+notation "𝔸" non associative with precedence 90 for @{'alphabet}.
+interpretation "set of names" 'alphabet = alpha.
+
+inductive tp : Type[0] ≝
+| top : tp
+| arr : tp → tp → tp.
+inductive tm : Type[0] ≝
+| var : nat → tm
+| par : 𝔸 → tm
+| abs : tp → tm → tm
+| app : tm → tm → tm.
+
+let rec Nth T n (l:list T) on n ≝
+ match l with
+ [ nil ⇒ None ?
+ | cons hd tl ⇒ match n with
+ [ O ⇒ Some ? hd
+ | S n0 ⇒ Nth T n0 tl ] ].
+
+inductive judg : list tp → tm → tp → Prop ≝
+| t_var : ∀g,n,t.Nth ? n g = Some ? t → judg g (var n) t
+| t_app : ∀g,m,n,t,u.judg g m (arr t u) → judg g n t → judg g (app m n) u
+| t_abs : ∀g,t,m,u.judg (t::g) m u → judg g (abs t m) (arr t u).
+
+definition Env := list (𝔸 × tp).
+
+axiom vclose_env : Env → list tp.
+axiom vclose_tm : Env → tm → tm.
+axiom Lam : 𝔸 → tp → tm → tm.
+definition Judg ≝ λG,M,T.judg (vclose_env G) (vclose_tm G M) T.
+definition dom ≝ λG:Env.map ?? (fst ??) G.
+
+definition sctx ≝ 𝔸 × tm.
+axiom swap_tm : 𝔸 → 𝔸 → tm → tm.
+definition sctx_app : sctx → 𝔸 → tm ≝ λM0,Y.let 〈X,M〉 ≝ M0 in swap_tm X Y M.
+
+axiom in_list : ∀A:Type[0].A → list A → Prop.
+interpretation "list membership" 'mem x l = (in_list ? x l).
+interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
+
+axiom in_Env : 𝔸 × tp → Env → Prop.
+notation "X ◃ G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+let rec FV M ≝ match M with
+ [ par X ⇒ [X]
+ | app M1 M2 ⇒ FV M1@FV M2
+ | abs T M0 ⇒ FV M0
+ | _ ⇒ [ ] ].
+
+(* axiom Lookup : 𝔸 → Env → option tp. *)
+
+(* forma alto livello del judgment
+ t_abs* : ∀G,T,X,M,U.
+ (∀Y ∉ supp(M).Judg (〈Y,T〉::G) (M[Y]) U) →
+ Judg G (Lam X T (M[X])) (arr T U) *)
+
+(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
+
+axiom Judg_ind : ∀P:Env → tm → tp → Prop.
+ (∀X,G,T.〈X,T〉 ◃ G → P G (par X) T) →
+ (∀G,M,N,T,U.
+ Judg G M (arr T U) → Judg G N T →
+ P G M (arr T U) → P G N T → P G (app M N) U) →
+ (∀G,T1,T2,X,M1.
+ (∀Y.Y ∉ (FV (Lam X T1 (sctx_app M1 X))) → Judg (〈Y,T1〉::G) (sctx_app M1 Y) T2) →
+ (∀Y.Y ∉ (FV (Lam X T1 (sctx_app M1 X))) → P (〈Y,T1〉::G) (sctx_app M1 Y) T2) →
+ P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) →
+ ∀G,M,T.Judg G M T → P G M T.
+
+axiom t_par : ∀X,G,T.〈X,T〉 ◃ G → Judg G (par X) T.
+axiom t_app2 : ∀G,M,N,T,U.Judg G M (arr T U) → Judg G N T → Judg G (app M N) U.
+axiom t_Lam : ∀G,X,M,T,U.Judg (〈X,T〉::G) M U → Judg G (Lam X T M) (arr T U).
+
+definition subenv ≝ λG1,G2.∀x.x ◃ G1 → x ◃ G2.
+interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
+
+axiom daemon : ∀P:Prop.P.
+
+theorem weakening : ∀G1,G2,M,T.G1 ⊆ G2 → Judg G1 M T → Judg G2 M T.
+#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (∀G2.?)
+@(Judg_ind … HJ)
+[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
+| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
+ [| @IH1 // | @IH2 // ]
+| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
+ [ (* trivial property of Lam *) @daemon
+ | (* trivial property of subenv *) @daemon ]
+]
+qed.
+
+(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
+ ricorsione *)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "binding/names.ma".
+
+(* permutations *)
+definition finite_perm : ∀X:Nset.(X → X) → Prop ≝
+ λX,f.injective X X f ∧ surjective X X f ∧ ∃l.∀x.x ∉ l → f x = x.
+
+(* maps a permutation to a list of parameters *)
+definition Pi_list : ∀X:Nset.(X → X) → list X → list X ≝
+ λX,p,xl.map ?? (λx.p x) xl.
+
+interpretation "permutation of X list" 'middot p x = (Pi_list p x).
+
+definition swap : ∀N:Nset.N → N → N → N ≝
+ λN,u,v,x.match (x == u) with
+ [true ⇒ v
+ |false ⇒ match (x == v) with
+ [true ⇒ u
+ |false ⇒ x]].
+
+axiom swap_right : ∀N,x,y.swap N x y y = x.
+(*
+#N x y;nnormalize;nrewrite > (p_eqb3 ? y y …);//;
+nlapply (refl ? (y ≟ x));ncases (y ≟ x) in ⊢ (???% → %);nnormalize;//;
+#H1;napply p_eqb1;//;
+nqed.
+*)
+
+axiom swap_left : ∀N,x,y.swap N x y x = y.
+(*
+#N x y;nnormalize;nrewrite > (p_eqb3 ? x x …);//;
+nqed.
+*)
+
+axiom swap_other : ∀N,x,y,z.x ≠ z → y ≠ z → swap N x y z = z.
+(*
+#N x y z H1 H2;nnormalize;nrewrite > (p_eqb4 …);
+##[nrewrite > (p_eqb4 …);//;@;ncases H2;/2/;
+##|@;ncases H1;/2/
+##]
+nqed.
+*)
+
+axiom swap_inv : ∀N,x,y,z.swap N x y (swap N x y z) = z.
+(*
+#N x y z;nlapply (refl ? (x ≟ z));ncases (x ≟ z) in ⊢ (???% → ?);#H1
+##[nrewrite > (p_eqb1 … H1);nrewrite > (swap_left …);//;
+##|nlapply (refl ? (y ≟ z));ncases (y ≟ z) in ⊢ (???% → ?);#H2
+ ##[nrewrite > (p_eqb1 … H2);nrewrite > (swap_right …);//;
+ ##|nrewrite > (swap_other …) in ⊢ (??(????%)?);/2/;
+ nrewrite > (swap_other …);/2/;
+ ##]
+##]
+nqed.
+*)
+
+axiom swap_fp : ∀N,x1,x2.finite_perm ? (swap N x1 x2).
+(*
+#N x1 x2;@
+##[@
+ ##[nwhd;#xa xb;nnormalize;nlapply (refl ? (xa ≟ x1));
+ ncases (xa ≟ x1) in ⊢ (???% → %);#H1
+ ##[nrewrite > (p_eqb1 … H1);nlapply (refl ? (xb ≟ x1));
+ ncases (xb ≟ x1) in ⊢ (???% → %);#H2
+ ##[nrewrite > (p_eqb1 … H2);//
+ ##|nlapply (refl ? (xb ≟ x2));
+ ncases (xb ≟ x2) in ⊢ (???% → %);#H3
+ ##[nnormalize;#H4;nrewrite > H4 in H3;
+ #H3;nrewrite > H3 in H2;#H2;ndestruct (H2)
+ ##|nnormalize;#H4;nrewrite > H4 in H3;
+ nrewrite > (p_eqb3 …);//;#H5;ndestruct (H5)
+ ##]
+ ##]
+ ##|nlapply (refl ? (xa ≟ x2));
+ ncases (xa ≟ x2) in ⊢ (???% → %);#H2
+ ##[nrewrite > (p_eqb1 … H2);nlapply (refl ? (xb ≟ x1));
+ ncases (xb ≟ x1) in ⊢ (???% → %);#H3
+ ##[nnormalize;#H4;nrewrite > H4 in H3;
+ #H3;nrewrite > (p_eqb1 … H3);@
+ ##|nnormalize;nlapply (refl ? (xb ≟ x2));
+ ncases (xb ≟ x2) in ⊢ (???% → %);#H4
+ ##[nrewrite > (p_eqb1 … H4);//
+ ##|nnormalize;#H5;nrewrite > H5 in H3;
+ nrewrite > (p_eqb3 …);//;#H6;ndestruct (H6);
+ ##]
+ ##]
+ ##|nnormalize;nlapply (refl ? (xb ≟ x1));
+ ncases (xb ≟ x1) in ⊢ (???% → %);#H3
+ ##[nnormalize;#H4;nrewrite > H4 in H2;nrewrite > (p_eqb3 …);//;
+ #H5;ndestruct (H5)
+ ##|nlapply (refl ? (xb ≟ x2));
+ ncases (xb ≟ x2) in ⊢ (???% → %);#H4
+ ##[nnormalize;#H5;nrewrite > H5 in H1;nrewrite > (p_eqb3 …);//;
+ #H6;ndestruct (H6)
+ ##|nnormalize;//
+ ##]
+ ##]
+ ##]
+ ##]
+ ##|nwhd;#z;nnormalize;nlapply (refl ? (z ≟ x1));
+ ncases (z ≟ x1) in ⊢ (???% → %);#H1
+ ##[nlapply (refl ? (z ≟ x2));
+ ncases (z ≟ x2) in ⊢ (???% → %);#H2
+ ##[@ z;nrewrite > H1;nrewrite > H2;napply p_eqb1;//
+ ##|@ x2;nrewrite > (p_eqb4 …);
+ ##[nrewrite > (p_eqb3 …);//;
+ nnormalize;napply p_eqb1;//
+ ##|nrewrite < (p_eqb1 … H1);@;#H3;nrewrite > H3 in H2;
+ nrewrite > (p_eqb3 …);//;#H2;ndestruct (H2)
+ ##]
+ ##]
+ ##|nlapply (refl ? (z ≟ x2));
+ ncases (z ≟ x2) in ⊢ (???% → %);#H2
+ ##[@ x1;nrewrite > (p_eqb3 …);//;
+ napply p_eqb1;nnormalize;//
+ ##|@ z;nrewrite > H1;nrewrite > H2;@;
+ ##]
+ ##]
+ ##]
+##|@ [x1;x2];#x0 H1;nrewrite > (swap_other …)
+ ##[@
+ ##|@;#H2;nrewrite > H2 in H1;*;#H3;napply H3;/2/;
+ ##|@;#H2;nrewrite > H2 in H1;*;#H3;napply H3;//;
+ ##]
+##]
+nqed.
+*)
+
+axiom inj_swap : ∀N,u,v.injective ?? (swap N u v).
+(*
+#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
+nqed.
+*)
+
+axiom surj_swap : ∀N,u,v.surjective ?? (swap N u v).
+(*
+#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
+nqed.
+*)
+
+axiom finite_swap : ∀N,u,v.∃l.∀x.x ∉ l → swap N u v x = x.
+(*
+#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
+nqed.
+*)
+
+(* swaps two lists of parameters
+definition Pi_swap_list : ∀xl,xl':list X.X → X ≝
+ λxl,xl',x.foldr2 ??? (λu,v,r.swap ? u v r) x xl xl'.
+
+nlemma fp_swap_list :
+ ∀xl,xl'.finite_perm ? (Pi_swap_list xl xl').
+#xl xl';@
+##[@;
+ ##[ngeneralize in match xl';nelim xl
+ ##[nnormalize;//;
+ ##|#x0 xl0;#IH xl'';nelim xl''
+ ##[nnormalize;//
+ ##|#x1 xl1 IH1 y0 y1;nchange in ⊢ (??%% → ?) with (swap ????);
+ #H1;nlapply (inj_swap … H1);#H2;
+ nlapply (IH … H2);//
+ ##]
+ ##]
+ ##|ngeneralize in match xl';nelim xl
+ ##[nnormalize;#_;#z;@z;@
+ ##|#x' xl0 IH xl'';nelim xl''
+ ##[nnormalize;#z;@z;@
+ ##|#x1 xl1 IH1 z;
+ nchange in ⊢ (??(λ_.???%)) with (swap ????);
+ ncases (surj_swap X x' x1 z);#x2 H1;
+ ncases (IH xl1 x2);#x3 H2;@ x3;
+ nrewrite < H2;napply H1
+ ##]
+ ##]
+ ##]
+##|ngeneralize in match xl';nelim xl
+ ##[#;@ [];#;@
+ ##|#x0 xl0 IH xl'';ncases xl''
+ ##[@ [];#;@
+ ##|#x1 xl1;ncases (IH xl1);#xl2 H1;
+ ncases (finite_swap X x0 x1);#xl3 H2;
+ @ (xl2@xl3);#x2 H3;
+ nchange in ⊢ (??%?) with (swap ????);
+ nrewrite > (H1 …);
+ ##[nrewrite > (H2 …);//;@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_r;//
+ ##|@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_l;//
+ ##]
+ ##]
+ ##]
+##]
+nqed.
+
+(* the 'reverse' swap of lists of parameters
+ composing Pi_swap_list and Pi_swap_list_r yields the identity function
+ (see the Pi_swap_list_inv lemma) *)
+ndefinition Pi_swap_list_r : ∀xl,xl':list X. Pi ≝
+ λxl,xl',x.foldl2 ??? (λr,u,v.swap ? u v r ) x xl xl'.
+
+nlemma fp_swap_list_r :
+ ∀xl,xl'.finite_perm ? (Pi_swap_list_r xl xl').
+#xl xl';@
+##[@;
+ ##[ngeneralize in match xl';nelim xl
+ ##[nnormalize;//;
+ ##|#x0 xl0;#IH xl'';nelim xl''
+ ##[nnormalize;//
+ ##|#x1 xl1 IH1 y0 y1;nwhd in ⊢ (??%% → ?);
+ #H1;nlapply (IH … H1);#H2;
+ napply (inj_swap … H2);
+ ##]
+ ##]
+ ##|ngeneralize in match xl';nelim xl
+ ##[nnormalize;#_;#z;@z;@
+ ##|#x' xl0 IH xl'';nelim xl''
+ ##[nnormalize;#z;@z;@
+ ##|#x1 xl1 IH1 z;nwhd in ⊢ (??(λ_.???%));
+ ncases (IH xl1 z);#x2 H1;
+ ncases (surj_swap X x' x1 x2);#x3 H2;
+ @ x3;nrewrite < H2;napply H1;
+ ##]
+ ##]
+ ##]
+##|ngeneralize in match xl';nelim xl
+ ##[#;@ [];#;@
+ ##|#x0 xl0 IH xl'';ncases xl''
+ ##[@ [];#;@
+ ##|#x1 xl1;
+ ncases (IH xl1);#xl2 H1;
+ ncases (finite_swap X x0 x1);#xl3 H2;
+ @ (xl2@xl3);#x2 H3;nwhd in ⊢ (??%?);
+ nrewrite > (H2 …);
+ ##[nrewrite > (H1 …);//;@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_l;//
+ ##|@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_r;//
+ ##]
+ ##]
+ ##]
+##]
+nqed.
+
+nlemma Pi_swap_list_inv :
+ ∀xl1,xl2,x.
+ Pi_swap_list xl1 xl2 (Pi_swap_list_r xl1 xl2 x) = x.
+#xl;nelim xl
+##[#;@
+##|#x1 xl1 IH xl';ncases xl'
+ ##[#;@
+ ##|#x2 xl2;#x;
+ nchange in ⊢ (??%?) with
+ (swap ??? (Pi_swap_list ??
+ (Pi_swap_list_r ?? (swap ????))));
+ nrewrite > (IH xl2 ?);napply swap_inv;
+ ##]
+##]
+nqed.
+
+nlemma Pi_swap_list_fresh :
+ ∀x,xl1,xl2.x ∉ xl1 → x ∉ xl2 → Pi_swap_list xl1 xl2 x = x.
+#x xl1;nelim xl1
+##[#;@
+##|#x3 xl3 IH xl2' H1;ncases xl2'
+ ##[#;@
+ ##|#x4 xl4 H2;ncut (x ∉ xl3 ∧ x ∉ xl4);
+ ##[@
+ ##[@;#H3;ncases H1;#H4;napply H4;/2/;
+ ##|@;#H3;ncases H2;#H4;napply H4;/2/
+ ##]
+ ##] *; #H1' H2';
+ nchange in ⊢ (??%?) with (swap ????);
+ nrewrite > (swap_other …)
+ ##[napply IH;//;
+ ##|nchange in ⊢ (?(???%)) with (Pi_swap_list ???);
+ nrewrite > (IH …);//;@;#H3;ncases H2;#H4;napply H4;//;
+ ##|nchange in ⊢ (?(???%)) with (Pi_swap_list ???);
+ nrewrite > (IH …);//;@;#H3;ncases H1;#H4;napply H4;//
+ ##]
+ ##]
+##]
+nqed.
+*)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/lists/list.ma".
+include "basics/deqsets.ma".
+include "binding/names.ma".
+include "binding/fp.ma".
+
+axiom alpha : Nset.
+notation "𝔸" non associative with precedence 90 for @{'alphabet}.
+interpretation "set of names" 'alphabet = alpha.
+
+inductive tp : Type[0] ≝
+| top : tp
+| arr : tp → tp → tp.
+inductive pretm : Type[0] ≝
+| var : nat → pretm
+| par : 𝔸 → pretm
+| abs : tp → pretm → pretm
+| app : pretm → pretm → pretm.
+
+let rec Nth T n (l:list T) on n ≝
+ match l with
+ [ nil ⇒ None ?
+ | cons hd tl ⇒ match n with
+ [ O ⇒ Some ? hd
+ | S n0 ⇒ Nth T n0 tl ] ].
+
+let rec vclose_tm_aux u x k ≝ match u with
+ [ var n ⇒ if (leb k n) then var (S n) else u
+ | par x0 ⇒ if (x0 == x) then (var k) else u
+ | app v1 v2 ⇒ app (vclose_tm_aux v1 x k) (vclose_tm_aux v2 x k)
+ | abs s v ⇒ abs s (vclose_tm_aux v x (S k)) ].
+definition vclose_tm ≝ λu,x.vclose_tm_aux u x O.
+
+definition vopen_var ≝ λn,x,k.match eqb n k with
+ [ true ⇒ par x
+ | false ⇒ match leb n k with
+ [ true ⇒ var n
+ | false ⇒ var (pred n) ] ].
+
+let rec vopen_tm_aux u x k ≝ match u with
+ [ var n ⇒ vopen_var n x k
+ | par x0 ⇒ u
+ | app v1 v2 ⇒ app (vopen_tm_aux v1 x k) (vopen_tm_aux v2 x k)
+ | abs s v ⇒ abs s (vopen_tm_aux v x (S k)) ].
+definition vopen_tm ≝ λu,x.vopen_tm_aux u x O.
+
+let rec FV u ≝ match u with
+ [ par x ⇒ [x]
+ | app v1 v2 ⇒ FV v1@FV v2
+ | abs s v ⇒ FV v
+ | _ ⇒ [ ] ].
+
+definition lam ≝ λx,s,u.abs s (vclose_tm u x).
+
+let rec Pi_map_tm p u on u ≝ match u with
+[ par x ⇒ par (p x)
+| var _ ⇒ u
+| app v1 v2 ⇒ app (Pi_map_tm p v1) (Pi_map_tm p v2)
+| abs s v ⇒ abs s (Pi_map_tm p v) ].
+
+interpretation "permutation of tm" 'middot p x = (Pi_map_tm p x).
+
+notation "hvbox(u⌈x⌉)"
+ with precedence 45
+ for @{ 'open $u $x }.
+
+(*
+notation "hvbox(u⌈x⌉)"
+ with precedence 45
+ for @{ 'open $u $x }.
+notation "❴ u ❵ x" non associative with precedence 90 for @{ 'open $u $x }.
+*)
+interpretation "ln term variable open" 'open u x = (vopen_tm u x).
+notation < "hvbox(ν x break . u)"
+ with precedence 20
+for @{'nu $x $u }.
+notation > "ν list1 x sep , . term 19 u" with precedence 20
+ for ${ fold right @{$u} rec acc @{'nu $x $acc)} }.
+interpretation "ln term variable close" 'nu x u = (vclose_tm u x).
+
+let rec tm_height u ≝ match u with
+[ app v1 v2 ⇒ S (max (tm_height v1) (tm_height v2))
+| abs s v ⇒ S (tm_height v)
+| _ ⇒ O ].
+
+theorem le_n_O_rect_Type0 : ∀n:nat. n ≤ O → ∀P: nat →Type[0]. P O → P n.
+#n (cases n) // #a #abs cases (?:False) /2/ qed.
+
+theorem nat_rect_Type0_1 : ∀n:nat.∀P:nat → Type[0].
+(∀m.(∀p. p < m → P p) → P m) → P n.
+#n #P #H
+cut (∀q:nat. q ≤ n → P q) /2/
+(elim n)
+ [#q #HleO (* applica male *)
+ @(le_n_O_rect_Type0 ? HleO)
+ @H #p #ltpO cases (?:False) /2/ (* 3 *)
+ |#p #Hind #q #HleS
+ @H #a #lta @Hind @le_S_S_to_le /2/
+ ]
+qed.
+
+lemma leb_false_to_lt : ∀n,m. leb n m = false → m < n.
+#n elim n
+[ #m normalize #H destruct(H)
+| #n0 #IH * // #m normalize #H @le_S_S @IH // ]
+qed.
+
+lemma nominal_eta_aux : ∀x,u.x ∉ FV u → ∀k.vclose_tm_aux (vopen_tm_aux u x k) x k = u.
+#x #u elim u
+[ #n #_ #k normalize cases (decidable_eq_nat n k) #Hnk
+ [ >Hnk >eqb_n_n normalize >(\b ?) //
+ | >(not_eq_to_eqb_false … Hnk) normalize cases (true_or_false (leb n k)) #Hleb
+ [ >Hleb normalize >(?:leb k n = false) //
+ @lt_to_leb_false @not_eq_to_le_to_lt /2/
+ | >Hleb normalize >(?:leb k (pred n) = true) normalize
+ [ cases (leb_false_to_lt … Hleb) //
+ | @le_to_leb_true cases (leb_false_to_lt … Hleb) normalize /2/ ] ] ]
+| #y normalize #Hy >(\bf ?) // @(not_to_not … Hy) //
+| #s #v #IH normalize #Hv #k >IH // @Hv
+| #v1 #v2 #IH1 #IH2 normalize #Hv1v2 #k
+ >IH1 [ >IH2 // | @(not_to_not … Hv1v2) @in_list_to_in_list_append_l ]
+ @(not_to_not … Hv1v2) @in_list_to_in_list_append_r ]
+qed.
+
+corollary nominal_eta : ∀x,u.x ∉ FV u → (νx.u⌈x⌉) = u.
+#x #u #Hu @nominal_eta_aux //
+qed.
+
+lemma eq_height_vopen_aux : ∀v,x,k.tm_height (vopen_tm_aux v x k) = tm_height v.
+#v #x elim v
+[ #n #k normalize cases (eqb n k) // cases (leb n k) //
+| #u #k %
+| #s #u #IH #k normalize >IH %
+| #u1 #u2 #IH1 #IH2 #k normalize >IH1 >IH2 % ]
+qed.
+
+corollary eq_height_vopen : ∀v,x.tm_height (v⌈x⌉) = tm_height v.
+#v #x @eq_height_vopen_aux
+qed.
+
+theorem pretm_ind_plus_aux :
+ ∀P:pretm → Type[0].
+ (∀x:𝔸.P (par x)) →
+ (∀n:ℕ.P (var n)) →
+ (∀v1,v2. P v1 → P v2 → P (app v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s,v.x ∉ FV v → x ∉ C → P (v⌈x⌉) → P (lam x s (v⌈x⌉))) →
+ ∀n,u.tm_height u ≤ n → P u.
+#P #Hpar #Hvar #Happ #C #Hlam #n change with ((λn.?) n); @(nat_rect_Type0_1 n ??)
+#m cases m
+[ #_ * /2/
+ [ normalize #s #v #Hfalse cases (?:False) cases (not_le_Sn_O (tm_height v)) /2/
+ | #v1 #v2 whd in ⊢ (?%?→?); #Hfalse cases (?:False) cases (not_le_Sn_O (max ??))
+ [ #H @H @Hfalse|*:skip] ] ]
+-m #m #IH * /2/
+[ #s #v whd in ⊢ (?%?→?); #Hv
+ lapply (p_fresh … (C@FV v)) letin y ≝ (N_fresh … (C@FV v)) #Hy
+ >(?:abs s v = lam y s (v⌈y⌉))
+ [| whd in ⊢ (???%); >nominal_eta // @(not_to_not … Hy) @in_list_to_in_list_append_r ]
+ @Hlam
+ [ @(not_to_not … Hy) @in_list_to_in_list_append_r
+ | @(not_to_not … Hy) @in_list_to_in_list_append_l ]
+ @IH [| @Hv | >eq_height_vopen % ]
+| #v1 #v2 whd in ⊢ (?%?→?); #Hv @Happ
+ [ @IH [| @Hv | @le_max_1 ] | @IH [| @Hv | @le_max_2 ] ] ]
+qed.
+
+corollary pretm_ind_plus :
+ ∀P:pretm → Type[0].
+ (∀x:𝔸.P (par x)) →
+ (∀n:ℕ.P (var n)) →
+ (∀v1,v2. P v1 → P v2 → P (app v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s,v.x ∉ FV v → x ∉ C → P (v⌈x⌉) → P (lam x s (v⌈x⌉))) →
+ ∀u.P u.
+#P #Hpar #Hvar #Happ #C #Hlam #u @pretm_ind_plus_aux /2/
+qed.
+
+(* maps a permutation to a list of terms *)
+definition Pi_map_list : (𝔸 → 𝔸) → list 𝔸 → list 𝔸 ≝ map 𝔸 𝔸 .
+
+(* interpretation "permutation of name list" 'middot p x = (Pi_map_list p x).*)
+
+(*
+inductive tm : pretm → Prop ≝
+| tm_par : ∀x:𝔸.tm (par x)
+| tm_app : ∀u,v.tm u → tm v → tm (app u v)
+| tm_lam : ∀x,s,u.tm u → tm (lam x s u).
+
+inductive ctx_aux : nat → pretm → Prop ≝
+| ctx_var : ∀n,k.n < k → ctx_aux k (var n)
+| ctx_par : ∀x,k.ctx_aux k (par x)
+| ctx_app : ∀u,v,k.ctx_aux k u → ctx_aux k v → ctx_aux k (app u v)
+(* è sostituibile da ctx_lam ? *)
+| ctx_abs : ∀s,u.ctx_aux (S k) u → ctx_aux k (abs s u).
+*)
+
+inductive tm_or_ctx (k:nat) : pretm → Type[0] ≝
+| toc_var : ∀n.n < k → tm_or_ctx k (var n)
+| toc_par : ∀x.tm_or_ctx k (par x)
+| toc_app : ∀u,v.tm_or_ctx k u → tm_or_ctx k v → tm_or_ctx k (app u v)
+| toc_lam : ∀x,s,u.tm_or_ctx k u → tm_or_ctx k (lam x s u).
+
+definition tm ≝ λt.tm_or_ctx O t.
+definition ctx ≝ λt.tm_or_ctx 1 t.
+
+definition check_tm ≝ λu,k.
+ pretm_ind_plus ?
+ (λ_.true)
+ (λn.leb (S n) k)
+ (λv1,v2,rv1,rv2.rv1 ∧ rv2)
+ [] (λx,s,v,px,pC,rv.rv)
+ u.
+
+axiom pretm_ind_plus_app : ∀P,u,v,C,H1,H2,H3,H4.
+ pretm_ind_plus P H1 H2 H3 C H4 (app u v) =
+ H3 u v (pretm_ind_plus P H1 H2 H3 C H4 u) (pretm_ind_plus P H1 H2 H3 C H4 v).
+
+axiom pretm_ind_plus_lam : ∀P,x,s,u,C,px,pC,H1,H2,H3,H4.
+ pretm_ind_plus P H1 H2 H3 C H4 (lam x s (u⌈x⌉)) =
+ H4 x s u px pC (pretm_ind_plus P H1 H2 H3 C H4 (u⌈x⌉)).
+
+record TM : Type[0] ≝ {
+ pretm_of_TM :> pretm;
+ tm_of_TM : check_tm pretm_of_TM O = true
+}.
+
+record CTX : Type[0] ≝ {
+ pretm_of_CTX :> pretm;
+ ctx_of_CTX : check_tm pretm_of_CTX 1 = true
+}.
+
+inductive tm2 : pretm → Type[0] ≝
+| tm_par : ∀x.tm2 (par x)
+| tm_app : ∀u,v.tm2 u → tm2 v → tm2 (app u v)
+| tm_lam : ∀x,s,u.x ∉ FV u → (∀y.y ∉ FV u → tm2 (u⌈y⌉)) → tm2 (lam x s (u⌈x⌉)).
+
+(*
+inductive tm' : pretm → Prop ≝
+| tm_par : ∀x.tm' (par x)
+| tm_app : ∀u,v.tm' u → tm' v → tm' (app u v)
+| tm_lam : ∀x,s,u,C.x ∉ FV u → x ∉ C → (∀y.y ∉ FV u → tm' (❴u❵y)) → tm' (lam x s (❴u❵x)).
+*)
+
+lemma pi_vclose_tm :
+ ∀z1,z2,x,u.swap 𝔸 z1 z2·(νx.u) = (ν swap ? z1 z2 x.swap 𝔸 z1 z2 · u).
+#z1 #z2 #x #u
+change with (vclose_tm_aux ???) in match (vclose_tm ??);
+change with (vclose_tm_aux ???) in ⊢ (???%); lapply O elim u normalize //
+[ #n #k cases (leb k n) normalize %
+| #x0 #k cases (true_or_false (x0==z1)) #H1 >H1 normalize
+ [ cases (true_or_false (x0==x)) #H2 >H2 normalize
+ [ <(\P H2) >H1 normalize >(\b (refl ? z2)) %
+ | >H1 normalize cases (true_or_false (x==z1)) #H3 >H3 normalize
+ [ >(\P H3) in H2; >H1 #Hfalse destruct (Hfalse)
+ | cases (true_or_false (x==z2)) #H4 >H4 normalize
+ [ cases (true_or_false (z2==z1)) #H5 >H5 normalize //
+ >(\P H5) in H4; >H3 #Hfalse destruct (Hfalse)
+ | >(\bf ?) // @sym_not_eq @(\Pf H4) ]
+ ]
+ ]
+ | cases (true_or_false (x0==x)) #H2 >H2 normalize
+ [ <(\P H2) >H1 normalize >(\b (refl ??)) %
+ | >H1 normalize cases (true_or_false (x==z1)) #H3 >H3 normalize
+ [ cases (true_or_false (x0==z2)) #H4 >H4 normalize
+ [ cases (true_or_false (z1==z2)) #H5 >H5 normalize //
+ <(\P H5) in H4; <(\P H3) >H2 #Hfalse destruct (Hfalse)
+ | >H4 % ]
+ | cases (true_or_false (x0==z2)) #H4 >H4 normalize
+ [ cases (true_or_false (x==z2)) #H5 >H5 normalize
+ [ <(\P H5) in H4; >H2 #Hfalse destruct (Hfalse)
+ | >(\bf ?) // @sym_not_eq @(\Pf H3) ]
+ | cases (true_or_false (x==z2)) #H5 >H5 normalize
+ [ >H1 %
+ | >H2 % ]
+ ]
+ ]
+ ]
+ ]
+]
+qed.
+
+lemma pi_vopen_tm :
+ ∀z1,z2,x,u.swap 𝔸 z1 z2·(u⌈x⌉) = (swap 𝔸 z1 z2 · u⌈swap 𝔸 z1 z2 x⌉).
+#z1 #z2 #x #u
+change with (vopen_tm_aux ???) in match (vopen_tm ??);
+change with (vopen_tm_aux ???) in ⊢ (???%); lapply O elim u normalize //
+#n #k cases (true_or_false (eqb n k)) #H1 >H1 normalize //
+cases (true_or_false (leb n k)) #H2 >H2 normalize //
+qed.
+
+lemma pi_lam :
+ ∀z1,z2,x,s,u.swap 𝔸 z1 z2 · lam x s u = lam (swap 𝔸 z1 z2 x) s (swap 𝔸 z1 z2 · u).
+#z1 #z2 #x #s #u whd in ⊢ (???%); <(pi_vclose_tm …) %
+qed.
+
+lemma eqv_FV : ∀z1,z2,u.FV (swap 𝔸 z1 z2 · u) = Pi_map_list (swap 𝔸 z1 z2) (FV u).
+#z1 #z2 #u elim u //
+[ #s #v normalize //
+| #v1 #v2 normalize /2/ ]
+qed.
+
+lemma swap_inv_tm : ∀z1,z2,u.swap 𝔸 z1 z2 · (swap 𝔸 z1 z2 · u) = u.
+#z1 #z2 #u elim u [1,3,4:normalize //]
+#x whd in ⊢ (??%?); >swap_inv %
+qed.
+
+lemma eqv_in_list : ∀x,l,z1,z2.x ∈ l → swap 𝔸 z1 z2 x ∈ Pi_map_list (swap 𝔸 z1 z2) l.
+#x #l #z1 #z2 #Hin elim Hin
+[ #x0 #l0 %
+| #x1 #x2 #l0 #Hin #IH %2 @IH ]
+qed.
+
+lemma eqv_tm2 : ∀u.tm2 u → ∀z1,z2.tm2 ((swap ? z1 z2)·u).
+#u #Hu #z1 #z2 letin p ≝ (swap ? z1 z2) elim Hu /2/
+#x #s #v #Hx #Hv #IH >pi_lam >pi_vopen_tm %3
+[ @(not_to_not … Hx) -Hx #Hx
+ <(swap_inv ? z1 z2 x) <(swap_inv_tm z1 z2 v) >eqv_FV @eqv_in_list //
+| #y #Hy <(swap_inv ? z1 z2 y)
+ <pi_vopen_tm @IH @(not_to_not … Hy) -Hy #Hy <(swap_inv ? z1 z2 y)
+ >eqv_FV @eqv_in_list //
+]
+qed.
+
+lemma vclose_vopen_aux : ∀x,u,k.vopen_tm_aux (vclose_tm_aux u x k) x k = u.
+#x #u elim u normalize //
+[ #n #k cases (true_or_false (leb k n)) #H >H whd in ⊢ (??%?);
+ [ cases (true_or_false (eqb (S n) k)) #H1 >H1
+ [ <(eqb_true_to_eq … H1) in H; #H lapply (leb_true_to_le … H) -H #H
+ cases (le_to_not_lt … H) -H #H cases (H ?) %
+ | whd in ⊢ (??%?); >lt_to_leb_false // @le_S_S /2/ ]
+ | cases (true_or_false (eqb n k)) #H1 >H1 normalize
+ [ >(eqb_true_to_eq … H1) in H; #H lapply (leb_false_to_not_le … H) -H
+ * #H cases (H ?) %
+ | >le_to_leb_true // @not_lt_to_le % #H2 >le_to_leb_true in H;
+ [ #H destruct (H) | /2/ ]
+ ]
+ ]
+| #x0 #k cases (true_or_false (x0==x)) #H1 >H1 normalize // >(\P H1) >eqb_n_n % ]
+qed.
+
+lemma vclose_vopen : ∀x,u.((νx.u)⌈x⌉) = u. #x #u @vclose_vopen_aux
+qed.
+
+(*
+theorem tm_to_tm : ∀t.tm' t → tm t.
+#t #H elim H
+*)
+
+lemma in_list_singleton : ∀T.∀t1,t2:T.t1 ∈ [t2] → t1 = t2.
+#T #t1 #t2 #H @(in_list_inv_ind ??? H) /2/
+qed.
+
+lemma fresh_vclose_tm_aux : ∀u,x,k.x ∉ FV (vclose_tm_aux u x k).
+#u #x elim u //
+[ #n #k normalize cases (leb k n) normalize //
+| #x0 #k normalize cases (true_or_false (x0==x)) #H >H normalize //
+ lapply (\Pf H) @not_to_not #Hin >(in_list_singleton ??? Hin) %
+| #v1 #v2 #IH1 #IH2 #k normalize % #Hin cases (in_list_append_to_or_in_list ???? Hin) /2/ ]
+qed.
+
+lemma fresh_vclose_tm : ∀u,x.x ∉ FV (νx.u). //
+qed.
+
+lemma check_tm_true_to_toc : ∀u,k.check_tm u k = true → tm_or_ctx k u.
+#u @(pretm_ind_plus ???? [ ] ? u)
+[ #x #k #_ %2
+| #n #k change with (leb (S n) k) in ⊢ (??%?→?); #H % @leb_true_to_le //
+| #v1 #v2 #rv1 #rv2 #k change with (pretm_ind_plus ???????) in ⊢ (??%?→?);
+ >pretm_ind_plus_app #H cases (andb_true ?? H) -H #Hv1 #Hv2 %3
+ [ @rv1 @Hv1 | @rv2 @Hv2 ]
+| #x #s #v #Hx #_ #rv #k change with (pretm_ind_plus ???????) in ⊢ (??%?→?);
+ >pretm_ind_plus_lam // #Hv %4 @rv @Hv ]
+qed.
+
+lemma toc_to_check_tm_true : ∀u,k.tm_or_ctx k u → check_tm u k = true.
+#u #k #Hu elim Hu //
+[ #n #Hn change with (leb (S n) k) in ⊢ (??%?); @le_to_leb_true @Hn
+| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 change with (pretm_ind_plus ???????) in ⊢ (??%?);
+ >pretm_ind_plus_app change with (check_tm v1 k ∧ check_tm v2 k) in ⊢ (??%?); /2/
+| #x #s #v #Hv #IH <(vclose_vopen x v) change with (pretm_ind_plus ???????) in ⊢ (??%?);
+ >pretm_ind_plus_lam [| // | @fresh_vclose_tm ] >(vclose_vopen x v) @IH ]
+qed.
+
+lemma fresh_swap_tm : ∀z1,z2,u.z1 ∉ FV u → z2 ∉ FV u → swap 𝔸 z1 z2 · u = u.
+#z1 #z2 #u elim u
+[2: normalize in ⊢ (?→%→%→?); #x #Hz1 #Hz2 whd in ⊢ (??%?); >swap_other //
+ [ @(not_to_not … Hz2) | @(not_to_not … Hz1) ] //
+|1: //
+| #s #v #IH normalize #Hz1 #Hz2 >IH // [@Hz2|@Hz1]
+| #v1 #v2 #IH1 #IH2 normalize #Hz1 #Hz2
+ >IH1 [| @(not_to_not … Hz2) @in_list_to_in_list_append_l | @(not_to_not … Hz1) @in_list_to_in_list_append_l ]
+ >IH2 // [@(not_to_not … Hz2) @in_list_to_in_list_append_r | @(not_to_not … Hz1) @in_list_to_in_list_append_r ]
+]
+qed.
+
+theorem tm_to_tm2 : ∀u.tm u → tm2 u.
+#t #Ht elim Ht
+[ #n #Hn cases (not_le_Sn_O n) #Hfalse cases (Hfalse Hn)
+| @tm_par
+| #u #v #Hu #Hv @tm_app
+| #x #s #u #Hu #IHu <(vclose_vopen x u) @tm_lam
+ [ @fresh_vclose_tm
+ | #y #Hy <(fresh_swap_tm x y (νx.u)) /2/ @fresh_vclose_tm ]
+]
+qed.
+
+theorem tm2_to_tm : ∀u.tm2 u → tm u.
+#u #pu elim pu /2/ #x #s #v #Hx #Hv #IH %4 @IH //
+qed.
+
+(* define PAR APP LAM *)
+definition PAR ≝ λx.mk_TM (par x) ?. // qed.
+definition APP ≝ λu,v:TM.mk_TM (app u v) ?.
+change with (pretm_ind_plus ???????) in match (check_tm ??); >pretm_ind_plus_app
+change with (check_tm ??) in match (pretm_ind_plus ???????); change with (check_tm ??) in match (pretm_ind_plus ???????) in ⊢ (??(??%)?);
+@andb_elim >(tm_of_TM u) >(tm_of_TM v) % qed.
+definition LAM ≝ λx,s.λu:TM.mk_TM (lam x s u) ?.
+change with (pretm_ind_plus ???????) in match (check_tm ??); <(vclose_vopen x u)
+>pretm_ind_plus_lam [| // | @fresh_vclose_tm ]
+change with (check_tm ??) in match (pretm_ind_plus ???????); >vclose_vopen
+@(tm_of_TM u) qed.
+
+axiom vopen_tm_down : ∀u,x,k.tm_or_ctx (S k) u → tm_or_ctx k (u⌈x⌉).
+(* needs true_plus_false
+
+#u #x #k #Hu elim Hu
+[ #n #Hn normalize cases (true_or_false (eqb n O)) #H >H [%2]
+ normalize >(?: leb n O = false) [|cases n in H; // >eqb_n_n #H destruct (H) ]
+ normalize lapply Hn cases n in H; normalize [ #Hfalse destruct (Hfalse) ]
+ #n0 #_ #Hn0 % @le_S_S_to_le //
+| #x0 %2
+| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 %3 //
+| #x0 #s #v #Hv #IH normalize @daemon
+]
+qed.
+*)
+
+definition vopen_TM ≝ λu:CTX.λx.mk_TM (u⌈x⌉) ?.
+@toc_to_check_tm_true @vopen_tm_down @check_tm_true_to_toc @ctx_of_CTX qed.
+
+axiom vclose_tm_up : ∀u,x,k.tm_or_ctx k u → tm_or_ctx (S k) (νx.u).
+
+definition vclose_TM ≝ λu:TM.λx.mk_CTX (νx.u) ?.
+@toc_to_check_tm_true @vclose_tm_up @check_tm_true_to_toc @tm_of_TM qed.
+
+interpretation "ln wf term variable open" 'open u x = (vopen_TM u x).
+interpretation "ln wf term variable close" 'nu x u = (vclose_TM u x).
+
+theorem tm_alpha : ∀x,y,s,u.x ∉ FV u → y ∉ FV u → lam x s (u⌈x⌉) = lam y s (u⌈y⌉).
+#x #y #s #u #Hx #Hy whd in ⊢ (??%%); @eq_f >nominal_eta // >nominal_eta //
+qed.
+
+lemma TM_to_tm2 : ∀u:TM.tm2 u.
+#u @tm_to_tm2 @check_tm_true_to_toc @tm_of_TM qed.
+
+theorem TM_ind_plus_weak :
+ ∀P:pretm → Type[0].
+ (∀x:𝔸.P (PAR x)) →
+ (∀v1,v2:TM.P v1 → P v2 → P (APP v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s.∀v:CTX.x ∉ FV v → x ∉ C →
+ (∀y.y ∉ FV v → P (v⌈y⌉)) → P (LAM x s (v⌈x⌉))) →
+ ∀u:TM.P u.
+#P #Hpar #Happ #C #Hlam #u elim (TM_to_tm2 u) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM …) (mk_TM …) IH1 IH2)
+ @toc_to_check_tm_true @tm2_to_tm //
+| #x #s #v #Hx #pv #IH
+ lapply (p_fresh … (C@FV v)) letin x0 ≝ (N_fresh … (C@FV v)) #Hx0
+ >(?:lam x s (v⌈x⌉) = lam x0 s (v⌈x0⌉))
+ [|@tm_alpha // @(not_to_not … Hx0) @in_list_to_in_list_append_r ]
+ @(Hlam x0 s (mk_CTX v ?) ??)
+ [ <(nominal_eta … Hx) @toc_to_check_tm_true @vclose_tm_up @tm2_to_tm @pv //
+ | @(not_to_not … Hx0) @in_list_to_in_list_append_r
+ | @(not_to_not … Hx0) @in_list_to_in_list_append_l
+ | @IH ]
+]
+qed.
+
+lemma eq_mk_TM : ∀u,v.u = v → ∀pu,pv.mk_TM u pu = mk_TM v pv.
+#u #v #Heq >Heq #pu #pv %
+qed.
+
+lemma eq_P : ∀T:Type[0].∀t1,t2:T.t1 = t2 → ∀P:T → Type[0].P t1 → P t2. // qed.
+
+theorem TM_ind_plus :
+ ∀P:TM → Type[0].
+ (∀x:𝔸.P (PAR x)) →
+ (∀v1,v2:TM.P v1 → P v2 → P (APP v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s.∀v:CTX.x ∉ FV v → x ∉ C →
+ (∀y.y ∉ FV v → P (v⌈y⌉)) → P (LAM x s (v⌈x⌉))) →
+ ∀u:TM.P u.
+#P #Hpar #Happ #C #Hlam * #u #pu
+>(?:mk_TM u pu =
+ mk_TM u (toc_to_check_tm_true … (tm2_to_tm … (tm_to_tm2 … (check_tm_true_to_toc … pu))))) [|%]
+elim (tm_to_tm2 u ?) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM …) (mk_TM …) IH1 IH2)
+| #x #s #v #Hx #pv #IH
+ lapply (p_fresh … (C@FV v)) letin x0 ≝ (N_fresh … (C@FV v)) #Hx0
+ lapply (Hlam x0 s (mk_CTX v ?) ???)
+ [2: @(not_to_not … Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0
+ |4: @toc_to_check_tm_true <(nominal_eta x v) // @vclose_tm_up @tm2_to_tm @pv //
+ | #y #Hy whd in match (vopen_TM ??);
+ >(?:mk_TM (v⌈y⌉) ? = mk_TM (v⌈y⌉) (toc_to_check_tm_true (v⌈y⌉) O (tm2_to_tm (v⌈y⌉) (pv y Hy))))
+ [@IH|%]
+ | @(not_to_not … Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_r @Hx0
+ | @eq_P @eq_mk_TM whd in match (vopen_TM ??); @tm_alpha // @(not_to_not … Hx0) @in_list_to_in_list_append_r ]
+]
+qed.
+
+notation
+"hvbox('nominal' u 'return' out 'with'
+ [ 'xpar' ident x ⇒ f1
+ | 'xapp' ident v1 ident v2 ident recv1 ident recv2 ⇒ f2
+ | 'xlam' ❨ident y # C❩ ident s ident w ident py1 ident py2 ident recw ⇒ f3 ])"
+with precedence 48
+for @{ TM_ind_plus $out (λ${ident x}:?.$f1)
+ (λ${ident v1}:?.λ${ident v2}:?.λ${ident recv1}:?.λ${ident recv2}:?.$f2)
+ $C (λ${ident y}:?.λ${ident s}:?.λ${ident w}:?.λ${ident py1}:?.λ${ident py2}:?.λ${ident recw}:?.$f3)
+ $u }.
+
+(* include "basics/jmeq.ma".*)
+
+definition subst ≝ (λu:TM.λx,v.
+ nominal u return (λ_.TM) with
+ [ xpar x0 ⇒ match x == x0 with [ true ⇒ v | false ⇒ PAR x0 ] (* u instead of PAR x0 does not work, u stays the same at every rec call! *)
+ | xapp v1 v2 recv1 recv2 ⇒ APP recv1 recv2
+ | xlam ❨y # x::FV v❩ s w py1 py2 recw ⇒ LAM y s (recw y py1) ]).
+
+lemma subst_def : ∀u,x,v.subst u x v =
+ nominal u return (λ_.TM) with
+ [ xpar x0 ⇒ match x == x0 with [ true ⇒ v | false ⇒ PAR x0 ]
+ | xapp v1 v2 recv1 recv2 ⇒ APP recv1 recv2
+ | xlam ❨y # x::FV v❩ s w py1 py2 recw ⇒ LAM y s (recw y py1) ]. //
+qed.
+
+axiom TM_ind_plus_LAM :
+ ∀x,s,u,out,f1,f2,C,f3,Hx1,Hx2.
+ TM_ind_plus out f1 f2 C f3 (LAM x s (u⌈x⌉)) =
+ f3 x s u Hx1 Hx2 (λy,Hy.TM_ind_plus ? f1 f2 C f3 ?).
+
+axiom TM_ind_plus_APP :
+ ∀u1,u2,out,f1,f2,C,f3.
+ TM_ind_plus out f1 f2 C f3 (APP u1 u2) =
+ f2 u1 u2 (TM_ind_plus out f1 f2 C f3 ?) (TM_ind_plus out f1 f2 C f3 ?).
+
+lemma eq_mk_CTX : ∀u,v.u = v → ∀pu,pv.mk_CTX u pu = mk_CTX v pv.
+#u #v #Heq >Heq #pu #pv %
+qed.
+
+lemma vclose_vopen_TM : ∀x.∀u:TM.((νx.u)⌈x⌉) = u.
+#x * #u #pu @eq_mk_TM @vclose_vopen qed.
+
+lemma nominal_eta_CTX : ∀x.∀u:CTX.x ∉ FV u → (νx.(u⌈x⌉)) = u.
+#x * #u #pu #Hx @eq_mk_CTX @nominal_eta // qed.
+
+theorem TM_alpha : ∀x,y,s.∀u:CTX.x ∉ FV u → y ∉ FV u → LAM x s (u⌈x⌉) = LAM y s (u⌈y⌉).
+#x #y #s #u #Hx #Hy @eq_mk_TM @tm_alpha // qed.
+
+axiom in_vopen_CTX : ∀x,y.∀v:CTX.x ∈ FV (v⌈y⌉) → x = y ∨ x ∈ FV v.
+
+theorem subst_fresh : ∀u,v:TM.∀x.x ∉ FV u → subst u x v = u.
+#u #v #x @(TM_ind_plus … (x::FV v) … u)
+[ #x0 normalize in ⊢ (%→?); #Hx normalize in ⊢ (??%?);
+ >(\bf ?) [| @(not_to_not … Hx) #Heq >Heq % ] %
+| #u1 #u2 #IH1 #IH2 normalize in ⊢ (%→?); #Hx
+ >subst_def >TM_ind_plus_APP @eq_mk_TM @eq_f2 @eq_f
+ [ <subst_def @IH1 @(not_to_not … Hx) @in_list_to_in_list_append_l
+ | <subst_def @IH2 @(not_to_not … Hx) @in_list_to_in_list_append_r ]
+| #x0 #s #v0 #Hx0 #HC #IH #Hx >subst_def >TM_ind_plus_LAM [|@HC|@Hx0]
+ @eq_f <subst_def @IH // @(not_to_not … Hx) -Hx #Hx
+ change with (FV (νx0.(v0⌈x0⌉))) in ⊢ (???%); >nominal_eta_CTX //
+ cases (in_vopen_CTX … Hx) // #Heq >Heq in HC; * #HC @False_ind @HC %
+]
+qed.
+
+example subst_LAM_same : ∀x,s,u,v. subst (LAM x s u) x v = LAM x s u.
+#x #s #u #v >subst_def <(vclose_vopen_TM x u)
+lapply (p_fresh … (FV (νx.u)@x::FV v)) letin x0 ≝ (N_fresh … (FV (νx.u)@x::FV v)) #Hx0
+>(TM_alpha x x0)
+[| @(not_to_not … Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0 | @fresh_vclose_tm ]
+>TM_ind_plus_LAM [| @(not_to_not … Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_r @Hx0 | @(not_to_not … Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0 ]
+@eq_f change with (subst ((νx.u)⌈x0⌉) x v) in ⊢ (??%?); @subst_fresh
+@(not_to_not … Hx0) #Hx0' cases (in_vopen_CTX … Hx0')
+[ #Heq >Heq @in_list_to_in_list_append_r %
+| #Hfalse @False_ind cases (fresh_vclose_tm u x) #H @H @Hfalse ]
+qed.
+
+(*
+notation > "Λ ident x. ident T [ident x] ↦ P"
+ with precedence 48 for @{'foo (λ${ident x}.λ${ident T}.$P)}.
+
+notation < "Λ ident x. ident T [ident x] ↦ P"
+ with precedence 48 for @{'foo (λ${ident x}:$Q.λ${ident T}:$R.$P)}.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ⇒ f1
+ | 'xapp' ident v1 ident v2 ⇒ f2
+ | 'xlam' ident x # C s w ⇒ f3 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (λ${ident x}:$Tx.$f1)
+ (λ${ident v1}:$Tv1.λ${ident v2}:$Tv2.λ${ident pv1}:$Tpv1.λ${ident pv2}:$Tpv2.λ${ident recv1}:$Trv1.λ${ident recv2}:$Trv2.$f2)
+ $C (λ${ident x}:$Tx.λ${ident s}:$Ts.λ${ident w}:$Tw.λ${ident py1}:$Tpy1.λ${ident py2}:$Tpy2.λ${ident pw}:$Tpw.λ${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+(* | 'xlam' ident x # C s w ^ f3 ]) *)
+with precedence 48
+for @{ tm2_ind_plus ? (λ${ident x}:$Tx.$f1)
+ (λ${ident v1}:$Tv1.λ${ident v2}:$Tv2.λ${ident pv1}:$Tpv1.λ${ident pv2}:$Tpv2.λ${ident recv1}:$Trv1.λ${ident recv2}:$Trv2.$f2)
+ $C (λ${ident x}:$Tx.λ${ident s}:$Ts.λ${ident w}:$Tw.λ${ident py1}:$Tpy1.λ${ident py2}:$Tpy2.λ${ident pw}:$Tpw.λ${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (λ${ident x}:?.$f1)
+ (λ${ident v1}:$Tv1.λ${ident v2}:$Tv2.λ${ident pv1}:$Tpv1.λ${ident pv2}:$Tpv2.λ${ident recv1}:$Trv1.λ${ident recv2}:$Trv2.$f2)
+ $C (λ${ident x}:?.λ${ident s}:$Ts.λ${ident w}:$Tw.λ${ident py1}:$Tpy1.λ${ident py2}:$Tpy2.λ${ident pw}:$Tpw.λ${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+
+axiom in_Env : 𝔸 × tp → Env → Prop.
+notation "X ◃ G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+
+
+inductive judg : list tp → tm → tp → Prop ≝
+| t_var : ∀g,n,t.Nth ? n g = Some ? t → judg g (var n) t
+| t_app : ∀g,m,n,t,u.judg g m (arr t u) → judg g n t → judg g (app m n) u
+| t_abs : ∀g,t,m,u.judg (t::g) m u → judg g (abs t m) (arr t u).
+
+definition Env := list (𝔸 × tp).
+
+axiom vclose_env : Env → list tp.
+axiom vclose_tm : Env → tm → tm.
+axiom Lam : 𝔸 → tp → tm → tm.
+definition Judg ≝ λG,M,T.judg (vclose_env G) (vclose_tm G M) T.
+definition dom ≝ λG:Env.map ?? (fst ??) G.
+
+definition sctx ≝ 𝔸 × tm.
+axiom swap_tm : 𝔸 → 𝔸 → tm → tm.
+definition sctx_app : sctx → 𝔸 → tm ≝ λM0,Y.let 〈X,M〉 ≝ M0 in swap_tm X Y M.
+
+axiom in_list : ∀A:Type[0].A → list A → Prop.
+interpretation "list membership" 'mem x l = (in_list ? x l).
+interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
+
+axiom in_Env : 𝔸 × tp → Env → Prop.
+notation "X ◃ G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+(* axiom Lookup : 𝔸 → Env → option tp. *)
+
+(* forma alto livello del judgment
+ t_abs* : ∀G,T,X,M,U.
+ (∀Y ∉ supp(M).Judg (〈Y,T〉::G) (M[Y]) U) →
+ Judg G (Lam X T (M[X])) (arr T U) *)
+
+(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
+
+axiom Judg_ind : ∀P:Env → tm → tp → Prop.
+ (∀X,G,T.〈X,T〉 ◃ G → P G (par X) T) →
+ (∀G,M,N,T,U.
+ Judg G M (arr T U) → Judg G N T →
+ P G M (arr T U) → P G N T → P G (app M N) U) →
+ (∀G,T1,T2,X,M1.
+ (∀Y.Y ∉ (FV (Lam X T1 (sctx_app M1 X))) → Judg (〈Y,T1〉::G) (sctx_app M1 Y) T2) →
+ (∀Y.Y ∉ (FV (Lam X T1 (sctx_app M1 X))) → P (〈Y,T1〉::G) (sctx_app M1 Y) T2) →
+ P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) →
+ ∀G,M,T.Judg G M T → P G M T.
+
+axiom t_par : ∀X,G,T.〈X,T〉 ◃ G → Judg G (par X) T.
+axiom t_app2 : ∀G,M,N,T,U.Judg G M (arr T U) → Judg G N T → Judg G (app M N) U.
+axiom t_Lam : ∀G,X,M,T,U.Judg (〈X,T〉::G) M U → Judg G (Lam X T M) (arr T U).
+
+definition subenv ≝ λG1,G2.∀x.x ◃ G1 → x ◃ G2.
+interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
+
+axiom daemon : ∀P:Prop.P.
+
+theorem weakening : ∀G1,G2,M,T.G1 ⊆ G2 → Judg G1 M T → Judg G2 M T.
+#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (∀G2.?)
+@(Judg_ind … HJ)
+[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
+| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
+ [| @IH1 // | @IH2 // ]
+| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
+ [ (* trivial property of Lam *) @daemon
+ | (* trivial property of subenv *) @daemon ]
+]
+qed.
+
+(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
+ ricorsione *)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/lists/list.ma".
+include "basics/deqsets.ma".
+include "binding/names.ma".
+include "binding/fp.ma".
+
+definition alpha : Nset ≝ X. check alpha
+notation "𝔸" non associative with precedence 90 for @{'alphabet}.
+interpretation "set of names" 'alphabet = alpha.
+
+inductive tp : Type[0] ≝
+| top : tp
+| arr : tp → tp → tp.
+inductive pretm : Type[0] ≝
+| var : nat → pretm
+| par : 𝔸 → pretm
+| abs : tp → pretm → pretm
+| app : pretm → pretm → pretm.
+
+let rec Nth T n (l:list T) on n ≝
+ match l with
+ [ nil ⇒ None ?
+ | cons hd tl ⇒ match n with
+ [ O ⇒ Some ? hd
+ | S n0 ⇒ Nth T n0 tl ] ].
+
+let rec vclose_tm_aux u x k ≝ match u with
+ [ var n ⇒ if (leb k n) then var (S n) else u
+ | par x0 ⇒ if (x0 == x) then (var k) else u
+ | app v1 v2 ⇒ app (vclose_tm_aux v1 x k) (vclose_tm_aux v2 x k)
+ | abs s v ⇒ abs s (vclose_tm_aux v x (S k)) ].
+definition vclose_tm ≝ λu,x.vclose_tm_aux u x O.
+
+definition vopen_var ≝ λn,x,k.match eqb n k with
+ [ true ⇒ par x
+ | false ⇒ match leb n k with
+ [ true ⇒ var n
+ | false ⇒ var (pred n) ] ].
+
+let rec vopen_tm_aux u x k ≝ match u with
+ [ var n ⇒ vopen_var n x k
+ | par x0 ⇒ u
+ | app v1 v2 ⇒ app (vopen_tm_aux v1 x k) (vopen_tm_aux v2 x k)
+ | abs s v ⇒ abs s (vopen_tm_aux v x (S k)) ].
+definition vopen_tm ≝ λu,x.vopen_tm_aux u x O.
+
+let rec FV u ≝ match u with
+ [ par x ⇒ [x]
+ | app v1 v2 ⇒ FV v1@FV v2
+ | abs s v ⇒ FV v
+ | _ ⇒ [ ] ].
+
+definition lam ≝ λx,s,u.abs s (vclose_tm u x).
+
+let rec Pi_map_tm p u on u ≝ match u with
+[ par x ⇒ par (p x)
+| var _ ⇒ u
+| app v1 v2 ⇒ app (Pi_map_tm p v1) (Pi_map_tm p v2)
+| abs s v ⇒ abs s (Pi_map_tm p v) ].
+
+interpretation "permutation of tm" 'middot p x = (Pi_map_tm p x).
+
+notation "hvbox(u⌈x⌉)"
+ with precedence 45
+ for @{ 'open $u $x }.
+
+(*
+notation "hvbox(u⌈x⌉)"
+ with precedence 45
+ for @{ 'open $u $x }.
+notation "❴ u ❵ x" non associative with precedence 90 for @{ 'open $u $x }.
+*)
+interpretation "ln term variable open" 'open u x = (vopen_tm u x).
+notation < "hvbox(ν x break . u)"
+ with precedence 20
+for @{'nu $x $u }.
+notation > "ν list1 x sep , . term 19 u" with precedence 20
+ for ${ fold right @{$u} rec acc @{'nu $x $acc)} }.
+interpretation "ln term variable close" 'nu x u = (vclose_tm u x).
+
+let rec tm_height u ≝ match u with
+[ app v1 v2 ⇒ S (max (tm_height v1) (tm_height v2))
+| abs s v ⇒ S (tm_height v)
+| _ ⇒ O ].
+
+theorem le_n_O_rect_Type0 : ∀n:nat. n ≤ O → ∀P: nat →Type[0]. P O → P n.
+#n (cases n) // #a #abs cases (?:False) /2/ qed.
+
+theorem nat_rect_Type0_1 : ∀n:nat.∀P:nat → Type[0].
+(∀m.(∀p. p < m → P p) → P m) → P n.
+#n #P #H
+cut (∀q:nat. q ≤ n → P q) /2/
+(elim n)
+ [#q #HleO (* applica male *)
+ @(le_n_O_rect_Type0 ? HleO)
+ @H #p #ltpO cases (?:False) /2/ (* 3 *)
+ |#p #Hind #q #HleS
+ @H #a #lta @Hind @le_S_S_to_le /2/
+ ]
+qed.
+
+lemma leb_false_to_lt : ∀n,m. leb n m = false → m < n.
+#n elim n
+[ #m normalize #H destruct(H)
+| #n0 #IH * // #m normalize #H @le_S_S @IH // ]
+qed.
+
+lemma nominal_eta_aux : ∀x,u.x ∉ FV u → ∀k.vclose_tm_aux (vopen_tm_aux u x k) x k = u.
+#x #u elim u
+[ #n #_ #k normalize cases (decidable_eq_nat n k) #Hnk
+ [ >Hnk >eqb_n_n whd in ⊢ (??%?); >(\b ?) //
+ | >(not_eq_to_eqb_false … Hnk) normalize cases (true_or_false (leb n k)) #Hleb
+ [ >Hleb normalize >(?:leb k n = false) //
+ @lt_to_leb_false @not_eq_to_le_to_lt /2/
+ | >Hleb normalize >(?:leb k (pred n) = true) normalize
+ [ cases (leb_false_to_lt … Hleb) //
+ | @le_to_leb_true cases (leb_false_to_lt … Hleb) normalize /2/ ] ] ]
+| #y normalize in ⊢ (%→?→?); #Hy whd in ⊢ (?→??%?); >(\bf ?) // @(not_to_not … Hy) //
+| #s #v #IH normalize #Hv #k >IH // @Hv
+| #v1 #v2 #IH1 #IH2 normalize #Hv1v2 #k
+ >IH1 [ >IH2 // | @(not_to_not … Hv1v2) @in_list_to_in_list_append_l ]
+ @(not_to_not … Hv1v2) @in_list_to_in_list_append_r ]
+qed.
+
+corollary nominal_eta : ∀x,u.x ∉ FV u → (νx.u⌈x⌉) = u.
+#x #u #Hu @nominal_eta_aux //
+qed.
+
+lemma eq_height_vopen_aux : ∀v,x,k.tm_height (vopen_tm_aux v x k) = tm_height v.
+#v #x elim v
+[ #n #k normalize cases (eqb n k) // cases (leb n k) //
+| #u #k %
+| #s #u #IH #k normalize >IH %
+| #u1 #u2 #IH1 #IH2 #k normalize >IH1 >IH2 % ]
+qed.
+
+corollary eq_height_vopen : ∀v,x.tm_height (v⌈x⌉) = tm_height v.
+#v #x @eq_height_vopen_aux
+qed.
+
+theorem pretm_ind_plus_aux :
+ ∀P:pretm → Type[0].
+ (∀x:𝔸.P (par x)) →
+ (∀n:ℕ.P (var n)) →
+ (∀v1,v2. P v1 → P v2 → P (app v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s,v.x ∉ FV v → x ∉ C → P (v⌈x⌉) → P (lam x s (v⌈x⌉))) →
+ ∀n,u.tm_height u ≤ n → P u.
+#P #Hpar #Hvar #Happ #C #Hlam #n change with ((λn.?) n); @(nat_rect_Type0_1 n ??)
+#m cases m
+[ #_ * /2/
+ [ normalize #s #v #Hfalse cases (?:False) cases (not_le_Sn_O (tm_height v)) /2/
+ | #v1 #v2 whd in ⊢ (?%?→?); #Hfalse cases (?:False) cases (not_le_Sn_O (S (max ??))) /2/ ] ]
+-m #m #IH * /2/
+[ #s #v whd in ⊢ (?%?→?); #Hv
+ lapply (p_fresh … (C@FV v)) letin y ≝ (N_fresh … (C@FV v)) #Hy
+ >(?:abs s v = lam y s (v⌈y⌉))
+ [| whd in ⊢ (???%); >nominal_eta // @(not_to_not … Hy) @in_list_to_in_list_append_r ]
+ @Hlam
+ [ @(not_to_not … Hy) @in_list_to_in_list_append_r
+ | @(not_to_not … Hy) @in_list_to_in_list_append_l ]
+ @IH [| @Hv | >eq_height_vopen % ]
+| #v1 #v2 whd in ⊢ (?%?→?); #Hv @Happ
+ [ @IH [| @Hv | // ] | @IH [| @Hv | // ] ] ]
+qed.
+
+corollary pretm_ind_plus :
+ ∀P:pretm → Type[0].
+ (∀x:𝔸.P (par x)) →
+ (∀n:ℕ.P (var n)) →
+ (∀v1,v2. P v1 → P v2 → P (app v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s,v.x ∉ FV v → x ∉ C → P (v⌈x⌉) → P (lam x s (v⌈x⌉))) →
+ ∀u.P u.
+#P #Hpar #Hvar #Happ #C #Hlam #u @pretm_ind_plus_aux /2/
+qed.
+
+(* maps a permutation to a list of terms *)
+definition Pi_map_list : (𝔸 → 𝔸) → list 𝔸 → list 𝔸 ≝ map 𝔸 𝔸 .
+
+(* interpretation "permutation of name list" 'middot p x = (Pi_map_list p x).*)
+
+(*
+inductive tm : pretm → Prop ≝
+| tm_par : ∀x:𝔸.tm (par x)
+| tm_app : ∀u,v.tm u → tm v → tm (app u v)
+| tm_lam : ∀x,s,u.tm u → tm (lam x s u).
+
+inductive ctx_aux : nat → pretm → Prop ≝
+| ctx_var : ∀n,k.n < k → ctx_aux k (var n)
+| ctx_par : ∀x,k.ctx_aux k (par x)
+| ctx_app : ∀u,v,k.ctx_aux k u → ctx_aux k v → ctx_aux k (app u v)
+(* è sostituibile da ctx_lam ? *)
+| ctx_abs : ∀s,u.ctx_aux (S k) u → ctx_aux k (abs s u).
+*)
+
+inductive tm_or_ctx (k:nat) : pretm → Type[0] ≝
+| toc_var : ∀n.n < k → tm_or_ctx k (var n)
+| toc_par : ∀x.tm_or_ctx k (par x)
+| toc_app : ∀u,v.tm_or_ctx k u → tm_or_ctx k v → tm_or_ctx k (app u v)
+| toc_lam : ∀x,s,u.tm_or_ctx k u → tm_or_ctx k (lam x s u).
+
+definition tm ≝ λt.tm_or_ctx O t.
+definition ctx ≝ λt.tm_or_ctx 1 t.
+
+record TM : Type[0] ≝ {
+ pretm_of_TM :> pretm;
+ tm_of_TM : tm pretm_of_TM
+}.
+
+record CTX : Type[0] ≝ {
+ pretm_of_CTX :> pretm;
+ ctx_of_CTX : ctx pretm_of_CTX
+}.
+
+inductive tm2 : pretm → Type[0] ≝
+| tm_par : ∀x.tm2 (par x)
+| tm_app : ∀u,v.tm2 u → tm2 v → tm2 (app u v)
+| tm_lam : ∀x,s,u.x ∉ FV u → (∀y.y ∉ FV u → tm2 (u⌈y⌉)) → tm2 (lam x s (u⌈x⌉)).
+
+(*
+inductive tm' : pretm → Prop ≝
+| tm_par : ∀x.tm' (par x)
+| tm_app : ∀u,v.tm' u → tm' v → tm' (app u v)
+| tm_lam : ∀x,s,u,C.x ∉ FV u → x ∉ C → (∀y.y ∉ FV u → tm' (❴u❵y)) → tm' (lam x s (❴u❵x)).
+*)
+
+axiom swap_inj : ∀N.∀z1,z2,x,y.swap N z1 z2 x = swap N z1 z2 y → x = y.
+
+lemma pi_vclose_tm :
+ ∀z1,z2,x,u.swap 𝔸 z1 z2·(νx.u) = (ν swap ? z1 z2 x.swap 𝔸 z1 z2 · u).
+#z1 #z2 #x #u
+change with (vclose_tm_aux ???) in match (vclose_tm ??);
+change with (vclose_tm_aux ???) in ⊢ (???%); lapply O elim u
+[3:whd in ⊢ (?→?→(?→ ??%%)→?→??%%); //
+|4:whd in ⊢ (?→?→(?→??%%)→(?→??%%)→?→??%%); //
+| #n #k whd in ⊢ (??(??%)%); cases (leb k n) normalize %
+| #x0 #k cases (true_or_false (x0==z1)) #H1 >H1 whd in ⊢ (??%%);
+ [ cases (true_or_false (x0==x)) #H2 >H2 whd in ⊢ (??(??%)%);
+ [ <(\P H2) >H1 whd in ⊢ (??(??%)%); >(\b ?) // >(\b ?) //
+ | >H2 whd in match (swap ????); >H1
+ whd in match (if false then var k else ?);
+ whd in match (if true then z2 else ?); >(\bf ?)
+ [ >(\P H1) >swap_left %
+ | <(swap_inv ? z1 z2 z2) in ⊢ (?(??%?)); % #H3
+ lapply (swap_inj … H3) >swap_right #H4 <H4 in H2; >H1 #H destruct (H) ]
+ ]
+ | >(?:(swap ? z1 z2 x0 == swap ? z1 z2 x) = (x0 == x))
+ [| cases (true_or_false (x0==x)) #H2 >H2
+ [ >(\P H2) @(\b ?) %
+ | @(\bf ?) % #H >(swap_inj … H) in H2; >(\b ?) // #H0 destruct (H0) ] ]
+ cases (true_or_false (x0==x)) #H2 >H2 whd in ⊢ (??(??%)%);
+ [ <(\P H2) >H1 >(\b (refl ??)) %
+ | >H1 >H2 % ]
+ ]
+ ]
+qed.
+
+lemma pi_vopen_tm :
+ ∀z1,z2,x,u.swap 𝔸 z1 z2·(u⌈x⌉) = (swap 𝔸 z1 z2 · u⌈swap 𝔸 z1 z2 x⌉).
+#z1 #z2 #x #u
+change with (vopen_tm_aux ???) in match (vopen_tm ??);
+change with (vopen_tm_aux ???) in ⊢ (???%); lapply O elim u //
+[2: #s #v whd in ⊢ ((?→??%%)→?→??%%); //
+|3: #v1 #v2 whd in ⊢ ((?→??%%)→(?→??%%)→?→??%%); /2/ ]
+#n #k whd in ⊢ (??(??%)%); cases (true_or_false (eqb n k)) #H1 >H1 //
+cases (true_or_false (leb n k)) #H2 >H2 normalize //
+qed.
+
+lemma pi_lam :
+ ∀z1,z2,x,s,u.swap 𝔸 z1 z2 · lam x s u = lam (swap 𝔸 z1 z2 x) s (swap 𝔸 z1 z2 · u).
+#z1 #z2 #x #s #u whd in ⊢ (???%); <(pi_vclose_tm …) %
+qed.
+
+lemma eqv_FV : ∀z1,z2,u.FV (swap 𝔸 z1 z2 · u) = Pi_map_list (swap 𝔸 z1 z2) (FV u).
+#z1 #z2 #u elim u //
+[ #s #v #H @H
+| #v1 #v2 whd in ⊢ (??%%→??%%→??%%); #H1 #H2 >H1 >H2
+ whd in ⊢ (???(????%)); /2/ ]
+qed.
+
+lemma swap_inv_tm : ∀z1,z2,u.swap 𝔸 z1 z2 · (swap 𝔸 z1 z2 · u) = u.
+#z1 #z2 #u elim u
+[1: #n %
+|3: #s #v whd in ⊢ (?→??%%); //
+|4: #v1 #v2 #Hv1 #Hv2 whd in ⊢ (??%%); // ]
+#x whd in ⊢ (??%?); >swap_inv %
+qed.
+
+lemma eqv_in_list : ∀x,l,z1,z2.x ∈ l → swap 𝔸 z1 z2 x ∈ Pi_map_list (swap 𝔸 z1 z2) l.
+#x #l #z1 #z2 #Hin elim Hin
+[ #x0 #l0 %
+| #x1 #x2 #l0 #Hin #IH %2 @IH ]
+qed.
+
+lemma eqv_tm2 : ∀u.tm2 u → ∀z1,z2.tm2 ((swap ? z1 z2)·u).
+#u #Hu #z1 #z2 letin p ≝ (swap ? z1 z2) elim Hu /2/
+#x #s #v #Hx #Hv #IH >pi_lam >pi_vopen_tm %3
+[ @(not_to_not … Hx) -Hx #Hx
+ <(swap_inv ? z1 z2 x) <(swap_inv_tm z1 z2 v) >eqv_FV @eqv_in_list //
+| #y #Hy <(swap_inv ? z1 z2 y)
+ <pi_vopen_tm @IH @(not_to_not … Hy) -Hy #Hy <(swap_inv ? z1 z2 y)
+ >eqv_FV @eqv_in_list //
+]
+qed.
+
+lemma vclose_vopen_aux : ∀x,u,k.vopen_tm_aux (vclose_tm_aux u x k) x k = u.
+#x #u elim u [1,3,4:normalize //]
+[ #n #k cases (true_or_false (leb k n)) #H >H whd in ⊢ (??%?);
+ [ cases (true_or_false (eqb (S n) k)) #H1 >H1
+ [ <(eqb_true_to_eq … H1) in H; #H lapply (leb_true_to_le … H) -H #H
+ cases (le_to_not_lt … H) -H #H cases (H ?) %
+ | whd in ⊢ (??%?); >lt_to_leb_false // @le_S_S /2/ ]
+ | cases (true_or_false (eqb n k)) #H1 >H1 normalize
+ [ >(eqb_true_to_eq … H1) in H; #H lapply (leb_false_to_not_le … H) -H
+ * #H cases (H ?) %
+ | >le_to_leb_true // @not_lt_to_le % #H2 >le_to_leb_true in H;
+ [ #H destruct (H) | /2/ ]
+ ]
+ ]
+| #x0 #k whd in ⊢ (??(?%??)?); cases (true_or_false (x0==x))
+ #H1 >H1 normalize // >(\P H1) >eqb_n_n % ]
+qed.
+
+lemma vclose_vopen : ∀x,u.((νx.u)⌈x⌉) = u. #x #u @vclose_vopen_aux
+qed.
+
+(*
+theorem tm_to_tm : ∀t.tm' t → tm t.
+#t #H elim H
+*)
+
+lemma in_list_singleton : ∀T.∀t1,t2:T.t1 ∈ [t2] → t1 = t2.
+#T #t1 #t2 #H @(in_list_inv_ind ??? H) /2/
+qed.
+
+lemma fresh_vclose_tm_aux : ∀u,x,k.x ∉ FV (vclose_tm_aux u x k).
+#u #x elim u //
+[ #n #k normalize cases (leb k n) normalize //
+| #x0 #k whd in ⊢ (?(???(?%))); cases (true_or_false (x0==x)) #H >H normalize //
+ lapply (\Pf H) @not_to_not #Hin >(in_list_singleton ??? Hin) %
+| #v1 #v2 #IH1 #IH2 #k normalize % #Hin cases (in_list_append_to_or_in_list ???? Hin) -Hin #Hin
+ [ cases (IH1 k) -IH1 #IH1 @IH1 @Hin | cases (IH2 k) -IH2 #IH2 @IH2 @Hin ]
+qed.
+
+lemma fresh_vclose_tm : ∀u,x.x ∉ FV (νx.u). //
+qed.
+
+lemma fresh_swap_tm : ∀z1,z2,u.z1 ∉ FV u → z2 ∉ FV u → swap 𝔸 z1 z2 · u = u.
+#z1 #z2 #u elim u
+[2: normalize in ⊢ (?→%→%→?); #x #Hz1 #Hz2 whd in ⊢ (??%?); >swap_other //
+ [ @(not_to_not … Hz2) | @(not_to_not … Hz1) ] //
+|1: //
+| #s #v #IH normalize #Hz1 #Hz2 >IH // [@Hz2|@Hz1]
+| #v1 #v2 #IH1 #IH2 normalize #Hz1 #Hz2
+ >IH1 [| @(not_to_not … Hz2) @in_list_to_in_list_append_l | @(not_to_not … Hz1) @in_list_to_in_list_append_l ]
+ >IH2 // [@(not_to_not … Hz2) @in_list_to_in_list_append_r | @(not_to_not … Hz1) @in_list_to_in_list_append_r ]
+]
+qed.
+
+theorem tm_to_tm2 : ∀u.tm u → tm2 u.
+#t #Ht elim Ht
+[ #n #Hn cases (not_le_Sn_O n) #Hfalse cases (Hfalse Hn)
+| @tm_par
+| #u #v #Hu #Hv @tm_app
+| #x #s #u #Hu #IHu <(vclose_vopen x u) @tm_lam
+ [ @fresh_vclose_tm
+ | #y #Hy <(fresh_swap_tm x y (νx.u)) /2/ @fresh_vclose_tm ]
+]
+qed.
+
+theorem tm2_to_tm : ∀u.tm2 u → tm u.
+#u #pu elim pu /2/ #x #s #v #Hx #Hv #IH %4 @IH //
+qed.
+
+definition PAR ≝ λx.mk_TM (par x) ?. // qed.
+definition APP ≝ λu,v:TM.mk_TM (app u v) ?./2/ qed.
+definition LAM ≝ λx,s.λu:TM.mk_TM (lam x s u) ?./2/ qed.
+
+axiom vopen_tm_down : ∀u,x,k.tm_or_ctx (S k) u → tm_or_ctx k (u⌈x⌉).
+(* needs true_plus_false
+
+#u #x #k #Hu elim Hu
+[ #n #Hn normalize cases (true_or_false (eqb n O)) #H >H [%2]
+ normalize >(?: leb n O = false) [|cases n in H; // >eqb_n_n #H destruct (H) ]
+ normalize lapply Hn cases n in H; normalize [ #Hfalse destruct (Hfalse) ]
+ #n0 #_ #Hn0 % @le_S_S_to_le //
+| #x0 %2
+| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 %3 //
+| #x0 #s #v #Hv #IH normalize @daemon
+]
+qed.
+*)
+
+definition vopen_TM ≝ λu:CTX.λx.mk_TM (u⌈x⌉) (vopen_tm_down …). @ctx_of_CTX qed.
+
+axiom vclose_tm_up : ∀u,x,k.tm_or_ctx k u → tm_or_ctx (S k) (νx.u).
+
+definition vclose_TM ≝ λu:TM.λx.mk_CTX (νx.u) (vclose_tm_up …). @tm_of_TM qed.
+
+interpretation "ln wf term variable open" 'open u x = (vopen_TM u x).
+interpretation "ln wf term variable close" 'nu x u = (vclose_TM u x).
+
+theorem tm_alpha : ∀x,y,s,u.x ∉ FV u → y ∉ FV u → lam x s (u⌈x⌉) = lam y s (u⌈y⌉).
+#x #y #s #u #Hx #Hy whd in ⊢ (??%%); @eq_f >nominal_eta // >nominal_eta //
+qed.
+
+theorem TM_ind_plus :
+(* non si può dare il principio in modo dipendente (almeno utilizzando tm2)
+ la "prova" purtroppo è in Type e non si può garantire che sia esattamente
+ quella che ci aspetteremmo
+ *)
+ ∀P:pretm → Type[0].
+ (∀x:𝔸.P (PAR x)) →
+ (∀v1,v2:TM.P v1 → P v2 → P (APP v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s.∀v:CTX.x ∉ FV v → x ∉ C →
+ (∀y.y ∉ FV v → P (v⌈y⌉)) → P (LAM x s (v⌈x⌉))) →
+ ∀u:TM.P u.
+#P #Hpar #Happ #C #Hlam * #u #pu elim (tm_to_tm2 u pu) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM …) (mk_TM …)) /2/
+| #x #s #v #Hx #pv #IH
+ lapply (p_fresh … (C@FV v)) letin x0 ≝ (N_fresh … (C@FV v)) #Hx0
+ >(?:lam x s (v⌈x⌉) = lam x0 s (v⌈x0⌉))
+ [|@tm_alpha // @(not_to_not … Hx0) @in_list_to_in_list_append_r ]
+ @(Hlam x0 s (mk_CTX v ?) ??)
+ [ <(nominal_eta … Hx) @vclose_tm_up @tm2_to_tm @pv //
+ | @(not_to_not … Hx0) @in_list_to_in_list_append_r
+ | @(not_to_not … Hx0) @in_list_to_in_list_append_l
+ | @IH ]
+]
+qed.
+
+notation
+"hvbox('nominal' u 'return' out 'with'
+ [ 'xpar' ident x ⇒ f1
+ | 'xapp' ident v1 ident v2 ident recv1 ident recv2 ⇒ f2
+ | 'xlam' ❨ident y # C❩ ident s ident w ident py1 ident py2 ident recw ⇒ f3 ])"
+with precedence 48
+for @{ TM_ind_plus $out (λ${ident x}:?.$f1)
+ (λ${ident v1}:?.λ${ident v2}:?.λ${ident recv1}:?.λ${ident recv2}:?.$f2)
+ $C (λ${ident y}:?.λ${ident s}:?.λ${ident w}:?.λ${ident py1}:?.λ${ident py2}:?.λ${ident recw}:?.$f3)
+ $u }.
+
+(* include "basics/jmeq.ma".*)
+
+definition subst ≝ (λu:TM.λx,v.
+ nominal u return (λ_.TM) with
+ [ xpar x0 ⇒ match x == x0 with [ true ⇒ v | false ⇒ u ]
+ | xapp v1 v2 recv1 recv2 ⇒ APP recv1 recv2
+ | xlam ❨y # x::FV v❩ s w py1 py2 recw ⇒ LAM y s (recw y py1) ]).
+
+lemma fasfd : ∀s,v. pretm_of_TM (subst (LAM O s (PAR 1)) O v) = pretm_of_TM (LAM O s (PAR 1)).
+#s #v normalize in ⊢ (??%?);
+
+
+theorem tm2_ind_plus :
+(* non si può dare il principio in modo dipendente (almeno utilizzando tm2) *)
+ ∀P:pretm → Type[0].
+ (∀x:𝔸.P (par x)) →
+ (∀v1,v2.tm2 v1 → tm2 v2 → P v1 → P v2 → P (app v1 v2)) →
+ ∀C:list 𝔸.
+ (∀x,s,v.x ∉ FV v → x ∉ C → (∀y.y ∉ FV v → tm2 (v⌈y⌉)) →
+ (∀y.y ∉ FV v → P (v⌈y⌉)) → P (lam x s (v⌈x⌉))) →
+ ∀u.tm2 u → P u.
+#P #Hpar #Happ #C #Hlam #u #pu elim pu /2/
+#x #s #v #px #pv #IH
+lapply (p_fresh … (C@FV v)) letin y ≝ (N_fresh … (C@FV v)) #Hy
+>(?:lam x s (v⌈x⌉) = lam y s (v⌈y⌉)) [| @tm_alpha // @(not_to_not … Hy) @in_list_to_in_list_append_r ]
+@Hlam /2/ lapply Hy -Hy @not_to_not #Hy
+[ @in_list_to_in_list_append_r @Hy | @in_list_to_in_list_append_l @Hy ]
+qed.
+
+definition check_tm ≝
+ λu.pretm_ind_plus ? (λ_.true) (λ_.false)
+ (λv1,v2,r1,r2.r1 ∧ r2) [ ] (λx,s,v,pv1,pv2,rv.rv) u.
+
+(*
+lemma check_tm_complete : ∀u.tm u → check_tm u = true.
+#u #pu @(tm2_ind_plus … [ ] … (tm_to_tm2 ? pu)) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2
+| #x #s #v #Hx1 #Hx2 #Hv #IH
+*)
+
+notation
+"hvbox('nominal' u 'return' out 'with'
+ [ 'xpar' ident x ⇒ f1
+ | 'xapp' ident v1 ident v2 ident pv1 ident pv2 ident recv1 ident recv2 ⇒ f2
+ | 'xlam' ❨ident y # C❩ ident s ident w ident py1 ident py2 ident pw ident recw ⇒ f3 ])"
+with precedence 48
+for @{ tm2_ind_plus $out (λ${ident x}:?.$f1)
+ (λ${ident v1}:?.λ${ident v2}:?.λ${ident pv1}:?.λ${ident pv2}:?.λ${ident recv1}:?.λ${ident recv2}:?.$f2)
+ $C (λ${ident y}:?.λ${ident s}:?.λ${ident w}:?.λ${ident py1}:?.λ${ident py2}:?.λ${ident pw}:?.λ${ident recw}:?.$f3)
+ ? (tm_to_tm2 ? $u) }.
+(* notation
+"hvbox('nominal' u 'with'
+ [ 'xlam' ident x # C ident s ident w ⇒ f3 ])"
+with precedence 48
+for @{ tm2_ind_plus ???
+ $C (λ${ident x}:?.λ${ident s}:?.λ${ident w}:?.λ${ident py1}:?.λ${ident py2}:?.
+ λ${ident pw}:?.λ${ident recw}:?.$f3) $u (tm_to_tm2 ??) }.
+*)
+
+
+definition subst ≝ (λu.λpu:tm u.λx,v.
+ nominal pu return (λ_.pretm) with
+ [ xpar x0 ⇒ match x == x0 with [ true ⇒ v | false ⇒ u ]
+ | xapp v1 v2 pv1 pv2 recv1 recv2 ⇒ app recv1 recv2
+ | xlam ❨y # x::FV v❩ s w py1 py2 pw recw ⇒ lam y s (recw y py1) ]).
+
+lemma fasfd : ∀x,s,u,p1,v. subst (lam x s u) p1 x v = lam x s u.
+#x #s #u #p1 #v
+
+
+definition subst ≝ λu.λpu:tm u.λx,y.
+ tm2_ind_plus ?
+ (* par x0 *) (λx0.match x == x0 with [ true ⇒ v | false ⇒ u ])
+ (* app v1 v2 *) (λv1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
+ (* lam y#(x::FV v) s w *) (x::FV v) (λy,s,w,py1,py2,pw,recw.lam y s (recw y py1))
+ u (tm_to_tm2 … pu).
+check subst
+definition subst ≝ λu.λpu:tm u.λx,v.
+ nominal u with
+ [ xlam y # (x::FV v) s w ^ ? ].
+
+(*
+notation > "Λ ident x. ident T [ident x] ↦ P"
+ with precedence 48 for @{'foo (λ${ident x}.λ${ident T}.$P)}.
+
+notation < "Λ ident x. ident T [ident x] ↦ P"
+ with precedence 48 for @{'foo (λ${ident x}:$Q.λ${ident T}:$R.$P)}.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ⇒ f1
+ | 'xapp' ident v1 ident v2 ⇒ f2
+ | 'xlam' ident x # C s w ⇒ f3 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (λ${ident x}:$Tx.$f1)
+ (λ${ident v1}:$Tv1.λ${ident v2}:$Tv2.λ${ident pv1}:$Tpv1.λ${ident pv2}:$Tpv2.λ${ident recv1}:$Trv1.λ${ident recv2}:$Trv2.$f2)
+ $C (λ${ident x}:$Tx.λ${ident s}:$Ts.λ${ident w}:$Tw.λ${ident py1}:$Tpy1.λ${ident py2}:$Tpy2.λ${ident pw}:$Tpw.λ${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+(* | 'xlam' ident x # C s w ^ f3 ]) *)
+with precedence 48
+for @{ tm2_ind_plus ? (λ${ident x}:$Tx.$f1)
+ (λ${ident v1}:$Tv1.λ${ident v2}:$Tv2.λ${ident pv1}:$Tpv1.λ${ident pv2}:$Tpv2.λ${ident recv1}:$Trv1.λ${ident recv2}:$Trv2.$f2)
+ $C (λ${ident x}:$Tx.λ${ident s}:$Ts.λ${ident w}:$Tw.λ${ident py1}:$Tpy1.λ${ident py2}:$Tpy2.λ${ident pw}:$Tpw.λ${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (λ${ident x}:?.$f1)
+ (λ${ident v1}:$Tv1.λ${ident v2}:$Tv2.λ${ident pv1}:$Tpv1.λ${ident pv2}:$Tpv2.λ${ident recv1}:$Trv1.λ${ident recv2}:$Trv2.$f2)
+ $C (λ${ident x}:?.λ${ident s}:$Ts.λ${ident w}:$Tw.λ${ident py1}:$Tpy1.λ${ident py2}:$Tpy2.λ${ident pw}:$Tpw.λ${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+
+
+definition subst ≝ λu.λpu:tm u.λx,v.
+ nominal u with
+ [ xpar x0 ^ match x == x0 with [ true ⇒ v | false ⇒ u ]
+ | xapp v1 v2 ^ ? ].
+ | xlam y # (x::FV v) s w ^ ? ].
+
+
+ (* par x0 *) (λx0.match x == x0 with [ true ⇒ v | false ⇒ u ])
+ (* app v1 v2 *) (λv1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
+ (* lam y#(x::FV v) s w *) (x::FV v) (λy,s,w,py1,py2,pw,recw.lam y s (recw y py1))
+ u (tm_to_tm2 … pu).
+
+
+*)
+definition subst ≝ λu.λpu:tm u.λx,v.
+ tm2_ind_plus ?
+ (* par x0 *) (λx0.match x == x0 with [ true ⇒ v | false ⇒ u ])
+ (* app v1 v2 *) (λv1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
+ (* lam y#(x::FV v) s w *) (x::FV v) (λy,s,w,py1,py2,pw,recw.lam y s (recw y py1))
+ u (tm_to_tm2 … pu).
+
+check subst
+
+
+axiom in_Env : 𝔸 × tp → Env → Prop.
+notation "X ◃ G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+
+
+inductive judg : list tp → tm → tp → Prop ≝
+| t_var : ∀g,n,t.Nth ? n g = Some ? t → judg g (var n) t
+| t_app : ∀g,m,n,t,u.judg g m (arr t u) → judg g n t → judg g (app m n) u
+| t_abs : ∀g,t,m,u.judg (t::g) m u → judg g (abs t m) (arr t u).
+
+definition Env := list (𝔸 × tp).
+
+axiom vclose_env : Env → list tp.
+axiom vclose_tm : Env → tm → tm.
+axiom Lam : 𝔸 → tp → tm → tm.
+definition Judg ≝ λG,M,T.judg (vclose_env G) (vclose_tm G M) T.
+definition dom ≝ λG:Env.map ?? (fst ??) G.
+
+definition sctx ≝ 𝔸 × tm.
+axiom swap_tm : 𝔸 → 𝔸 → tm → tm.
+definition sctx_app : sctx → 𝔸 → tm ≝ λM0,Y.let 〈X,M〉 ≝ M0 in swap_tm X Y M.
+
+axiom in_list : ∀A:Type[0].A → list A → Prop.
+interpretation "list membership" 'mem x l = (in_list ? x l).
+interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
+
+axiom in_Env : 𝔸 × tp → Env → Prop.
+notation "X ◃ G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+let rec FV M ≝ match M with
+ [ par X ⇒ [X]
+ | app M1 M2 ⇒ FV M1@FV M2
+ | abs T M0 ⇒ FV M0
+ | _ ⇒ [ ] ].
+
+(* axiom Lookup : 𝔸 → Env → option tp. *)
+
+(* forma alto livello del judgment
+ t_abs* : ∀G,T,X,M,U.
+ (∀Y ∉ supp(M).Judg (〈Y,T〉::G) (M[Y]) U) →
+ Judg G (Lam X T (M[X])) (arr T U) *)
+
+(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
+
+axiom Judg_ind : ∀P:Env → tm → tp → Prop.
+ (∀X,G,T.〈X,T〉 ◃ G → P G (par X) T) →
+ (∀G,M,N,T,U.
+ Judg G M (arr T U) → Judg G N T →
+ P G M (arr T U) → P G N T → P G (app M N) U) →
+ (∀G,T1,T2,X,M1.
+ (∀Y.Y ∉ (FV (Lam X T1 (sctx_app M1 X))) → Judg (〈Y,T1〉::G) (sctx_app M1 Y) T2) →
+ (∀Y.Y ∉ (FV (Lam X T1 (sctx_app M1 X))) → P (〈Y,T1〉::G) (sctx_app M1 Y) T2) →
+ P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) →
+ ∀G,M,T.Judg G M T → P G M T.
+
+axiom t_par : ∀X,G,T.〈X,T〉 ◃ G → Judg G (par X) T.
+axiom t_app2 : ∀G,M,N,T,U.Judg G M (arr T U) → Judg G N T → Judg G (app M N) U.
+axiom t_Lam : ∀G,X,M,T,U.Judg (〈X,T〉::G) M U → Judg G (Lam X T M) (arr T U).
+
+definition subenv ≝ λG1,G2.∀x.x ◃ G1 → x ◃ G2.
+interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
+
+axiom daemon : ∀P:Prop.P.
+
+theorem weakening : ∀G1,G2,M,T.G1 ⊆ G2 → Judg G1 M T → Judg G2 M T.
+#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (∀G2.?)
+@(Judg_ind … HJ)
+[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
+| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
+ [| @IH1 // | @IH2 // ]
+| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
+ [ (* trivial property of Lam *) @daemon
+ | (* trivial property of subenv *) @daemon ]
+]
+qed.
+
+(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
+ ricorsione *)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/logic.ma".
+include "basics/lists/in.ma".
+include "basics/types.ma".
+
+(*interpretation "list membership" 'mem x l = (in_list ? x l).*)
+
+record Nset : Type[1] ≝
+{
+ (* carrier is specified as a coercion: when an object X of type Nset is
+ given, but something of type Type is expected, Matita will insert a
+ hidden coercion: the user sees "X", but really means "carrier X" *)
+ carrier :> DeqSet;
+ N_fresh : list carrier → carrier;
+ p_fresh : ∀l.N_fresh l ∉ l
+}.
+
+definition maxlist ≝
+ λl.foldr ?? (λx,acc.max x acc) 0 l.
+
+definition natfresh ≝ λl.S (maxlist l).
+
+lemma le_max_1 : ∀x,y.x ≤ max x y. /2/
+qed.
+
+lemma le_max_2 : ∀x,y.y ≤ max x y. /2/
+qed.
+
+lemma le_maxlist : ∀l,x.x ∈ l → x ≤ maxlist l.
+#l elim l
+[#x #Hx @False_ind cases (not_in_list_nil ? x) #H1 /2/
+|#y #tl #IH #x #H1 change with (max ??) in ⊢ (??%);
+ cases (in_list_cons_case ???? H1);#H2;
+ [ >H2 @le_max_1
+ | whd in ⊢ (??%); lapply (refl ? (leb y (maxlist tl)));
+ cases (leb y (maxlist tl)) in ⊢ (???% → %);#H3
+ [ @IH //
+ | lapply (IH ? H2) #H4
+ lapply (leb_false_to_not_le … H3) #H5
+ lapply (not_le_to_lt … H5) #H6
+ @(transitive_le … H4)
+ @(transitive_le … H6) %2 %
+ ]
+ ]
+]
+qed.
+
+(* prove freshness for nat *)
+lemma lt_l_natfresh_l : ∀l,x.x ∈ l → x < natfresh l.
+#l #x #H1 @le_S_S /2/
+qed.
+
+(*naxiom p_Xfresh : ∀l.∀x:Xcarr.x ∈ l → x ≠ ntm (Xfresh l) ∧ x ≠ ntp (Xfresh l).*)
+lemma p_natfresh : ∀l.natfresh l ∉ l.
+#l % #H1 lapply (lt_l_natfresh_l … H1) #H2
+cases (lt_to_not_eq … H2) #H3 @H3 %
+qed.
+
+include "basics/finset.ma".
+
+definition X : Nset ≝ mk_Nset DeqNat ….
+[ @natfresh
+| @p_natfresh
+]
+qed.
\ No newline at end of file
--- /dev/null
+include "turing/auxiliary_machines1.ma".
+include "turing/multi_to_mono/shift_trace_machines.ma".
+
+(******************************************************************************)
+(* mtiL: complete move L for tape i. We reaching the left border of trace i, *)
+(* add a blank if there is no more tape, then move the i-trace and finally *)
+(* come back to the head position. *)
+(******************************************************************************)
+
+(* we say that a tape is regular if for any trace after the first blank we
+ only have other blanks *)
+
+definition all_blanks_in ≝ λsig,l.
+ ∀x. mem ? x l → x = blank sig.
+
+definition regular_i ≝ λsig,n.λl:list (multi_sig sig n).λi.
+ all_blanks_in ? (after_blank ? (trace sig n i l)).
+
+definition regular_trace ≝ λsig,n,a.λls,rs:list (multi_sig sig n).λi.
+ Or (And (regular_i sig n (a::ls) i) (regular_i sig n rs i))
+ (And (regular_i sig n ls i) (regular_i sig n (a::rs) i)).
+
+axiom regular_tail: ∀sig,n,l,i.
+ regular_i sig n l i → regular_i sig n (tail ? l) i.
+
+axiom regular_extend: ∀sig,n,l,i.
+ regular_i sig n l i → regular_i sig n (l@[all_blank sig n]) i.
+
+axiom all_blank_after_blank: ∀sig,n,l1,b,l2,i.
+ nth i ? (vec … b) (blank ?) = blank ? →
+ regular_i sig n (l1@b::l2) i → all_blanks_in ? (trace sig n i l2).
+
+lemma regular_trace_extl: ∀sig,n,a,ls,rs,i.
+ regular_trace sig n a ls rs i →
+ regular_trace sig n a (ls@[all_blank sig n]) rs i.
+#sig #n #a #ls #rs #i *
+ [* #H1 #H2 % % // @(regular_extend … H1)
+ |* #H1 #H2 %2 % // @(regular_extend … H1)
+ ]
+qed.
+
+lemma regular_cons_hd_rs: ∀sig,n.∀a:multi_sig sig n.∀ls,rs1,rs2,i.
+ regular_trace sig n a ls (rs1@rs2) i →
+ regular_trace sig n a ls (rs1@((hd ? rs2 (all_blank …))::(tail ? rs2))) i.
+#sig #n #a #ls #rs1 #rs2 #i cases rs2 [2: #b #tl #H @H]
+*[* #H1 >append_nil #H2 %1 %
+ [@H1 | whd in match (hd ???); @(regular_extend … rs1) //]
+ |* #H1 >append_nil #H2 %2 %
+ [@H1 | whd in match (hd ???); @(regular_extend … (a::rs1)) //]
+ ]
+qed.
+
+lemma eq_trace_to_regular : ∀sig,n.∀a1,a2:multi_sig sig n.∀ls1,ls2,rs1,rs2,i.
+ nth i ? (vec … a1) (blank ?) = nth i ? (vec … a2) (blank ?) →
+ trace sig n i ls1 = trace sig n i ls2 →
+ trace sig n i rs1 = trace sig n i rs2 →
+ regular_trace sig n a1 ls1 rs1 i →
+ regular_trace sig n a2 ls2 rs2 i.
+#sig #n #a1 #a2 #ls1 #ls2 #rs1 #rs2 #i #H1 #H2 #H3 #H4
+whd in match (regular_trace ??????); whd in match (regular_i ????);
+whd in match (regular_i ?? rs2 ?); whd in match (regular_i ?? ls2 ?);
+whd in match (regular_i ?? (a2::rs2) ?); whd in match (trace ????);
+<trace_def whd in match (trace ??? (a2::rs2)); <trace_def
+<H1 <H2 <H3 @H4
+qed.
+
+(******************************* move_to_blank_L ******************************)
+(* we compose machines together to reduce the number of output cases, and
+ improve semantics *)
+
+definition move_to_blank_L ≝ λsig,n,i.
+ (move_until ? L (no_blank sig n i)) · extend ? (all_blank sig n).
+
+(*
+definition R_move_to_blank_L ≝ λsig,n,i,t1,t2.
+(current ? t1 = None ? →
+ t2 = midtape (multi_sig sig n) (left ? t1) (all_blank …) (right ? t1)) ∧
+∀ls,a,rs.t1 = midtape ? ls a rs →
+ ((no_blank sig n i a = false) ∧ t2 = t1) ∨
+ (∃b,ls1,ls2.
+ (no_blank sig n i b = false) ∧
+ (∀j.j ≤n → to_blank_i ?? j (ls1@b::ls2) = to_blank_i ?? j ls) ∧
+ t2 = midtape ? ls2 b ((reverse ? (a::ls1))@rs)).
+*)
+
+definition R_move_to_blank_L ≝ λsig,n,i,t1,t2.
+(current ? t1 = None ? →
+ t2 = midtape (multi_sig sig n) (left ? t1) (all_blank …) (right ? t1)) ∧
+∀ls,a,rs.
+ t1 = midtape (multi_sig sig n) ls a rs →
+ regular_i sig n (a::ls) i →
+ (∀j. j ≠ i → regular_trace … a ls rs j) →
+ (∃b,ls1,ls2.
+ (regular_i sig n (ls1@b::ls2) i) ∧
+ (∀j. j ≠ i → regular_trace …
+ (hd ? (ls1@b::ls2) (all_blank …)) (tail ? (ls1@b::ls2)) rs j) ∧
+ (no_blank sig n i b = false) ∧
+ (hd (multi_sig sig n) (ls1@[b]) (all_blank …) = a) ∧ (* not implied by the next fact *)
+ (∀j.j ≤n → to_blank_i ?? j (ls1@b::ls2) = to_blank_i ?? j (a::ls)) ∧
+ t2 = midtape ? ls2 b ((reverse ? ls1)@rs)).
+
+theorem sem_move_to_blank_L: ∀sig,n,i.
+ move_to_blank_L sig n i ⊨ R_move_to_blank_L sig n i.
+#sig #n #i
+@(sem_seq_app ??????
+ (ssem_move_until_L ? (no_blank sig n i)) (sem_extend ? (all_blank sig n)))
+#tin #tout * #t1 * * #Ht1a #Ht1b * #Ht2a #Ht2b %
+ [#Hcur >(Ht1a Hcur) in Ht2a; /2 by /
+ |#ls #a #rs #Htin #Hreg #Hreg2 -Ht1a cases (Ht1b … Htin)
+ [* #Hnb #Ht1 -Ht1b -Ht2a >Ht1 in Ht2b; >Htin #H
+ %{a} %{[ ]} %{ls}
+ %[%[%[%[%[@Hreg|@Hreg2]|@Hnb]|//]|//]|@H normalize % #H1 destruct (H1)]
+ |*
+ [(* we find the blank *)
+ * #ls1 * #b * #ls2 * * * #H1 #H2 #H3 #Ht1
+ >Ht1 in Ht2b; #Hout -Ht1b
+ %{b} %{(a::ls1)} %{ls2}
+ %[%[%[%[%[>H1 in Hreg; #H @H
+ |#j #jneqi whd in match (hd ???); whd in match (tail ??);
+ <H1 @(Hreg2 j jneqi)]|@H2] |//]|>H1 //]
+ |@Hout normalize % normalize #H destruct (H)
+ ]
+ |* #b * #lss * * #H1 #H2 #Ht1 -Ht1b >Ht1 in Ht2a;
+ whd in match (left ??); whd in match (right ??); #Hout
+ %{(all_blank …)} %{(lss@[b])} %{[]}
+ %[%[%[%[%[<H2 @regular_extend //
+ |<H2 #j #jneqi whd in match (hd ???); whd in match (tail ??);
+ @regular_trace_extl @Hreg2 //]
+ |whd in match (no_blank ????); >blank_all_blank //]
+ |<H2 //]
+ |#j #lejn <H2 @sym_eq @to_blank_i_ext]
+ |>reverse_append >reverse_single @Hout normalize //
+ ]
+ ]
+ ]
+qed.
+
+(******************************************************************************)
+
+definition shift_i_L ≝ λsig,n,i.
+ ncombf_r (multi_sig …) (shift_i sig n i) (all_blank sig n) ·
+ mti sig n i ·
+ extend ? (all_blank sig n).
+
+definition R_shift_i_L ≝ λsig,n,i,t1,t2.
+ (∀a,ls,rs.
+ t1 = midtape ? ls a rs →
+ ((∃rs1,b,rs2,a1,rss.
+ rs = rs1@b::rs2 ∧
+ nth i ? (vec … b) (blank ?) = (blank ?) ∧
+ (∀x. mem ? x rs1 → nth i ? (vec … x) (blank ?) ≠ (blank ?)) ∧
+ shift_l sig n i (a::rs1) (a1::rss) ∧
+ t2 = midtape (multi_sig sig n) ((reverse ? (a1::rss))@ls) b rs2) ∨
+ (∃b,rss.
+ (∀x. mem ? x rs → nth i ? (vec … x) (blank ?) ≠ (blank ?)) ∧
+ shift_l sig n i (a::rs) (rss@[b]) ∧
+ t2 = midtape (multi_sig sig n)
+ ((reverse ? (rss@[b]))@ls) (all_blank sig n) [ ]))).
+
+definition R_shift_i_L_new ≝ λsig,n,i,t1,t2.
+ (∀a,ls,rs.
+ t1 = midtape ? ls a rs →
+ ∃rs1,b,rs2,rss.
+ b = hd ? rs2 (all_blank sig n) ∧
+ nth i ? (vec … b) (blank ?) = (blank ?) ∧
+ rs = rs1@rs2 ∧
+ (∀x. mem ? x rs1 → nth i ? (vec … x) (blank ?) ≠ (blank ?)) ∧
+ shift_l sig n i (a::rs1) rss ∧
+ t2 = midtape (multi_sig sig n) ((reverse ? rss)@ls) b (tail ? rs2)).
+
+theorem sem_shift_i_L: ∀sig,n,i. shift_i_L sig n i ⊨ R_shift_i_L sig n i.
+#sig #n #i
+@(sem_seq_app ??????
+ (sem_ncombf_r (multi_sig sig n) (shift_i sig n i)(all_blank sig n))
+ (sem_seq ????? (ssem_mti sig n i)
+ (sem_extend ? (all_blank sig n))))
+#tin #tout * #t1 * * #Ht1a #Ht1b * #t2 * * #Ht2a #Ht2b * #Htout1 #Htout2
+#a #ls #rs cases rs
+ [#Htin %2 %{(shift_i sig n i a (all_blank sig n))} %{[ ]}
+ %[%[#x @False_ind | @daemon]
+ |lapply (Ht1a … Htin) -Ht1a -Ht1b #Ht1
+ lapply (Ht2a … Ht1) -Ht2a -Ht2b #Ht2 >Ht2 in Htout1;
+ >Ht1 whd in match (left ??); whd in match (right ??); #Htout @Htout //
+ ]
+ |#a1 #rs1 #Htin
+ lapply (Ht1b … Htin) -Ht1a -Ht1b #Ht1
+ lapply (Ht2b … Ht1) -Ht2a -Ht2b *
+ [(* a1 is blank *) * #H1 #H2 %1
+ %{[ ]} %{a1} %{rs1} %{(shift_i sig n i a a1)} %{[ ]}
+ %[%[%[%[// |//] |#x @False_ind] | @daemon]
+ |>Htout2 [>H2 >reverse_single @Ht1 |>H2 >Ht1 normalize % #H destruct (H)]
+ ]
+ |*
+ [* #rs10 * #b * #rs2 * #rss * * * * #H1 #H2 #H3 #H4
+ #Ht2 %1
+ %{(a1::rs10)} %{b} %{rs2} %{(shift_i sig n i a a1)} %{rss}
+ %[%[%[%[>H1 //|//] |@H3] |@daemon ]
+ |>reverse_cons >associative_append
+ >H2 in Htout2; #Htout >Htout [@Ht2| >Ht2 normalize % #H destruct (H)]
+ ]
+ |* #b * #rss * * #H1 #H2
+ #Ht2 %2
+ %{(shift_i sig n i b (all_blank sig n))} %{(shift_i sig n i a a1::rss)}
+ %[%[@H1 |@daemon ]
+ |>Ht2 in Htout1; #Htout >Htout //
+ whd in match (left ??); whd in match (right ??);
+ >reverse_append >reverse_single >associative_append >reverse_cons
+ >associative_append //
+ ]
+ ]
+ ]
+ ]
+qed.
+
+theorem sem_shift_i_L_new: ∀sig,n,i.
+ shift_i_L sig n i ⊨ R_shift_i_L_new sig n i.
+#sig #n #i
+@(Realize_to_Realize … (sem_shift_i_L sig n i))
+#t1 #t2 #H #a #ls #rs #Ht1 lapply (H a ls rs Ht1) *
+ [* #rs1 * #b * #rs2 * #a1 * #rss * * * * #H1 #H2 #H3 #H4 #Ht2
+ %{rs1} %{b} %{(b::rs2)} %{(a1::rss)}
+ %[%[%[%[%[//|@H2]|@H1]|@H3]|@H4] | whd in match (tail ??); @Ht2]
+ |* #b * #rss * * #H1 #H2 #Ht2
+ %{rs} %{(all_blank sig n)} %{[]} %{(rss@[b])}
+ %[%[%[%[%[//|@blank_all_blank]|//]|@H1]|@H2] | whd in match (tail ??); @Ht2]
+ ]
+qed.
+
+
+(*******************************************************************************
+The following machine implements a full move of for a trace: we reach the left
+border, shift the i-th trace and come back to the head position. *)
+
+(* this exclude the possibility that traces do not overlap: the head must
+remain inside all traces *)
+
+definition mtiL ≝ λsig,n,i.
+ move_to_blank_L sig n i ·
+ shift_i_L sig n i ·
+ move_until ? L (no_head sig n).
+
+definition Rmtil ≝ λsig,n,i,t1,t2.
+ ∀ls,a,rs.
+ t1 = midtape (multi_sig sig n) ls a rs →
+ nth n ? (vec … a) (blank ?) = head ? →
+ (∀i.regular_trace sig n a ls rs i) →
+ (* next: we cannot be on rightof on trace i *)
+ (nth i ? (vec … a) (blank ?) = (blank ?)
+ → nth i ? (vec … (hd ? rs (all_blank …))) (blank ?) ≠ (blank ?)) →
+ no_head_in … ls →
+ no_head_in … rs →
+ (∃ls1,a1,rs1.
+ t2 = midtape (multi_sig …) ls1 a1 rs1 ∧
+ (∀i.regular_trace … a1 ls1 rs1 i) ∧
+ (∀j. j ≤ n → j ≠ i → to_blank_i ? n j (a1::ls1) = to_blank_i ? n j (a::ls)) ∧
+ (∀j. j ≤ n → j ≠ i → to_blank_i ? n j rs1 = to_blank_i ? n j rs) ∧
+ (to_blank_i ? n i ls1 = to_blank_i ? n i (a::ls)) ∧
+ (to_blank_i ? n i (a1::rs1)) = to_blank_i ? n i rs).
+
+theorem sem_Rmtil: ∀sig,n,i. i < n → mtiL sig n i ⊨ Rmtil sig n i.
+#sig #n #i #lt_in
+@(sem_seq_app ??????
+ (sem_move_to_blank_L … )
+ (sem_seq ????? (sem_shift_i_L_new …)
+ (ssem_move_until_L ? (no_head sig n))))
+#tin #tout * #t1 * * #_ #Ht1 * #t2 * #Ht2 * #_ #Htout
+(* we start looking into Rmitl *)
+#ls #a #rs #Htin (* tin is a midtape *)
+#Hhead #Hreg #no_rightof #Hnohead_ls #Hnohead_rs
+cut (regular_i sig n (a::ls) i)
+ [cases (Hreg i) * //
+ cases (true_or_false (nth i ? (vec … a) (blank ?) == (blank ?))) #Htest
+ [#_ @daemon (* absurd, since hd rs non e' blank *)
+ |#H #_ @daemon]] #Hreg1
+lapply (Ht1 … Htin Hreg1 ?) [#j #_ @Hreg] -Ht1 -Htin
+* #b * #ls1 * #ls2 * * * * * #reg_ls1_i #reg_ls1_j #Hno_blankb #Hhead #Hls1 #Ht1
+lapply (Ht2 … Ht1) -Ht2 -Ht1
+* #rs1 * #b0 * #rs2 * #rss * * * * * #Hb0 #Hb0blank #Hrs1 #Hrs1b #Hrss #Ht2
+(* we need to recover the position of the head of the emulated machine
+ that is the head of ls1. This is somewhere inside rs1 *)
+cut (∃rs11. rs1 = (reverse ? ls1)@rs11)
+ [cut (ls1 = [ ] ∨ ∃aa,tlls1. ls1 = aa::tlls1)
+ [cases ls1 [%1 // | #aa #tlls1 %2 %{aa} %{tlls1} //]] *
+ [#H1ls1 %{rs1} >H1ls1 //
+ |* #aa * #tlls1 #H1ls1 >H1ls1 in Hrs1;
+ cut (aa = a) [>H1ls1 in Hls1; #H @(to_blank_hd … H)] #eqaa >eqaa
+ #Hrs1_aux cases (compare_append … (sym_eq … Hrs1_aux)) #l *
+ [* #H1 #H2 %{l} @H1
+ |(* this is absurd : if l is empty, the case is as before.
+ if l is not empty then it must start with a blank, since it is the
+ first character in rs2. But in this case we would have a blank
+ inside ls1=a::tls1 that is absurd *)
+ @daemon
+ ]]]
+ * #rs11 #H1
+cut (rs = rs11@rs2)
+ [@(injective_append_l … (reverse … ls1)) >Hrs1 <associative_append <H1 //] #H2
+lapply (Htout … Ht2) -Htout -Ht2 *
+ [(* the current character on trace i holds the head-mark.
+ The case is absurd, since b0 is the head of rs2, that is a sublist of rs,
+ and the head-mark is not in rs *)
+ * #H3 @False_ind @(absurd (nth n ? (vec … b0) (blank sig) = head ?))
+ [@(\P ?) @injective_notb @H3 ]
+ @Hnohead_rs >H2 >trace_append @mem_append_l2
+ lapply Hb0 cases rs2
+ [whd in match (hd ???); #H >H in H3; whd in match (no_head ???);
+ >all_blank_n normalize -H #H destruct (H); @False_ind
+ |#c #r #H4 %1 >H4 //
+ ]
+ |*
+ [(* we reach the head position *)
+ (* cut (trace sig n j (a1::ls20)=trace sig n j (ls1@b::ls2)) *)
+ * #ls10 * #a1 * #ls20 * * * #Hls20 #Ha1 #Hnh #Htout
+ cut (∀j.j ≠ i →
+ trace sig n j (reverse (multi_sig sig n) rs1@b::ls2) =
+ trace sig n j (ls10@a1::ls20))
+ [#j #ineqj >append_cons <reverse_cons >trace_def <map_append <reverse_map
+ lapply (trace_shift_neq …lt_in ? (sym_not_eq … ineqj) … Hrss) [//] #Htr
+ <(trace_def … (b::rs1)) <Htr >reverse_map >map_append @eq_f @Hls20 ]
+ #Htracej
+ cut (trace sig n i (reverse (multi_sig sig n) (rs1@[b0])@ls2) =
+ trace sig n i (ls10@a1::ls20))
+ [>trace_def <map_append <reverse_map <map_append <(trace_def … [b0])
+ cut (trace sig n i [b0] = [blank ?]) [@daemon] #Hcut >Hcut
+ lapply (trace_shift … lt_in … Hrss) [//] whd in match (tail ??); #Htr <Htr
+ >reverse_map >map_append <trace_def <Hls20 %
+ ]
+ #Htracei
+ cut (∀j. j ≠ i →
+ (trace sig n j (reverse (multi_sig sig n) rs11) = trace sig n j ls10) ∧
+ (trace sig n j (ls1@b::ls2) = trace sig n j (a1::ls20)))
+ [@daemon (* si fa
+ #j #ineqj @(first_P_to_eq ? (λx. x ≠ head ?))
+ [lapply (Htracej … ineqj) >trace_def in ⊢ (%→?); <map_append
+ >trace_def in ⊢ (%→?); <map_append #H @H
+ | *) ] #H2
+ cut ((trace sig n i (b0::reverse ? rs11) = trace sig n i (ls10@[a1])) ∧
+ (trace sig n i (ls1@ls2) = trace sig n i ls20))
+ [>H1 in Htracei; >reverse_append >reverse_single >reverse_append
+ >reverse_reverse >associative_append >associative_append
+ @daemon
+ ] #H3
+ cut (∀j. j ≠ i →
+ trace sig n j (reverse (multi_sig sig n) ls10@rs2) = trace sig n j rs)
+ [#j #jneqi @(injective_append_l … (trace sig n j (reverse ? ls1)))
+ >map_append >map_append >Hrs1 >H1 >associative_append
+ <map_append <map_append in ⊢ (???%); @eq_f
+ <map_append <map_append @eq_f2 // @sym_eq
+ <(reverse_reverse … rs11) <reverse_map <reverse_map in ⊢ (???%);
+ @eq_f @(proj1 … (H2 j jneqi))] #Hrs_j
+ %{ls20} %{a1} %{(reverse ? (b0::ls10)@tail (multi_sig sig n) rs2)}
+ %[%[%[%[%[@Htout
+ |#j cases (decidable_eq_nat j i)
+ [#eqji >eqji (* by cases wether a1 is blank *)
+ @daemon
+ |#jneqi lapply (reg_ls1_j … jneqi) #H4
+ >reverse_cons >associative_append >Hb0 @regular_cons_hd_rs
+ @(eq_trace_to_regular … H4)
+ [<hd_trace >(proj2 … (H2 … jneqi)) >hd_trace %
+ |<tail_trace >(proj2 … (H2 … jneqi)) >tail_trace %
+ |@sym_eq @Hrs_j //
+ ]
+ ]]
+ |#j #lejn #jneqi <(Hls1 … lejn)
+ >to_blank_i_def >to_blank_i_def @eq_f @sym_eq @(proj2 … (H2 j jneqi))]
+ |#j #lejn #jneqi >reverse_cons >associative_append >Hb0
+ <to_blank_hd_cons >to_blank_i_def >to_blank_i_def @eq_f @Hrs_j //]
+ |<(Hls1 i) [2:@lt_to_le //]
+ lapply (all_blank_after_blank … reg_ls1_i)
+ [@(\P ?) @daemon] #allb_ls2
+ whd in match (to_blank_i ????); <(proj2 … H3)
+ @daemon ]
+ |>reverse_cons >associative_append
+ cut (to_blank_i sig n i rs = to_blank_i sig n i (rs11@[b0])) [@daemon]
+ #Hcut >Hcut >(to_blank_i_chop … b0 (a1::reverse …ls10)) [2: @Hb0blank]
+ >to_blank_i_def >to_blank_i_def @eq_f
+ >trace_def >trace_def @injective_reverse >reverse_map >reverse_cons
+ >reverse_reverse >reverse_map >reverse_append >reverse_single @sym_eq
+ @(proj1 … H3)
+ ]
+ |(*we do not find the head: this is absurd *)
+ * #b1 * #lss * * #H2 @False_ind
+ cut (∀x0. mem ? x0 (trace sig n n (b0::reverse ? rss@ls2)) → x0 ≠ head ?)
+ [@daemon] -H2 #H2
+ lapply (trace_shift_neq sig n i n … lt_in … Hrss)
+ [@lt_to_not_eq @lt_in | // ]
+ #H3 @(absurd
+ (nth n ? (vec … (hd ? (ls1@[b]) (all_blank sig n))) (blank ?) = head ?))
+ [>Hhead //
+ |@H2 >trace_def %2 <map_append @mem_append_l1 <reverse_map <trace_def
+ >H3 >H1 >trace_def >reverse_map >reverse_cons >reverse_append
+ >reverse_reverse >associative_append <map_append @mem_append_l2
+ cases ls1 [%1 % |#x #ll %1 %]
+ ]
+ ]
+ ]
+qed.
open Printf
-open GrafiteTypes
-open MatitaGtkMisc
open MatitaGuiTypes
-open GtkSourceView2
+open GtkSourceView3
let matita_script_current = ref (fun _ -> (assert false : < advance: ?statement:string -> unit -> unit; status: GrafiteTypes.status >));;
let register_matita_script_current f = matita_script_current := f;;
*)
class clickableMathView obj =
-let text_width = 80 in
+(*let text_width = 80 in*)
object (self)
- inherit GSourceView2.source_view obj
+ inherit GSourceView3.source_view obj
method strings_of_selection = (assert false : (paste_kind * string) list)
self#buffer#apply_tag all_tag ~start:(self#buffer#get_iter `START)
~stop:(self#buffer#get_iter `END);
ignore(all_tag#connect#event
- ~callback:(fun ~origin event pos ->
+ ~callback:(fun ~origin:_ event _pos ->
match GdkEvent.get_type event with
| `MOTION_NOTIFY ->
Gdk.Window.set_cursor
| _ -> false));
let hyperlink_tag = self#buffer#create_tag [] in
ignore(hyperlink_tag#connect#event
- ~callback:(fun ~origin event pos ->
+ ~callback:(fun ~origin:_ event pos ->
let offset = (new GText.iter pos)#offset in
let _,_,href =
try
List.find
- (fun (start,stop,href) -> start <= offset && offset <= stop
+ (fun (start,stop,_href) -> start <= offset && offset <= stop
) hyperlinks
with
Not_found -> assert false
false
| _ -> false));
List.iter
- ( fun (start,stop,(href : string)) ->
+ ( fun (start,stop,(_href : string)) ->
self#buffer#apply_tag hyperlink_tag
~start:(self#buffer#get_iter_at_char start)
~stop:(self#buffer#get_iter_at_char (stop+1));
Gobject.set_params (Gobject.try_cast obj "GtkSourceView") pl;
new _cicMathView obj)(*)) ?auto_indent ?highlight_current_line ?indent_on_tab ?indent_width ?insert_spaces_instead_of_tabs ?right_margin_position ?show_line_marks ?show_line_numbers ?show_right_margin ?smart_home_end ?tab_width ?editable ?cursor_visible ?justification ?wrap_mode ?accepts_tab ?border_width*) [] ?width ?height ?packing ?show () :> cicMathView)
-let screenshot status sequents metasenv subst (filename as ofn) =
+let screenshot _status _sequents _metasenv _subst (_filename (*as ofn*)) =
() (*MATITA 1.0
let w = GWindow.window ~title:"screenshot" () in
let width = 500 in
+++ /dev/null
-
-include "basic_2/dynamic/cnv_cpce.ma".
-
-definition dropable_bi: predicate … ≝
- λR. ∀L1,L2. L1 ⪤[R] L2 → ∀b,f. 𝐔⦃f⦄ →
- ∀K1. ⇩*[b,f] L1 ≘ K1 → ∀K2. ⇩*[b,f] L2 ≘ K2 → K1 ⪤[R] K2.
-
-definition IH (h) (a): relation3 genv lenv term ≝
- λG,L0,T0. ⦃G,L0⦄ ⊢ T0 ![h,a] →
- ∀n,T1. ⦃G,L0⦄ ⊢ T0 ➡[n,h] T1 → ∀T2. ⦃G,L0⦄ ⊢ T0 ⬌η[h] T2 →
- ∀L1. ⦃G,L0⦄ ⊢ ➡[h] L1 →
- ∃∃T. ⦃G,L1⦄ ⊢ T1 ⬌η[h] T & ⦃G,L0⦄ ⊢ T2 ➡[n,h] T.
-
-lemma pippo_aux (h) (a) (G0) (L0) (T0):
- (∀G,L,T. ⦃G0,L0,T0⦄ >[h] ⦃G,L,T⦄ → IH h a G L T) →
- IH h a G0 L0 T0.
-#h #a #G0 #L0 * *
-[ #s #_ #_ #n #X1 #HX1 #X2 #HX2 #L1 #HL01
- elim (cpm_inv_sort1 … HX1) -HX1 #H #Hn destruct
- lapply (cpce_inv_sort_sn … HX2) -HX2 #H destruct
- /3 width=3 by cpce_sort, cpm_sort, ex2_intro/
-| #i #IH #Hi #n #X1 #HX1 #X2 #HX2 #L1 #HL01
- elim (cnv_inv_lref_drops … Hi) -Hi #I #K0 #W0 #HLK0 #HW0
- elim (lpr_drops_conf … HLK0 … HL01) [| // ] #Y1 #H1 #HLK1
- elim (lex_inv_pair_sn … H1) -H1 #K1 #W1 #HK01 #HW01 #H destruct
- elim (cpce_inv_lref_sn_drops … HX2 … HLK0) -HX2 *
- [ #HI #H destruct
- elim (cpm_inv_lref1_drops … HX1) -HX1 *
- [ #H1 #H2 destruct -HW0 -HLK0 -IH
- @(ex2_intro … (#i)) [| // ]
- @cpce_zero_drops #n #p #Y1 #X1 #V1 #U1 #HLY1 #HWU1
- lapply (drops_mono … HLY1 … HLK1) -L1 #H2 destruct
- /4 width=12 by lpr_cpms_trans, cpms_step_sn/
- | #Y0 #W0 #W1 #HLY0 #HW01 #HWX1 -HI -HW0 -IH
- lapply (drops_mono … HLY0 … HLK0) -HLY0 #H destruct
- @(ex2_intro … X1) [| /2 width=6 by cpm_delta_drops/ ]
-
-
-(*
-lemma cpce_inv_eta_drops (h) (n) (G) (L) (i):
- ∀X. ⦃G,L⦄ ⊢ #i ⬌η[h] X →
- ∀K,W. ⇩*[i] L ≘ K.ⓛW →
- ∀p,V1,U. ⦃G,K⦄ ⊢ W ➡*[n,h] ⓛ{p}V1.U →
- ∀V2. ⦃G,K⦄ ⊢ V1 ⬌η[h] V2 →
- ∀W2. ⇧*[↑i] V2 ≘ W2 → X = +ⓛW2.ⓐ#0.#↑i.
-
-theorem cpce_mono_cnv (h) (a) (G) (L):
- ∀T. ⦃G,L⦄ ⊢ T ![h,a] →
- ∀T1. ⦃G,L⦄ ⊢ T ⬌η[h] T1 → ∀T2. ⦃G,L⦄ ⊢ T ⬌η[h] T2 → T1 = T2.
-#h #a #G #L #T #HT
-*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/dynamic/cnv_cpce.ma".
+
+(* CONTEXT-SENSITIVE NATIVE VALIDITY FOR TERMS ******************************)
+
+definition IH (h) (a): relation3 genv lenv term ≝
+ λG,L0,T0. ⦃G,L0⦄ ⊢ T0 ![h,a] →
+ ∀n,T1. ⦃G,L0⦄ ⊢ T0 ➡[n,h] T1 → ∀T2. ⦃G,L0⦄ ⊢ T0 ⬌η[h] T2 →
+ ∀L1. ⦃G,L0⦄ ⊢ ➡[h] L1 →
+ ∃∃T. ⦃G,L1⦄ ⊢ T1 ⬌η[h] T & ⦃G,L0⦄ ⊢ T2 ➡[n,h] T.
+
+lemma pippo_aux (h) (a) (G0) (L0) (T0):
+ (∀G,L,T. ⦃G0,L0,T0⦄ >[h] ⦃G,L,T⦄ → IH h a G L T) →
+ IH h a G0 L0 T0.
+#h #a #G0 #L0 * *
+[ #s #_ #_ #n #X1 #HX1 #X2 #HX2 #L1 #HL01
+ elim (cpm_inv_sort1 … HX1) -HX1 #H #Hn destruct
+ lapply (cpce_inv_sort_sn … HX2) -HX2 #H destruct
+ /3 width=3 by cpce_sort, cpm_sort, ex2_intro/
+| #i #IH #Hi #n #X1 #HX1 #X2 #HX2 #L1 #HL01
+ elim (cnv_inv_lref_drops … Hi) -Hi #I #K0 #W0 #HLK0 #HW0
+ elim (lpr_drops_conf … HLK0 … HL01) [| // ] #Y1 #H1 #HLK1
+ elim (lex_inv_pair_sn … H1) -H1 #K1 #W1 #HK01 #HW01 #H destruct
+ elim (cpce_inv_lref_sn_drops_bind … HX2 … HLK0) -HX2 *
+ [ #HI #H destruct
+ elim (cpm_inv_lref1_drops … HX1) -HX1 *
+ [ #H1 #H2 destruct -HW0 -HLK0 -IH
+ @(ex2_intro … (#i)) [| // ]
+ @cpce_zero_drops #n #p #Y1 #X1 #V1 #U1 #HLY1 #HWU1
+ lapply (drops_mono … HLY1 … HLK1) -L1 #H2 destruct
+ /4 width=12 by lpr_cpms_trans, cpms_step_sn/
+ | #Y0 #W0 #W1 #HLY0 #HW01 #HWX1 -HI -HW0 -IH
+ lapply (drops_mono … HLY0 … HLK0) -HLY0 #H destruct
+ @(ex2_intro … X1) [| /2 width=6 by cpm_delta_drops/ ]
+
+(*
+lemma cpce_inv_eta_drops (h) (n) (G) (L) (i):
+ ∀X. ⦃G,L⦄ ⊢ #i ⬌η[h] X →
+ ∀K,W. ⇩*[i] L ≘ K.ⓛW →
+ ∀p,V1,U. ⦃G,K⦄ ⊢ W ➡*[n,h] ⓛ{p}V1.U →
+ ∀V2. ⦃G,K⦄ ⊢ V1 ⬌η[h] V2 →
+ ∀W2. ⇧*[↑i] V2 ≘ W2 → X = +ⓛW2.ⓐ#0.#↑i.
+
+theorem cpce_mono_cnv (h) (a) (G) (L):
+ ∀T. ⦃G,L⦄ ⊢ T ![h,a] →
+ ∀T1. ⦃G,L⦄ ⊢ T ⬌η[h] T1 → ∀T2. ⦃G,L⦄ ⊢ T ⬌η[h] T2 → T1 = T2.
+#h #a #G #L #T #HT
+*)
+0.99.4 - 26/12/2018 - beta version for the 1.x series
+ * ported to lablgkt3, ulex-camlp5 1.2, ocaml 4.07
+ * bug fix: aliases were no longer added automatically to the script
+
0.99.3 - 06/05/2016 - beta version for the 1.x series
- * cyclic sort hierarchies are now allowed through the "cyclic" keyword
- * new syntax for let rec/corec with flavor specifier
- * optional parameters added to the syntax of definitions
- * new attribute "Implied" put beside "Generated" and "Provided";
- it denotes an object provided not as defined by the user, but as generated by another ITP
- * the command "defined" is added as a presentational alternative to "qed" for definitions
- * improved standard library and contributions
- * improved binaries using matita components
- * source code updated for the latest version of OCaml and related tools
+ * cyclic sort hierarchies are now allowed through the "cyclic" keyword
+ * new syntax for let rec/corec with flavor specifier
+ * optional parameters added to the syntax of definitions
+ * new attribute "Implied" put beside "Generated" and "Provided";
+ it denotes an object provided not as defined by the user, but as
+ generated by another ITP
+ * the command "defined" is added as a presentational alternative to
+ "qed" for definitions
+ * improved standard library and contributions
+ * improved binaries using matita components
+ * source code updated for the latest version of OCaml and related
+ tools
* several bug fixes
0.99.1 - 17/11/2011 - alpha version for the 1.x series
<!-- ================= Tactics ========================= -->
-<!--
<chapter id="sec_declarative_tactics">
<title>Declarative Tactics</title>
<sect1 id="tac_assume">
<title>assume</title>
<titleabbrev>assume</titleabbrev>
- <para><userinput>assume x : t</userinput></para>
+ <para><userinput>assume x : T</userinput></para>
<para>
<variablelist>
<varlistentry role="tactic.synopsis">
<term>Synopsis:</term>
<listitem>
- <para><emphasis role="bold">assume</emphasis> &id; <emphasis role="bold"> : </emphasis> &sterm;</para>
+ <para><emphasis role="bold">assume</emphasis> &id; <emphasis role="bold"> : </emphasis>
+ &sterm; </para>
</listitem>
</varlistentry>
<varlistentry>
<term>Pre-conditions:</term>
<listitem>
- <para>The conclusion of the current proof must be
- <command>∀x:T.P</command> or
- <command>T→P</command> where <command>T</command> is
- a data type (i.e. <command>T</command> has type
- <command>Set</command> or <command>Type</command>).</para>
+ <para>
+ The conclusion of the sequent to prove must be a universal quantification.
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>Action:</term>
<listitem>
- <para>It adds to the context of the current sequent to prove a new
- declaration <command>x : T </command>. The new conclusion becomes
- <command>P</command>.</para>
+ <para>
+ It applies the right introduction rule for the universal quantifier, closing the current sequent (in Natural Deduction this corresponds to the introduction rule for the quantifier).
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>New sequents to prove:</term>
<listitem>
- <para>None.</para>
+ <para>
+ It opens a new sequent to prove the quantified subformula adding <command>x : T</command> to the hypotheses.
+ </para>
</listitem>
</varlistentry>
</variablelist>
</para>
</sect1>
- <sect1 id="tac_byinduction">
- <title>by induction hypothesis we know</title>
- <titleabbrev>by induction hypothesis we know</titleabbrev>
- <para><userinput>by induction hypothesis we know t (id)</userinput></para>
- <para>
- <variablelist>
- <varlistentry role="tactic.synopsis">
- <term>Synopsis:</term>
- <listitem><para><emphasis role="bold">by induction hypothesis we know</emphasis> &term; <emphasis role="bold"> (</emphasis> &id; <emphasis role="bold">)</emphasis></para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Pre-condition:</term>
- <listitem>
- <para>To be used in a proof by induction to state the inductive
- hypothesis.</para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Action:</term>
- <listitem>
- <para> Introduces the inductive hypothesis. </para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>New sequents to prove:</term>
- <listitem>
- <para>None.</para>
- </listitem>
- </varlistentry>
- </variablelist>
- </para>
- </sect1>
-
- <sect1 id="tac_case">
- <title>case</title>
- <titleabbrev>case</titleabbrev>
- <para><userinput>case id (id1:t1) … (idn:tn)</userinput></para>
- <para>
- <variablelist>
- <varlistentry role="tactic.synopsis">
- <term>Synopsis:</term>
- <listitem>
- <para><emphasis role="bold">case</emphasis> &id; [<emphasis role="bold">(</emphasis> &id; <emphasis role="bold">:</emphasis> &term; <emphasis role="bold">)</emphasis>] … </para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Pre-condition:</term>
- <listitem>
- <para>To be used in a proof by induction or by cases to start
- a new case</para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Action:</term>
- <listitem>
- <para>Starts the new case <command>id</command> declaring
- the local parameters <command>(id1:t1) … (idn:tn)</command></para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>New sequents to prove:</term>
- <listitem>
- <para>None</para>
- </listitem>
- </varlistentry>
- </variablelist>
- </para>
- </sect1>
-
- <sect1 id="tac_bydone">
- <title>done</title>
- <titleabbrev>done</titleabbrev>
- <para><userinput>justification done</userinput></para>
- <para>
+ <sect1 id="tac_suppose">
+ <title>suppose</title>
+ <titleabbrev>suppose</titleabbrev>
+ <para><userinput>suppose A (H)</userinput></para>
+ <para>
<variablelist>
<varlistentry role="tactic.synopsis">
<term>Synopsis:</term>
<listitem>
- <para>&justification; <emphasis role="bold">done</emphasis></para>
+ <para><emphasis role="bold">suppose</emphasis> &term; <emphasis role="bold"> (</emphasis> &id;
+ <emphasis role="bold">) </emphasis></para>
</listitem>
</varlistentry>
- <varlistentry>
+ <varlistentry>
<term>Pre-condition:</term>
- <listitem>
- <para></para>
- </listitem>
- </varlistentry>
- <varlistentry>
+ <listitem>
+ <para>
+ The conclusion of the sequent to prove must be an implication.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
<term>Action:</term>
- <listitem>
- <para>It closes the current sequent given the justification.</para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>New sequents to prove:</term>
- <listitem>
- <para>None.</para>
- </listitem>
- </varlistentry>
- </variablelist>
- </para>
+ <listitem>
+ <para>
+ It applies the right introduction rule for the implication, closing the current sequent (in Natural Deduction this corresponds to the introduction rule for the implication).
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequents to prove:</term>
+ <listitem>
+ <para>
+ It opens a new sequent to prove the consequent of the implication adding the antecedent <command>A</command> to the hypotheses. The name of the new hypothesis is <command>H</command>.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
</sect1>
-
- <sect1 id="tac_exitselim">
- <title>let such that</title>
- <titleabbrev>let such that</titleabbrev>
- <para><userinput>justification let x:t such that p (id)</userinput>
- </para>
- <para>
- <variablelist>
- <varlistentry role="tactic.synopsis">
- <term>Synopsis:</term>
- <listitem>
- <para>&justification; <emphasis role="bold">let</emphasis> &id;
- <emphasis role="bold">:</emphasis> &term; <emphasis role="bold">such that</emphasis> &term;
- <emphasis role="bold">(</emphasis> &id; <emphasis role="bold">)</emphasis></para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Pre-condition:</term>
- <listitem>
- <para>
- </para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Action:</term>
- <listitem>
- <para>It derives <command>∃x:t.p</command> using the
- <command>justification</command> and then it introduces in the context
- <command>x</command> and the hypothesis
- <command>p</command> labelled with
- <command>id</command>.
- </para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>New sequent to prove:</term>
- <listitem>
- <para>None.</para>
- </listitem>
- </varlistentry>
- </variablelist>
- </para>
+<sect1 id="tac_let">
+ <title>letin</title>
+ <titleabbrev>letin</titleabbrev>
+ <para><userinput>let x := T </userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para><emphasis role="bold">let</emphasis> &id; <emphasis role="bold"> = </emphasis> &term;</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
+ <listitem>
+ <para>None</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>It adds a new local definition <command>x := T</command> to the context of the sequent to prove.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequents to prove:</term>
+ <listitem>
+ <para>None.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
</sect1>
- <sect1 id="tac_obtain">
- <title>obtain</title>
- <titleabbrev>obtain</titleabbrev>
- <para><userinput>obtain H t1 = t2 justification</userinput></para>
+ <sect1 id="tac_thatisequivalentto">
+ <title>that is equivalent to</title>
+ <titleabbrev>that is equivalent to</titleabbrev>
+ <para><userinput>that is equivalent to t</userinput></para>
<para>
<variablelist>
<varlistentry role="tactic.synopsis">
<term>Synopsis:</term>
<listitem>
- <para>[<emphasis role="bold">obtain</emphasis> &id; | <emphasis role="bold">conclude</emphasis> &term;] <emphasis role="bold">=</emphasis> &term; [&autoparams; | <emphasis role="bold">using</emphasis> &term; | <emphasis role="bold">using once</emphasis> &term; | <emphasis role="bold">proof</emphasis>] [<emphasis role="bold">done</emphasis>]</para>
+ <para>
+ <emphasis role="bold">that is equivalent to</emphasis> &term;
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>Pre-condition:</term>
<listitem>
- <para><command>conclude</command> can be used only if the current
- sequent is stating an equality. The left hand side must be omitted
- in an equality chain.</para>
+ <para>
+ The user must have applied one of the following tactics immediately before applying this tactic: <emphasis role="bold">assume</emphasis>, <emphasis role="bold">suppose</emphasis>, <emphasis role="bold">we need to prove</emphasis>, <emphasis role="bold">by just we proved</emphasis>,<emphasis role="bold">the thesis becomes</emphasis>, <emphasis role="bold">that is equivalent to</emphasis>.
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>Action:</term>
<listitem>
- <para>Starts or continues an equality chain. If the chain starts
- with <command>obtain H</command> a new subproof named
- <command>H</command> is started.</para>
+ <para>
+ If the tactic that was applied before this introduced a new hypothesis in the context, this tactic works on this hypothesis; otherwise, it works on the conclusion. Either way, if the term <command>t</command> is beta-equivalent to the term <command>t1</command> on which this tactic is working (i.e. they can be reduced to a common term), <command>t1</command> is changed with <command>t</command>.
+
+ If the tactic that was applied before this tactic was <emphasis role="bold">that is equivalent to</emphasis>, and that tactic was working on a term <command>t1</command>, this tactic keeps working on <command>t1</command>.
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>New sequent to prove:</term>
<listitem>
- <para>If the chain starts
- with <command>obtain H</command> a nre sequent for
- <command>t2 = ?</command> is opened.
- </para>
+ <para>
+ If this tactic is working on the conclusion, a new sequent with the same hypotheses and the conclusion changed to <command>t</command> is opened. If this tactic is working on the last introduced hypotesis, a new sequent with the same conclusion is opened. The hypotheses of this sequent are the same, except for the one on which the tactic is working on, which is changed with <command>t</command>.
+ </para>
</listitem>
</varlistentry>
</variablelist>
</para>
</sect1>
- <sect1 id="tac_suppose">
- <title>suppose</title>
- <titleabbrev>suppose</titleabbrev>
- <para><userinput>suppose t1 (x) that is equivalent to t2</userinput></para>
- <para>
- <variablelist>
- <varlistentry role="tactic.synopsis">
- <term>Synopsis:</term>
- <listitem>
- <para><emphasis role="bold">suppose</emphasis> &term; <emphasis role="bold"> (</emphasis> &id;
- <emphasis role="bold">) </emphasis> [ <emphasis role="bold">that is equivalent to</emphasis> &term; ]</para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Pre-condition:</term>
- <listitem>
- <para>The conclusion of the current proof must be
- <command>∀x:T.P</command> or
- <command>T→P</command> where <command>T</command> is
- a proposition (i.e. <command>T</command> has type
- <command>Prop</command> or <command>CProp</command>).</para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Action:</term>
- <listitem>
- <para>It adds to the context of the current sequent to prove a new
- declaration <command>x : T </command>. The new conclusion becomes
- <command>P</command>.</para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>New sequents to prove:</term>
- <listitem>
- <para>None.</para>
- </listitem>
- </varlistentry>
- </variablelist>
- </para>
- </sect1>
-
<sect1 id="tac_thesisbecomes">
<title>the thesis becomes</title>
<titleabbrev>the thesis becomes</titleabbrev>
- <para><userinput>the thesis becomes t</userinput></para>
+ <para><userinput>the thesis becomes P</userinput></para>
<para>
<variablelist>
<varlistentry role="tactic.synopsis">
<varlistentry>
<term>Pre-condition:</term>
<listitem>
- <para>The provided term <command>t</command> must be convertible with
- current sequent.</para>
+ <para>The provided term <command>P</command> must be identical to the current conclusion.</para>
</listitem>
</varlistentry>
<varlistentry>
<term>Action:</term>
<listitem>
- <para>It changes the current goal to the one provided.</para>
+ <para>It allows the user to start a chain of reductions on the conclusion with the tactic <emphasis role="bold">that is equivalent to</emphasis>, after stating the current conclusion.</para>
</listitem>
</varlistentry>
<varlistentry>
</variablelist>
</para>
</sect1>
-
+
<sect1 id="tac_weneedtoprove">
<title>we need to prove</title>
<titleabbrev>we need to prove</titleabbrev>
- <para><userinput>we need to prove t1 (id) or equivalently t2</userinput></para>
+ <para><userinput>we need to prove T [(H)]</userinput></para>
<para>
<variablelist>
<varlistentry role="tactic.synopsis">
<para><emphasis role="bold">we need to prove</emphasis> &term;
[<emphasis role="bold">(</emphasis>&id;
<emphasis role="bold">)</emphasis>]
- [ <emphasis role="bold">or equivalently</emphasis> &term;]</para>
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>Pre-condition:</term>
<listitem>
- <para></para>
+ <para>None.</para>
</listitem>
</varlistentry>
<varlistentry>
<term>Action:</term>
<listitem>
- <para>If <command>id</command> is provided, starts a subproof that once concluded
- will be named <command>id</command>. Otherwise states what needs to be proved.
- If <command>t2</command> is provided, the new goal is
- immediately changed to <command>t2</command> wich must
- be equivalent to <command>t1</command>.
+ <para>If <command>id</command> is provided, it applies a logical cut on <command>T</command>. Otherwise, it allows the user to start a chain of reductions on the conclusion with the tactic <emphasis role="bold">that is equivalent to</emphasis>.
</para>
</listitem>
</varlistentry>
<varlistentry>
<term>New sequents to prove:</term>
<listitem>
- <para>The stated one if <command>id</command> is provided</para>
+ <para>If <command>id</command> is supplied, a new sequent with <command>T</command> as the conclusion is opened, and a new sequent with the conclusion of the sequent on which this tactic was applied is opened, with <command>H:T</command> added to the hypotheses.</para>
</listitem>
</varlistentry>
</variablelist>
</para>
</sect1>
+ <sect1 id="tac_bytermweproved">
+ <title>we proved</title>
+ <titleabbrev>we proved</titleabbrev>
+ <para><userinput>justification we proved T [(id)]</userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para>&justification; <emphasis role="bold">we proved</emphasis> &term;
+ [<emphasis role="bold">(</emphasis> &id;
+ <emphasis role="bold">)</emphasis>]
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
+ <listitem>
+ <para>
+ None.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>
+ If <command>id</command> is supplied, a logical cut on <command>T</command> is made. Otherwise, if <command>T</command> is identical to the current conclusion, it allows the user to start a chain of reductions on the conclusion with the tactic <emphasis role="bold">that is equivalent to</emphasis>.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequent to prove:</term>
+ <listitem>
+ <para>
+ If <command>id</command> is supplied, a new sequent with <command>T</command> as the conclusion is opened and then immediately closed using the supplied justification. A new sequent with the conclusion of the sequent on which this tactic was applied is opened, and a new hypotesis <command>T</command> is added to the context, with name <command>id</command>.
+ If <command>id</command> is not supplied, no new sequents are opened.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
+
+
+ <sect1 id="tac_existselim">
+ <title>let such that</title>
+ <titleabbrev>let such that</titleabbrev>
+ <para><userinput>justification let x:T such that P (H)</userinput>
+ </para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para>&justification; <emphasis role="bold">let</emphasis> &id;
+ <emphasis role="bold">:</emphasis> &term; <emphasis role="bold">such that</emphasis> &term;
+ <emphasis role="bold">(</emphasis> &id; <emphasis role="bold">)</emphasis></para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
+ <listitem>
+ <para>
+ None.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>
+ It applies the left introduction rule of the existential quantifier on the formula <command>∃ x. P(x)</command> (in Natural Deduction this corresponds to the elimination rule for the quantifier).
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequent to prove:</term>
+ <listitem>
+ <para>A new sequent with <command>∃ x. P(x)</command> as the conclusion is opened and then immediately closed using the given justification. A new sequent with the conclusion of the sequent on which this tactic was applied is opened, and two new hypotheses <command>x : T</command> and <command>H : P</command> are added to the context.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
<sect1 id="tac_andelim">
<title>we have</title>
<titleabbrev>we have</titleabbrev>
- <para><userinput>justification we have t1 (id1) and t2 (id2)</userinput>
+ <para><userinput>justification we have A (H1) and B (H2)</userinput>
</para>
<para>
<variablelist>
<varlistentry>
<term>Pre-condition:</term>
<listitem>
- <para></para>
+ <para>
+ None.
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>Action:</term>
<listitem>
- <para>It derives <command>t1∧t2</command> using the
- <command>justification</command> then it introduces in the context
- <command>t1</command> labelled with <command>id1</command> and
- <command>t2</command> labelled with <command>id2</command>.
- </para>
+ <para>
+ It applies the left multiplicative introduction rule for the conjunction on the formula <command>A ∧ B</command> (in Natural Deduction this corresponds to the elimination rule for the conjunction).
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>New sequent to prove:</term>
<listitem>
- <para>None.</para>
+ <para>A new sequent with <command>A ∧ B</command> as the conclusion is opened and then immediately closed using the given justification. A new sequent with the conclusion of the sequent on which this tactic was applied is opened, and two new hypotheses <command>H1 : A</command> and <command>H2 : B</command> are added to the context.</para>
</listitem>
</varlistentry>
</variablelist>
</para>
</sect1>
+
+ <sect1 id="tac_weproceedbyinduction">
+ <title>we proceed by induction on</title>
+ <titleabbrev>we proceed by induction on</titleabbrev>
+ <para><userinput>we proceed by induction on t to prove P</userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para><emphasis role="bold">we proceed by induction on</emphasis> &term; <emphasis role="bold"> to prove </emphasis> &term; </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
+ <listitem>
+ <para>The type of <command>t</command> must be an inductive type and <command>P</command> must be identical to the current conclusion.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>It applies the induction principle on <command>t</command> to prove <command>P</command>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequents to prove:</term>
+ <listitem>
+ <para>It opens a new sequent for each constructor of the type of <command>t</command>, each with the conclusion <command>P</command> instantiated for the constructor. For the inductive constructors (i.e. if the inductive type is <command>T</command>, constructors with an argument of type <command>T</command>), the conclusion is a logical implication, where the antecedent is the inductive hypothesis for the constructor, and the consequent is <command>P</command>.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
+
<sect1 id="tac_weproceedbycases">
<title>we proceed by cases on</title>
<titleabbrev>we proceed by cases on</titleabbrev>
- <para><userinput>we proceed by cases on t to prove th</userinput></para>
+ <para><userinput>we proceed by cases on t to prove P</userinput></para>
<para>
<variablelist>
<varlistentry role="tactic.synopsis">
<varlistentry>
<term>Pre-condition:</term>
<listitem>
- <para><command>t</command> must inhabitant of an inductive type and
+ <para>The type of <command>t</command> must be an inductive type and <command>P</command> must be identical to the current conclusion.
+ </para>
+ <!--para><command>t</command> must inhabitant of an inductive type and
<command>th</command> must be the conclusion to be proved by
- cases.</para>
+ cases.</para-->
</listitem>
</varlistentry>
<varlistentry>
<term>Action:</term>
<listitem>
- <para> It proceeds by cases on <command>t</command> </para>
+ <para> It proceeds by case-analysis on <command>t</command> </para>
</listitem>
</varlistentry>
<varlistentry>
<term>New sequents to prove:</term>
<listitem>
<para>It opens one new sequent for each constructor of the
- type of <command>t</command>.</para>
+ type of <command>t</command>, each with the conclusion <command>P</command> instantiated for the constructor.</para>
</listitem>
</varlistentry>
</variablelist>
</para>
</sect1>
-
- <sect1 id="tac_weproceedbyinduction">
- <title>we proceed by induction on</title>
- <titleabbrev>we proceed by induction on</titleabbrev>
- <para><userinput>we proceed by induction on t to prove th</userinput></para>
- <para>
- <variablelist>
- <varlistentry role="tactic.synopsis">
- <term>Synopsis:</term>
- <listitem>
- <para><emphasis role="bold">we proceed by induction on</emphasis> &term; <emphasis role="bold"> to prove </emphasis> &term; </para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Pre-condition:</term>
- <listitem>
- <para><command>t</command> must inhabitant of an inductive type and
- <command>th</command> must be the conclusion to be proved by induction.
- </para>
- </listitem>
- </varlistentry>
- <varlistentry>
- <term>Action:</term>
+
+ <sect1 id="tac_case">
+ <title>case</title>
+ <titleabbrev>case</titleabbrev>
+ <para><userinput>case id (id1:T1) … (idn:Tn)</userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para><emphasis role="bold">case</emphasis> &id; [<emphasis role="bold">(</emphasis> &id; <emphasis role="bold">:</emphasis> &term; <emphasis role="bold">)</emphasis>] … [<emphasis role="bold">(</emphasis> &id; <emphasis role="bold">:</emphasis> &term; <emphasis role="bold">)</emphasis>]</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
<listitem>
- <para>It proceed by induction on <command>t</command>.</para>
+ <para>The user must have started a proof by induction/cases that has not been concluded yet, <command>id</command> must be a constructor for the inductive type of the term under induction/case-analysis, and the case must not have already been proved.</para>
</listitem>
- </varlistentry>
- <varlistentry>
- <term>New sequents to prove:</term>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
<listitem>
- <para>It opens one new sequent for each constructor of the
- type of <command>t</command>.</para>
+ <para>It starts the proof for the case <command>id</command>, where <command>id1:T1</command>,…,<command>idn:Tn</command> are the arguments of the constructor, each declared with its type.</para>
</listitem>
- </varlistentry>
- </variablelist>
- </para>
- </sect1>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequents to prove:</term>
+ <listitem>
+ <para>The sequent for the case <command>id</command>.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
+ <sect1 id="tac_byinduction">
+ <title>by induction hypothesis we know</title>
+ <titleabbrev>by induction hypothesis we know</titleabbrev>
+ <para><userinput>by induction hypothesis we know P (id)</userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem><para><emphasis role="bold">by induction hypothesis we know</emphasis> &term; <emphasis role="bold"> (</emphasis> &id; <emphasis role="bold">)</emphasis></para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
+ <listitem>
+ <para>The user must have started proving a case for a proof by induction/case-analysis.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para> It introduces the inductive hypothesis. </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequents to prove:</term>
+ <listitem>
+ <para>None.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
- <sect1 id="tac_bytermweproved">
- <title>we proved</title>
- <titleabbrev>we proved</titleabbrev>
- <para><userinput>justification we proved t (id)</userinput></para>
- <variablelist>
+ <sect1 id="tac_conclude">
+ <title>conclude</title>
+ <titleabbrev>conclude</titleabbrev>
+ <para><userinput>conclude t1 </userinput></para>
+ <para>
+ <variablelist>
<varlistentry role="tactic.synopsis">
<term>Synopsis:</term>
<listitem>
- <para>&justification; <emphasis role="bold">we proved</emphasis> &term;
- <emphasis role="bold">(</emphasis> &id;
- <emphasis role="bold">)</emphasis></para>
+ <para><emphasis role="bold">conclude</emphasis> &term;</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
+ <listitem>
+ <para>
+ The current conclusion must be an equality <command>t1 = tk</command>
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>It starts an equality chain on the conclusion. It allows the user to apply the tactic <emphasis role="bold">=</emphasis> to continue the chain.</para>
</listitem>
- </varlistentry>
- <varlistentry>
- <term>Pre-condition:</term>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequent to prove:</term>
<listitem>
- <para><command>t</command>must have type <command>Prop</command>.
- </para>
+ <para>None.</para>
</listitem>
- </varlistentry>
- <varlistentry>
- <term>Action:</term>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
+ <sect1 id="tac_obtain">
+ <title>obtain</title>
+ <titleabbrev>obtain</titleabbrev>
+ <para><userinput>obtain H t1 </userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para><emphasis role="bold">obtain</emphasis> &id; &term;</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
<listitem>
- <para>It derives <command>t</command>
- using the justification and labels the conclusion with
- <command>id</command>.
- </para>
+ <para>
+ None.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>It starts an equality chain <command>t1 = ?</command>, which, when concluded, will be added to hypoteses of the current sequent. It allows the user to apply the tactic <emphasis role="bold">=</emphasis> to continue the chain.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequent to prove:</term>
+ <listitem>
+ <para>A new sequent for <command>t1 = ?</command> is opened, a new sequent for <command>?</command> is opened, and a new sequent with the conclusion of the sequent on which this tactic was applied is opened, with <command>H: t1 = ?</command> added to its hypotheses. This hypotesis will be changed when the equality chain is concluded with <command>H: t1 = tk</command>, where <command>tk</command> is the last term of the equality chain. The goal for <command>?</command> can be safely ignored, as it will be automatically closed when the equality chain is concluded.</para>
</listitem>
- </varlistentry>
- <varlistentry>
- <term>New sequent to prove:</term>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
+ <sect1 id="tac_rewrite">
+ <title>=</title>
+ <titleabbrev>=</titleabbrev>
+ <para><userinput>= t2 justification</userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para>
+ <emphasis role="bold">=</emphasis> &term; [&autoparams; | <emphasis role="bold">using</emphasis> &term; | <emphasis role="bold">using once</emphasis> &term; | <emphasis role="bold">proof</emphasis>] [<emphasis role="bold">done</emphasis>]
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
<listitem>
- <para>None.</para>
+ <para>
+ The user must have started an equality chain with <emphasis role="bold">conclude</emphasis> or <emphasis role="bold">obtain</emphasis> that has not been concluded yet.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>
+ It applies the transitivity of <command>=</command> on the left-hand-side of the current conclusion, <command>t2</command>, and the right-hand-side of the current conclusion, using the given justification. If <emphasis role="bold">done</emphasis> is supplied, this represents the last step in the equality chain.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequent to prove:</term>
+ <listitem>
+ <para>
+ A new sequent for <command>lhs = t2</command> is opened and then immediately closed using the given justification. A new sequent with the conclusion <command>t2 = rhs</command> is opened.
+ </para>
</listitem>
- </varlistentry>
- </variablelist>
- </para>
- </sect1>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
+
+ <sect1 id="tac_bydone">
+ <title>done</title>
+ <titleabbrev>done</titleabbrev>
+ <para><userinput>justification done</userinput></para>
+ <para>
+ <variablelist>
+ <varlistentry role="tactic.synopsis">
+ <term>Synopsis:</term>
+ <listitem>
+ <para>&justification; <emphasis role="bold">done</emphasis></para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Pre-condition:</term>
+ <listitem>
+ <para>The user is proving a sequent which was opened with the tactic <emphasis role="bold">we need to prove</emphasis>, or the user is proving a sequent which was opened with the tactic <emphasis role="bold">we proceed by induction/cases on</emphasis>, or the user is proving a chain of equalities that was started with either the tactic <emphasis role="bold">conclude</emphasis> or <emphasis role="bold">obtain</emphasis>.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>Action:</term>
+ <listitem>
+ <para>It closes the current sequent with the given justification.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>New sequents to prove:</term>
+ <listitem>
+ <para>None.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </para>
+ </sect1>
</chapter>
--->
method load_graph_from_file ?(gviz_cmd = "dot") fname =
let tmp_png = tempfile () in
let rc = Sys.command (mk_gviz_cmd gviz_cmd png_flags fname tmp_png) in
- if rc <> 0 then
+ if rc <> 0 || (Unix.stat tmp_png).Unix.st_size = 0 then begin
eprintf
("Graphviz command failed (exit code: %d) on the following graph:\n"
^^ "%s\n%!")
rc (HExtlib.input_file fname);
- image#set_file tmp_png;
- HExtlib.safe_remove tmp_png;
- let tmp_map = tempfile () in
- ignore (Sys.command (mk_gviz_cmd gviz_cmd map_flags fname tmp_map));
- self#load_map tmp_map;
- HExtlib.safe_remove tmp_map
+ (* CSC: it would be better to show something explaining that the
+ graph is empty *)
+ image#clear ()
+ end else begin
+ image#set_file tmp_png;
+ HExtlib.safe_remove tmp_png;
+ let tmp_map = tempfile () in
+ ignore (Sys.command (mk_gviz_cmd gviz_cmd map_flags fname tmp_map));
+ self#load_map tmp_map;
+ HExtlib.safe_remove tmp_map
+ end
method private load_map fname =
let areas = ref [] in
+++ /dev/null
-<?xml version="1.0"?>
-<glade-interface>
- <!-- interface-requires gtk+ 2.16 -->
- <!-- interface-naming-policy toplevel-contextual -->
- <widget class="GtkWindow" id="BrowserWin">
- <property name="width_request">500</property>
- <property name="height_request">480</property>
- <property name="visible">True</property>
- <property name="title" translatable="yes">Cic browser</property>
- <property name="window_position">center-on-parent</property>
- <property name="default_width">500</property>
- <property name="default_height">480</property>
- <property name="destroy_with_parent">True</property>
- <child>
- <widget class="GtkEventBox" id="BrowserWinEventBox">
- <property name="visible">True</property>
- <child>
- <widget class="GtkVBox" id="BrowserVBox">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkMenuBar" id="menubar2">
- <property name="visible">True</property>
- <child>
- <widget class="GtkMenuItem" id="BrowserFileMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_File</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="BrowserFileMenu_menu">
- <child>
- <widget class="GtkImageMenuItem" id="BrowserNewMenuItem">
- <property name="label">gtk-new</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="BrowserUrlMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Open _Location ...</property>
- <property name="use_underline">True</property>
- <accelerator key="L" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separatormenuitem1">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="BrowserCloseMenuItem">
- <property name="label">gtk-close</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="BrowserEditMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_Edit</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="BrowserEditMenu_menu">
- <child>
- <widget class="GtkImageMenuItem" id="BrowserCopyMenuItem">
- <property name="label">gtk-copy</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkFrame" id="frame2">
- <property name="visible">True</property>
- <property name="label_xalign">0</property>
- <property name="label_yalign">0</property>
- <property name="shadow_type">none</property>
- <child>
- <widget class="GtkHBox" id="BrowserHBox">
- <property name="visible">True</property>
- <child>
- <widget class="GtkButton" id="BrowserNewButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image303">
- <property name="visible">True</property>
- <property name="stock">gtk-new</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="BrowserBackButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image304">
- <property name="visible">True</property>
- <property name="stock">gtk-go-back</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="BrowserForwardButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image305">
- <property name="visible">True</property>
- <property name="stock">gtk-go-forward</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="BrowserRefreshButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="tooltip" translatable="yes">refresh</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image229">
- <property name="visible">True</property>
- <property name="stock">gtk-refresh</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">3</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="BrowserHomeButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="tooltip" translatable="yes">home</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image190">
- <property name="visible">True</property>
- <property name="stock">gtk-home</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">4</property>
- </packing>
- </child>
- <child>
- <widget class="GtkImage" id="image301">
- <property name="visible">True</property>
- <property name="stock">gtk-jump-to</property>
- <property name="icon-size">2</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="padding">3</property>
- <property name="position">5</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="UriHBox">
- <property name="visible">True</property>
- <child>
- <widget class="GtkEntry" id="browserUri">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="has_focus">True</property>
- <property name="invisible_char">●</property>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">6</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkNotebook" id="mathOrListNotebook">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <child>
- <widget class="GtkScrolledWindow" id="ScrolledBrowser">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <child>
- <placeholder/>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkLabel" id="mathLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">MathView</property>
- </widget>
- <packing>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindow9">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <property name="shadow_type">in</property>
- <child>
- <widget class="GtkTreeView" id="whelpResultTreeview">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="headers_visible">False</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="WhelpResult">
- <property name="visible">True</property>
- <property name="label" translatable="yes">WhelpResult</property>
- </widget>
- <packing>
- <property name="position">1</property>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindow11">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <child>
- <widget class="GtkViewport" id="viewport2">
- <property name="visible">True</property>
- <property name="shadow_type">none</property>
- <child>
- <widget class="GtkImage" id="BrowserImage">
- <property name="visible">True</property>
- <property name="stock">gtk-missing-image</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="EasterEggLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">WhelpEasterEgg</property>
- </widget>
- <packing>
- <property name="position">2</property>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- <child>
- <widget class="GtkScrolledWindow" id="GraphScrolledWin">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <child>
- <placeholder/>
- </child>
- </widget>
- <packing>
- <property name="position">3</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label26">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Graph</property>
- </widget>
- <packing>
- <property name="position">3</property>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- <child>
- <widget class="GtkVBox" id="vbox20">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwinContent">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="border_width">3</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <property name="shadow_type">in</property>
- <child>
- <placeholder/>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="hbox35">
- <property name="visible">True</property>
- <property name="border_width">4</property>
- <property name="spacing">4</property>
- <child>
- <widget class="GtkVBox" id="vbox22">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkEntry" id="entrySearch">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="has_focus">True</property>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="buttonSearch">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <child>
- <widget class="GtkAlignment" id="alignment21">
- <property name="visible">True</property>
- <property name="xscale">0</property>
- <property name="yscale">0</property>
- <child>
- <widget class="GtkHBox" id="hbox36">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkImage" id="image1068">
- <property name="visible">True</property>
- <property name="stock">gtk-find</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label32">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Search</property>
- <property name="use_underline">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">4</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="SearchText">
- <property name="visible">True</property>
- <property name="label" translatable="yes">SearchText</property>
- </widget>
- <packing>
- <property name="position">4</property>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">3</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkDialog" id="ConfirmationDialog">
- <property name="title" translatable="yes">DUMMY</property>
- <property name="resizable">False</property>
- <property name="modal">True</property>
- <property name="window_position">center</property>
- <property name="type_hint">dialog</property>
- <child internal-child="vbox">
- <widget class="GtkVBox" id="dialog-vbox1">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkLabel" id="ConfirmationDialogLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">DUMMY</property>
- <property name="justify">center</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child internal-child="action_area">
- <widget class="GtkHButtonBox" id="dialog-action_area1">
- <property name="visible">True</property>
- <property name="layout_style">end</property>
- <child>
- <widget class="GtkButton" id="ConfirmationDialogCancelButton">
- <property name="label">gtk-cancel</property>
- <property name="response_id">-6</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="ConfirmationDialogOkButton">
- <property name="label">gtk-ok</property>
- <property name="response_id">-5</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="pack_type">end</property>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkDialog" id="EmptyDialog">
- <property name="visible">True</property>
- <property name="title" translatable="yes">DUMMY</property>
- <property name="type_hint">dialog</property>
- <child internal-child="vbox">
- <widget class="GtkVBox" id="EmptyDialogVBox">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkLabel" id="EmptyDialogLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">DUMMY</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <placeholder/>
- </child>
- <child internal-child="action_area">
- <widget class="GtkHButtonBox" id="dialog-action_area5">
- <property name="visible">True</property>
- <property name="layout_style">end</property>
- <child>
- <widget class="GtkButton" id="EmptyDialogCancelButton">
- <property name="label">gtk-cancel</property>
- <property name="response_id">-6</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="EmptyDialogOkButton">
- <property name="label">gtk-ok</property>
- <property name="response_id">-5</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="pack_type">end</property>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkFileSelection" id="FileSelectionWin">
- <property name="border_width">10</property>
- <property name="title" translatable="yes">Select File</property>
- <property name="modal">True</property>
- <property name="window_position">center</property>
- <property name="type_hint">dialog</property>
- <child internal-child="cancel_button">
- <widget class="GtkButton" id="fileSelCancelButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- </widget>
- </child>
- <child internal-child="ok_button">
- <widget class="GtkButton" id="fileSelOkButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- </widget>
- </child>
- </widget>
- <widget class="GtkWindow" id="MainWin">
- <property name="title" translatable="yes">Matita</property>
- <child>
- <widget class="GtkEventBox" id="MainWinEventBox">
- <property name="visible">True</property>
- <child>
- <widget class="GtkVBox" id="vbox8">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkHandleBox" id="menuBarHandleBox">
- <property name="visible">True</property>
- <child>
- <widget class="GtkMenuBar" id="menubar1">
- <property name="visible">True</property>
- <child>
- <widget class="GtkMenuItem" id="fileMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_File</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="fileMenu_menu">
- <child>
- <widget class="GtkImageMenuItem" id="newMenuItem">
- <property name="label">gtk-new</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="n" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="openMenuItem">
- <property name="label">gtk-open</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="o" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="saveMenuItem">
- <property name="label">gtk-save</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="s" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="saveAsMenuItem">
- <property name="label">gtk-save-as</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="s" signal="activate" modifiers="GDK_SHIFT_MASK | GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator2">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="closeMenuItem">
- <property name="label">gtk-close</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="w" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="quitMenuItem">
- <property name="label">gtk-quit</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="q" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="editMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_Edit</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="editMenu_menu">
- <child>
- <widget class="GtkImageMenuItem" id="undoMenuItem">
- <property name="label">gtk-undo</property>
- <property name="visible">True</property>
- <property name="sensitive">False</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="z" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="redoMenuItem">
- <property name="label">gtk-redo</property>
- <property name="visible">True</property>
- <property name="sensitive">False</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="z" signal="activate" modifiers="GDK_SHIFT_MASK | GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator3">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="cutMenuItem">
- <property name="label">gtk-cut</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="x" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="copyMenuItem">
- <property name="label">gtk-copy</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="c" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="pasteMenuItem">
- <property name="label">gtk-paste</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="v" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="pastePatternMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Paste as pattern</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkCheckMenuItem" id="unicodeAsTexMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Paste Unicode as TeX</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkCheckMenuItem" id="menuitemAutoAltL">
- <property name="visible">True</property>
- <property name="tooltip" translatable="yes">Automatically expands TeX macros to their corresponding UTF-8 symbol</property>
- <property name="label" translatable="yes">Auto-expand TeX Macros</property>
- <property name="use_underline">True</property>
- <property name="active">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="deleteMenuItem">
- <property name="label">gtk-delete</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator4">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="selectAllMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Select _All</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator7">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="findReplMenuItem">
- <property name="label">gtk-find-and-replace</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="f" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator8">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="LigatureButton">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Next ligature</property>
- <property name="use_underline">True</property>
- <accelerator key="l" signal="activate" modifiers="GDK_MOD1_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="externalEditorMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Edit with e_xternal editor</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="scriptMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_Script</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="scriptMenu_menu">
- <child>
- <widget class="GtkImageMenuItem" id="scriptAdvanceMenuItem">
- <property name="label">gtk-go-down</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="Page_Down" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="scriptRetractMenuItem">
- <property name="label">gtk-go-up</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="Page_Up" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator9">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="scriptBottomMenuItem">
- <property name="label">gtk-goto-bottom</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="End" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="scriptTopMenuItem">
- <property name="label">gtk-goto-top</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="Home" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator10">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="scriptJumpMenuItem">
- <property name="label">gtk-jump-to</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="period" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="viewMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_View</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="viewMenu_menu">
- <child>
- <widget class="GtkMenuItem" id="newCicBrowserMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">New CIC _browser</property>
- <property name="use_underline">True</property>
- <accelerator key="F3" signal="activate"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator5">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkCheckMenuItem" id="fullscreenMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_Fullscreen</property>
- <property name="use_underline">True</property>
- <accelerator key="F11" signal="activate"/>
- </widget>
- </child>
- <child>
- <widget class="GtkCheckMenuItem" id="menuitemPalette">
- <property name="visible">True</property>
- <property name="tooltip" translatable="yes">Shows a palette with natural deduction rules</property>
- <property name="label" translatable="yes">Natural deduction palette</property>
- <property name="use_underline">True</property>
- <accelerator key="F2" signal="activate"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator1">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="increaseFontSizeMenuItem">
- <property name="label">gtk-zoom-in</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="plus" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="decreaseFontSizeMenuItem">
- <property name="label">gtk-zoom-out</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="minus" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="normalFontSizeMenuItem">
- <property name="label">gtk-zoom-100</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="equal" signal="activate" modifiers="GDK_CONTROL_MASK"/>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator12">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkCheckMenuItem" id="ppNotationMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Pretty print notation</property>
- <property name="use_underline">True</property>
- <property name="active">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkCheckMenuItem" id="hideCoercionsMenuItem">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Hide coercions</property>
- <property name="use_underline">True</property>
- <property name="active">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator13">
- <property name="visible">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="showCoercionsGraphMenuItem">
- <property name="visible">True</property>
- <property name="tooltip" translatable="yes">Displays the graph of coercions</property>
- <property name="label" translatable="yes">Coercions Graph</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="showHintsDbMenuItem">
- <property name="visible">True</property>
- <property name="tooltip" translatable="yes">Displays the database of hints</property>
- <property name="label" translatable="yes">Hints database</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="showTermGrammarMenuItem">
- <property name="visible">True</property>
- <property name="tooltip" translatable="yes">Displays the terms grammar as extended by the user</property>
- <property name="label" translatable="yes">Terms grammar</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="showUnicodeTable">
- <property name="visible">True</property>
- <property name="tooltip" translatable="yes">Show the conversion table from TeX like sequences to UTF-8</property>
- <property name="label" translatable="yes">TeX/UTF-8 table</property>
- <property name="use_underline">True</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="debugMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_Debug</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="debugMenu_menu">
- <child>
- <widget class="GtkSeparatorMenuItem" id="separator6">
- <property name="visible">True</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkMenuItem" id="helpMenu">
- <property name="visible">True</property>
- <property name="label" translatable="yes">_Help</property>
- <property name="use_underline">True</property>
- <child>
- <widget class="GtkMenu" id="helpMenu_menu">
- <child>
- <widget class="GtkImageMenuItem" id="contentsMenuItem">
- <property name="label">gtk-help</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- <accelerator key="F1" signal="activate"/>
- </widget>
- </child>
- <child>
- <widget class="GtkImageMenuItem" id="aboutMenuItem">
- <property name="label">gtk-about</property>
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- <property name="use_stock">True</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="hbox99">
- <property name="visible">True</property>
- <child>
- <widget class="GtkHPaned" id="hpaneScriptSequent">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <child>
- <widget class="GtkHBox" id="hbox18">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkHandleBox" id="TacticsButtonsHandlebox">
- <property name="visible">True</property>
- <property name="handle_position">top</property>
- <child>
- <widget class="GtkVBox" id="vboxTacticsPalette">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkExpander" id="expander1">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <child>
- <widget class="GtkVBox" id="vbox1">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkButton" id="butImpl_intro">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label8">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Implication (⇒<sub>i</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butAnd_intro">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label7">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Conjunction (∧<sub>i</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butOr_intro_left">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label9">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Disjunction left (∨<sub>i-l</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butOr_intro_right">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label10">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Disjunction right (∨<sub>i-r</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">3</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butNot_intro">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label11">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Negation (¬<sub>i</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">4</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butTop_intro">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label12">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Top (⊤<sub>i</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">5</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butForall_intro">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label20">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Universal (∀<sub>i</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">6</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butExists_intro">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label21">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Existential (∃<sub>i</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">7</property>
- </packing>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkLabel" id="label4">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Introduction rules</property>
- </widget>
- <packing>
- <property name="type">label_item</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkExpander" id="expander2">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <child>
- <widget class="GtkVBox" id="vbox3">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkButton" id="butImpl_elim">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label22">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Implication (⇒<sub>e</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butAnd_elim_left">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label23">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Conjunction left (∧<sub>e-l</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butAnd_elim_right">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label24">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Conjunction right (∧<sub>e-r</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butOr_elim">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label27">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Disjunction (∨<sub>e</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">3</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butNot_elim">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label31">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Negation (¬<sub>e</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">4</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butBot_elim">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label33">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Bottom (⊥<sub>e</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">5</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butForall_elim">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label34">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Universal (∀<sub>e</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">6</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butExists_elim">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- <child>
- <widget class="GtkLabel" id="label35">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Existential (∃<sub>e</sub>)</property>
- <property name="use_markup">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">7</property>
- </packing>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkLabel" id="label5">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Elimination rules</property>
- </widget>
- <packing>
- <property name="type">label_item</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkExpander" id="expander3">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <child>
- <widget class="GtkVBox" id="vbox4">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkButton" id="butRAA">
- <property name="label" translatable="yes">Reduction to Absurdity (RAA)</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butUseLemma">
- <property name="label" translatable="yes">Use lemma (lem)</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="butDischarge">
- <property name="label" translatable="yes">Discharge (discharge)</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">True</property>
- </widget>
- <packing>
- <property name="position">2</property>
- </packing>
- </child>
- </widget>
- </child>
- <child>
- <widget class="GtkLabel" id="label6">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Misc rules</property>
- </widget>
- <packing>
- <property name="type">label_item</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkVBox" id="vboxScript">
- <property name="width_request">400</property>
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkHBox" id="hbox28">
- <property name="visible">True</property>
- <child>
- <widget class="GtkToolbar" id="buttonsToolbar">
- <property name="visible">True</property>
- <property name="toolbar_style">both</property>
- <child>
- <widget class="GtkToolItem" id="toolitem41">
- <property name="visible">True</property>
- <child>
- <widget class="GtkButton" id="scriptTopButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="tooltip" translatable="yes">Restart</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image920">
- <property name="visible">True</property>
- <property name="stock">gtk-goto-top</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- </packing>
- </child>
- <child>
- <widget class="GtkToolItem" id="toolitem42">
- <property name="visible">True</property>
- <child>
- <widget class="GtkButton" id="scriptRetractButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="tooltip" translatable="yes">Retract 1 phrase</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image921">
- <property name="visible">True</property>
- <property name="stock">gtk-go-up</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- </packing>
- </child>
- <child>
- <widget class="GtkToolItem" id="toolitem43">
- <property name="visible">True</property>
- <child>
- <widget class="GtkButton" id="scriptJumpButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="tooltip" translatable="yes">Execute until point</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image922">
- <property name="visible">True</property>
- <property name="stock">gtk-jump-to</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- </packing>
- </child>
- <child>
- <widget class="GtkToolItem" id="toolitem44">
- <property name="visible">True</property>
- <child>
- <widget class="GtkButton" id="scriptAdvanceButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="tooltip" translatable="yes">Execute 1 phrase</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image923">
- <property name="visible">True</property>
- <property name="stock">gtk-go-down</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- </packing>
- </child>
- <child>
- <widget class="GtkToolItem" id="toolitem45">
- <property name="visible">True</property>
- <child>
- <widget class="GtkButton" id="scriptBottomButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="tooltip" translatable="yes">Execute all</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image924">
- <property name="visible">True</property>
- <property name="stock">gtk-goto-bottom</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkToolbar" id="toolbar2">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <property name="toolbar_style">both</property>
- <child>
- <widget class="GtkToolItem" id="toolitem46">
- <property name="visible">True</property>
- <child>
- <widget class="GtkButton" id="scriptAbortButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="relief">none</property>
- <child>
- <widget class="GtkImage" id="image927">
- <property name="visible">True</property>
- <property name="stock">gtk-stop</property>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkNotebook" id="scriptNotebook">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="scrollable">True</property>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- <packing>
- <property name="type">tab</property>
- </packing>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- <packing>
- <property name="type">tab</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="resize">False</property>
- <property name="shrink">True</property>
- </packing>
- </child>
- <child>
- <widget class="GtkVPaned" id="vpaned1">
- <property name="width_request">250</property>
- <property name="height_request">500</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="position">380</property>
- <child>
- <widget class="GtkNotebook" id="sequentsNotebook">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="scrollable">True</property>
- </widget>
- <packing>
- <property name="resize">False</property>
- <property name="shrink">True</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="hbox9">
- <property name="visible">True</property>
- <child>
- <widget class="GtkScrolledWindow" id="logScrolledWin">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">never</property>
- <property name="shadow_type">in</property>
- <child>
- <widget class="GtkTextView" id="logTextView">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="editable">False</property>
- <property name="wrap_mode">char</property>
- <property name="cursor_visible">False</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="resize">True</property>
- <property name="shrink">True</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="resize">True</property>
- <property name="shrink">True</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="hbox10">
- <property name="visible">True</property>
- <child>
- <widget class="GtkStatusbar" id="StatusBar">
- <property name="visible">True</property>
- <property name="has_resize_grip">False</property>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkNotebook" id="HintNotebook">
- <property name="visible">True</property>
- <property name="show_tabs">False</property>
- <child>
- <widget class="GtkImage" id="HintLowImage">
- <property name="visible">True</property>
- <property name="stock">gtk-missing-image</property>
- </widget>
- </child>
- <child>
- <widget class="GtkLabel" id="label14">
- <property name="visible">True</property>
- <property name="label" translatable="yes">label14</property>
- </widget>
- <packing>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- <child>
- <widget class="GtkImage" id="HintMediumImage">
- <property name="visible">True</property>
- <property name="stock">gtk-missing-image</property>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label15">
- <property name="visible">True</property>
- <property name="label" translatable="yes">label15</property>
- </widget>
- <packing>
- <property name="position">1</property>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- <child>
- <widget class="GtkImage" id="HintHighImage">
- <property name="visible">True</property>
- <property name="stock">gtk-missing-image</property>
- </widget>
- <packing>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label16">
- <property name="visible">True</property>
- <property name="label" translatable="yes">label16</property>
- </widget>
- <packing>
- <property name="position">2</property>
- <property name="tab_fill">False</property>
- <property name="type">tab</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkDialog" id="TextDialog">
- <property name="title" translatable="yes">DUMMY</property>
- <property name="type_hint">dialog</property>
- <child internal-child="vbox">
- <widget class="GtkVBox" id="vbox5">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkLabel" id="TextDialogLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">DUMMY</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindow2">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <property name="shadow_type">in</property>
- <child>
- <widget class="GtkTextView" id="TextDialogTextView">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">3</property>
- </packing>
- </child>
- <child internal-child="action_area">
- <widget class="GtkHButtonBox" id="hbuttonbox1">
- <property name="visible">True</property>
- <property name="layout_style">end</property>
- <child>
- <widget class="GtkButton" id="TextDialogCancelButton">
- <property name="label">gtk-cancel</property>
- <property name="response_id">-6</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="TextDialogOkButton">
- <property name="label">gtk-ok</property>
- <property name="response_id">-5</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="pack_type">end</property>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkDialog" id="UriChoiceDialog">
- <property name="height_request">280</property>
- <property name="title" translatable="yes">Uri choice</property>
- <property name="modal">True</property>
- <property name="window_position">center</property>
- <property name="type_hint">dialog</property>
- <child internal-child="vbox">
- <widget class="GtkVBox" id="dialog-vbox3">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <property name="spacing">4</property>
- <child>
- <widget class="GtkVBox" id="vbox2">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <property name="spacing">3</property>
- <child>
- <widget class="GtkLabel" id="UriChoiceLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">some informative message here ...</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindow1">
- <property name="width_request">400</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <child>
- <widget class="GtkTreeView" id="UriChoiceTreeView">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="headers_visible">False</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="uriEntryHBox">
- <property name="visible">True</property>
- <child>
- <widget class="GtkLabel" id="label2">
- <property name="visible">True</property>
- <property name="label" translatable="yes">URI: </property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkEntry" id="entry1">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">2</property>
- </packing>
- </child>
- <child internal-child="action_area">
- <widget class="GtkHButtonBox" id="dialog-action_area3">
- <property name="visible">True</property>
- <property name="layout_style">end</property>
- <child>
- <widget class="GtkButton" id="UriChoiceAbortButton">
- <property name="label">gtk-cancel</property>
- <property name="response_id">-6</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="UriChoiceSelectedButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <child>
- <widget class="GtkAlignment" id="alignment2">
- <property name="visible">True</property>
- <property name="xscale">0</property>
- <property name="yscale">0</property>
- <child>
- <widget class="GtkHBox" id="hbox3">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkImage" id="image19">
- <property name="visible">True</property>
- <property name="stock">gtk-index</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label3">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Try _Selected</property>
- <property name="use_underline">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="UriChoiceConstantsButton">
- <property name="label" translatable="yes">Try Constants</property>
- <property name="visible">True</property>
- <property name="sensitive">False</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_underline">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="copyButton">
- <property name="label">gtk-copy</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">3</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="uriChoiceAutoButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <child>
- <widget class="GtkAlignment" id="alignment5">
- <property name="visible">True</property>
- <property name="xscale">0</property>
- <property name="yscale">0</property>
- <child>
- <widget class="GtkHBox" id="hbox16">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkImage" id="image302">
- <property name="visible">True</property>
- <property name="stock">gtk-ok</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="okLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">bla bla bla</property>
- <property name="use_underline">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">4</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="uriChoiceForwardButton">
- <property name="label">gtk-go-forward</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">5</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="pack_type">end</property>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkWindow" id="FindReplWin">
- <property name="border_width">5</property>
- <property name="title" translatable="yes">Find & Replace</property>
- <property name="resizable">False</property>
- <property name="window_position">mouse</property>
- <property name="type_hint">dialog</property>
- <child>
- <widget class="GtkTable" id="table1">
- <property name="visible">True</property>
- <property name="n_rows">3</property>
- <property name="n_columns">2</property>
- <property name="row_spacing">5</property>
- <child>
- <widget class="GtkLabel" id="label17">
- <property name="visible">True</property>
- <property name="xalign">0</property>
- <property name="label" translatable="yes">Find:</property>
- </widget>
- <packing>
- <property name="x_options"></property>
- <property name="y_options"></property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label18">
- <property name="visible">True</property>
- <property name="xalign">0</property>
- <property name="label" translatable="yes">Replace with: </property>
- </widget>
- <packing>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- <property name="x_options"></property>
- <property name="y_options"></property>
- </packing>
- </child>
- <child>
- <widget class="GtkEntry" id="findEntry">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="has_focus">True</property>
- <property name="can_default">True</property>
- <property name="has_default">True</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="y_options"></property>
- </packing>
- </child>
- <child>
- <widget class="GtkEntry" id="replaceEntry">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- <property name="y_options"></property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="hbox19">
- <property name="visible">True</property>
- <property name="spacing">5</property>
- <child>
- <widget class="GtkVBox" id="vbox9">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="findButton">
- <property name="label">gtk-find</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="findReplButton">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <child>
- <widget class="GtkAlignment" id="alignment13">
- <property name="visible">True</property>
- <property name="xscale">0</property>
- <property name="yscale">0</property>
- <child>
- <widget class="GtkHBox" id="hbox20">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkImage" id="image357">
- <property name="visible">True</property>
- <property name="stock">gtk-find-and-replace</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label19">
- <property name="visible">True</property>
- <property name="label">_Replace</property>
- <property name="use_underline">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="cancelButton">
- <property name="label">gtk-cancel</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">3</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="right_attach">2</property>
- <property name="top_attach">2</property>
- <property name="bottom_attach">3</property>
- <property name="y_padding">5</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkDialog" id="DisambiguationErrors">
- <property name="width_request">450</property>
- <property name="height_request">400</property>
- <property name="title" translatable="yes">title</property>
- <property name="modal">True</property>
- <property name="type_hint">dialog</property>
- <child internal-child="vbox">
- <widget class="GtkVBox" id="vbox14">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkVBox" id="vbox15">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkLabel" id="disambiguationErrorsLabel">
- <property name="visible">True</property>
- <property name="label" translatable="yes">some informative message here ...</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindow12">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">automatic</property>
- <property name="vscrollbar_policy">automatic</property>
- <property name="shadow_type">in</property>
- <child>
- <widget class="GtkTreeView" id="treeview">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="headers_visible">False</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">2</property>
- </packing>
- </child>
- <child internal-child="action_area">
- <widget class="GtkHButtonBox" id="hbuttonbox2">
- <property name="visible">True</property>
- <property name="layout_style">end</property>
- <child>
- <widget class="GtkButton" id="button6">
- <property name="label">gtk-help</property>
- <property name="response_id">-11</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="disambiguationErrorsMoreErrors">
- <property name="response_id">-6</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <child>
- <widget class="GtkAlignment" id="alignment18">
- <property name="visible">True</property>
- <property name="xscale">0</property>
- <property name="yscale">0</property>
- <child>
- <widget class="GtkHBox" id="hbox29">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkImage" id="image926">
- <property name="visible">True</property>
- <property name="stock">gtk-zoom-in</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label28">
- <property name="visible">True</property>
- <property name="label">More</property>
- <property name="use_underline">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="disambiguationErrorsCancelButton">
- <property name="label">gtk-cancel</property>
- <property name="response_id">-6</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="has_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="disambiguationErrorsOkButton">
- <property name="label">gtk-ok</property>
- <property name="response_id">-5</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">3</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="pack_type">end</property>
- <property name="position">0</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- <widget class="GtkWindow" id="AutoWin">
- <property name="width_request">600</property>
- <property name="height_request">400</property>
- <property name="visible">True</property>
- <property name="title" translatable="yes">Auto</property>
- <property name="type_hint">dialog</property>
- <property name="gravity">south-east</property>
- <child>
- <widget class="GtkVBox" id="vbox17">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkHBox" id="hbox30">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindowAREA">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="vscrollbar_policy">automatic</property>
- <property name="shadow_type">in</property>
- <child>
- <widget class="GtkViewport" id="viewportAREA">
- <property name="visible">True</property>
- <child>
- <widget class="GtkTable" id="table">
- <property name="visible">True</property>
- <property name="n_rows">3</property>
- <property name="n_columns">3</property>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- <child>
- <placeholder/>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkVBox" id="vbox18">
- <property name="visible">True</property>
- <property name="orientation">vertical</property>
- <child>
- <widget class="GtkButton" id="buttonUP">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <child>
- <widget class="GtkAlignment" id="alignment19">
- <property name="visible">True</property>
- <property name="xscale">0</property>
- <property name="yscale">0</property>
- <child>
- <widget class="GtkHBox" id="hbox31">
- <property name="visible">True</property>
- <property name="spacing">2</property>
- <child>
- <widget class="GtkImage" id="image1066">
- <property name="visible">True</property>
- <property name="stock">gtk-go-up</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkLabel" id="label30">
- <property name="visible">True</property>
- <property name="use_underline">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="buttonDOWN">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="receives_default">False</property>
- <child>
- <widget class="GtkImage" id="image1065">
- <property name="visible">True</property>
- <property name="stock">gtk-go-down</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHSeparator" id="hseparator3">
- <property name="visible">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="padding">3</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHBox" id="hbox32">
- <property name="visible">True</property>
- <child>
- <widget class="GtkLabel" id="labelLAST">
- <property name="visible">True</property>
- <property name="xalign">0</property>
- <property name="label" translatable="yes">Last:</property>
- </widget>
- <packing>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkHButtonBox" id="hbuttonbox3">
- <property name="visible">True</property>
- <property name="border_width">4</property>
- <property name="spacing">4</property>
- <property name="layout_style">end</property>
- <child>
- <widget class="GtkButton" id="buttonPAUSE">
- <property name="label">gtk-media-pause</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">0</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="buttonPLAY">
- <property name="label">gtk-media-play</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">1</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="buttonNEXT">
- <property name="label">gtk-media-next</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- <child>
- <widget class="GtkButton" id="buttonCLOSE">
- <property name="label">gtk-close</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="can_default">True</property>
- <property name="receives_default">False</property>
- <property name="use_stock">True</property>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="fill">False</property>
- <property name="position">3</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="position">1</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="expand">False</property>
- <property name="position">2</property>
- </packing>
- </child>
- </widget>
- </child>
- </widget>
-</glade-interface>
<keyword>inversion</keyword>
<keyword>lapply</keyword>
<keyword>destruct</keyword>
+ <keyword>assume</keyword>
+ <keyword>suppose</keyword>
+ <keyword>that</keyword>
+ <keyword>is</keyword>
+ <keyword>equivalent</keyword>
+ <keyword>to</keyword>
+ <keyword>we</keyword>
+ <keyword>need</keyword>
+ <keyword>prove</keyword>
+ <keyword>or</keyword>
+ <keyword>equivalently</keyword>
+ <keyword>by</keyword>
+ <keyword>done</keyword>
+ <keyword>proved</keyword>
+ <keyword>have</keyword>
+ <keyword>such</keyword>
+ <keyword>the</keyword>
+ <keyword>thesis</keyword>
+ <keyword>becomes</keyword>
+ <keyword>conclude</keyword>
+ <keyword>obtain</keyword>
+ <keyword>proceed</keyword>
+ <keyword>induction</keyword>
+ <keyword>case</keyword>
+ <keyword>hypothesis</keyword>
+ <keyword>know</keyword>
<!-- commands -->
<keyword>alias</keyword>
(* $Id$ *)
-open Printf
-
-open MatitaGtkMisc
-open GrafiteTypes
-
(** {2 Initialization} *)
let _ =
--- /dev/null
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- Generated with glade 3.22.1 -->
+<interface>
+ <requires lib="gtk+" version="3.20"/>
+ <object class="GtkWindow" id="AutoWin">
+ <property name="width_request">600</property>
+ <property name="height_request">400</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">Auto</property>
+ <property name="type_hint">dialog</property>
+ <property name="gravity">south-east</property>
+ <child>
+ <object class="GtkBox" id="vbox17">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkBox" id="hbox30">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindowAREA">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkViewport" id="viewportAREA">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkGrid" id="table">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vbox18">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkButton" id="buttonUP">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <child>
+ <object class="GtkAlignment" id="alignment19">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <child>
+ <object class="GtkBox" id="hbox31">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkImage" id="image1066">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-go-up</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label30">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="use_underline">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="buttonDOWN">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <child>
+ <object class="GtkImage" id="image1065">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-go-down</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkSeparator" id="hseparator3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="padding">3</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="hbox32">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkLabel" id="labelLAST">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Last:</property>
+ <property name="xalign">0</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButtonBox" id="hbuttonbox3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="border_width">4</property>
+ <property name="spacing">4</property>
+ <property name="layout_style">end</property>
+ <child>
+ <object class="GtkButton" id="buttonPAUSE">
+ <property name="label">gtk-media-pause</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="buttonPLAY">
+ <property name="label">gtk-media-play</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="buttonNEXT">
+ <property name="label">gtk-media-next</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="buttonCLOSE">
+ <property name="label">gtk-close</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ <object class="GtkWindow" id="BrowserWin">
+ <property name="width_request">500</property>
+ <property name="height_request">480</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">Cic browser</property>
+ <property name="window_position">center-on-parent</property>
+ <property name="default_width">500</property>
+ <property name="default_height">480</property>
+ <property name="destroy_with_parent">True</property>
+ <child>
+ <object class="GtkEventBox" id="BrowserWinEventBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkBox" id="BrowserVBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkMenuBar" id="menubar2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="BrowserFileMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_File</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="BrowserFileMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="BrowserNewMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_New</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="BrowserUrlMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Open _Location ...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="L" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separatormenuitem1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="BrowserCloseMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Quit</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="BrowserEditMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Edit</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="BrowserEditMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="BrowserCopyMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Copy</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkFrame" id="frame2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label_xalign">0</property>
+ <property name="label_yalign">0</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkBox" id="BrowserHBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkButton" id="BrowserNewButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image303">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-new</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="BrowserBackButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image304">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-go-back</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="BrowserForwardButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image305">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-go-forward</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="BrowserRefreshButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="tooltip_text" translatable="yes">refresh</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image229">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-refresh</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="BrowserHomeButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="tooltip_text" translatable="yes">home</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image190">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-home</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkImage" id="image301">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-jump-to</property>
+ <property name="icon_size">2</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="padding">3</property>
+ <property name="position">5</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="UriHBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkEntry" id="browserUri">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="has_focus">True</property>
+ <property name="invisible_char">●</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">6</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkNotebook" id="mathOrListNotebook">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <child>
+ <object class="GtkScrolledWindow" id="ScrolledBrowser">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ </object>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="mathLabel">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">MathView</property>
+ </object>
+ <packing>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindow9">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkTreeView" id="whelpResultTreeview">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection"/>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="WhelpResult">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">WhelpResult</property>
+ </object>
+ <packing>
+ <property name="position">1</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindow11">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <child>
+ <object class="GtkViewport" id="viewport2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="shadow_type">none</property>
+ <child>
+ <object class="GtkImage" id="BrowserImage">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-missing-image</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="EasterEggLabel">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">WhelpEasterEgg</property>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="GraphScrolledWin">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ </object>
+ <packing>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label26">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Graph</property>
+ </object>
+ <packing>
+ <property name="position">3</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vbox20">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwinContent">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="border_width">3</property>
+ <property name="shadow_type">in</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="hbox35">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="border_width">4</property>
+ <property name="spacing">4</property>
+ <child>
+ <object class="GtkBox" id="vbox22">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkEntry" id="entrySearch">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="has_focus">True</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="buttonSearch">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <child>
+ <object class="GtkAlignment" id="alignment21">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <child>
+ <object class="GtkBox" id="hbox36">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkImage" id="image1068">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-find</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label32">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Search</property>
+ <property name="use_underline">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="position">4</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="SearchText">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">SearchText</property>
+ </object>
+ <packing>
+ <property name="position">4</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <object class="GtkDialog" id="DisambiguationErrors">
+ <property name="width_request">450</property>
+ <property name="height_request">400</property>
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">title</property>
+ <property name="modal">True</property>
+ <property name="type_hint">dialog</property>
+ <child internal-child="vbox">
+ <object class="GtkBox" id="vbox14">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child internal-child="action_area">
+ <object class="GtkButtonBox" id="hbuttonbox2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="layout_style">spread</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="pack_type">end</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vbox15">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkLabel" id="disambiguationErrorsLabel">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">some informative message here ...</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindow12">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="vexpand">True</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkTreeView" id="treeview">
+ <property name="height_request">717</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection"/>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ <object class="GtkWindow" id="FindReplWin">
+ <property name="can_focus">False</property>
+ <property name="border_width">5</property>
+ <property name="title" translatable="yes">Find & Replace</property>
+ <property name="resizable">False</property>
+ <property name="window_position">mouse</property>
+ <property name="type_hint">dialog</property>
+ <child>
+ <object class="GtkGrid" id="table1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="row_spacing">9</property>
+ <child>
+ <object class="GtkLabel" id="label17">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Find:</property>
+ <property name="xalign">0</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label18">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Replace with: </property>
+ <property name="xalign">0</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkEntry" id="findEntry">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="has_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkEntry" id="replaceEntry">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="hbox19">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">5</property>
+ <property name="homogeneous">True</property>
+ <child>
+ <object class="GtkButton" id="findButton">
+ <property name="label">gtk-find</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="findReplButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <child>
+ <object class="GtkAlignment" id="alignment13">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <child>
+ <object class="GtkBox" id="hbox20">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkImage" id="image357">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-find-and-replace</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label19">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Replace</property>
+ <property name="use_underline">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="cancelButton">
+ <property name="label">gtk-cancel</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">2</property>
+ <property name="width">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ <object class="GtkWindow" id="MainWin">
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">Matita</property>
+ <child>
+ <object class="GtkEventBox" id="MainWinEventBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkBox" id="vbox8">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkMenuBar" id="menubar1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="fileMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_File</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="fileMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="newMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_New</property>
+ <property name="use_underline">True</property>
+ <accelerator key="n" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="openMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Open...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="o" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="saveMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Save</property>
+ <property name="use_underline">True</property>
+ <accelerator key="s" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="saveAsMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Save as...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="s" signal="activate" modifiers="GDK_SHIFT_MASK | GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="closeMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Close</property>
+ <property name="use_underline">True</property>
+ <accelerator key="w" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="quitMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Quit</property>
+ <property name="use_underline">True</property>
+ <accelerator key="q" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="editMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Edit</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="editMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="undoMenuItem">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Undo</property>
+ <property name="use_underline">True</property>
+ <accelerator key="z" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="redoMenuItem">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">False</property>
+ <property name="label">_Redo</property>
+ <property name="use_underline">True</property>
+ <accelerator key="z" signal="activate" modifiers="GDK_SHIFT_MASK | GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="cutMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Cut</property>
+ <property name="use_underline">True</property>
+ <accelerator key="x" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="copyMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Copy</property>
+ <property name="use_underline">True</property>
+ <accelerator key="c" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="pasteMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Paste</property>
+ <property name="use_underline">True</property>
+ <accelerator key="v" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="pastePatternMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Paste as pattern</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkCheckMenuItem" id="unicodeAsTexMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Paste Unicode as TeX</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkCheckMenuItem" id="menuitemAutoAltL">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Auto-expand TeX Macros</property>
+ <property name="use_underline">True</property>
+ <property name="active">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="deleteMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Delete</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="selectAllMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Select _All</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator7">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="findReplMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Find and replace...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="f" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator8">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="LigatureButton">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Next ligature</property>
+ <property name="use_underline">True</property>
+ <accelerator key="l" signal="activate" modifiers="GDK_MOD1_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="externalEditorMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Edit with e_xternal editor</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="scriptMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Script</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="scriptMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="scriptAdvanceMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Execute 1 phrase</property>
+ <property name="use_underline">True</property>
+ <accelerator key="Page_Down" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="scriptRetractMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Retract 1 phrase</property>
+ <property name="use_underline">True</property>
+ <accelerator key="Page_Up" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator9">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="scriptBottomMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Execute all</property>
+ <property name="use_underline">True</property>
+ <accelerator key="End" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="scriptTopMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Retract all</property>
+ <property name="use_underline">True</property>
+ <accelerator key="Home" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator10">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="scriptJumpMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Execute until cursor</property>
+ <property name="use_underline">True</property>
+ <accelerator key="period" signal="activate" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK"/>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="viewMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_View</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="viewMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="newCicBrowserMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">New CIC _browser</property>
+ <property name="use_underline">True</property>
+ <accelerator key="F3" signal="activate"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator5">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkCheckMenuItem" id="fullscreenMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Fullscreen</property>
+ <property name="use_underline">True</property>
+ <accelerator key="F11" signal="activate"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkCheckMenuItem" id="menuitemPalette">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Natural deduction palette</property>
+ <property name="use_underline">True</property>
+ <accelerator key="F2" signal="activate"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="increaseFontSizeMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Zoom in</property>
+ <property name="use_underline">True</property>
+ <accelerator key="plus" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="decreaseFontSizeMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Zoom out</property>
+ <property name="use_underline">True</property>
+ <accelerator key="minus" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="normalFontSizeMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Normal size</property>
+ <property name="use_underline">True</property>
+ <accelerator key="equal" signal="activate" modifiers="GDK_CONTROL_MASK"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator12">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkCheckMenuItem" id="ppNotationMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Pretty print notation</property>
+ <property name="use_underline">True</property>
+ <property name="active">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkCheckMenuItem" id="hideCoercionsMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Hide coercions</property>
+ <property name="use_underline">True</property>
+ <property name="active">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator13">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="showCoercionsGraphMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Coercions Graph</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="showHintsDbMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Hints database</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="showTermGrammarMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Terms grammar</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="showUnicodeTable">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">TeX/UTF-8 table</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="debugMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Debug</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="debugMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkSeparatorMenuItem" id="separator6">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="helpMenu">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">_Help</property>
+ <property name="use_underline">True</property>
+ <child type="submenu">
+ <object class="GtkMenu" id="helpMenu_menu">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkMenuItem" id="contentsMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">Contents</property>
+ <property name="use_underline">True</property>
+ <accelerator key="F1" signal="activate"/>
+ </object>
+ </child>
+ <child>
+ <object class="GtkMenuItem" id="aboutMenuItem">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label">About</property>
+ <property name="use_underline">True</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="hbox99">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkPaned" id="hpaneScriptSequent">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <child>
+ <object class="GtkBox" id="hbox18">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkBox" id="TacticsButtonsHandlebox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkBox" id="vboxTacticsPalette">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkExpander" id="expander1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <child>
+ <object class="GtkBox" id="vbox1">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkButton" id="butImpl_intro">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label8">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Implication (⇒<sub>i</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butAnd_intro">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label7">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Conjunction (∧<sub>i</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butOr_intro_left">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label9">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Disjunction left (∨<sub>i-l</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butOr_intro_right">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label10">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Disjunction right (∨<sub>i-r</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butNot_intro">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label11">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Negation (¬<sub>i</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butTop_intro">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label12">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Top (⊤<sub>i</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">5</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butForall_intro">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label20">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Universal (∀<sub>i</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">6</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butExists_intro">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label21">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Existential (∃<sub>i</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">7</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Introduction rules</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkExpander" id="expander2">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <child>
+ <object class="GtkBox" id="vbox3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkButton" id="butImpl_elim">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label22">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Implication (⇒<sub>e</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butAnd_elim_left">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label23">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Conjunction left (∧<sub>e-l</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butAnd_elim_right">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label24">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Conjunction right (∧<sub>e-r</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butOr_elim">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label27">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Disjunction (∨<sub>e</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butNot_elim">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label31">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Negation (¬<sub>e</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butBot_elim">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label33">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Bottom (⊥<sub>e</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">5</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butForall_elim">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label34">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Universal (∀<sub>e</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">6</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butExists_elim">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ <child>
+ <object class="GtkLabel" id="label35">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Existential (∃<sub>e</sub>)</property>
+ <property name="use_markup">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">7</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label5">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Elimination rules</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkExpander" id="expander3">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <child>
+ <object class="GtkBox" id="vbox4">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkButton" id="butRAA">
+ <property name="label" translatable="yes">Reduction to Absurdity (RAA)</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butUseLemma">
+ <property name="label" translatable="yes">Use lemma (lem)</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="butDischarge">
+ <property name="label" translatable="yes">Discharge (discharge)</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ <child type="label">
+ <object class="GtkLabel" id="label6">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Misc rules</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vboxScript">
+ <property name="width_request">400</property>
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkBox" id="hbox28">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkToolbar" id="buttonsToolbar">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="toolbar_style">both</property>
+ <child>
+ <object class="GtkToolItem" id="toolitem41">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkButton" id="scriptTopButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="tooltip_text" translatable="yes">Retract all</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image920">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-goto-top</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolItem" id="toolitem42">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkButton" id="scriptRetractButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="tooltip_text" translatable="yes">Retract 1 phrase</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image921">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-go-up</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolItem" id="toolitem43">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkButton" id="scriptJumpButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="tooltip_text" translatable="yes">Execute until cursor</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image922">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-jump-to</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolItem" id="toolitem44">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkButton" id="scriptAdvanceButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="tooltip_text" translatable="yes">Execute 1 phrase</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image923">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-go-down</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolItem" id="toolitem45">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkButton" id="scriptBottomButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="tooltip_text" translatable="yes">Execute all</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image924">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-goto-bottom</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkToolbar" id="toolbar2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="toolbar_style">both</property>
+ <child>
+ <object class="GtkToolItem" id="toolitem46">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkButton" id="scriptAbortButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">False</property>
+ <property name="relief">none</property>
+ <child>
+ <object class="GtkImage" id="image927">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-stop</property>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkNotebook" id="scriptNotebook">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="scrollable">True</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="resize">False</property>
+ <property name="shrink">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkPaned" id="vpaned1">
+ <property name="width_request">250</property>
+ <property name="height_request">500</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="orientation">vertical</property>
+ <property name="position">380</property>
+ <child>
+ <object class="GtkNotebook" id="sequentsNotebook">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="scrollable">True</property>
+ </object>
+ <packing>
+ <property name="resize">False</property>
+ <property name="shrink">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="hbox9">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkScrolledWindow" id="logScrolledWin">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">never</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkTextView" id="logTextView">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">False</property>
+ <property name="wrap_mode">char</property>
+ <property name="cursor_visible">False</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="resize">True</property>
+ <property name="shrink">True</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="resize">True</property>
+ <property name="shrink">True</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="hbox10">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkStatusbar" id="StatusBar">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkNotebook" id="HintNotebook">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="show_tabs">False</property>
+ <child>
+ <object class="GtkImage" id="HintLowImage">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-missing-image</property>
+ </object>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label14">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label14</property>
+ </object>
+ <packing>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkImage" id="HintMediumImage">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-missing-image</property>
+ </object>
+ <packing>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label15">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label15</property>
+ </object>
+ <packing>
+ <property name="position">1</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkImage" id="HintHighImage">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-missing-image</property>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child type="tab">
+ <object class="GtkLabel" id="label16">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">label16</property>
+ </object>
+ <packing>
+ <property name="position">2</property>
+ <property name="tab_fill">False</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <object class="GtkDialog" id="UriChoiceDialog">
+ <property name="height_request">280</property>
+ <property name="can_focus">False</property>
+ <property name="title" translatable="yes">Uri choice</property>
+ <property name="modal">True</property>
+ <property name="window_position">center</property>
+ <property name="type_hint">dialog</property>
+ <child internal-child="vbox">
+ <object class="GtkBox" id="dialog-vbox3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="spacing">4</property>
+ <child internal-child="action_area">
+ <object class="GtkButtonBox" id="dialog-action_area3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="layout_style">end</property>
+ <child>
+ <object class="GtkButton" id="UriChoiceAbortButton">
+ <property name="label">gtk-cancel</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="UriChoiceSelectedButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <child>
+ <object class="GtkAlignment" id="alignment2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <child>
+ <object class="GtkBox" id="hbox3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkImage" id="image19">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-index</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label3">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">Try _Selected</property>
+ <property name="use_underline">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="UriChoiceConstantsButton">
+ <property name="label" translatable="yes">Try Constants</property>
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_underline">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="copyButton">
+ <property name="label">gtk-copy</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="uriChoiceAutoButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <child>
+ <object class="GtkAlignment" id="alignment5">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <child>
+ <object class="GtkBox" id="hbox16">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkImage" id="image302">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="stock">gtk-ok</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="okLabel">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">bla bla bla</property>
+ <property name="use_underline">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="uriChoiceForwardButton">
+ <property name="label">gtk-go-forward</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="can_default">True</property>
+ <property name="receives_default">False</property>
+ <property name="use_stock">True</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">5</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="pack_type">end</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="vbox2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="spacing">3</property>
+ <child>
+ <object class="GtkLabel" id="UriChoiceLabel">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">some informative message here ...</property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkScrolledWindow" id="scrolledwindow1">
+ <property name="width_request">400</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="vexpand">True</property>
+ <child>
+ <object class="GtkTreeView" id="UriChoiceTreeView">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <child internal-child="selection">
+ <object class="GtkTreeSelection"/>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkBox" id="uriEntryHBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="vexpand">True</property>
+ <child>
+ <object class="GtkLabel" id="label2">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="label" translatable="yes">URI: </property>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkEntry" id="entry1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">2</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ <action-widgets>
+ <action-widget response="-6">UriChoiceAbortButton</action-widget>
+ </action-widgets>
+ </object>
+</interface>
(* Copyright (C) 2005, HELM Team.
- *
+ *
* This file is part of HELM, an Hypertextual, Electronic
* Library of Mathematics, developed at the Computer Science
* Department, University of Bologna, Italy.
- *
+ *
* HELM is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
- *
+ *
* HELM is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* along with HELM; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston,
* MA 02111-1307, USA.
- *
+ *
* For details, see the HELM World-Wide-Web page,
* http://helm.cs.unibo.it/
- *)
+*)
(* $Id$ *)
module G = GrafiteAst
-open GrafiteTypes
open Printf
class status baseuri =
- object
- inherit GrafiteTypes.status baseuri
- inherit ApplyTransformation.status
- end
+ object
+ inherit GrafiteTypes.status baseuri
+ inherit ApplyTransformation.status
+ end
exception TryingToAdd of string Lazy.t
exception EnrichedWithStatus of exn * status
let slash_n_RE = Pcre.regexp "\\n" ;;
-let pp_ast_statement status stm =
- let stm = GrafiteAstPp.pp_statement status stm
- ~map_unicode_to_tex:(Helm_registry.get_bool "matita.paste_unicode_as_tex")
+let first_line = ref true ;;
+
+let cases_or_induction_context stack =
+ match stack with
+ [] -> false
+ | (_g,_t,_k,_tag,p)::_tl -> try
+ let s = List.assoc "context" p in
+ s = "cases" || s = "induction"
+ with
+ Not_found -> false
+;;
+
+let has_focused_goal stack =
+ match stack with
+ [] -> false
+ | (g,_t,_k,_tag,_p)::_tl -> (List.length g) > 0
+;;
+
+let get_indentation status _statement =
+ let base_ind =
+ match status#stack with
+ [] -> 0
+ | s -> List.length(s) * 2
in
- let stm = Pcre.replace ~rex:slash_n_RE stm in
- let stm =
+ if cases_or_induction_context status#stack then
+ (
+ if has_focused_goal status#stack then
+ base_ind + 2
+ else
+ base_ind
+ )
+ else
+ base_ind
+;;
+
+let pp_ind s n =
+ let rec aux s n =
+ match n with
+ 0 -> s
+ | n -> " " ^ (aux s (n-1))
+ in
+ aux s n
+
+let write_ast_to_file status fname statement =
+ let indentation = get_indentation status statement in
+ let str = match statement with
+ G.Comment _ -> GrafiteAstPp.pp_statement status statement
+ ~map_unicode_to_tex:(Helm_registry.get_bool "matita.paste_unicode_as_tex")
+ | G.Executable (_,code) ->
+ (
+ match code with
+ G.NTactic _ -> GrafiteAstPp.pp_statement status statement
+ ~map_unicode_to_tex:(Helm_registry.get_bool "matita.paste_unicode_as_tex")
+ | G.NCommand (_,cmd) ->
+ (
+ match cmd with
+ | G.NObj (_,obj,_) ->
+ (
+ match obj with
+ NotationPt.Theorem _ -> "\n" ^ GrafiteAstPp.pp_statement status statement
+ ~map_unicode_to_tex:(Helm_registry.get_bool "matita.paste_unicode_as_tex")
+ | _ -> ""
+ )
+ | G.NQed _ -> GrafiteAstPp.pp_statement status statement
+ ~map_unicode_to_tex:(Helm_registry.get_bool "matita.paste_unicode_as_tex")
+ | _ -> ""
+ )
+ | _ -> ""
+ )
+ in
+ if str <> "" then
+ (
+ let s = pp_ind str indentation in
+ let flaglist = if !first_line = false then [Open_wronly; Open_append; Open_creat]
+ else (first_line := false; [Open_wronly; Open_trunc; Open_creat])
+ in
+ let out_channel =
+ open_out_gen flaglist 0o0644 fname in
+ let _ = output_string out_channel ((if str.[0] <> '\n' then s else str) ^ "\n") in
+ let _ = close_out out_channel in
+ str
+ )
+ else
+ str
+;;
+
+let pp_ast_statement status stm ~fname =
+ let stm = write_ast_to_file status (fname ^ ".parsed.ma") stm in
+ if stm <> "" then
+ (
+ let stm = Pcre.replace ~rex:slash_n_RE stm in
+ let stm =
if String.length stm > 50 then String.sub stm 0 50 ^ " ..."
else stm
- in
+ in
HLog.debug ("Executing: ``" ^ stm ^ "''")
+ )
+ else
+ HLog.debug ("Executing: `` Unprintable statement ''")
;;
let clean_exit baseuri exn =
raise (FailureCompiling (baseuri,exn))
;;
-let cut prefix s =
+let cut prefix s =
let lenp = String.length prefix in
let lens = String.length s in
assert (lens > lenp);
String.sub s lenp (lens-lenp)
;;
-let print_string =
- let indent = ref 0 in
- let print_string ~right_justify s =
- let ss =
- match right_justify with
- None -> ""
- | Some (ss,len_ss) ->
- let i = 80 - !indent - len_ss - String.length s in
- if i > 0 then String.make i ' ' ^ ss else ss
- in
- assert (!indent >=0);
- print_string (String.make !indent ' ' ^ s ^ ss) in
- fun enter ?right_justify s ->
- if enter then (print_string ~right_justify s; incr indent) else (decr indent; print_string ~right_justify s)
+let print_string =
+ let indent = ref 0 in
+ let print_string ~right_justify s =
+ let ss =
+ match right_justify with
+ None -> ""
+ | Some (ss,len_ss) ->
+ let i = 80 - !indent - len_ss - String.length s in
+ if i > 0 then String.make i ' ' ^ ss else ss
+ in
+ assert (!indent >=0);
+ print_string (String.make !indent ' ' ^ s ^ ss) in
+ fun enter ?right_justify s ->
+ if enter then (print_string ~right_justify s; incr indent) else (decr indent; print_string ~right_justify s)
;;
-let pp_times ss fname rc big_bang big_bang_u big_bang_s =
+let pp_times ss fname rc big_bang big_bang_u big_bang_s =
if not (Helm_registry.get_bool "matita.verbose") then
let { Unix.tms_utime = u ; Unix.tms_stime = s} = Unix.times () in
let r = Unix.gettimeofday () -. big_bang in
let u = u -. big_bang_u in
let s = s -. big_bang_s in
let extra = try Sys.getenv "BENCH_EXTRA_TEXT" with Not_found -> "" in
- let rc =
+ let rc =
if rc then "\e[0;32mOK\e[0m" else "\e[0;31mFAIL\e[0m" in
- let times =
- let fmt t =
+ let times =
+ let fmt t =
let seconds = int_of_float t in
let cents = int_of_float ((t -. floor t) *. 100.0) in
let minutes = seconds / 60 in
;;
let eval_ast ~include_paths ?do_heavy_checks status (text,prefix_len,ast) =
- let baseuri = status#baseuri in
- let new_aliases,new_status =
- GrafiteDisambiguate.eval_with_new_aliases status
- (fun status ->
- let time0 = Unix.gettimeofday () in
- let status =
- GrafiteEngine.eval_ast ~include_paths ?do_heavy_checks status
- (text,prefix_len,ast) in
- let time1 = Unix.gettimeofday () in
- HLog.debug ("... grafite_engine done in " ^ string_of_float (time1 -. time0) ^ "s");
- status
- ) in
- let _,intermediate_states =
- List.fold_left
- (fun (status,acc) (k,value) ->
- let v = GrafiteAst.description_of_alias value in
- let b =
- try
- let NReference.Ref (uri,_) = NReference.reference_of_string v in
- NUri.baseuri_of_uri uri = baseuri
- with
- NReference.IllFormedReference _ ->
- false (* v is a description, not a URI *)
- in
- if b then
- status,acc
- else
- let status =
- GrafiteDisambiguate.set_proof_aliases status ~implicit_aliases:false
- GrafiteAst.WithPreferences [k,value]
- in
- status, (status ,Some (k,value))::acc
- ) (status,[]) new_aliases (* WARNING: this must be the old status! *)
- in
+ let baseuri = status#baseuri in
+ let new_aliases,new_status =
+ GrafiteDisambiguate.eval_with_new_aliases status
+ (fun status ->
+ let time0 = Unix.gettimeofday () in
+ let status =
+ GrafiteEngine.eval_ast ~include_paths ?do_heavy_checks status
+ (text,prefix_len,ast) in
+ let time1 = Unix.gettimeofday () in
+ HLog.debug ("... grafite_engine done in " ^ string_of_float (time1 -. time0) ^ "s");
+ status
+ ) in
+ let _,intermediate_states =
+ List.fold_left
+ (fun (status,acc) (k,value) ->
+ let v = GrafiteAst.description_of_alias value in
+ let b =
+ try
+ let NReference.Ref (uri,_) = NReference.reference_of_string v in
+ NUri.baseuri_of_uri uri = baseuri
+ with
+ NReference.IllFormedReference _ ->
+ false (* v is a description, not a URI *)
+ in
+ if b then
+ status,acc
+ else
+ let status =
+ GrafiteDisambiguate.set_proof_aliases status ~implicit_aliases:false
+ GrafiteAst.WithPreferences [k,value]
+ in
+ status, (status ,Some (k,value))::acc
+ ) (status,[]) new_aliases (* WARNING: this must be the old status! *)
+ in
(new_status,None)::intermediate_states
;;
let baseuri_of_script ~include_paths fname =
- try Librarian.baseuri_of_script ~include_paths fname
- with
- Librarian.NoRootFor _ ->
+ try Librarian.baseuri_of_script ~include_paths fname
+ with
+ Librarian.NoRootFor _ ->
HLog.error ("The included file '"^fname^"' has no root file,");
HLog.error "please create it.";
raise (Failure ("No root file for "^fname))
- | Librarian.FileNotFound _ ->
+ | Librarian.FileNotFound _ ->
raise (Failure ("File not found: "^fname))
;;
(* given a path to a ma file inside the include_paths, returns the
new include_paths associated to that file *)
-let read_include_paths ~include_paths file =
+let read_include_paths ~include_paths:_ file =
try
let root, _buri, _fname, _tgt =
Librarian.baseuri_of_script ~include_paths:[] file in
in
let rc = root :: includes in
List.iter (HLog.debug) rc; rc
- with Librarian.NoRootFor _ | Librarian.FileNotFound _ ->
- []
+ with Librarian.NoRootFor _ | Librarian.FileNotFound _ ->
+ []
;;
-let rec get_ast status ~compiling ~asserted ~include_paths strm =
+let rec get_ast status ~compiling ~asserted ~include_paths strm =
match GrafiteParser.parse_statement status strm with
- (GrafiteAst.Executable
+ (GrafiteAst.Executable
(_,GrafiteAst.NCommand (_,GrafiteAst.Include (_,_,mafilename)))) as cmd
- ->
- let already_included = NCicLibrary.get_transitively_included status in
- let asserted,_ =
- assert_ng ~already_included ~compiling ~asserted ~include_paths
- mafilename
- in
- asserted,cmd
- | cmd -> asserted,cmd
+ ->
+ let already_included = NCicLibrary.get_transitively_included status in
+ let asserted,_ =
+ assert_ng ~already_included ~compiling ~asserted ~include_paths
+ mafilename
+ in
+ asserted,cmd
+ | cmd -> asserted,cmd
and eval_from_stream ~compiling ~asserted ~include_paths ?do_heavy_checks status str cb =
- let matita_debug = Helm_registry.get_bool "matita.debug" in
- let rec loop asserted status str =
- let asserted,stop,status,str =
- try
- let cont =
- try Some (get_ast status ~compiling ~asserted ~include_paths str)
- with End_of_file -> None in
- match cont with
- | None -> asserted, true, status, str
- | Some (asserted,ast) ->
- cb status ast;
- let new_statuses =
- eval_ast ~include_paths ?do_heavy_checks status ("",0,ast) in
- let status =
- match new_statuses with
- [s,None] -> s
- | _::(_,Some (_,value))::_ ->
- raise (TryingToAdd (lazy (GrafiteAstPp.pp_alias value)))
- | _ -> assert false in
- (* CSC: complex patch to re-build the lexer since the tokens may
- have changed. Note: this way we loose look-ahead tokens.
- Hence the "include" command must be terminated (no look-ahead) *)
- let str =
- match ast with
- (GrafiteAst.Executable
- (_,GrafiteAst.NCommand
- (_,(GrafiteAst.Include _ | GrafiteAst.Notation _)))) ->
+ let matita_debug = Helm_registry.get_bool "matita.debug" in
+ let rec loop asserted status str =
+ let asserted,stop,status,str =
+ try
+ let cont =
+ try Some (get_ast status ~compiling ~asserted ~include_paths str)
+ with End_of_file -> None in
+ match cont with
+ | None -> asserted, true, status, str
+ | Some (asserted,ast) ->
+ cb status ast;
+ let new_statuses =
+ eval_ast ~include_paths ?do_heavy_checks status ("",0,ast) in
+ let status =
+ match new_statuses with
+ [s,None] -> s
+ | _::(_,Some (_,value))::_ ->
+ raise (TryingToAdd (lazy (GrafiteAstPp.pp_alias value)))
+ | _ -> assert false in
+ (* CSC: complex patch to re-build the lexer since the tokens may
+ have changed. Note: this way we loose look-ahead tokens.
+ Hence the "include" command must be terminated (no look-ahead) *)
+ let str =
+ match ast with
+ (GrafiteAst.Executable
+ (_,GrafiteAst.NCommand
+ (_,(GrafiteAst.Include _ | GrafiteAst.Notation _)))) ->
GrafiteParser.parsable_statement status
- (GrafiteParser.strm_of_parsable str)
- | _ -> str
- in
- asserted, false, status, str
- with exn when not matita_debug ->
- raise (EnrichedWithStatus (exn, status))
+ (GrafiteParser.strm_of_parsable str)
+ | _ -> str
+ in
+ asserted, false, status, str
+ with exn when not matita_debug ->
+ raise (EnrichedWithStatus (exn, status))
+ in
+ if stop then asserted,status else loop asserted status str
in
- if stop then asserted,status else loop asserted status str
- in
loop asserted status str
and compile ~compiling ~asserted ~include_paths fname =
if List.mem fname compiling then raise (CircularDependency fname);
let compiling = fname::compiling in
let matita_debug = Helm_registry.get_bool "matita.debug" in
- let root,baseuri,fname,_tgt =
+ let root,baseuri,fname,_tgt =
Librarian.baseuri_of_script ~include_paths fname in
if Http_getter_storage.is_read_only baseuri then assert false;
(* MATITA 1.0: debbo fare time_travel sulla ng_library? *)
let ocamldirname = Filename.dirname fname in
let ocamlfname = Filename.chop_extension (Filename.basename fname) in
let status,ocamlfname =
- Common.modname_of_filename status false ocamlfname in
+ Common.modname_of_filename status false ocamlfname in
let ocamlfname = ocamldirname ^ "/" ^ ocamlfname ^ ".ml" in
let status = OcamlExtraction.open_file status ~baseuri ocamlfname in
let big_bang = Unix.gettimeofday () in
- let { Unix.tms_utime = big_bang_u ; Unix.tms_stime = big_bang_s} =
- Unix.times ()
+ let { Unix.tms_utime = big_bang_u ; Unix.tms_stime = big_bang_s} =
+ Unix.times ()
in
let time = Unix.time () in
- let cc =
- let rex = Str.regexp ".*opt$" in
- if Str.string_match rex Sys.argv.(0) 0 then "matitac.opt"
- else "matitac" in
+ let cc =
+ let rex = Str.regexp ".*opt$" in
+ if Str.string_match rex Sys.argv.(0) 0 then "matitac.opt"
+ else "matitac" in
let s = Printf.sprintf "%s %s" cc (cut (root^"/") fname) in
try
(* cleanup of previously compiled objects *)
if (not (Http_getter_storage.is_empty ~local:true baseuri))
- then begin
+ then begin
HLog.message ("baseuri " ^ baseuri ^ " is not empty");
HLog.message ("cleaning baseuri " ^ baseuri);
LibraryClean.clean_baseuris [baseuri];
end;
HLog.message ("compiling " ^ Filename.basename fname ^ " in " ^ baseuri);
if not (Helm_registry.get_bool "matita.verbose") then
- (print_string true (s ^ "\n"); flush stdout);
+ (print_string true (s ^ "\n"); flush stdout);
(* we dalay this error check until we print 'matitac file ' *)
assert (Http_getter_storage.is_empty ~local:true baseuri);
(* create dir for XML files *)
if not (Helm_registry.get_opt_default Helm_registry.bool "matita.nodisk"
- ~default:false)
+ ~default:false)
then
- HExtlib.mkdir
- (Filename.dirname
- (Http_getter.filename ~local:true ~writable:true (baseuri ^
- "foo.con")));
+ HExtlib.mkdir
+ (Filename.dirname
+ (Http_getter.filename ~local:true ~writable:true (baseuri ^
+ "foo.con")));
let buf =
- GrafiteParser.parsable_statement status
- (Ulexing.from_utf8_channel (open_in fname))
+ GrafiteParser.parsable_statement status
+ (Ulexing.from_utf8_channel (open_in fname))
in
let print_cb =
- if not (Helm_registry.get_bool "matita.verbose") then (fun _ _ -> ())
- else pp_ast_statement
+ if not (Helm_registry.get_bool "matita.verbose") then fun _ _ -> ()
+ else pp_ast_statement ~fname
in
let asserted, status =
- eval_from_stream ~compiling ~asserted ~include_paths status buf print_cb in
+ eval_from_stream ~compiling ~asserted ~include_paths status buf print_cb in
let status = OcamlExtraction.close_file status in
let elapsed = Unix.time () -. time in
- (if Helm_registry.get_bool "matita.moo" then begin
- GrafiteTypes.Serializer.serialize ~baseuri:(NUri.uri_of_string baseuri)
- status
- end;
+ (if Helm_registry.get_bool "matita.moo" then begin
+ GrafiteTypes.Serializer.serialize ~baseuri:(NUri.uri_of_string baseuri)
+ status
+ end;
let tm = Unix.gmtime elapsed in
let sec = string_of_int tm.Unix.tm_sec ^ "''" in
- let min =
- if tm.Unix.tm_min > 0 then (string_of_int tm.Unix.tm_min^"' ") else ""
+ let min =
+ if tm.Unix.tm_min > 0 then (string_of_int tm.Unix.tm_min^"' ") else ""
in
- let hou =
+ let hou =
if tm.Unix.tm_hour > 0 then (string_of_int tm.Unix.tm_hour^"h ") else ""
in
- HLog.message
+ HLog.message
(sprintf "execution of %s completed in %s." fname (hou^min^sec));
pp_times s fname true big_bang big_bang_u big_bang_s;
(*CSC: bad, one imperative bit is still there!
to be moved into functional status *)
NCicMetaSubst.pushmaxmeta ();
-(* MATITA 1.0: debbo fare time_travel sulla ng_library?
- LexiconSync.time_travel
- ~present:lexicon_status ~past:initial_lexicon_status;
-*)
+ (* MATITA 1.0: debbo fare time_travel sulla ng_library?
+ LexiconSync.time_travel
+ ~present:lexicon_status ~past:initial_lexicon_status;
+ *)
asserted)
- with
+ with
(* all exceptions should be wrapped to allow lexicon-undo (LS.time_travel) *)
| exn when not matita_debug ->
-(* MATITA 1.0: debbo fare time_travel sulla ng_library?
- LexiconSync.time_travel ~present:lexicon ~past:initial_lexicon_status;
- * *)
- (*CSC: bad, one imperative bit is still there!
- to be moved into functional status *)
- NCicMetaSubst.pushmaxmeta ();
- pp_times s fname false big_bang big_bang_u big_bang_s;
- clean_exit baseuri exn
+ (* MATITA 1.0: debbo fare time_travel sulla ng_library?
+ LexiconSync.time_travel ~present:lexicon ~past:initial_lexicon_status;
+ * *)
+ (*CSC: bad, one imperative bit is still there!
+ to be moved into functional status *)
+ NCicMetaSubst.pushmaxmeta ();
+ pp_times s fname false big_bang big_bang_u big_bang_s;
+ clean_exit baseuri exn
and assert_ng ~already_included ~compiling ~asserted ~include_paths mapath =
- let root,baseuri,fullmapath,_ =
- Librarian.baseuri_of_script ~include_paths mapath in
- if List.mem fullmapath asserted then asserted,false
- else
- begin
- let include_paths =
- let includes =
- try
- Str.split (Str.regexp " ")
- (List.assoc "include_paths" (Librarian.load_root_file (root^"/root")))
- with Not_found -> []
- in
- root::includes @
- Helm_registry.get_list Helm_registry.string "matita.includes" in
- let baseuri = NUri.uri_of_string baseuri in
- let ngtime_of baseuri =
- let ngpath = NCicLibrary.ng_path_of_baseuri baseuri in
- try
- Some (Unix.stat ngpath).Unix.st_mtime
- with Unix.Unix_error (Unix.ENOENT, "stat", f) when f = ngpath -> None in
- let matime =
- try (Unix.stat fullmapath).Unix.st_mtime
- with Unix.Unix_error (Unix.ENOENT, "stat", f) when f = fullmapath -> assert false
- in
- let ngtime = ngtime_of baseuri in
- let asserted,to_be_compiled =
- match ngtime with
- Some ngtime ->
- let preamble = GrafiteTypes.Serializer.dependencies_of baseuri in
- let asserted,children_bad =
- List.fold_left
- (fun (asserted,b) mapath ->
- let asserted,b1 =
- try
- assert_ng ~already_included ~compiling ~asserted ~include_paths
- mapath
- with Librarian.NoRootFor _ | Librarian.FileNotFound _ ->
- asserted, true
- in
- asserted, b || b1
- || let _,baseuri,_,_ =
- (*CSC: bug here? include_paths should be empty and
- mapath should be absolute *)
- Librarian.baseuri_of_script ~include_paths mapath in
- let baseuri = NUri.uri_of_string baseuri in
- (match ngtime_of baseuri with
- Some child_ngtime -> child_ngtime > ngtime
- | None -> assert false)
- ) (asserted,false) preamble
+ let root,baseuri,fullmapath,_ =
+ Librarian.baseuri_of_script ~include_paths mapath in
+ if List.mem fullmapath asserted then asserted,false
+ else
+ begin
+ let include_paths =
+ let includes =
+ try
+ Str.split (Str.regexp " ")
+ (List.assoc "include_paths" (Librarian.load_root_file (root^"/root")))
+ with Not_found -> []
in
- asserted, children_bad || matime > ngtime
- | None -> asserted,true
- in
- if not to_be_compiled then fullmapath::asserted,false
- else
- if List.mem baseuri already_included then
- (* maybe recompiling it I would get the same... *)
- raise (AlreadyLoaded (lazy mapath))
- else
- let asserted = compile ~compiling ~asserted ~include_paths fullmapath in
- fullmapath::asserted,true
- end
+ root::includes @
+ Helm_registry.get_list Helm_registry.string "matita.includes" in
+ let baseuri = NUri.uri_of_string baseuri in
+ let ngtime_of baseuri =
+ let ngpath = NCicLibrary.ng_path_of_baseuri baseuri in
+ try
+ Some (Unix.stat ngpath).Unix.st_mtime
+ with Unix.Unix_error (Unix.ENOENT, "stat", f) when f = ngpath -> None in
+ let matime =
+ try (Unix.stat fullmapath).Unix.st_mtime
+ with Unix.Unix_error (Unix.ENOENT, "stat", f) when f = fullmapath -> assert false
+ in
+ let ngtime = ngtime_of baseuri in
+ let asserted,to_be_compiled =
+ match ngtime with
+ Some ngtime ->
+ let preamble = GrafiteTypes.Serializer.dependencies_of baseuri in
+ let asserted,children_bad =
+ List.fold_left
+ (fun (asserted,b) mapath ->
+ let asserted,b1 =
+ try
+ assert_ng ~already_included ~compiling ~asserted ~include_paths
+ mapath
+ with Librarian.NoRootFor _ | Librarian.FileNotFound _ ->
+ asserted, true
+ in
+ asserted, b || b1
+ || let _,baseuri,_,_ =
+ (*CSC: bug here? include_paths should be empty and
+ mapath should be absolute *)
+ Librarian.baseuri_of_script ~include_paths mapath in
+ let baseuri = NUri.uri_of_string baseuri in
+ (match ngtime_of baseuri with
+ Some child_ngtime -> child_ngtime > ngtime
+ | None -> assert false)
+ ) (asserted,false) preamble
+ in
+ asserted, children_bad || matime > ngtime
+ | None -> asserted,true
+ in
+ if not to_be_compiled then fullmapath::asserted,false
+ else
+ if List.mem baseuri already_included then
+ (* maybe recompiling it I would get the same... *)
+ raise (AlreadyLoaded (lazy mapath))
+ else
+ let asserted = compile ~compiling ~asserted ~include_paths fullmapath in
+ fullmapath::asserted,true
+ end
;;
let assert_ng ~include_paths mapath =
- snd (assert_ng ~include_paths ~already_included:[] ~compiling:[] ~asserted:[]
- mapath)
+ snd (assert_ng ~include_paths ~already_included:[] ~compiling:[] ~asserted:[]
+ mapath)
let get_ast status ~include_paths strm =
- snd (get_ast status ~compiling:[] ~asserted:[] ~include_paths strm)
+ snd (get_ast status ~compiling:[] ~asserted:[] ~include_paths strm)
| GrafiteTypes.Command_error msg -> None, "Error: " ^ msg
| CicNotationParser.Parse_error err ->
None, sprintf "Parse error: %s" err
- | Unix.Unix_error (code, api, param) ->
+ | Unix.Unix_error (code, api, _param) ->
let err = Unix.error_message code in
None, "Unix Error (" ^ api ^ "): " ^ err
| HMarshal.Corrupt_file fname -> None, sprintf "file '%s' is corrupt" fname
(* $Id$ *)
-exception PopupClosed
open Printf
let wrap_callback0 f = fun _ -> try f () with Not_found -> assert false
(fun renderer -> GTree.view_column ~renderer ())
renderers
in
- object (self)
+ object
val text_columns = text_columns
initializer
let lookup_pixbuf tag =
try List.assoc tag tags with Not_found -> assert false
in
- object (self)
+ object
initializer
tree_view#set_model (Some (list_store :> GTree.model));
ignore (tree_view#append_column tag_vcolumn);
])
in
let toggle_vcol = GTree.view_column ~renderer:toggle_rend () in
- object (self)
+ object
initializer
tree_view#set_model (Some (list_store :> GTree.model));
ignore (tree_view#append_column text_vcol);
class type gui =
object
method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
- method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
- method newEmptyDialog: unit -> MatitaGeneratedGui.emptyDialog
end
let popup_message
- ~title ~message ~buttons ~callback
+ ~title ~message ~buttons
?(message_type=`QUESTION) ?parent ?(use_markup=true)
- ?(destroy_with_parent=true) ?(allow_grow=false) ?(allow_shrink=false)
- ?icon ?(modal=true) ?(resizable=false) ?screen ?type_hint
- ?(position=`CENTER_ON_PARENT) ?wm_name ?wm_class ?border_width ?width
+ ?(destroy_with_parent=true) ?icon ?(modal=true) ?(resizable=false)
+ ?screen ?type_hint
+ ?(position=`CENTER_ON_PARENT) ?wmclass ?border_width ?width
?height ?(show=true) ()
=
let m =
GWindow.message_dialog
~message ~use_markup ~message_type ~buttons ?parent ~destroy_with_parent
- ~title ~allow_grow ~allow_shrink ?icon ~modal ~resizable ?screen
- ?type_hint ~position ?wm_name ?wm_class ?border_width ?width ?height
+ ~title ?icon ~modal ~resizable ?screen
+ ?type_hint ~position ?wmclass ?border_width ?width ?height
~show ()
in
- ignore(m#connect#response
- ~callback:(fun a -> GMain.Main.quit ();callback a));
- ignore(m#connect#close
- ~callback:(fun _ -> GMain.Main.quit ();raise PopupClosed));
- GtkThread.main ();
+ ignore(m#run ()) ;
m#destroy ()
let popup_message_lowlevel
- ~title ~message ?(no_separator=true) ~callback ~message_type ~buttons
- ?parent ?(destroy_with_parent=true) ?(allow_grow=false) ?(allow_shrink=false)
- ?icon ?(modal=true) ?(resizable=false) ?screen ?type_hint
- ?(position=`CENTER_ON_PARENT) ?wm_name ?wm_class ?border_width ?width
- ?height ?(show=true) ()
+ ~title ~message ?no_separator:(_=true) ~message_type ~buttons
+ ?parent ?(destroy_with_parent=true)
+ ?icon ?modal:(_=true) ?(resizable=false) ?screen ?type_hint
+ ?(position=`CENTER_ON_PARENT) ?wmclass ?border_width ?width
+ ?height ()
=
let m =
GWindow.dialog
- ~no_separator
- ?parent ~destroy_with_parent
- ~title ~allow_grow ~allow_shrink ?icon ~modal ~resizable ?screen
- ?type_hint ~position ?wm_name ?wm_class ?border_width ?width ?height
- ~show:false ()
+ ?parent ~destroy_with_parent
+ ~title ?icon ~resizable ?screen
+ ?type_hint ~position ?wmclass ?border_width ?width ?height ()
in
let stock =
match message_type with
m#vbox#pack ~from:`START
~padding:20 ~expand:true ~fill:true (hbox:>GObj.widget);
List.iter (fun (x, y) ->
- m#add_button_stock x y;
- if y = `CANCEL then
- m#set_default_response y
+ m#add_button_stock x y
) buttons;
- ignore(m#connect#response
- ~callback:(fun a -> GMain.Main.quit ();callback a));
- ignore(m#connect#close
- ~callback:(fun _ -> GMain.Main.quit ();callback `POPUPCLOSED));
- if show = true then
- m#show ();
- GtkThread.main ();
- m#destroy ()
+ let res = m#run () in
+ m#destroy () ;
+ res
let ask_confirmation ~title ~message ?parent () =
- let rc = ref `YES in
- let callback =
- function
- | `YES -> rc := `YES
- | `NO -> rc := `NO
- | `CANCEL -> rc := `CANCEL
- | `DELETE_EVENT -> rc := `CANCEL
- | `POPUPCLOSED -> rc := `CANCEL
- in
- let buttons = [`YES,`YES ; `NO,`NO ; `CANCEL,`CANCEL] in
- popup_message_lowlevel
- ~title ~message ~message_type:`WARNING ~callback ~buttons ?parent ();
- !rc
+ GtkThread.sync (fun _ ->
+ let buttons = [`YES,`YES ; `NO,`NO ; `CANCEL,`DELETE_EVENT] in
+ popup_message_lowlevel
+ ~title ~message ~message_type:`WARNING ~buttons ?parent ()
+ ) ()
let report_error ~title ~message ?parent () =
- let callback _ = () in
- let buttons = GWindow.Buttons.ok in
- try
- popup_message
- ~title ~message ~message_type:`ERROR ~callback ~buttons ?parent ()
- with
- | PopupClosed -> ()
-
-
-let ask_text ~(gui:#gui) ?(title = "") ?(message = "") ?(multiline = false)
- ?default ()
-=
- let dialog = gui#newEmptyDialog () in
- dialog#emptyDialog#set_title title;
- dialog#emptyDialogLabel#set_label message;
- let result = ref None in
- let return r =
- result := r;
- dialog#emptyDialog#destroy ();
- GMain.Main.quit ()
- in
- ignore (dialog#emptyDialog#event#connect#delete (fun _ -> true));
- if multiline then begin (* multiline input required: use a TextView widget *)
- let win =
- GBin.scrolled_window ~width:400 ~height:150 ~hpolicy:`NEVER
- ~vpolicy:`ALWAYS ~packing:dialog#emptyDialogVBox#add ()
- in
- let view = GText.view ~wrap_mode:`CHAR ~packing:win#add () in
- let buffer = view#buffer in
- (match default with
- | None -> ()
- | Some text ->
- buffer#set_text text;
- buffer#select_range buffer#start_iter buffer#end_iter);
- view#misc#grab_focus ();
- connect_button dialog#emptyDialogOkButton (fun _ ->
- return (Some (buffer#get_text ())))
- end else begin (* monoline input required: use a TextEntry widget *)
- let entry = GEdit.entry ~packing:dialog#emptyDialogVBox#add () in
- (match default with
- | None -> ()
- | Some text ->
- entry#set_text text;
- entry#select_region ~start:0 ~stop:max_int);
- entry#misc#grab_focus ();
- connect_button dialog#emptyDialogOkButton (fun _ ->
- return (Some entry#text))
- end;
- connect_button dialog#emptyDialogCancelButton (fun _ ->return None);
- dialog#emptyDialog#show ();
- GtkThread.main ();
- (match !result with None -> raise MatitaTypes.Cancel | Some r -> r)
+ let buttons = GWindow.Buttons.ok in
+ popup_message ~title ~message ~message_type:`ERROR ~buttons ?parent ()
let utf8_parsed_text s floc =
let start, stop = HExtlib.loc_of_floc floc in
let matita_lang =
let source_language_manager =
- GSourceView2.source_language_manager ~default:true in
+ GSourceView3.source_language_manager ~default:true in
source_language_manager#set_search_path
(BuildTimeConf.runtime_base_dir ::
source_language_manager#search_path);
class type gui =
object (* minimal gui object requirements *)
method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
- method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
- method newEmptyDialog: unit -> MatitaGeneratedGui.emptyDialog
end
(** {3 Dialogs}
val ask_confirmation:
title:string -> message:string ->
?parent:#GWindow.window_skel ->
- unit ->
- [`YES | `NO | `CANCEL]
-
- (** @param multiline (default: false) if true a TextView widget will be used
- * for prompting the user otherwise a TextEntry widget will be
- * @return the string given by the user *)
-val ask_text:
- gui:#gui ->
- ?title:string -> ?message:string ->
- ?multiline:bool -> ?default:string -> unit ->
- string
+ unit -> [`YES | `NO | `DELETE_EVENT ]
val report_error:
title:string -> message:string ->
val escape_pango_markup: string -> string
-val matita_lang: GSourceView2.source_language
+val matita_lang: GSourceView3.source_language
open MatitaGtkMisc
open MatitaMisc
-exception Found of int
-
let all_disambiguation_passes = ref false
(* this is a shit and should be changed :-{ *)
?(msg = "") ?(nonvars_button = false) ?(hide_uri_entry=false)
?(hide_try=false) ?(ok_label="_Auto") ?(ok_action:[`SELECT|`AUTO] = `AUTO)
?copy_cb ()
- ~id uris
+ ~id:_ uris
=
if (selection_mode <> `SINGLE) &&
(Helm_registry.get_opt_default Helm_registry.get_bool ~default:true "matita.auto_disambiguation")
| uris -> return (Some (List.map NReference.reference_of_string uris)));
connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
dialog#uriChoiceDialog#show ();
+ (* CSC: old Gtk2 code. Use #run instead. Look for similar code handling
+ other dialogs *)
GtkThread.main ();
(match !choices with
| None -> raise MatitaTypes.Cancel
(let loc_row = tree_store#append () in
begin
match lll with
- [passes,envs_and_diffs,_,_] ->
+ [passes,_envs_and_diffs,_,_] ->
tree_store#set ~row:loc_row ~column:id_col
("Error location " ^ string_of_int (!idx1+1) ^
", error message " ^ string_of_int (!idx1+1) ^ ".1" ^
exception UseLibrary;;
let interactive_error_interp ~all_passes
- (source_buffer:GSourceView2.source_buffer) notify_exn offset errorll filename
+ (source_buffer:GSourceView3.source_buffer) notify_exn offset errorll filename
=
(* hook to save a script for each disambiguation error *)
if false then
(MultiPassDisambiguator.DisambiguationError
(offset,[[env,diff,lazy (loffset,Lazy.force msg),significant]]));
| _::_ ->
+ GtkThread.sync (fun _ ->
let dialog = new disambiguationErrors () in
- if all_passes then
- dialog#disambiguationErrorsMoreErrors#misc#set_sensitive false;
+ dialog#toplevel#add_button "Fix this interpretation" `OK;
+ dialog#toplevel#add_button "Close" `DELETE_EVENT;
+ if not all_passes then
+ dialog#toplevel#add_button "More errors" `HELP; (* HELP means MORE *)
let model = new interpErrorModel dialog#treeview choices in
dialog#disambiguationErrors#set_title "Disambiguation error";
dialog#disambiguationErrorsLabel#set_label
(MultiPassDisambiguator.DisambiguationError
(offset,[[env,diff,lazy(loffset,Lazy.force msg),significant]]))
));
- let return _ =
- dialog#disambiguationErrors#destroy ();
- GMain.Main.quit ()
+ (match GtkThread.sync dialog#toplevel#run () with
+ | `OK ->
+ let tree_path =
+ match fst (dialog#treeview#get_cursor ()) with
+ None -> assert false
+ | Some tp -> tp in
+ let idx1,idx2,idx3 = model#get_interp_no tree_path in
+ let diff =
+ match idx2,idx3 with
+ Some idx2, Some idx3 ->
+ let _,lll = List.nth choices idx1 in
+ let _,envs_and_diffs,_,_ = List.nth lll idx2 in
+ let _,_,diff = List.nth envs_and_diffs idx3 in
+ diff
+ | _,_ -> assert false
in
- let fail _ = return () in
- ignore(dialog#disambiguationErrors#event#connect#delete (fun _ -> true));
- connect_button dialog#disambiguationErrorsOkButton
- (fun _ ->
- let tree_path =
- match fst (dialog#treeview#get_cursor ()) with
- None -> assert false
- | Some tp -> tp in
- let idx1,idx2,idx3 = model#get_interp_no tree_path in
- let diff =
- match idx2,idx3 with
- Some idx2, Some idx3 ->
- let _,lll = List.nth choices idx1 in
- let _,envs_and_diffs,_,_ = List.nth lll idx2 in
- let _,_,diff = List.nth envs_and_diffs idx3 in
- diff
- | _,_ -> assert false
- in
- let newtxt =
- String.concat "\n"
- ("" ::
- List.map
- (fun k,desc ->
- let alias =
- match k with
- | DisambiguateTypes.Id id ->
- GrafiteAst.Ident_alias (id, desc)
- | DisambiguateTypes.Symbol (symb, i)->
- GrafiteAst.Symbol_alias (symb, i, desc)
- | DisambiguateTypes.Num i ->
- GrafiteAst.Number_alias (i, desc)
- in
- GrafiteAstPp.pp_alias alias)
- diff) ^ "\n"
- in
- source_buffer#insert
- ~iter:
- (source_buffer#get_iter_at_mark
- (`NAME "beginning_of_statement")) newtxt ;
- return ()
- );
- connect_button dialog#disambiguationErrorsMoreErrors
- (fun _ -> return () ; raise UseLibrary);
- connect_button dialog#disambiguationErrorsCancelButton fail;
- dialog#disambiguationErrors#show ();
- GtkThread.main ()
-
+ let newtxt =
+ String.concat "\n"
+ ("" ::
+ List.map
+ (fun k,desc ->
+ let alias =
+ match k with
+ | DisambiguateTypes.Id id ->
+ GrafiteAst.Ident_alias (id, desc)
+ | DisambiguateTypes.Symbol (symb, i)->
+ GrafiteAst.Symbol_alias (symb, i, desc)
+ | DisambiguateTypes.Num i ->
+ GrafiteAst.Number_alias (i, desc)
+ in
+ GrafiteAstPp.pp_alias alias)
+ diff) ^ "\n"
+ in
+ source_buffer#insert
+ ~iter:
+ (source_buffer#get_iter_at_mark
+ (`NAME "beginning_of_statement")) newtxt
+ | `HELP (* HELP MEANS MORE *) ->
+ dialog#toplevel#destroy () ;
+ raise UseLibrary
+ | `DELETE_EVENT -> ()
+ | _ -> assert false) ;
+ dialog#toplevel#destroy ()
+ ) ()
class gui () =
(* creation order _is_ relevant for windows placement *)
let main = new mainWin () in
let sequents_viewer =
MatitaMathView.sequentsViewer_instance main#sequentsNotebook in
- let fileSel = new fileSelectionWin () in
let findRepl = new findReplWin () in
let keyBindingBoxes = (* event boxes which should receive global key events *)
[ main#mainWinEventBox ]
~website:"http://matita.cs.unibo.it"
()
in
+ ignore(about_dialog#event#connect#delete (fun _ -> true));
ignore(about_dialog#connect#response (fun _ ->about_dialog#misc#hide ()));
connect_menu_item main#contentsMenuItem (fun () ->
if 0 = Sys.command "which gnome-help" then
~callback:(fun _ -> hide_find_Repl ();true));
connect_menu_item main#undoMenuItem
(fun () -> (MatitaScript.current ())#safe_undo);
-(*CSC: XXX
- ignore(source_view#source_buffer#connect#can_undo
- ~callback:main#undoMenuItem#misc#set_sensitive);
-*) main#undoMenuItem#misc#set_sensitive true;
+ main#undoMenuItem#misc#set_sensitive false;
connect_menu_item main#redoMenuItem
(fun () -> (MatitaScript.current ())#safe_redo);
-(*CSC: XXX
- ignore(source_view#source_buffer#connect#can_redo
- ~callback:main#redoMenuItem#misc#set_sensitive);
-*) main#redoMenuItem#misc#set_sensitive true;
+ main#redoMenuItem#misc#set_sensitive false;
connect_menu_item main#editMenu (fun () ->
main#copyMenuItem#misc#set_sensitive
(MatitaScript.current ())#canCopy;
GtkThread.sync (fun () -> ()) ()
in
let worker_thread = ref None in
- let notify_exn (source_view : GSourceView2.source_view) exn =
+ let notify_exn (source_view : GSourceView3.source_view) exn =
let floc, msg = MatitaExcPp.to_string exn in
begin
match floc with
with
exc -> script#source_view#misc#grab_focus (); raise exc in
- (* file selection win *)
- ignore (fileSel#fileSelectionWin#event#connect#delete (fun _ -> true));
- ignore (fileSel#fileSelectionWin#connect#response (fun event ->
- let return r =
- chosen_file <- r;
- fileSel#fileSelectionWin#misc#hide ();
- GMain.Main.quit ()
- in
- match event with
- | `OK ->
- let fname = fileSel#fileSelectionWin#filename in
- if Sys.file_exists fname then
- begin
- if HExtlib.is_regular fname && not (_only_directory) then
- return (Some fname)
- else if _only_directory && HExtlib.is_dir fname then
- return (Some fname)
- end
- else
- begin
- if _ok_not_exists then
- return (Some fname)
- end
- | `CANCEL -> return None
- | `HELP -> ()
- | `DELETE_EVENT -> return None));
(* menus *)
List.iter (fun w -> w#misc#set_sensitive false) [ main#saveMenuItem ];
(* console *)
current_page <- page;
let script = MatitaScript.at_page page in
script#activate;
+ main#undoMenuItem#misc#set_sensitive
+ script#source_view#source_buffer#can_undo ;
+ main#redoMenuItem#misc#set_sensitive
+ script#source_view#source_buffer#can_redo ;
main#saveMenuItem#misc#set_sensitive script#has_name))
method private externalEditor () =
save_moo script#status;
true
| `NO -> true
- | `CANCEL -> false
+ | `DELETE_EVENT -> false
else
(save_moo script#status; true)
console#message ("'"^file^"' loaded.");
self#_enableSaveTo file
- method private _enableSaveTo file =
+ method private _enableSaveTo _file =
self#main#saveMenuItem#misc#set_sensitive true
method private console = console
- method private fileSel = fileSel
method private findRepl = findRepl
method main = main
(fun _ -> callback ();true));
self#addKeyBinding GdkKeysyms._q callback
+ method private chooseFileOrDir ok_not_exists only_directory =
+ let fileSel = GWindow.file_chooser_dialog
+ ~action:`OPEN
+ ~title:"Select file"
+ ~modal:true
+ ~type_hint:`DIALOG
+ ~position:`CENTER
+ () in
+ fileSel#add_select_button_stock `OPEN `OK;
+ fileSel#add_button_stock `CANCEL `CANCEL;
+ ignore (fileSel#set_current_folder(Sys.getcwd ())) ;
+ let res =
+ let rec aux () =
+ match fileSel#run () with
+ | `OK ->
+ (match fileSel#filename with
+ None -> aux ()
+ | Some fname ->
+ if Sys.file_exists fname then
+ begin
+ if HExtlib.is_regular fname && not (only_directory) then
+ Some fname
+ else if only_directory && HExtlib.is_dir fname then
+ Some fname
+ else
+ aux ()
+ end
+ else if ok_not_exists then Some fname else aux ())
+ | `CANCEL -> None
+ | `DELETE_EVENT -> None in
+ aux () in
+ fileSel#destroy () ;
+ res
+
method private chooseFile ?(ok_not_exists = false) () =
- _ok_not_exists <- ok_not_exists;
- _only_directory <- false;
- fileSel#fileSelectionWin#show ();
- GtkThread.main ();
- chosen_file
+ self#chooseFileOrDir ok_not_exists false
method private chooseDir ?(ok_not_exists = false) () =
- _ok_not_exists <- ok_not_exists;
- _only_directory <- true;
- fileSel#fileSelectionWin#show ();
- GtkThread.main ();
(* we should check that this is a directory *)
- chosen_file
+ self#chooseFileOrDir ok_not_exists true
end
let interactive_string_choice
- text prefix_len ?(title = "") ?(msg = "") () ~id locs uris
+ text prefix_len ?(title = "") ?msg:(_ = "") () ~id:_ locs uris
=
+ GtkThread.sync (fun _ ->
let dialog = new uriChoiceDialog () in
dialog#uriEntryHBox#misc#hide ();
dialog#uriChoiceSelectedButton#misc#hide ();
dialog#uriChoiceTreeView#selection#set_mode
(`SINGLE :> Gtk.Tags.selection_mode);
let model = new stringListModel dialog#uriChoiceTreeView in
- let choices = ref None in
+ let choices = ref [] in
dialog#uriChoiceDialog#set_title title;
let hack_len = MatitaGtkMisc.utf8_string_length text in
let rec colorize acc_len = function
in
dialog#uriChoiceLabel#set_label txt;
List.iter model#easy_append uris;
- let return v =
- choices := v;
- dialog#uriChoiceDialog#destroy ();
- GMain.Main.quit ()
- in
- ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
connect_button dialog#uriChoiceForwardButton (fun _ ->
match model#easy_selection () with
| [] -> ()
- | uris -> return (Some uris));
- connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
+ | uris -> choices := uris; dialog#toplevel#response `OK);
+ connect_button dialog#uriChoiceAbortButton (fun _ -> dialog#toplevel#response `DELETE_EVENT);
dialog#uriChoiceDialog#show ();
- GtkThread.main ();
- (match !choices with
- | None -> raise MatitaTypes.Cancel
- | Some uris -> uris)
+ let res =
+ match dialog#toplevel#run () with
+ | `DELETE_EVENT -> dialog#toplevel#destroy() ; raise MatitaTypes.Cancel
+ | `OK -> !choices
+ | _ -> assert false in
+ dialog#toplevel#destroy () ;
+ res) ()
let interactive_interp_choice () text prefix_len choices =
(*List.iter (fun l -> prerr_endline "==="; List.iter (fun (_,id,dsc) -> prerr_endline (id ^ " = " ^ dsc)) l) choices;*)
let _ =
(* disambiguator callbacks *)
Disambiguate.set_choose_uris_callback
- (fun ~selection_mode ?ok ?(enable_button_for_non_vars=false) ~title ~msg ->
+ (fun ~selection_mode ?ok ?enable_button_for_non_vars:(_=false) ~title ~msg ->
interactive_uri_choice ~selection_mode ?ok_label:ok ~title ~msg ());
Disambiguate.set_choose_interp_callback (interactive_interp_choice ());
(* gtk initialization *)
- GtkMain.Rc.add_default_file BuildTimeConf.gtkrc_file; (* loads gtk rc *)
- ignore (GMain.Main.init ())
-
+ GtkMain.Rc.add_default_file BuildTimeConf.gtkrc_file (* loads gtk rc *)
--- /dev/null
+ignore (GMain.Main.init ())
open Printf
-open GrafiteTypes
open MatitaGtkMisc
-open MatitaGuiTypes
open CicMathView
module Stack = Continuationals.Stack
GtkSignal.disconnect notebook#as_widget id;
switch_page_callback <- None
| None -> ());
- for i = 0 to pages do notebook#remove_page 0 done;
+ for _i = 0 to pages do notebook#remove_page 0 done;
notebook#set_show_tabs true;
pages <- 0;
page2goal <- [];
scrolledWin <- Some w;
(match cicMathView#misc#parent with
| None -> ()
- | Some parent ->
- let parent =
- match cicMathView#misc#parent with
- None -> assert false
- | Some p -> GContainer.cast_container p
- in
+ | Some p ->
+ let parent = GContainer.cast_container p in
parent#remove cicMathView#coerce);
w#add cicMathView#coerce
in
let stack_goals = Stack.open_goals status#stack in
let proof_goals = List.map fst metasenv in
if
- HExtlib.list_uniq (List.sort Pervasives.compare stack_goals)
- <> List.sort Pervasives.compare proof_goals
+ HExtlib.list_uniq (List.sort compare stack_goals)
+ <> List.sort compare proof_goals
then begin
prerr_endline ("STACK GOALS = " ^ String.concat " " (List.map string_of_int stack_goals));
prerr_endline ("PROOF GOALS = " ^ String.concat " " (List.map string_of_int proof_goals));
in
let add_switch _ _ (_, sw) = add_tab (render_switch sw) sw in
Stack.iter (** populate notebook with tabs *)
- ~env:(fun depth tag (pos, sw) ->
+ ~env:(fun depth _tag (pos, sw) ->
let markup =
match depth, pos with
| 0, 0 -> `Current (render_switch sw)
method private render_page:
'status. #ApplyTransformation.status as 'status -> page:int ->
goal_switch:Stack.switch -> unit
- = fun status ~page ~goal_switch ->
+ = fun status ~page:_ ~goal_switch ->
(match goal_switch with
| Stack.Open goal ->
let menv,subst = _metasenv in
cicMathView#nload_sequent status menv subst goal
- | Stack.Closed goal ->
+ | Stack.Closed _goal ->
let root = Lazy.force closed_goal_mathml in
cicMathView#load_root ~root);
(try
let dir_RE = Pcre.regexp "^cic:((/([^/]+/)*[^/]+(/)?)|/|)$" in
let is_uri txt = Pcre.pmatch ~rex:uri_RE txt in
let is_dir txt = Pcre.pmatch ~rex:dir_RE txt in
- let gui = MatitaMisc.get_gui () in
+ let _gui = MatitaMisc.get_gui () in
let win = new MatitaGeneratedGui.browserWin () in
let _ = win#browserUri#misc#grab_focus () in
let gviz = LablGraphviz.graphviz ~packing:win#graphScrolledWin#add () in
let searchText =
- GSourceView2.source_view ~auto_indent:false ~editable:false ()
+ GSourceView3.source_view ~auto_indent:false ~editable:false ()
in
let _ =
win#scrolledwinContent#add (searchText :> GObj.widget);
close_out oc;
if tred then
gviz#load_graph_from_file
- ~gviz_cmd:"dot -Txdot | tred |gvpack -gv | dot" filename
+ (* gvpack can no longer read the output of -Txdot :-( *)
+ (*~gviz_cmd:"dot -Txdot | tred |gvpack -gv | dot" filename*)
+ ~gviz_cmd:"dot -Txdot | tred | dot" filename
else
gviz#load_graph_from_file
- ~gviz_cmd:"dot -Txdot | gvpack -gv | dot" filename;
+ (* gvpack can no longer read the output of -Txdot :-( *)
+ (*~gviz_cmd:"dot -Txdot | gvpack -gv | dot" filename;*)
+ ~gviz_cmd:"dot -Txdot | dot" filename;
HExtlib.safe_remove filename
in
object (self)
self#_showMath;
mathView#load_root (Lazy.force empty_mathml)
- method private _loadCheck term =
+ method private _loadCheck _term =
failwith "not implemented _loadCheck";
(* self#_showMath *)
method private redraw_gviz ?center_on () =
if Sys.command "which dot" = 0 then
let tmpfile, oc = Filename.open_temp_file "matita" ".dot" in
- let fmt = Format.formatter_of_out_channel oc in
- (* MATITA 1.0 MetadataDeps.DepGraph.render fmt gviz_graph;*)
+ (* MATITA 1.0 let fmt = Format.formatter_of_out_channel oc in
+ MetadataDeps.DepGraph.render fmt gviz_graph;*)
close_out oc;
gviz#load_graph_from_file ~gviz_cmd:"tred | dot" tmpfile;
(match center_on with
"the graph of dependencies amoung objects. Please install it.")
~parent:win#toplevel ()
- method private dependencies direction uri () =
+ method private dependencies _direction _uri () =
assert false (* MATITA 1.0
let dbd = LibraryDb.instance () in
let graph =
let content = Http_getter.ls ~local:false dir in
let l =
List.fast_sort
- Pervasives.compare
+ compare
(List.map
(function
| Http_getter_types.Ls_section s -> "dir", s
| mv :: tl ->
(match mv#get_selections with
| [] -> aux tl
- | sel :: _ -> mv)
+ | _sel :: _ -> mv)
in
aux (get_math_views ())
let absolute_path file =
if file.[0] = '/' then file else Unix.getcwd () ^ "/" ^ file
-let is_proof_script fname = true (** TODO Zack *)
-let is_proof_object fname = true (** TODO Zack *)
+let is_proof_script _fname = true (** TODO Zack *)
+let is_proof_object _fname = true (** TODO Zack *)
let append_phrase_sep s =
if not (Pcre.pmatch ~pat:(sprintf "%s$" BuildTimeConf.phrase_sep) s) then
let size = size + 1 in
let decr x = let x' = x - 1 in if x' < 0 then size + x' else x' in
let incr x = (x + 1) mod size in
- object (self)
- val data = Array.create size ""
+ object
+ val data = Array.make size ""
inherit basic_history (0, -1 , -1)
class ['a] browser_history ?memento size init =
object (self)
initializer match memento with Some m -> self#load m | _ -> ()
- val data = Array.create size init
+ val data = Array.make size init
inherit basic_history (0, 0, 0)
let rec aux =
function
| [] -> raise Not_found
- | hd :: tl as l when equality hd e -> l
- | hd :: tl -> aux tl
+ | hd :: _ as l when equality hd e -> l
+ | _ :: tl -> aux tl
in
aux l
(* $Id$ *)
open Printf
-open GrafiteTypes
module TA = GrafiteAst
(fun (acc, to_prepend) (status,alias) ->
match alias with
| None -> (status,to_prepend ^ nonskipped_txt)::acc,""
- | Some (k,value) ->
+ | Some (_k,value) ->
let newtxt = GrafiteAstPp.pp_alias value in
(status,to_prepend ^ newtxt ^ "\n")::acc, "")
([],skipped_txt) enriched_history_fragment
let pp_eager_statement_ast = GrafiteAstPp.pp_statement
-let eval_nmacro include_paths (buffer : GText.buffer) status unparsed_text parsed_text script mac =
+let eval_nmacro _include_paths (_buffer : GText.buffer) status _unparsed_text parsed_text script mac =
let parsed_text_length = String.length parsed_text in
match mac with
| TA.Screenshot (_,name) ->
in
match st with
| GrafiteAst.Executable (loc, ex) ->
- let _, nonskipped, skipped, parsed_text_length = text_of_loc loc in
+ let _, nonskipped, skipped, _parsed_text_length = text_of_loc loc in
eval_executable include_paths buffer status unparsed_text
skipped nonskipped script ex loc
| GrafiteAst.Comment (loc, GrafiteAst.Code (_, ex))
when Helm_registry.get_bool "matita.execcomments" ->
- let _, nonskipped, skipped, parsed_text_length = text_of_loc loc in
+ let _, nonskipped, skipped, _parsed_text_length = text_of_loc loc in
eval_executable include_paths buffer status unparsed_text
skipped nonskipped script ex loc
| GrafiteAst.Comment (loc, _) ->
*)
class script ~(parent:GBin.scrolled_window) ~tab_label () =
let source_view =
- GSourceView2.source_view
+ GSourceView3.source_view
~auto_indent:true
~insert_spaces_instead_of_tabs:true ~tab_width:2
~right_margin_position:80 ~show_right_margin:true
() in
let buffer = source_view#buffer in
let source_buffer = source_view#source_buffer in
+let _ =
+ source_buffer#connect#notify_can_undo
+ ~callback:(MatitaMisc.get_gui ())#main#undoMenuItem#misc#set_sensitive in
+let _ =
+ source_buffer#connect#notify_can_redo
+ ~callback:(MatitaMisc.get_gui ())#main#redoMenuItem#misc#set_sensitive in
let similarsymbols_tag_name = "similarsymbolos" in
let similarsymbols_tag = `NAME similarsymbols_tag_name in
let initial_statuses current baseuri =
let status = new MatitaEngine.status baseuri in
(match current with
- Some current -> NCicLibrary.time_travel status;
+ Some _current -> NCicLibrary.time_travel status;
(*
(* MATITA 1.0: there is a known bug in invalidation; temporary fix here *)
NCicEnvironment.invalidate () *)
false
));
ignore(source_view#event#connect#button_release
- ~callback:(fun button -> clean_locked := false; false));
+ ~callback:(fun _button -> clean_locked := false; false));
ignore(source_view#buffer#connect#after#apply_tag
~callback:(
fun tag ~start:_ ~stop:_ ->
let menuItems = menu#children in
let undoMenuItem, redoMenuItem =
match menuItems with
- [undo;redo;sep1;cut;copy;paste;delete;sep2;
- selectall;sep3;inputmethod;insertunicodecharacter] ->
+ [undo;redo;_sep1;cut;copy;paste;delete;_sep2;
+ _selectall;_sep3;_inputmethod;_insertunicodecharacter] ->
List.iter menu#remove [ copy; cut; delete; paste ];
undo,redo
| _ -> assert false in
let add_menu_item =
let i = ref 2 in (* last occupied position *)
- fun ?label ?stock () ->
+ fun ~label ->
incr i;
- GMenu.image_menu_item ?label ?stock ~packing:(menu#insert ~pos:!i)
- ()
- in
- let copy = add_menu_item ~stock:`COPY () in
- let cut = add_menu_item ~stock:`CUT () in
- let delete = add_menu_item ~stock:`DELETE () in
- let paste = add_menu_item ~stock:`PASTE () in
- let paste_pattern = add_menu_item ~label:"Paste as pattern" () in
+ GMenu.menu_item ~label ~packing:(menu#insert ~pos:!i) () in
+ let copy = add_menu_item ~label:"Copy" in
+ let cut = add_menu_item ~label:"Cut" in
+ let delete = add_menu_item ~label:"Delete" in
+ let paste = add_menu_item ~label:"Paste" in
+ let paste_pattern = add_menu_item ~label:"Paste as pattern" in
copy#misc#set_sensitive self#canCopy;
cut#misc#set_sensitive self#canCut;
delete#misc#set_sensitive self#canDelete;
MatitaGtkMisc.connect_menu_item paste self#paste;
MatitaGtkMisc.connect_menu_item paste_pattern self#pastePattern;
let new_undoMenuItem =
- GMenu.image_menu_item
- ~image:(GMisc.image ~stock:`UNDO ())
+ GMenu.menu_item
~use_mnemonic:true
~label:"_Undo"
~packing:(menu#insert ~pos:0) () in
new_undoMenuItem#misc#set_sensitive
- (undoMenuItem#misc#get_flag `SENSITIVE);
+ undoMenuItem#misc#sensitive;
menu#remove (undoMenuItem :> GMenu.menu_item);
MatitaGtkMisc.connect_menu_item new_undoMenuItem
(fun () -> self#safe_undo);
let new_redoMenuItem =
- GMenu.image_menu_item
- ~image:(GMisc.image ~stock:`REDO ())
+ GMenu.menu_item
~use_mnemonic:true
~label:"_Redo"
~packing:(menu#insert ~pos:1) () in
new_redoMenuItem#misc#set_sensitive
- (redoMenuItem#misc#get_flag `SENSITIVE);
+ redoMenuItem#misc#sensitive;
menu#remove (redoMenuItem :> GMenu.menu_item);
MatitaGtkMisc.connect_menu_item new_redoMenuItem
(fun () -> self#safe_redo)));
(** misc *)
method clean_dirty_lock: unit
method set_star: bool -> unit
- method source_view: GSourceView2.source_view
+ method source_view: GSourceView3.source_view
method has_parent: GObj.widget -> bool
(* debug *)
(* $Id$ *)
-open Printf
-open GrafiteTypes
-
(** user hit the cancel button *)
exception Cancel
let get_all_eqclass () =
let rc = ref [] in
Hashtbl.iter
- (fun k v ->
+ (fun _k v ->
if not (List.mem v !rc) then
rc := v :: !rc)
classes;
projects / helm.git / commitdiff