From ea44a4cacd238d7fa5a397f043f3e3321eb66543 Mon Sep 17 00:00:00 2001 From: John Harrison Date: Wed, 6 Oct 2021 23:58:31 +0000 Subject: [PATCH] Removed trailing whitespace in many files --- 100/arithmetic.ml | 2 +- 100/arithmetic_geometric_mean.ml | 2 +- 100/ballot.ml | 2 +- 100/bertrand.ml | 2 +- 100/cantor.ml | 4 +- 100/cubic.ml | 12 +- 100/descartes.ml | 32 +- 100/friendship.ml | 8 +- 100/heron.ml | 2 +- 100/minkowski.ml | 76 +-- 100/ratcountable.ml | 4 +- 100/subsequence.ml | 22 +- 100/triangular.ml | 2 +- Arithmetic/arithprov.ml | 16 +- Boyer_Moore/counterexample.ml | 32 +- Boyer_Moore/environment.ml | 8 +- Boyer_Moore/generalize.ml | 64 +- Boyer_Moore/main.ml | 28 +- Boyer_Moore/make.ml | 8 +- Boyer_Moore/rewrite_rules.ml | 2 +- Boyer_Moore/shells.ml | 4 +- Boyer_Moore/struct_equal.ml | 6 +- Boyer_Moore/support.ml | 8 +- Boyer_Moore/testset/arith.ml | 2 +- Boyer_Moore/waterfall.ml | 30 +- Examples/combin.ml | 2 +- Examples/cooper.ml | 6 +- Examples/gcdrecurrence.ml | 4 +- Examples/inverse_bug_puzzle_miz3.ml | 2 +- Examples/mccarthy.ml | 8 +- Examples/padics.ml | 2 +- Examples/pell.ml | 4 +- Examples/sylvester_gallai.ml | 2 +- Examples/update_database.ml | 2 +- Formal_ineqs/README.md | 2 +- Formal_ineqs/arith/arith_cache.hl | 26 +- Formal_ineqs/arith/eval_interval.hl | 14 +- Formal_ineqs/arith/float_pow.hl | 22 +- Formal_ineqs/docs/FormalVerifier.tex | 14 +- Formal_ineqs/examples.hl | 6 +- Formal_ineqs/examples_flyspeck.hl | 50 +- Formal_ineqs/examples_other.hl | 6 +- Formal_ineqs/examples_poly.hl | 14 +- Formal_ineqs/informal/informal_atn.hl | 4 +- .../informal/informal_eval_interval.hl | 12 +- Formal_ineqs/informal/informal_exp.hl | 4 +- Formal_ineqs/informal/informal_float.hl | 20 +- Formal_ineqs/informal/informal_interval.hl | 8 +- Formal_ineqs/informal/informal_matan.hl | 8 +- Formal_ineqs/informal/informal_nat.hl | 10 +- Formal_ineqs/informal/informal_poly.hl | 10 +- Formal_ineqs/informal/informal_search.hl | 14 +- Formal_ineqs/informal/informal_sin_cos.hl | 12 +- Formal_ineqs/informal/informal_taylor.hl | 58 +- Formal_ineqs/informal/informal_verifier.hl | 46 +- Formal_ineqs/lib/ipow.hl | 20 +- Formal_ineqs/lib/ssreflect/sections.hl | 20 +- Formal_ineqs/lib/ssreflect/ssreflect.hl | 94 +-- Formal_ineqs/lib/ssrfun.hl | 8 +- Formal_ineqs/list/list_conversions.hl | 34 +- Formal_ineqs/misc/report.hl | 12 +- Formal_ineqs/taylor/m_taylor_arith.hl | 644 +++++++++--------- Formal_ineqs/taylor/m_taylor_arith2.hl | 172 ++--- .../theory/multivariate_taylor-compiled.hl | 72 +- .../taylor/theory/multivariate_taylor.vhl | 112 +-- .../taylor/theory/taylor_interval-compiled.hl | 106 +-- .../taylor/theory/taylor_interval.vhl | 188 ++--- Formal_ineqs/tests/log.hl | 4 +- Formal_ineqs/tests/nat_test.hl | 24 +- Formal_ineqs/tests/results.hl | 10 +- Formal_ineqs/tests/test_utils.hl | 18 +- Formal_ineqs/trig/asn_acs_eval.hl | 14 +- Formal_ineqs/trig/atn.hl | 16 +- Formal_ineqs/trig/atn_eval.hl | 30 +- Formal_ineqs/trig/cos_bounds_eval.hl | 24 +- Formal_ineqs/trig/cos_eval.hl | 94 +-- Formal_ineqs/trig/exp_eval.hl | 34 +- Formal_ineqs/trig/exp_log.hl | 22 +- Formal_ineqs/trig/log_eval.hl | 8 +- Formal_ineqs/trig/matan.hl | 46 +- Formal_ineqs/trig/matan_eval.hl | 30 +- Formal_ineqs/trig/poly.hl | 30 +- Formal_ineqs/trig/poly_eval.hl | 50 +- Formal_ineqs/trig/series.hl | 64 +- Formal_ineqs/trig/sin_cos.hl | 20 +- Formal_ineqs/trig/sin_eval.hl | 4 +- Formal_ineqs/trig/test.hl | 2 +- Formal_ineqs/trig/unused.hl | 22 +- Formal_ineqs/verifier/certificate.hl | 24 +- Formal_ineqs/verifier/m_verifier.hl | 202 +++--- Formal_ineqs/verifier/m_verifier_build.hl | 16 +- Formal_ineqs/verifier/m_verifier_main.hl | 100 +-- Functionspaces/README | 14 +- Help/.singlefun.doc | 6 +- Help/.valmod.doc | 4 +- Help/ABS_CONV.doc | 2 +- Help/ACCEPT_TAC.doc | 4 +- Help/ALL_TAC.doc | 8 +- Help/ASM_ARITH_TAC.doc | 18 +- Help/ASM_FOL_TAC.doc | 10 +- Help/ASM_SIMP_TAC.doc | 2 +- Help/ASSOC_CONV.doc | 10 +- Help/AUGMENT_SIMPSET.doc | 6 +- Help/BETA.doc | 8 +- Help/BETA_TAC.doc | 4 +- Help/BINDER_CONV.doc | 8 +- Help/BINOP_TAC.doc | 12 +- Help/BITS_ELIM_CONV.doc | 8 +- Help/BOOL_CASES_TAC.doc | 4 +- Help/CACHE_CONV.doc | 10 +- Help/CHANGED_CONV.doc | 12 +- Help/CHAR_EQ_CONV.doc | 8 +- Help/CHEAT_TAC.doc | 6 +- Help/CHOOSE_THEN.doc | 4 +- Help/CHOOSE_UPPERCASE.doc | 2 +- Help/CNF_CONV.doc | 14 +- Help/COMB2_CONV.doc | 2 +- Help/CONDS_CELIM_CONV.doc | 4 +- Help/CONJUNCTS_UPPERCASE.doc | 2 +- Help/CONJ_ACI_RULE.doc | 6 +- Help/CONV_TAC.doc | 10 +- Help/DISJ_CASES_THEN2.doc | 2 +- Help/EQT_ELIM.doc | 2 +- Help/ETA_CONV.doc | 4 +- Help/EXISTS_EQUATION.doc | 10 +- Help/EXPAND_TAC.doc | 10 +- Help/FIND_ASSUM.doc | 24 +- Help/FIRST_ASSUM.doc | 2 +- Help/FORALL_UNWIND_CONV.doc | 4 +- Help/F_F.doc | 2 +- Help/GABS_CONV.doc | 2 +- Help/GEN.doc | 2 +- Help/GENERAL_REWRITE_CONV.doc | 10 +- Help/GEN_NNF_CONV.doc | 2 +- Help/GEN_REAL_ARITH.doc | 14 +- Help/HAS_SIZE_CONV.doc | 4 +- Help/HAS_SIZE_DIMINDEX_RULE.doc | 2 +- Help/HIGHER_REWRITE_CONV.doc | 6 +- Help/IMP_REWR_CONV.doc | 10 +- Help/INSTANTIATE_ALL.doc | 8 +- Help/INSTANTIATE_UPPERCASE.doc | 6 +- Help/INST_TYPE.doc | 4 +- Help/INTEGER_RULE.doc | 20 +- Help/INTRO_TAC.doc | 12 +- Help/INT_POLY_CONV.doc | 18 +- Help/INT_REM_DOWN_CONV.doc | 2 +- Help/INT_RING.doc | 6 +- Help/ISPEC.doc | 2 +- Help/ISPECL.doc | 2 +- Help/LAND_CONV.doc | 6 +- Help/LIST_CONV.doc | 2 +- Help/MATCH_ACCEPT_TAC.doc | 4 +- Help/MATCH_CONV.doc | 4 +- Help/META_EXISTS_TAC.doc | 6 +- Help/META_SPEC_TAC.doc | 2 +- Help/MK_COMB_TAC.doc | 6 +- Help/MK_EXISTS_UPPERCASE.doc | 6 +- Help/MK_FORALL_UPPERCASE.doc | 8 +- Help/MOD_DOWN_CONV.doc | 2 +- Help/MONO_TAC.doc | 10 +- Help/MP_CONV.doc | 10 +- Help/NNF_CONV.doc | 12 +- Help/NO_TAC.doc | 14 +- Help/NUMBER_RULE.doc | 6 +- Help/NUMBER_TAC.doc | 8 +- Help/NUM_EVEN_CONV.doc | 6 +- Help/NUM_EXP_CONV.doc | 4 +- Help/NUM_FACT_CONV.doc | 4 +- Help/NUM_GE_CONV.doc | 12 +- Help/NUM_GT_CONV.doc | 12 +- Help/NUM_LE_CONV.doc | 12 +- Help/NUM_LT_CONV.doc | 36 +- Help/NUM_NORMALIZE_CONV.doc | 12 +- Help/NUM_ODD_CONV.doc | 6 +- Help/NUM_PRE_CONV.doc | 6 +- Help/NUM_REDUCE_TAC.doc | 8 +- Help/NUM_RED_CONV.doc | 2 +- Help/NUM_RING.doc | 16 +- Help/NUM_SUB_CONV.doc | 8 +- Help/NUM_SUC_CONV.doc | 4 +- Help/NUM_TO_INT_CONV.doc | 2 +- Help/ONCE_ASM_REWRITE_TAC.doc | 2 +- Help/ONCE_DEPTH_SQCONV.doc | 6 +- Help/ONCE_REWRITE_TAC.doc | 10 +- Help/ONCE_SIMPLIFY_CONV.doc | 2 +- Help/ONCE_SIMP_CONV.doc | 12 +- Help/ONCE_SIMP_TAC.doc | 6 +- Help/ORDERED_IMP_REWR_CONV.doc | 8 +- Help/ORDERED_REWR_CONV.doc | 14 +- Help/ORELSE.doc | 16 +- Help/PINST.doc | 14 +- Help/POP_ASSUM.doc | 14 +- Help/POP_ASSUM_LIST.doc | 2 +- Help/PROP_ATOM_CONV.doc | 8 +- Help/PURE_SIMP_CONV.doc | 2 +- Help/PURE_SIMP_TAC.doc | 4 +- Help/REAL_FIELD.doc | 10 +- Help/REAL_IDEAL_CONV.doc | 16 +- Help/REAL_INT_RAT_CONV.doc | 4 +- Help/REAL_INT_REDUCE_CONV.doc | 2 +- Help/REAL_INT_RED_CONV.doc | 10 +- Help/REAL_LINEAR_PROVER.doc | 2 +- Help/REAL_POLY_MUL_CONV.doc | 4 +- Help/REAL_POLY_NEG_CONV.doc | 6 +- Help/REAL_POLY_POW_CONV.doc | 4 +- Help/REAL_POLY_SUB_CONV.doc | 4 +- Help/RECALL_ACCEPT_TAC.doc | 8 +- Help/REFL.doc | 2 +- Help/REFUTE_THEN.doc | 20 +- Help/REPEATC.doc | 2 +- Help/REPEAT_UPPERCASE.doc | 6 +- Help/REPLICATE_TAC.doc | 10 +- Help/REWRITES_CONV.doc | 6 +- Help/RIGHT_BETAS.doc | 2 +- Help/RING_AND_IDEAL_CONV.doc | 4 +- Help/SELECT_ELIM_TAC.doc | 12 +- Help/SET_TAC.doc | 4 +- Help/SIMPLE_CHOOSE.doc | 2 +- Help/SIMPLE_EXISTS.doc | 8 +- Help/SIMPLIFY_CONV.doc | 12 +- Help/SIMP_CONV.doc | 2 +- Help/STRING_EQ_CONV.doc | 6 +- Help/STRIP_GOAL_THEN.doc | 2 +- Help/STRUCT_CASES_TAC.doc | 2 +- Help/SUBST_VAR_TAC.doc | 20 +- Help/SYM.doc | 4 +- Help/SYM_CONV.doc | 2 +- Help/TAUT.doc | 12 +- Help/THEN.doc | 10 +- Help/TOP_SWEEP_CONV.doc | 12 +- Help/TRANS.doc | 2 +- Help/TRANS_TAC.doc | 2 +- Help/TRY.doc | 10 +- Help/TRY_CONV.doc | 2 +- Help/UNDISCH_TAC.doc | 2 +- Help/UNDISCH_THEN.doc | 2 +- Help/UNIFY_ACCEPT_TAC.doc | 28 +- Help/VALID.doc | 6 +- Help/WEAK_CNF_CONV.doc | 6 +- Help/X_CHOOSE_THEN.doc | 4 +- Help/X_META_EXISTS_TAC.doc | 4 +- Help/alpha.doc | 2 +- Help/apply.doc | 4 +- Help/assocd.doc | 6 +- Help/aty.doc | 4 +- Help/b.doc | 12 +- Help/basic_convs.doc | 4 +- Help/basic_net.doc | 12 +- Help/basic_prover.doc | 8 +- Help/basic_rewrites.doc | 12 +- Help/binops.doc | 8 +- Help/bool_ty.doc | 2 +- Help/bty.doc | 4 +- Help/by.doc | 4 +- Help/cases.doc | 6 +- Help/check.doc | 2 +- Help/choose.doc | 2 +- Help/comment_token.doc | 2 +- Help/compose_insts.doc | 4 +- Help/concl.doc | 2 +- Help/conjuncts.doc | 4 +- Help/current_goalstack.doc | 4 +- Help/decreasing.doc | 2 +- Help/define.doc | 4 +- Help/define_type.doc | 40 +- Help/defined.doc | 6 +- Help/definitions.doc | 6 +- Help/denominator.doc | 4 +- ...erive_nonschematic_inductive_relations.doc | 20 +- Help/derive_strong_induction.doc | 26 +- Help/dest_binder.doc | 8 +- Help/dest_binop.doc | 4 +- Help/dest_char.doc | 8 +- Help/dest_comb.doc | 2 +- Help/dest_finty.doc | 2 +- Help/dest_fun_ty.doc | 6 +- Help/dest_iff.doc | 8 +- Help/dest_numeral.doc | 2 +- Help/dest_realintconst.doc | 2 +- Help/dest_setenum.doc | 6 +- Help/dest_uexists.doc | 2 +- Help/disjuncts.doc | 12 +- Help/distinctness_store.doc | 6 +- Help/do_list.doc | 6 +- Help/dpty.doc | 2 +- Help/empty_ss.doc | 6 +- Help/equals_goal.doc | 6 +- Help/equals_thm.doc | 8 +- Help/exists.doc | 2 +- Help/extend_basic_congs.doc | 16 +- Help/extend_basic_convs.doc | 12 +- Help/fail.doc | 12 +- Help/find_path.doc | 4 +- Help/find_terms.doc | 2 +- Help/flush_goalstack.doc | 6 +- Help/foldr.doc | 10 +- Help/follow_path.doc | 8 +- Help/forall.doc | 2 +- Help/forall2.doc | 6 +- Help/free_in.doc | 2 +- Help/freesin.doc | 6 +- Help/g.doc | 2 +- Help/gcd_num.doc | 8 +- Help/get_type_arity.doc | 6 +- Help/graph.doc | 2 +- Help/help.doc | 2 +- Help/hol_dir.doc | 2 +- Help/hol_expand_directory.doc | 6 +- Help/ignore_constant_varstruct.doc | 16 +- Help/increasing.doc | 2 +- Help/index.doc | 4 +- Help/inductive_type_store.doc | 18 +- Help/infixes.doc | 2 +- Help/insert.doc | 4 +- Help/insert_prime.doc | 6 +- Help/inst.doc | 20 +- Help/inst_goal.doc | 2 +- Help/install_user_printer.doc | 6 +- Help/installed_parsers.doc | 4 +- Help/intersect.doc | 2 +- Help/is_binder.doc | 4 +- Help/is_const.doc | 2 +- Help/is_imp.doc | 2 +- Help/is_numeral.doc | 2 +- Help/is_prefix.doc | 4 +- Help/is_ratconst.doc | 4 +- Help/is_realintconst.doc | 2 +- Help/is_reserved_word.doc | 6 +- Help/is_type.doc | 2 +- Help/is_uexists.doc | 2 +- Help/is_vartype.doc | 2 +- Help/isalnum.doc | 6 +- Help/isalpha.doc | 6 +- Help/isbra.doc | 6 +- Help/isnum.doc | 4 +- Help/issep.doc | 4 +- Help/isspace.doc | 2 +- Help/issymb.doc | 8 +- Help/itlist.doc | 2 +- Help/lcm_num.doc | 2 +- Help/let_CONV.doc | 4 +- Help/lhand.doc | 12 +- Help/lift_theorem.doc | 44 +- Help/list_mk_binop.doc | 10 +- Help/list_mk_gabs.doc | 4 +- Help/list_mk_icomb.doc | 8 +- Help/loaded_files.doc | 8 +- Help/lookup.doc | 16 +- Help/make_args.doc | 6 +- Help/map2.doc | 2 +- Help/mapf.doc | 8 +- Help/mem_prime.doc | 6 +- Help/merge.doc | 6 +- Help/merge_nets.doc | 2 +- Help/mergesort.doc | 8 +- Help/meson_dcutin.doc | 8 +- Help/meson_depth.doc | 6 +- Help/meson_prefine.doc | 16 +- Help/meson_skew.doc | 10 +- Help/meson_split_limit.doc | 12 +- Help/mk_abs.doc | 8 +- Help/mk_binder.doc | 10 +- Help/mk_binop.doc | 6 +- Help/mk_char.doc | 6 +- Help/mk_const.doc | 14 +- Help/mk_flist.doc | 6 +- Help/mk_fthm.doc | 8 +- Help/mk_fun_ty.doc | 4 +- Help/mk_gabs.doc | 16 +- Help/mk_goalstate.doc | 2 +- Help/mk_iff.doc | 4 +- Help/mk_intconst.doc | 2 +- Help/mk_list.doc | 2 +- Help/mk_numeral.doc | 10 +- Help/mk_pair.doc | 2 +- Help/mk_primed_var.doc | 6 +- Help/mk_realintconst.doc | 2 +- Help/mk_rewrites.doc | 12 +- Help/mk_setenum.doc | 4 +- Help/mk_small_numeral.doc | 2 +- Help/mk_string.doc | 2 +- Help/net_of_cong.doc | 8 +- Help/new_constant.doc | 6 +- Help/new_definition.doc | 12 +- Help/new_inductive_set.doc | 2 +- Help/nsplit.doc | 2 +- Help/null_inst.doc | 2 +- Help/null_meta.doc | 2 +- Help/num_0.doc | 2 +- Help/numdom.doc | 4 +- Help/numerator.doc | 4 +- Help/occurs_in.doc | 4 +- Help/parse_as_infix.doc | 12 +- Help/parse_as_prefix.doc | 4 +- Help/parse_pretype.doc | 4 +- Help/parse_term.doc | 4 +- Help/parse_type.doc | 4 +- Help/partition.doc | 2 +- Help/pp_print_qterm.doc | 4 +- Help/pp_print_qtype.doc | 4 +- Help/pp_print_term.doc | 4 +- Help/pp_print_type.doc | 4 +- Help/prebroken_binops.doc | 8 +- Help/prefixes.doc | 6 +- Help/preterm_of_term.doc | 8 +- Help/pretype_of_type.doc | 6 +- Help/print_goalstack.doc | 6 +- Help/print_thm.doc | 2 +- Help/print_to_string.doc | 2 +- Help/prove_monotonicity_hyps.doc | 12 +- Help/prove_recursive_functions_exist.doc | 36 +- Help/quotexpander.doc | 4 +- Help/rat_of_term.doc | 2 +- Help/rator.doc | 6 +- Help/reduce_interface.doc | 6 +- Help/refine.doc | 2 +- Help/remove_type_abbrev.doc | 6 +- Help/repeat.doc | 4 +- Help/report.doc | 2 +- Help/report_timing.doc | 8 +- Help/reserve_words.doc | 4 +- Help/reserved_words.doc | 4 +- Help/retypecheck.doc | 10 +- Help/rev_assoc.doc | 2 +- Help/reverse_interface_mapping.doc | 6 +- Help/rotate.doc | 2 +- Help/set_basic_congs.doc | 12 +- Help/set_basic_convs.doc | 8 +- Help/set_basic_rewrites.doc | 10 +- Help/set_eq.doc | 4 +- Help/setify.doc | 4 +- Help/shareout.doc | 6 +- Help/sort.doc | 10 +- Help/ss_of_congs.doc | 8 +- Help/ss_of_conv.doc | 12 +- Help/ss_of_maker.doc | 16 +- Help/ss_of_prover.doc | 14 +- Help/ss_of_provers.doc | 14 +- Help/ss_of_thms.doc | 12 +- Help/string_of_file.doc | 2 +- Help/string_of_term.doc | 4 +- Help/string_of_thm.doc | 4 +- Help/string_of_type.doc | 4 +- Help/strings_of_file.doc | 4 +- Help/strip_gabs.doc | 2 +- Help/strip_ncomb.doc | 4 +- Help/subset.doc | 4 +- Help/temp_path.doc | 2 +- Help/term_match.doc | 8 +- Help/term_of_preterm.doc | 10 +- Help/term_order.doc | 14 +- Help/term_type_unify.doc | 4 +- Help/term_union.doc | 12 +- Help/the_inductive_definitions.doc | 4 +- Help/the_inductive_types.doc | 4 +- Help/the_overload_skeletons.doc | 2 +- Help/the_type_definitions.doc | 12 +- Help/top_realgoal.doc | 4 +- Help/try_user_parser.doc | 8 +- Help/try_user_printer.doc | 2 +- Help/tryapplyd.doc | 12 +- Help/type_abbrevs.doc | 2 +- Help/type_invention_warning.doc | 2 +- Help/type_match.doc | 14 +- Help/type_of_pretype.doc | 8 +- Help/type_unify.doc | 4 +- Help/type_vars_in_term.doc | 4 +- Help/typify_universal_set.doc | 8 +- Help/undefine.doc | 8 +- Help/undefined.doc | 4 +- Help/union.doc | 4 +- Help/union_prime.doc | 2 +- Help/unions.doc | 2 +- Help/unions_prime.doc | 4 +- Help/unparse_as_infix.doc | 6 +- Help/unreserve_words.doc | 8 +- Help/unspaced_binops.doc | 2 +- Help/use_file.doc | 2 +- Help/variant.doc | 6 +- Help/variants.doc | 2 +- Help/verbose.doc | 4 +- Help/warn.doc | 2 +- IEEE/common.hl | 198 +++--- IsabelleLight/README | 14 +- IsabelleLight/meta_rules.ml | 174 ++--- IsabelleLight/support.ml | 14 +- Jordan/num_ext_gcd.ml | 36 +- Jordan/parse_ext_override_interface.ml | 22 +- Jordan/real_ext_geom_series.ml | 14 +- Jordan/tactics_refine.ml | 42 +- LP_arith/Makefile | 2 +- LP_arith/cdd_cert.c | 38 +- Library/bitsize.ml | 2 +- Library/calc_real.ml | 2 +- Logic/fole.ml | 14 +- Logic/herbrand.ml | 4 +- Logic/support.ml | 2 +- Minisat/minisat_resolve.ml | 6 +- Minisat/sat_script.ml | 10 +- Minisat/zc2mso/README | 2 +- Multivariate/geom.ml | 20 +- Multivariate/misc.ml | 2 +- Multivariate/msum.ml | 2 +- ProofTrace/fusion.ml.diff | 60 +- Proofrecording/diffs/tactics.ml | 12 +- Proofrecording/tools/startcore.ml | 2 +- QBF/mygraph.ml | 4 +- QBF/qbfr.ml | 48 +- QUICK_REFERENCE.txt | 8 +- RichterHilbertAxiomGeometry/miz3/Miz3Tips | 86 +-- RichterHilbertAxiomGeometry/miz3/README | 2 +- .../miz3/hol-light-fonts.el | 14 +- RichterHilbertAxiomGeometry/miz3/make.ml | 4 +- RichterHilbertAxiomGeometry/thmTopology | 28 +- Rqe/condense.ml | 302 ++++---- Rqe/condense_thms.ml | 48 +- Rqe/dedmatrix.ml | 100 +-- Rqe/dedmatrix_thms.ml | 36 +- Rqe/inferisign.ml | 158 ++--- Rqe/inferisign_thms.ml | 148 ++-- Rqe/inferpsign.ml | 148 ++-- Rqe/inferpsign_thms.ml | 140 ++-- Rqe/lift_qelim.ml | 8 +- Rqe/list_rewrites.ml | 4 +- Rqe/main_thms.ml | 60 +- Rqe/matinsert.ml | 32 +- Rqe/pdivides.ml | 14 +- Rqe/pdivides_thms.ml | 8 +- Rqe/rewrites.ml | 10 +- Rqe/rqe_lib.ml | 48 +- Rqe/rqe_list.ml | 44 +- Rqe/rqe_main.ml | 352 +++++----- Rqe/rqe_num.ml | 4 +- Rqe/signs.ml | 138 ++-- Rqe/signs_thms.ml | 6 +- Rqe/simplify.ml | 34 +- Rqe/testform.ml | 102 +-- Rqe/testform_thms.ml | 62 +- Rqe/timers.ml | 6 +- Tutorial/Number_theory.ml | 2 +- Tutorial/Real_analysis.ml | 2 +- Unity/mk_comp_unity.ml | 2 +- Unity/mk_ensures.ml | 26 +- Unity/mk_state_logic.ml | 8 +- Unity/mk_unless.ml | 2 +- grobner.ml | 2 +- iterate.ml | 4 +- miz3/Samples/bug0.ml | 4 +- miz3/Samples/icms.ml | 10 +- miz3/Samples/robbins.ml | 62 +- miz3/grammar/miz3.y | 14 +- pa_j_3.1x_6.02.1.ml | 2 +- pa_j_3.1x_6.02.2.ml | 2 +- pa_j_3.1x_6.xx.ml | 2 +- parser.ml | 2 +- system.ml | 2 +- wf.ml | 2 +- 557 files changed, 4399 insertions(+), 4399 deletions(-) diff --git a/100/arithmetic.ml b/100/arithmetic.ml index cd3c9ea6..414c25ab 100644 --- a/100/arithmetic.ml +++ b/100/arithmetic.ml @@ -7,7 +7,7 @@ let ARITHMETIC_PROGRESSION_LEMMA = prove INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let ARITHMETIC_PROGRESSION = prove - (`!n. 1 <= n + (`!n. 1 <= n ==> nsum(0..n-1) (\i. a + d * i) = (n * (2 * a + (n - 1) * d)) DIV 2`, INDUCT_TAC THEN REWRITE_TAC[ARITHMETIC_PROGRESSION_LEMMA; SUC_SUB1] THEN ARITH_TAC);; diff --git a/100/arithmetic_geometric_mean.ml b/100/arithmetic_geometric_mean.ml index d5536040..f5d98f47 100644 --- a/100/arithmetic_geometric_mean.ml +++ b/100/arithmetic_geometric_mean.ml @@ -67,7 +67,7 @@ let AGM = prove ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH; SUM_SING_NUMSEG] THEN REAL_ARITH_TAC; - REWRITE_TAC[ADD1] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + REWRITE_TAC[ADD1] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x(n + 1) * (sum(1..n) x / &n) pow n` THEN ASM_SIMP_TAC[LEMMA_3; GSYM REAL_OF_NUM_ADD; LE_1; ARITH_RULE `i <= n ==> i <= n + 1`] THEN diff --git a/100/ballot.ml b/100/ballot.ml index 3138eda4..f749430f 100644 --- a/100/ballot.ml +++ b/100/ballot.ml @@ -311,7 +311,7 @@ let VALID_COUNTINGS = prove ASM_SIMP_TAC[MULT_CLAUSES; ARITH_RULE `a <= b ==> SUC a - SUC b = 0`] THEN MATCH_MP_TAC(NUM_RING `~(a + b + 1 = 0) /\ - (SUC a + SUC b) * + (SUC a + SUC b) * ((SUC a + b) * (a + SUC b) * y + (a + SUC b) * (SUC a + b) * z) = (SUC a + b) * (a + SUC b) * w ==> (SUC a + SUC b) * (y + z) = w`) THEN diff --git a/100/bertrand.ml b/100/bertrand.ml index 0bd02db7..1591b286 100644 --- a/100/bertrand.ml +++ b/100/bertrand.ml @@ -1838,7 +1838,7 @@ let PSI_SQRT = prove ASM_REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN REWRITE_TAC[mangoldt; primepow] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP_MULT] THEN - REWRITE_TAC[EXP_MONO_EQ; ARITH_EQ] THEN COND_CASES_TAC THEN + REWRITE_TAC[EXP_MONO_EQ; ARITH_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[aprimedivisor] THEN REPEAT AP_TERM_TAC THEN ABS_TAC THEN diff --git a/100/cantor.ml b/100/cantor.ml index 03857653..fe13e567 100644 --- a/100/cantor.ml +++ b/100/cantor.ml @@ -73,7 +73,7 @@ let CANTOR_TAYLOR = prove ASM_MESON_TAC[]);; let SURJECTIVE_COMPOSE = prove - (`(!y. ?x. f(x) = y) /\ (!z. ?y. g(y) = z) + (`(!y. ?x. f(x) = y) /\ (!z. ?y. g(y) = z) ==> (!z. ?x. (g o f) x = z)`, MESON_TAC[o_THM]);; @@ -93,5 +93,5 @@ let CANTOR_JOHNSTONE = prove (REWRITE_RULE[NOT_EXISTS_THM] CANTOR)) THEN REWRITE_TAC[] THEN MATCH_MP_TAC SURJECTIVE_COMPOSE THEN ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN - MATCH_MP_TAC INJECTIVE_SURJECTIVE_PREIMAGE THEN + MATCH_MP_TAC INJECTIVE_SURJECTIVE_PREIMAGE THEN ASM_REWRITE_TAC[]);; diff --git a/100/cubic.ml b/100/cubic.ml index 49dcd973..981d0e84 100644 --- a/100/cubic.ml +++ b/100/cubic.ml @@ -46,7 +46,7 @@ let CUBIC_BASIC = COMPLEX_FIELD s3 = --s1 * (Cx(&1) - i * t) / Cx(&2) /\ i pow 2 + Cx(&1) = Cx(&0) /\ t pow 2 = Cx(&3) - ==> if p = Cx(&0) then + ==> if p = Cx(&0) then (y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0) <=> y = s1 \/ y = s2 \/ y = s3) else @@ -67,20 +67,20 @@ let CUBIC = prove let s1 = if p = Cx(&0) then ccbrt(Cx(&2) * q) else ccbrt(q + s) in let s2 = --s1 * (Cx(&1) + ii * csqrt(Cx(&3))) / Cx(&2) and s3 = --s1 * (Cx(&1) - ii * csqrt(Cx(&3))) / Cx(&2) in - if p = Cx(&0) then + if p = Cx(&0) then a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> x = s1 - b / (Cx(&3) * a) \/ - x = s2 - b / (Cx(&3) * a) \/ + x = s2 - b / (Cx(&3) * a) \/ x = s3 - b / (Cx(&3) * a) else - ~(s1 = Cx(&0)) /\ + ~(s1 = Cx(&0)) /\ (a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> x = s1 - p / s1 - b / (Cx(&3) * a) \/ x = s2 - p / s2 - b / (Cx(&3) * a) \/ x = s3 - p / s3 - b / (Cx(&3) * a))`, DISCH_TAC THEN REPEAT LET_TAC THEN ABBREV_TAC `y = x + b / (Cx(&3) * a)` THEN - SUBGOAL_THEN + SUBGOAL_THEN `a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0)` SUBST1_TAC THENL @@ -89,7 +89,7 @@ let CUBIC = prove ALL_TAC] THEN ONCE_REWRITE_TAC[COMPLEX_RING `x = a - b <=> x + b = (a:complex)`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CUBIC_BASIC THEN - MAP_EVERY EXISTS_TAC + MAP_EVERY EXISTS_TAC [`ii`; `csqrt(Cx(&3))`; `csqrt (q pow 2 + p pow 3)`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CSQRT]; diff --git a/100/descartes.ml b/100/descartes.ml index 2b8013f2..1c0c86ab 100644 --- a/100/descartes.ml +++ b/100/descartes.ml @@ -500,18 +500,18 @@ let MULTIPLICITY_UNIQUE = prove MAP_EVERY EXISTS_TAC [`b:num->real`; `m:num`] THEN ASM_REWRITE_TAC[]]);; let MULTIPLICITY_WORKS = prove - (`!r n a. + (`!r n a. (?i. i IN 0..n /\ ~(a i = &0)) - ==> ?b m. + ==> ?b m. ~(sum(0..m) (\i. b i * r pow i) = &0) /\ - !x. sum(0..n) (\i. a i * x pow i) = + !x. sum(0..n) (\i. a i * x pow i) = (x - r) pow multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r * sum(0..m) (\i. b i * x pow i)`, REWRITE_TAC[multiplicity] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN - GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN ASM_CASES_TAC `(a:num->real) n = &0` THENL - [ASM_CASES_TAC `n = 0` THEN + [ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN @@ -532,7 +532,7 @@ let MULTIPLICITY_WORKS = prove ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2; SUM_SING] THEN REWRITE_TAC[real_pow; REAL_MUL_RID] THEN ASM_MESON_TAC[]; ALL_TAC] THEN - MP_TAC(GEN `x:real` (ISPECL [`a:num->real`; `x:real`; `r:real`; `n:num`] + MP_TAC(GEN `x:real` (ISPECL [`a:num->real`; `x:real`; `r:real`; `n:num`] REAL_SUB_POLYFUN)) THEN ASM_SIMP_TAC[LE_1; REAL_SUB_RZERO] THEN ABBREV_TAC `b j = sum (j + 1..n) (\i. a i * r pow (i - j - 1))` THEN DISCH_THEN(K ALL_TAC) THEN @@ -551,7 +551,7 @@ let MULTIPLICITY_WORKS = prove STRIP_TAC THEN ASM_REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC]; MAP_EVERY EXISTS_TAC [`0`; `a:num->real`; `n:num`] THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]]);; - + let MULTIPLICITY_OTHER_ROOT = prove (`!a n r s. ~(r = s) /\ (?i. i IN 0..n /\ ~(a i = &0)) @@ -560,7 +560,7 @@ let MULTIPLICITY_OTHER_ROOT = prove REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MULTIPLICITY_UNIQUE THEN REWRITE_TAC[] THEN - MP_TAC(ISPECL [`s:real`; `n:num`; `a:num->real`] + MP_TAC(ISPECL [`s:real`; `n:num`; `a:num->real`] MULTIPLICITY_WORKS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:num->real`; `p:num`] THEN @@ -584,7 +584,7 @@ let MULTIPLICITY_OTHER_ROOT = prove MAP_EVERY X_GEN_TAC [`a:num->real`; `n:num`] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN - EXISTS_TAC `\i. (if 0 < i then a(i - 1) else &0) - + EXISTS_TAC `\i. (if 0 < i then a(i - 1) else &0) - (if i <= n then r * a i else &0)` THEN EXISTS_TAC `n + 1` THEN REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG] THEN X_GEN_TAC `x:real` THEN @@ -744,10 +744,10 @@ let VARIATION_POSITIVE_ROOT_MULTIPLICITY_FACTOR = prove (* ------------------------------------------------------------------------- *) let DESCARTES_RULE_OF_SIGNS = prove - (`!f a n. f = (\x. sum(0..n) (\i. a i * x pow i)) /\ + (`!f a n. f = (\x. sum(0..n) (\i. a i * x pow i)) /\ (?i. i IN 0..n /\ ~(a i = &0)) ==> ?d. EVEN d /\ - variation(0..n) a = + variation(0..n) a = nsum {r | &0 < r /\ f(r) = &0} (\r. multiplicity f r) + d`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN @@ -757,7 +757,7 @@ let DESCARTES_RULE_OF_SIGNS = prove [ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2] THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN - FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `a:num->real`)] THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_NUMSEG; ARITH_RULE `i <= n ==> i <= n - 1 \/ i = n`]; @@ -781,17 +781,17 @@ let DESCARTES_RULE_OF_SIGNS = prove FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN - MP_TAC(ISPECL [`r:real`; `n:num`; `a:num->real`] + MP_TAC(ISPECL [`r:real`; `n:num`; `a:num->real`] VARIATION_POSITIVE_ROOT_MULTIPLICITY_FACTOR) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:num->real`; `m:num`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN - FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `b:num->real`) THEN ANTS_TAC THENL [EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_0]; ALL_TAC] THEN - DISCH_THEN(X_CHOOSE_THEN `d1:num` + DISCH_THEN(X_CHOOSE_THEN `d1:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d2:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN @@ -800,7 +800,7 @@ let DESCARTES_RULE_OF_SIGNS = prove MATCH_MP_TAC(ARITH_RULE `x + y = z ==> (x + d1) + (y + d2):num = z + d1 + d2`) THEN SUBGOAL_THEN - `{r | &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0} = + `{r | &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0} = r INSERT {r | &0 < r /\ sum(0..m) (\i. b i * r pow i) = &0}` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `x IN s /\ s DELETE x = t ==> s = x INSERT t`) THEN diff --git a/100/friendship.ml b/100/friendship.ml index ffc33cd1..631c4940 100644 --- a/100/friendship.ml +++ b/100/friendship.ml @@ -704,18 +704,18 @@ let FRIENDSHIP = prove SUBGOAL_THEN `~(p divides 1)` MP_TAC THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN REWRITE_TAC[] THEN - MATCH_MP_TAC(NUMBER_RULE + MATCH_MP_TAC(NUMBER_RULE `!x. p divides (x + 1) /\ p divides x ==> p divides 1`) THEN EXISTS_TAC `m - 1` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ARITH_RULE `~(m = 0) ==> m - 1 + 1 = m`] THEN MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `p - 2` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NUMBER_RULE `!q c K1 K2. - p divides q /\ p divides c /\ + p divides q /\ p divides c /\ c = (q + 1) * K1 + K2 /\ K1 + K2 = ((q + 1) * q + 1) * nep2 ==> p divides nep2`) THEN - MAP_EVERY EXISTS_TAC + MAP_EVERY EXISTS_TAC [`m - 1`; `CARD {x:num->person | cycle friend p x}`; `CARD {x:num->person | path friend (p-2) x /\ x (p-2) = x 0}`; `CARD {x:num->person | path friend (p-2) x /\ ~(x (p-2) = x 0)}`] THEN @@ -743,7 +743,7 @@ let FRIENDSHIP = prove ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN - UNDISCH_TAC `3 <= p` THEN ARITH_TAC; + UNDISCH_TAC `3 <= p` THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`N:num`; `m:num`; `friend:person->person->bool`; `p - 2`] HAS_SIZE_PATHS) THEN diff --git a/100/heron.ml b/100/heron.ml index 2677749a..af425bba 100644 --- a/100/heron.ml +++ b/100/heron.ml @@ -24,7 +24,7 @@ let SQRT_ELIM_TAC = (* ------------------------------------------------------------------------- *) let HERON = prove - (`!A B C:real^2. + (`!A B C:real^2. let a = dist(C,B) and b = dist(A,C) and c = dist(B,A) in diff --git a/100/minkowski.ml b/100/minkowski.ml index 54937bf2..79f2756d 100644 --- a/100/minkowski.ml +++ b/100/minkowski.ml @@ -72,18 +72,18 @@ let BLICHFELDT = prove ==> ?x y. x IN s /\ y IN s /\ ~(x = y) /\ !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i - y$i)`, SUBGOAL_THEN - `!s:real^N->bool. + `!s:real^N->bool. bounded s /\ measurable s /\ &1 < measure s ==> ?x y. x IN s /\ y IN s /\ ~(x = y) /\ !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i - y$i)` ASSUME_TAC THENL [ALL_TAC; - REPEAT STRIP_TAC THEN - FIRST_ASSUM(MP_TAC o SPEC `measure(s:real^N->bool) - &1` o + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `measure(s:real^N->bool) - &1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] MEASURABLE_INNER_COMPACT)) THEN ASM_REWRITE_TAC[REAL_SUB_LT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN - FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ASM SET_TAC[]]] THEN REPEAT STRIP_TAC THEN @@ -181,22 +181,22 @@ let BLICHFELDT = prove (* The usual form of the theorem. *) (* ------------------------------------------------------------------------- *) -let MINKOWSKI = prove - (`!s:real^N->bool. - convex s /\ - (!x. x IN s ==> (--x) IN s) /\ - &2 pow dimindex(:N) < measure s - ==> ?u. ~(u = vec 0) /\ - (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ - u IN s`, +let MINKOWSKI = prove + (`!s:real^N->bool. + convex s /\ + (!x. x IN s ==> (--x) IN s) /\ + &2 pow dimindex(:N) < measure s + ==> ?u. ~(u = vec 0) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ + u IN s`, SUBGOAL_THEN - `!s:real^N->bool. - convex s /\ - bounded s /\ - (!x. x IN s ==> (--x) IN s) /\ - &2 pow dimindex(:N) < measure s - ==> ?u. ~(u = vec 0) /\ - (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ + `!s:real^N->bool. + convex s /\ + bounded s /\ + (!x. x IN s ==> (--x) IN s) /\ + &2 pow dimindex(:N) < measure s + ==> ?u. ~(u = vec 0) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ u IN s` ASSUME_TAC THENL [ALL_TAC; @@ -206,7 +206,7 @@ let MINKOWSKI = prove ASM_SIMP_TAC[LEBESGUE_MEASURABLE_CONVEX] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN - DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC o SPEC `vec 0:real^N` o + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN FIRST_X_ASSUM(MP_TAC o SPEC `s INTER ball(vec 0:real^N,r)`) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN @@ -219,25 +219,25 @@ let MINKOWSKI = prove MATCH_MP_TAC MEASURABLE_CONVEX THEN SIMP_TAC[BOUNDED_INTER; BOUNDED_BALL] THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL]] THEN - REPEAT STRIP_TAC THEN - MP_TAC(ISPEC `IMAGE (\x:real^N. (&1 / &2) % x) s` BLICHFELDT) THEN - ASM_SIMP_TAC[MEASURABLE_SCALING; MEASURE_SCALING; MEASURABLE_CONVEX; - BOUNDED_SCALING] THEN - REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV; REAL_ABS_NUM] THEN - ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN - REWRITE_TAC[GSYM real_div; REAL_POW_INV] THEN - ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN - REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. (&1 / &2) % x) s` BLICHFELDT) THEN + ASM_SIMP_TAC[MEASURABLE_SCALING; MEASURE_SCALING; MEASURABLE_CONVEX; + BOUNDED_SCALING] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM real_div; REAL_POW_INV] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `inv(&2) % x:real^N = inv(&2) % y <=> x = y`] THEN - REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN - SIMP_TAC[VECTOR_MUL_COMPONENT; GSYM REAL_SUB_LDISTRIB] THEN - MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN - EXISTS_TAC `inv(&2) % (u - v):real^N` THEN - ASM_SIMP_TAC[VECTOR_ARITH `inv(&2) % (u - v):real^N = vec 0 <=> u = v`] THEN - ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN - REWRITE_TAC[VECTOR_SUB; VECTOR_ADD_LDISTRIB] THEN - FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN - ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; GSYM REAL_SUB_LDISTRIB] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN + EXISTS_TAC `inv(&2) % (u - v):real^N` THEN + ASM_SIMP_TAC[VECTOR_ARITH `inv(&2) % (u - v):real^N = vec 0 <=> u = v`] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN + REWRITE_TAC[VECTOR_SUB; VECTOR_ADD_LDISTRIB] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* A slightly sharper variant for use when the set is also closed. *) diff --git a/100/ratcountable.ml b/100/ratcountable.ml index df40ca78..66166b2a 100644 --- a/100/ratcountable.ml +++ b/100/ratcountable.ml @@ -60,9 +60,9 @@ let DENUMERABLE_RATIONALS = prove (* ------------------------------------------------------------------------- *) let DENUMERABLE_RATIONALS_EXPAND = prove - (`?rat:num->real. (!n. rational(rat n)) /\ + (`?rat:num->real. (!n. rational(rat n)) /\ (!x. rational x ==> ?!n. x = rat n)`, MP_TAC DENUMERABLE_RATIONALS THEN REWRITE_TAC[denumerable] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[eq_c] THEN - REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);; diff --git a/100/subsequence.ml b/100/subsequence.ml index 1b4385f7..6861a125 100644 --- a/100/subsequence.ml +++ b/100/subsequence.ml @@ -4,7 +4,7 @@ let lemma = prove (`!f s. s = UNIONS (IMAGE (\a. {x | x IN s /\ f(x) = a}) (IMAGE f s))`, - REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN GEN_TAC THEN + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN GEN_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_IMAGE] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN @@ -15,11 +15,11 @@ let lemma = prove (* ------------------------------------------------------------------------- *) let PIGEONHOLE_LEMMA = prove - (`!f:A->B s n. + (`!f:A->B s n. FINITE s /\ (n - 1) * CARD(IMAGE f s) < CARD s ==> ?t a. t SUBSET s /\ t HAS_SIZE n /\ (!x. x IN t ==> f(x) = a)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN - MP_TAC(ISPECL [`f:A->B`; `s:A->bool`] lemma) THEN DISCH_THEN(fun th -> + MP_TAC(ISPECL [`f:A->B`; `s:A->bool`] lemma) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [th]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT] THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN MATCH_MP_TAC @@ -42,7 +42,7 @@ let PIGEONHOLE_LEMMA = prove (* ------------------------------------------------------------------------- *) let mono_on = define - `mono_on (f:num->real) r s <=> + `mono_on (f:num->real) r s <=> !i j. i IN s /\ j IN s /\ i <= j ==> r (f i) (f j)`;; let MONO_ON_SUBSET = prove @@ -60,7 +60,7 @@ let ERDOS_SZEKERES = prove REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i. i IN (1..m*n+1) - ==> ?k. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE k /\ + ==> ?k. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE k /\ mono_on f (<=) s /\ i IN s /\ (!j. j IN s ==> i <= j)) /\ (!l. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE l /\ mono_on f (<=) s /\ i IN s /\ (!j. j IN s ==> i <= j)) @@ -100,25 +100,25 @@ let ERDOS_SZEKERES = prove MP_TAC THENL [MATCH_MP_TAC PIGEONHOLE_LEMMA THEN REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; ADD_SUB] THEN - MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n * CARD(1..m)` THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n * CARD(1..m)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CARD_NUMSEG_1] THEN ARITH_TAC] THEN - REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->bool` THEN - DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[mono_on] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN - REWRITE_TAC[LE_LT; real_ge] THEN STRIP_TAC THEN + REWRITE_TAC[LE_LT; real_ge] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN - REMOVE_THEN "*" (fun th -> + REMOVE_THEN "*" (fun th -> MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th)) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->bool` STRIP_ASSUME_TAC o CONJUNCT1) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `k + 1` o CONJUNCT2) THEN ASM_SIMP_TAC[ARITH_RULE `~(k + 1 <= k)`; GSYM REAL_NOT_LT] THEN - REWRITE_TAC[CONTRAPOS_THM] THEN + REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN EXISTS_TAC `(i:num) INSERT s` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[HAS_SIZE_CLAUSES; GSYM ADD1] THEN ASM_MESON_TAC[NOT_LT]; diff --git a/100/triangular.ml b/100/triangular.ml index 54777362..138c636e 100644 --- a/100/triangular.ml +++ b/100/triangular.ml @@ -63,7 +63,7 @@ let TRIANGLE_CONVERGES = prove needs "Library/analysis.ml";; -override_interface ("-->",`(tends_num_real)`);; +override_interface ("-->",`(tends_num_real)`);; let TRIANGLE_CONVERGES' = prove (`(\n. sum(1..n) (\k. &1 / &(triangle k))) --> &2`, diff --git a/Arithmetic/arithprov.ml b/Arithmetic/arithprov.ml index ab308ff2..d7d01388 100644 --- a/Arithmetic/arithprov.ml +++ b/Arithmetic/arithprov.ml @@ -311,16 +311,16 @@ let FREEFORM_THM = prove let AXIOM,AXIOM_THM = let th0 = prove - (`((?x p. P (number x) (gform p) /\ ~(x IN FV(p))) <=> + (`((?x p. P (number x) (gform p) /\ ~(x IN FV(p))) <=> (?x p. FREEFORM x p /\ P x p)) /\ ((?x t. P (number x) (gterm t) /\ ~(x IN FVT(t))) <=> (?x t. FREETERM x t /\ P x t))`, - REWRITE_TAC[FREETERM_THM; FREEFORM_THM] THEN CONJ_TAC THEN - REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN - ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[FREETERM_THM; FREEFORM_THM] THEN CONJ_TAC THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN - REWRITE_TAC[UNWIND_THM2; IN_IMAGE] THEN - ASM_MESON_TAC[IN_IMAGE; NUMBER_DENUMBER]) + REWRITE_TAC[UNWIND_THM2; IN_IMAGE] THEN + ASM_MESON_TAC[IN_IMAGE; NUMBER_DENUMBER]) and th1 = prove (`((?p. P(gform p)) <=> (?p. FORM(p) /\ P p)) /\ ((?t. P(gterm t)) <=> (?t. TERM(t) /\ P t))`, @@ -330,7 +330,7 @@ let AXIOM,AXIOM_THM = MESON_TAC[NUMBER_DENUMBER]) in let th = (REWRITE_CONV[GSYM GFORM_INJ] THENC REWRITE_CONV[gform; gterm] THENC - REWRITE_CONV[th0] THENC REWRITE_CONV[th1] THENC + REWRITE_CONV[th0] THENC REWRITE_CONV[th1] THENC REWRITE_CONV[th2] THENC REWRITE_CONV[RIGHT_AND_EXISTS_THM]) (rhs(concl(SPEC `a:form` axiom_CASES))) in @@ -362,7 +362,7 @@ let AXIOM_FORMULA = prove REWRITE_TAC[AXIOM; FREEFORM_THM; FREETERM_THM; FORM_THM; TERM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC(BINDER_CONV SYM_CONV) THEN - REWRITE_TAC[GFORM_CASES; GTERM_CASES; + REWRITE_TAC[GFORM_CASES; GTERM_CASES; GTERM_CASES_ALT; GFORM_CASES_ALT] THEN MESON_TAC[NUMBER_DENUMBER]);; diff --git a/Boyer_Moore/counterexample.ml b/Boyer_Moore/counterexample.ml index 6cd0eec4..bfbdd361 100644 --- a/Boyer_Moore/counterexample.ml +++ b/Boyer_Moore/counterexample.ml @@ -68,18 +68,18 @@ let rec shell_type_match : hol_type -> (hol_type * hol_type) list = if (is_type ty) then let tys,tyargs = dest_type ty in let info = try sys_shell_info tys - with Failure _ -> failwith ("No shell defined for type '" ^ + with Failure _ -> failwith ("No shell defined for type '" ^ (string_of_type ty) ^ "'") in itlist union (map shell_type_match tyargs) [] else - try type_match ty `:num` [] - with Failure _ -> failwith ("Unknown type '" ^ + try type_match ty `:num` [] + with Failure _ -> failwith ("Unknown type '" ^ (string_of_type ty) ^ "' that doesn't match 'num'!");; (*----------------------------------------------------------------------------*) (* HL_rewrite_ground_term : term -> term *) -(* *) +(* *) (* Uses HOL Light's REWRITE_CONV to rewrite a ground term. *) (* The function and accessor definitions are used as rewrite rules. *) (* This reduces valid expressions to `T`. *) @@ -87,19 +87,19 @@ let rec shell_type_match : hol_type -> (hol_type * hol_type) list = let HL_rewrite_ground_term tm = (* ((proof_print_newline) o (proof_print_term) o (proof_print_string "Checking:")) tm ;*) - if (frees tm = []) then + if (frees tm = []) then (* let rules = (union ((flat o defs) ()) (all_accessor_thms ())) *) (* let rules = (union (rewrite_rules ()) (all_accessor_thms ())) *) let numred = try (rhs o concl o NUM_REDUCE_CONV) tm with Failure _ -> tm in if (is_T numred) then numred else - let rew = REWRITE_CONV (union (rewrite_rules ()) (all_accessor_thms ())) + let rew = REWRITE_CONV (union (rewrite_rules ()) (all_accessor_thms ())) in (rhs o concl o rew) tm else failwith ("rewrite_ground_term: free vars in term: " ^ (string_of_term tm));; let HL_rewrite_ground_term' tm = - if (frees tm = []) then + if (frees tm = []) then (* let rules = (union ((flat o defs) ()) (all_accessor_thms ())) *) let rules = (union ((flat o defs) ()) (all_accessor_thms ())) in let arith_rules = [PRE;ADD;MULT;EXP;EVEN;ODD;LE;LT;GE;GT;SUB] in @@ -143,17 +143,17 @@ let random_example : int -> hol_type -> term = let sinfo = sys_shell_info tystr in let ocons = shell_constructors sinfo in let sh_arg_types = shell_arg_types sinfo in - + let arg_type_pairs = zip sh_arg_types typarams in let arg_types_matches = try - itlist (fun (x,y) l -> type_match x y l) arg_type_pairs tyi + itlist (fun (x,y) l -> type_match x y l) arg_type_pairs tyi with Failure _ -> failwith "Shell argument types cannot be matched." in - + let mk_cons_type = fun arglist -> List.fold_left (fun ty i -> mk_type ("fun",[i;ty])) ty' (rev arglist) in let inst_cons = map (fun x,y,_ -> x,map (inst_type arg_types_matches) y) ocons in let mk_cons = fun x,y -> - try let n = num_of_string x in (mk_numeral n),y + try let n = num_of_string x in (mk_numeral n),y with Failure _ -> mk_mconst(x,(mk_cons_type y)),y in let cons = map mk_cons inst_cons in @@ -171,7 +171,7 @@ let random_example : int -> hol_type -> term = else (fst o hd) tcons in fun maxdepth ty -> random_example' maxdepth maxdepth ty;; - + (* print_string "*" ; print_term cconstm ; print_string "*" ; print_type (type_of cconstm); print_newline (); *) (* map (fun x -> print_term x ; print_string ":" ; print_type (type_of x); print_newline()) args ; *) (* print_newline (); *) @@ -188,15 +188,15 @@ let random_grounding maxdepth tm = let counter_check_once maxdepth tm = let tm' = random_grounding maxdepth tm in - let tm'' = HL_rewrite_ground_term tm' in - if (is_T(tm'')) then true else let junk = + let tm'' = HL_rewrite_ground_term tm' in + if (is_T(tm'')) then true else let junk = warn (!proof_printing) ("Found counterexample for " ^ string_of_term(tm) ^ " : " ^ string_of_term(tm')) in - inc_counterexamples() ; false;; + inc_counterexamples() ; false;; let rec counter_check_n maxdepth n tm = if (n<=0) then true else if (counter_check_once maxdepth tm) then counter_check_n maxdepth (n-1) tm else false;; -let counter_check maxdepth tm = +let counter_check maxdepth tm = counter_check_n maxdepth !counter_check_num tm;; diff --git a/Boyer_Moore/environment.ml b/Boyer_Moore/environment.ml index 9dc7a116..91589602 100644 --- a/Boyer_Moore/environment.ml +++ b/Boyer_Moore/environment.ml @@ -67,7 +67,7 @@ let system_defs = ref ([] : (string * (int * (string * thm) list)) list);; (*----------------------------------------------------------------------------*) let new_def th = -try +try (let make_into_eqn th = let tm = concl th in if (is_eq tm) then th @@ -246,10 +246,10 @@ let gen_lemmas () = !system_gen_lemmas;; let rec max_var_depth tm = if (is_var tm) then 1 - else if ((is_numeral tm) - || (is_const tm) + else if ((is_numeral tm) + || (is_const tm) || (is_T tm) || (is_F tm)) then 0 - else try + else try let (f,args) = strip_comb tm in let fn = (fst o dest_const) f in let l = flat [defs_names();all_constructors();all_accessors()] in diff --git a/Boyer_Moore/generalize.ml b/Boyer_Moore/generalize.ml index 1cd3b231..1f7b5b56 100644 --- a/Boyer_Moore/generalize.ml +++ b/Boyer_Moore/generalize.ml @@ -29,7 +29,7 @@ let is_generalizable accessors tm = not ((is_var tm) || (is_explicit_value_template tm) || (is_eq tm) || - (try(mem ((fst o dest_const o fst o strip_comb) tm) accessors) + (try(mem ((fst o dest_const o fst o strip_comb) tm) accessors) with Failure _ -> false));; (*----------------------------------------------------------------------------*) @@ -245,7 +245,7 @@ try in let tm' = itlist (curry mk_disj) (map (lhs o concl) lemmas) tm in let new_vars = distinct_vars (frees tm') (map type_of gen_terms) in let tm'' = subst (lcombinep (new_vars,gen_terms)) tm' - in let countercheck = try counter_check 5 tm'' with Failure _ -> + in let countercheck = try counter_check 5 tm'' with Failure _ -> warn true "Could not generate counter example!" ; true in if (countercheck = true) then let proof th'' = let th' = SPECL gen_terms (GENL new_vars th'') @@ -288,11 +288,11 @@ try ( in let clist = map fst3 ((shell_constructors o sys_shell_info) v_ty) in let conjs = conj_list tm in let check_constructor_eq c v tms = - let res = map (is_constructor_eq c v) tms + let res = map (is_constructor_eq c v) tms in if (mem true res) then true else false in let check_constructor_neq c v tms = - let res = map (is_constructor_neq c v) tms + let res = map (is_constructor_neq c v) tms in if (mem true res) then true else false in let check_constructor c all_constr v tms = @@ -306,16 +306,16 @@ try ( in assoc true reslist ) with Failure _ -> failwith "infer_constructor";; -let get_rec_pos_of_fun f = +let get_rec_pos_of_fun f = try ( (fst o get_def o fst o dest_const) f ) with Failure _ -> 0;; let rec is_in_rec_pos subtm tm = let (op,args) = strip_comb tm - in try ( + in try ( let rec_argn = get_rec_pos_of_fun op - in if ( (el (rec_argn - 1) args) = subtm ) + in if ( (el (rec_argn - 1) args) = subtm ) then true else failwith "" ) with Failure _ -> mem true (map (is_in_rec_pos subtm) args) ;; @@ -329,13 +329,13 @@ try ( let eliminateSelectors tm = try ( - let vars = frees tm + let vars = frees tm in let vars' = filter (not o (fun v -> is_var_in_rec_pos v tm )) vars in if (vars' = []) then tm else let rec find_candidate vars tm = if ( vars = [] ) then failwith "find_candidate" - else let var = (hd vars) in try ( (var,infer_constructor var tm) ) - with Failure _ -> find_candidate (tl vars) tm + else let var = (hd vars) in try ( (var,infer_constructor var tm) ) + with Failure _ -> find_candidate (tl vars) tm in let (var,constr) = find_candidate vars' tm in let v_ty = (fst o dest_type) (type_of var) in let s_info = sys_shell_info v_ty @@ -386,10 +386,10 @@ let is_rec_type tm = try( mem ((fst o dest_type o type_of) tm) (shells()) ) with let is_generalizable_subterm bad tm = (is_rec_type tm) && - not ( (is_var tm) || + not ( (is_var tm) || (is_const tm) || (is_numeral tm) || - (contains_any tm bad) );; + (contains_any tm bad) );; (*----------------------------------------------------------------------------*) (* A set S of terms is called a suitable proposal for some formula phi if each*) @@ -397,7 +397,7 @@ let is_generalizable_subterm bad tm = (* occurs at least twice in phi. *) (* Here gens is assumed to be the generalizable subterms of phi as found by *) (* find_bm_terms. This means that it will contain t' as many times as it was *) -(* found in phi. Therefore, the occurences of t' in gens are equivalent to its*) +(* found in phi. Therefore, the occurences of t' in gens are equivalent to its*) (* occurences in phi. *) (*----------------------------------------------------------------------------*) @@ -412,14 +412,14 @@ let is_eq_suitable t eq = if (not !checksuitableeq) then true else if (not (is_eq eq)) then false else let l,r = dest_eq eq in - if ((is_subterm t r) && (is_subterm t l)) then true + if ((is_subterm t r) && (is_subterm t l)) then true else length(find_bm_terms ((=) t) eq) > 1;; - + let generateProposals tm phi = let rec generateProposals' bad tm phi gens = let p = [] in - if (is_eq tm) + if (is_eq tm) then let (t1,t2) = dest_eq tm in let p1 = (generateProposals' bad t1 phi gens) in let p1' = if (is_suitable_proposal [t1] phi gens) then p1@[[t1]] else p1 @@ -476,14 +476,14 @@ let rec separate f v v' allrpos tm = if (not rpos) then tm else if (tm = v) then v' else (separate f v v' allrpos tm) - in if (is_comb tm) then ( + in if (is_comb tm) then ( let (op,args) = strip_comb tm in let recpos = get_rec_pos_of_fun op - in if ((allrpos) && not (op = `(=)`)) + in if ((allrpos) && not (op = `(=)`)) then (list_mk_comb (op,(map (fun (t,i) -> replace t v v' ((i = recpos) || (recpos = 0))) (number_list args)))) - else if (op = `(=)`) + else if (op = `(=)`) then (list_mk_comb(op,[replace (hd args) v v' true;replace ((hd o tl) args) v v' true])) - else if (op = f) + else if (op = f) then (list_mk_comb (op,(map (fun (t,i) -> replace t v v' (i = recpos)) (number_list args)))) else (list_mk_comb (op,(map (separate f v v' allrpos) args))) ) @@ -492,10 +492,10 @@ let rec separate f v v' allrpos tm = let rec generalized_apart_successfully v v' tm tm' = if (tm' = v') then true - else if (is_eq tm) then ( let (tm1,tm2) = dest_eq tm + else if (is_eq tm) then ( let (tm1,tm2) = dest_eq tm in let (tm1',tm2') = dest_eq tm' - in (generalized_apart_successfully v v' tm1 tm1') - && (generalized_apart_successfully v v' tm2 tm2') ) + in (generalized_apart_successfully v v' tm1 tm1') + && (generalized_apart_successfully v v' tm2 tm2') ) else ( let av = all_variables tm in let av' = all_variables tm' in let varsub = List.combine av av' @@ -504,7 +504,7 @@ let rec generalized_apart_successfully v v' tm tm' = let useful_apart_generalization v v' tm gen = let eqssub = List.combine (all_equations tm) (all_equations gen) in let eqsok = forall (fun (x,y) -> (x=y) || (generalized_apart_successfully v v' x y)) eqssub - in let countercheck = try counter_check 5 gen with Failure s -> + in let countercheck = try counter_check 5 gen with Failure s -> warn true ("Could not generate counter example: " ^ s) ; true in eqsok && (generalized_apart_successfully v v' tm gen) && countercheck;; @@ -514,7 +514,7 @@ let generalize_apart tm = in let dfs = map strip_comb fs in let find_f (op,args) dfs = ( let r = get_rec_pos_of_fun op - in let arg_filter args args' = + in let arg_filter args args' = (let v = el (r-1) args in (is_var v) && (mem v (snd (remove_el r args')))) in let match_filter (op',args') = @@ -530,7 +530,7 @@ let generalize_apart tm = in let restpcs = subtract pcs [f] in let recposs = map get_rec_pos_of_fun restpcs in let recpos = try (find ((<) 0) recposs) with Failure _ -> 0 - in let gen = if (forall (fun x -> (x = 0) || (x = recpos)) recposs) + in let gen = if (forall (fun x -> (x = 0) || (x = recpos)) recposs) then separate f v v' true tm else failwith "not same recpos for all functions" in if (useful_apart_generalization v v' tm gen) then (gen,[v',v]) @@ -544,7 +544,7 @@ let checkgen = ref true;; let generalize_heuristic_aderhold (tm,(ind:bool)) = if (mem tm !my_gen_terms && !checkgen) then failwith "" -else +else try (let ELIM_LEMMA lemma th = let rest = snd (dest_disj (concl th)) @@ -554,9 +554,9 @@ try in let (new_ap_vars,gen_ap_terms) = List.split subs in let (tm'',subs) = try( generalizeCommonSubterms tm' ) with Failure _ -> (tm',[]) in if (tm = tm'') then failwith "" - else let (new_vars,gen_terms) = List.split subs + else let (new_vars,gen_terms) = List.split subs in let lemmas = [] - in let countercheck = try counter_check 5 tm'' with Failure s -> + in let countercheck = try counter_check 5 tm'' with Failure s -> warn true ("Could not generate counter example: " ^ s) ; true in if (countercheck = true) then let proof th'' = let th' = ((SPECL gen_ap_terms) o (GENL new_ap_vars) o @@ -569,7 +569,7 @@ try let generalize_heuristic_ext (tm,(ind:bool)) = if (mem tm !my_gen_terms && !checkgen) then failwith "" -else +else try (let ELIM_LEMMA lemma th = let rest = snd (dest_disj (concl th)) @@ -579,10 +579,10 @@ try in let (tm',subs) = try( generalize_apart tm ) with Failure _ -> (tm,[]) in let (new_ap_vars,gen_ap_terms) = List.split subs in let gen_terms = terms_to_be_generalized tm' - in let _ = check (fun l -> not (l = [])) (gen_ap_terms@gen_terms) + in let _ = check (fun l -> not (l = [])) (gen_ap_terms@gen_terms) in let new_vars = distinct_vars (frees tm') (map type_of gen_terms) in let tm'' = subst (lcombinep (new_vars,gen_terms)) tm' - in let countercheck = try counter_check 5 tm'' with Failure _ -> + in let countercheck = try counter_check 5 tm'' with Failure _ -> warn true "Could not generate counter example!" ; true in if (countercheck = true) then let proof th'' = let th' = ((SPECL gen_ap_terms) o (GENL new_ap_vars) o diff --git a/Boyer_Moore/main.ml b/Boyer_Moore/main.ml index 8197f88e..05c9de02 100644 --- a/Boyer_Moore/main.ml +++ b/Boyer_Moore/main.ml @@ -23,8 +23,8 @@ (*----------------------------------------------------------------------------*) let BOYER_MOORE_FINAL l tm = -my_gen_terms := []; -counterexamples := 0; +my_gen_terms := []; +counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline @@ -42,8 +42,8 @@ try (proof_print_newline ) with Failure _ -> failwith "BOYER_MOORE";; let BOYER_MOORE_MESON l tm = -my_gen_terms := []; -counterexamples := 0; +my_gen_terms := []; +counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline @@ -62,8 +62,8 @@ try (proof_print_newline ) with Failure _ -> failwith "BOYER_MOORE";; let BOYER_MOORE_GEN l tm = -my_gen_terms := []; -counterexamples := 0; +my_gen_terms := []; +counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline @@ -81,8 +81,8 @@ try (proof_print_newline ) with Failure _ -> failwith "BOYER_MOORE";; let BOYER_MOORE_EXT tm = -my_gen_terms := []; -counterexamples := 0; +my_gen_terms := []; +counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline @@ -102,8 +102,8 @@ try (proof_print_newline let BOYER_MOORE_RE l tm = -my_gen_terms := []; -counterexamples := 0; +my_gen_terms := []; +counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline @@ -122,8 +122,8 @@ try (proof_print_newline ) with Failure _ -> failwith "BOYER_MOORE";; let BOYER_MOORE tm = -counterexamples := 0; -my_gen_terms := []; +counterexamples := 0; +my_gen_terms := []; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline @@ -251,9 +251,9 @@ let (BMF_TAC:thm list -> tactic) = setify_heuristic; subst_heuristic; HL_simplify_heuristic l; - use_equality_heuristic; + use_equality_heuristic; generalize_heuristic_ext; - irrelevance_heuristic; + irrelevance_heuristic; induction_heuristic] aslw ) with Failure s -> failwith ("BMF_TAC: " ^ s);; diff --git a/Boyer_Moore/make.ml b/Boyer_Moore/make.ml index b480324d..161f5627 100644 --- a/Boyer_Moore/make.ml +++ b/Boyer_Moore/make.ml @@ -16,7 +16,7 @@ loads "Boyer_Moore/boyer-moore.ml";; let BM = BOYER_MOORE;; (* Pure re-implementation of R.Boulton's work. *) let BME = BOYER_MOORE_EXT;; (* Extended with early termination heuristics and HOL Light features. *) -let BMR = BOYER_MOORE_RE [];; +let BMR = BOYER_MOORE_RE [];; let BMG = BOYER_MOORE_GEN [];; (* Further extended with M.Aderhold's generalization techniques. *) let BMF = BOYER_MOORE_FINAL [];; @@ -145,8 +145,8 @@ let bm_test f tm = let pfpt = (print_term tm ; print_newline() ; proof_printer false) in let (resu,(t1,t2)) = bm_time f tm in let pfpt = proof_printer pfpt in - printf "Proven: %b - Time: %f - Steps: %d - Inductions: %d - Gen terms: %d - Over gens: %d \\\\\n" resu -(t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; + printf "Proven: %b - Time: %f - Steps: %d - Inductions: %d - Gen terms: %d - Over gens: %d \\\\\n" resu +(t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; !my_gen_terms;; (* ------------------------------------------------------------------------- *) @@ -158,7 +158,7 @@ let bm_test2 f tm = let pfpt = (print_term tm ; print_newline() ; proof_printer false) in let (resu,(t1,t2)) = bm_time f tm in let pfpt = proof_printer pfpt in - printf "& %b & %f & %d & %d & %d & %d \\\\\n" resu (t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; + printf "& %b & %f & %d & %d & %d & %d \\\\\n" resu (t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; ();; (* ------------------------------------------------------------------------- *) diff --git a/Boyer_Moore/rewrite_rules.ml b/Boyer_Moore/rewrite_rules.ml index 92cca5c0..289c90e1 100644 --- a/Boyer_Moore/rewrite_rules.ml +++ b/Boyer_Moore/rewrite_rules.ml @@ -334,7 +334,7 @@ let MULTI_DISJ_DISCH (overs,unders) th = try (let th1 = itlist UNDER_DISJ_DISCH unders th in let tm1 = rhs (concl th1) - in let th2 = + in let th2 = if (try(is_T (fst (dest_disj tm1))) with Failure _ -> false) then (CONV_RULE (RAND_CONV (REWR_CONV T_OR)) th1) else if (try(is_F (fst (dest_disj tm1))) with Failure _ -> false) then diff --git a/Boyer_Moore/shells.ml b/Boyer_Moore/shells.ml index 2be2f6ff..d47ec042 100644 --- a/Boyer_Moore/shells.ml +++ b/Boyer_Moore/shells.ml @@ -34,7 +34,7 @@ type shell_info = cases : thm; (* Cases theorem *) distinct : thm list; (* Constructors distinct *) one_one : thm list; (* Constructors one-one *) - struct_conv : conv -> conv};; + struct_conv : conv -> conv};; type shell = Shell of string * shell_info;; @@ -67,7 +67,7 @@ let sys_shell_info name = shell_info !system_shells name;; (* Functions to extract the components of shell information. *) (*----------------------------------------------------------------------------*) let shell_constructors info = info.constructors;; -let shell_accessor_thms info = +let shell_accessor_thms info = ((map snd) o flat o (map thd3) o shell_constructors) info;; let shell_arg_types info = info.arg_types;; diff --git a/Boyer_Moore/struct_equal.ml b/Boyer_Moore/struct_equal.ml index ed4d97df..38233b45 100644 --- a/Boyer_Moore/struct_equal.ml +++ b/Boyer_Moore/struct_equal.ml @@ -255,7 +255,7 @@ let CONJS_CONV = try( let is st th = try(fst(dest_const(rand(concl th))) = st) with Failure _ -> false in let v1 = genvar `:bool` and v2 = genvar `:bool` - in let fthm1 = + in let fthm1 = let th1 = ASSUME (mk_eq(v1,`F`)) in let cnj = mk_conj(v1,v2) in let th1 = DISCH cnj (EQ_MP th1 (CONJUNCT1 (ASSUME cnj))) @@ -264,7 +264,7 @@ try( in let fthm2 = CONV_RULE(ONCE_DEPTH_CONV(REWR_CONV CONJ_SYM)) fthm1 in let fandr th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] fthm1) th in let fandl th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] fthm2) th - in let tthm1 = + in let tthm1 = let th1 = ASSUME (mk_eq(v1,`T`)) in let th2 = SUBS_OCCS [[2],th1] (REFL (mk_conj(v1,v2))) in DISCH (mk_eq(v1,`T`)) (ONCE_REWRITE_RULE [] th2) @@ -321,7 +321,7 @@ let ONE_STEP_RECTY_EQ_CONV (induction,distincts,oneOnes) = EQF_INTRO o EQT_ELIM o (VAR_NOT_EQ_STRUCT_OF_VAR_CONV (induction,distincts,oneOnes)) o mk_neg - in let INJ_REW = GEN_REWRITE_CONV I oneOnes + in let INJ_REW = GEN_REWRITE_CONV I oneOnes (* Deleted empty_rewrites - GEN_REWRITE_CONV different in hol light - hope it works *) in let ths1 = map SPEC_ALL distincts in let ths2 = map (GEN_ALL o EQF_INTRO o NOT_EQ_SYM) ths1 diff --git a/Boyer_Moore/support.ml b/Boyer_Moore/support.ml index 794c2649..d9a819a8 100644 --- a/Boyer_Moore/support.ml +++ b/Boyer_Moore/support.ml @@ -62,7 +62,7 @@ let lcombinep (x,y) = List.combine x y;; let lcount x l = length ( filter ((=) x) l );; -let list_mk_imp (tms,tm) = +let list_mk_imp (tms,tm) = if (tms = []) then tm else try itlist (fun p q -> mk_imp (p,q)) tms tm with Failure _ -> failwith "list_mk_imp";; @@ -75,7 +75,7 @@ let INDUCT_TAC_ thm = MATCH_MP_TAC thm THEN (* Checks whether the elements of a list are all distinct. *) (*--------------------------------------------------------------------------*) -let rec distinct x = +let rec distinct x = if (x = []) then true else not (mem (hd x) (tl x)) && distinct (tl x);; @@ -163,7 +163,7 @@ let rec sort_on_snd l = (*----------------------------------------------------------------------------*) let rec conj_list tm = - try + try (let (tm1,tm2) = dest_conj tm in tm1::(conj_list tm2)) with Failure _ -> [tm];; @@ -191,7 +191,7 @@ let rec disj_list tm = (*----------------------------------------------------------------------------*) let find_bm_terms p tm = - try + try (let rec accum tml p tm = let tml' = if (p tm) then (tm::tml) else tml in ( let args = snd (strip_comb tm) diff --git a/Boyer_Moore/testset/arith.ml b/Boyer_Moore/testset/arith.ml index 8c2c2bee..1aa78872 100644 --- a/Boyer_Moore/testset/arith.ml +++ b/Boyer_Moore/testset/arith.ml @@ -1,4 +1,4 @@ -let mytheory = ref [ +let mytheory = ref [ `m + 0 = m`; `m + (SUC n) = SUC(m + n)`; `m + n = n + m`; diff --git a/Boyer_Moore/waterfall.ml b/Boyer_Moore/waterfall.ml index 0b8910c9..7d4768ad 100644 --- a/Boyer_Moore/waterfall.ml +++ b/Boyer_Moore/waterfall.ml @@ -76,7 +76,7 @@ try let apply_fproof s f tms ths = try ( -(* print_string "Terms:" ; print_newline() ; +(* print_string "Terms:" ; print_newline() ; ignore (map (fun x -> (print_term x ; print_newline())) tms); print_string "Theorems:"; print_newline(); ignore (map (fun x -> (print_thm x ; print_newline())) ths); @@ -168,7 +168,7 @@ let proof_print_tmi (tm,i) = let proof_print_clause cl = if !proof_printing then ( - match cl with + match cl with | Clause_proved thm -> (print_thm thm; print_newline (); cl) | _ -> cl ) @@ -234,10 +234,10 @@ let rec proof_print_clausetree cl = (* is passed to ALL of the heuristics. *) (*----------------------------------------------------------------------------*) -let nth_tail n l = if (n > length l) then [] - else let rec repeattl l i = - if ( i = 0 ) then l - else tl (repeattl l (i-1)) +let nth_tail n l = if (n > length l) then [] + else let rec repeattl l i = + if ( i = 0 ) then l + else tl (repeattl l (i-1)) in repeattl l n;; @@ -267,7 +267,7 @@ let rec filtered_waterfall heuristics warehouse tmi = if (max_var_depth (fst tmi) > 12) then (warn true "Reached maximum depth!" ; Clause tmi) (*failwith "cannot prove"*) else let heurn = try (assoc (fst tmi) warehouse) with Failure _ -> 0 in - let warehouse = (if (heurn > 0) then + let warehouse = (if (heurn > 0) then ( proof_print_string ("Warehouse kicking in! Skipping " ^ string_of_int(heurn) ^ " heuristic(s)") () ; proof_print_newline () ; List.remove_assoc (fst tmi) warehouse) else (warehouse)) in @@ -388,7 +388,7 @@ try( (let (_,tm_bind,ty_bind) = term_match [] patt tm in let (insts,vars) = List.split tm_bind in let f = (SPECL insts) o (GENL vars) o (INST_TYPE ty_bind) - in fun th -> apply_fproof "inst_of" (f o hd) [patt] [th] + in fun th -> apply_fproof "inst_of" (f o hd) [patt] [th] )) with Failure _ -> failwith "inst_of";; (*----------------------------------------------------------------------------*) @@ -451,7 +451,7 @@ let rec insert_into_inst_tree (tm,n) tree = | (No_insts (tm',n')) -> (try ( (let f = inst_of tm' tm in Insts (tm,n,[No_insts (tm',n'),f])) - ) with Failure _ -> try( let f = inst_of tm tm' + ) with Failure _ -> try( let f = inst_of tm tm' in Insts (tm',n',[No_insts (tm,n),f])) with Failure _ -> failwith "insert_into_inst_tree" ) | (Insts (tm',n',insts)) -> @@ -587,12 +587,12 @@ let prove_pool conv tml = let rec WATERFALL heuristics induction (tm,(ind:bool)) = let conv tm = - proof_print_string "Doing induction on:" () ; bm_steps := hash ((+) 1) ((+) 1) !bm_steps ; + proof_print_string "Doing induction on:" () ; bm_steps := hash ((+) 1) ((+) 1) !bm_steps ; let void = proof_print_term tm ; proof_print_newline () in let (tmil,proof) = induction (tm,false) in dec_print_depth (proof - (map (WATERFALL heuristics induction) (inc_print_depth tmil))) + (map (WATERFALL heuristics induction) (inc_print_depth tmil))) in let void = proof_print_newline () in let tree = waterfall heuristics (tm,ind) in let tmil = fringe_of_clause_tree tree @@ -615,7 +615,7 @@ let rec FILTERED_WATERFALL heuristics induction warehouse (tm,(ind:bool)) = let (tmil,proof) = induction (tm,false) in dec_print_depth (proof - (map (FILTERED_WATERFALL heuristics induction ((tm,(length heuristics) + 1)::warehouse)) (inc_print_depth tmil))) + (map (FILTERED_WATERFALL heuristics induction ((tm,(length heuristics) + 1)::warehouse)) (inc_print_depth tmil))) in let void = proof_print_newline () in let tree = filtered_waterfall heuristics [] (tm,ind) (* in let void = proof_print_clausetree tree *) @@ -676,8 +676,8 @@ try (let is_atom tm = in let is_literal tm = (is_atom tm) || ((is_neg tm) && (try (is_atom (rand tm)) with Failure _ -> false)) in let is_clause tm = forall is_literal (disj_list tm) - in let result_string = fun tms -> let s = length tms - in let plural = if (s=1) then "" else "s" + in let result_string = fun tms -> let s = length tms + in let plural = if (s=1) then "" else "s" in ("-> Clausal Form Heuristic (" ^ string_of_int(s) ^ " clause" ^ plural ^ ")") in if (forall is_clause (conj_list tm)) && (not (free_in `T` tm)) && (not (free_in `F` tm)) @@ -691,7 +691,7 @@ try (let is_atom tm = in if (is_T tm') then (proof_print_string_l "-> Clausal Form Heuristic" () ; ([],apply_fproof "clausal_form_heuristic" (fun _ -> EQT_ELIM th) [])) else let tms = conj_list tm' - in (proof_print_string_l (result_string tms) () ; + in (proof_print_string_l (result_string tms) () ; (map (fun tm -> (tm,i)) tms, apply_fproof "clausal_form_heuristic" ((EQ_MP (SYM th)) o LIST_CONJ) tms)) ) with Failure _ -> failwith "clausal_form_heuristic";; diff --git a/Examples/combin.ml b/Examples/combin.ml index 2406b5de..1579bfcc 100644 --- a/Examples/combin.ml +++ b/Examples/combin.ml @@ -7,7 +7,7 @@ (* *) (* http://www.comlab.ox.ac.uk/tom.melham/pub/Camilleri-1992-RID.pdf *) (* ========================================================================= *) - + needs "Examples/reduct.ml";; (* ------------------------------------------------------------------------- *) diff --git a/Examples/cooper.ml b/Examples/cooper.ml index 54cc4bca..13cdcff1 100644 --- a/Examples/cooper.ml +++ b/Examples/cooper.ml @@ -1500,12 +1500,12 @@ time COOPER_CONV &3 divides (&4 * x + z) /\ (x + y + z = &7 * z)`;; -time COOPER_CONV +time COOPER_CONV `?y x. &5 * x + x + x < x \/ (y = &7 - x) /\ &33 + z < x /\ - x + &1 <= &2 * y \/ - &3 divides (&4 * x + z) /\ + x + &1 <= &2 * y \/ + &3 divides (&4 * x + z) /\ (x + y + z = &7 * z)`;; *****) diff --git a/Examples/gcdrecurrence.ml b/Examples/gcdrecurrence.ml index 1ae08965..01437d69 100644 --- a/Examples/gcdrecurrence.ml +++ b/Examples/gcdrecurrence.ml @@ -206,9 +206,9 @@ let pelly = define (!a n. pelly a (n + 2) = 2 * a * pelly a (n + 1) - pelly a (n))`;; let PELLY_INCREASES = prove - (`!a n. ~(a = 0) ==> pelly a n <= pelly a (n + 1)`, + (`!a n. ~(a = 0) ==> pelly a n <= pelly a (n + 1)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN - INDUCT_TAC THEN + INDUCT_TAC THEN ASM_SIMP_TAC[pelly; ARITH; LE_1; ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN TRANS_TAC LE_TRANS `2 * pelly a (n + 1) - pelly a n` THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN diff --git a/Examples/inverse_bug_puzzle_miz3.ml b/Examples/inverse_bug_puzzle_miz3.ml index ece5e80e..d24b90d7 100644 --- a/Examples/inverse_bug_puzzle_miz3.ml +++ b/Examples/inverse_bug_puzzle_miz3.ml @@ -19,7 +19,7 @@ (* ========================================================================= *) needs "Multivariate/determinants.ml";; - + #load "unix.cma";; loadt "miz3/miz3.ml";; diff --git a/Examples/mccarthy.ml b/Examples/mccarthy.ml index 1c771f59..0e894a41 100644 --- a/Examples/mccarthy.ml +++ b/Examples/mccarthy.ml @@ -182,10 +182,10 @@ let UPDATE_SAME = prove *) let CORRECTNESS_THEOREM = prove - (`!e map s s' r. - (!v. map v < r) ==> - (!v. s v = s' (Reg (map v))) ==> - (S' (C e map r) s' Acc = E e s) /\ + (`!e map s s' r. + (!v. map v < r) ==> + (!v. s v = s' (Reg (map v))) ==> + (S' (C e map r) s' Acc = E e s) /\ (!x. (x < r) ==> (S' (C e map r) s' (Reg x) = s' (Reg x)))`, MATCH_MP_TAC exp_INDUCT THEN REWRITE_TAC[E_DEF; S_DEF; S'_DEF; update_def; C_DEF; S'_APPEND] THEN diff --git a/Examples/padics.ml b/Examples/padics.ml index ed4333ac..df577779 100644 --- a/Examples/padics.ml +++ b/Examples/padics.ml @@ -911,7 +911,7 @@ let SIMPLE_PADIC_ARITH_TAC = (MATCH_MP_TAC CONTINUOUS_MAP_PADIC_SUB THEN CONJ_TAC) ORELSE (MATCH_MP_TAC CONTINUOUS_MAP_PADIC_MUL THEN CONJ_TAC) ORELSE (MATCH_MP_TAC CONTINUOUS_MAP_PADIC_NEG)) THEN - REPEAT(GEN_REWRITE_TAC I + REPEAT(GEN_REWRITE_TAC I [CONTINUOUS_MAP_OF_FST; CONTINUOUS_MAP_OF_SND] THEN DISJ2_TAC) THEN REWRITE_TAC[CONTINUOUS_MAP_FST; CONTINUOUS_MAP_SND; diff --git a/Examples/pell.ml b/Examples/pell.ml index 26b21a6e..af48fd5e 100644 --- a/Examples/pell.ml +++ b/Examples/pell.ml @@ -477,8 +477,8 @@ let SOLUTIONS_INDUCTION = prove REWRITE_TAC[MULT_AC] THEN MATCH_MP_TAC(TAUT `(a <=> b) /\ (~a /\ ~b ==> F) ==> a /\ b`) THEN CONJ_TAC THENL - [GEN_REWRITE_TAC LAND_CONV - [SYM(REWRITE_RULE[NOT_SUC] + [GEN_REWRITE_TAC LAND_CONV + [SYM(REWRITE_RULE[NOT_SUC] (SPECL [`x:num`; `y:num`; `SUC 1`] EXP_MONO_LT))] THEN ASM_REWRITE_TAC[ARITH_SUC] THEN REWRITE_TAC[LT_ADD_RCANCEL; LT_MULT_LCANCEL] THEN diff --git a/Examples/sylvester_gallai.ml b/Examples/sylvester_gallai.ml index e854fcff..1f676c73 100644 --- a/Examples/sylvester_gallai.ml +++ b/Examples/sylvester_gallai.ml @@ -93,7 +93,7 @@ let SYLVESTER_GALLAI_LEMMA = prove MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_POW_1_LT THEN SIMP_TAC[ARITH_EQ; REAL_SUB_LE; REAL_ARITH `&1 - x < &1 <=> &0 < x`] THEN - ASM_SIMP_TAC[ARITH_EQ; REAL_LT_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + ASM_SIMP_TAC[ARITH_EQ; REAL_LT_RDIV_EQ; REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) diff --git a/Examples/update_database.ml b/Examples/update_database.ml index 2ecac795..c69c4567 100644 --- a/Examples/update_database.ml +++ b/Examples/update_database.ml @@ -161,7 +161,7 @@ let search = | Comb(Var("",_),Var(pat,_)) -> name_contains pat | Comb(Var("",_),pat) -> exists_subterm_satisfying (aconv pat) | pat -> exists_subterm_satisfying (can (term_match [] pat)) in - fun pats -> + fun pats -> update_database(); let triv,nontriv = partition is_var pats in (if triv <> [] then diff --git a/Formal_ineqs/README.md b/Formal_ineqs/README.md index 472a5e02..15c79953 100644 --- a/Formal_ineqs/README.md +++ b/Formal_ineqs/README.md @@ -1,7 +1,7 @@ A tool for verification of nonlinear inequalities in HOL Light ============ -The most recent version of the tool is available +The most recent version of the tool is available [here](https://github.com/monadius/formal_ineqs). Part of the Flyspeck project: diff --git a/Formal_ineqs/arith/arith_cache.hl b/Formal_ineqs/arith/arith_cache.hl index 738a31df..43f56e92 100644 --- a/Formal_ineqs/arith/arith_cache.hl +++ b/Formal_ineqs/arith/arith_cache.hl @@ -109,34 +109,34 @@ let tm1_tm2_hash tm1 tm2 = (* SUC *) -let raw_suc_conv_hash tm = +let raw_suc_conv_hash tm = let _ = suc_counter := !suc_counter + 1 in (* let _ = suc_list := tm :: !suc_list in *) Arith_num.raw_suc_conv_hash tm;; (* x = 0 *) -let raw_eq0_hash_conv tm = +let raw_eq0_hash_conv tm = let _ = eq0_counter := !eq0_counter + 1 in (* let _ = eq0_list := tm :: !eq0_list in *) Arith_num.raw_eq0_hash_conv tm;; (* PRE *) -let raw_pre_hash_conv tm = +let raw_pre_hash_conv tm = let _ = pre_counter := !pre_counter + 1 in Arith_num.raw_pre_hash_conv tm;; (* x > 0 *) -let raw_gt0_hash_conv tm = +let raw_gt0_hash_conv tm = let _ = gt0_counter := !gt0_counter + 1 in Arith_num.raw_gt0_hash_conv tm;; (* x < y *) -let raw_lt_hash_conv tm = +let raw_lt_hash_conv tm = let _ = lt_counter := !lt_counter + 1 in Arith_num.raw_lt_hash_conv tm;; (* x <= y *) -let raw_le_hash_conv tm = +let raw_le_hash_conv tm = let _ = le_counter := !le_counter + 1 in let hash = op_tm_hash tm in try @@ -147,7 +147,7 @@ let raw_le_hash_conv tm = result;; (* x + y *) -let raw_add_conv_hash tm = +let raw_add_conv_hash tm = let _ = add_counter := !add_counter + 1 in let hash = op_tm_hash tm in try @@ -158,7 +158,7 @@ let raw_add_conv_hash tm = result;; (* x - y *) -let raw_sub_hash_conv tm = +let raw_sub_hash_conv tm = let _ = sub_counter := !sub_counter + 1 in let hash = op_tm_hash tm in try @@ -168,7 +168,7 @@ let raw_sub_hash_conv tm = let _ = my_add sub_table hash result in result;; -let raw_sub_and_le_hash_conv tm1 tm2 = +let raw_sub_and_le_hash_conv tm1 tm2 = let _ = sub_le_counter := !sub_le_counter + 1 in let hash = tm1_tm2_hash tm1 tm2 in try @@ -179,7 +179,7 @@ let raw_sub_and_le_hash_conv tm1 tm2 = result;; (* x * y *) -let raw_mul_conv_hash tm = +let raw_mul_conv_hash tm = let _ = mul_counter := !mul_counter + 1 in let hash = op_tm_hash tm in try @@ -190,7 +190,7 @@ let raw_mul_conv_hash tm = result;; (* x / y *) -let raw_div_hash_conv tm = +let raw_div_hash_conv tm = let _ = div_counter := !div_counter + 1 in let hash = op_tm_hash tm in try @@ -201,11 +201,11 @@ let raw_div_hash_conv tm = result;; (* EVEN, ODD *) -let raw_even_hash_conv tm = +let raw_even_hash_conv tm = let _ = even_counter := !even_counter + 1 in Arith_num.raw_even_hash_conv tm;; -let raw_odd_hash_conv tm = +let raw_odd_hash_conv tm = let _ = odd_counter := !odd_counter + 1 in Arith_num.raw_odd_hash_conv tm;; diff --git a/Formal_ineqs/arith/eval_interval.hl b/Formal_ineqs/arith/eval_interval.hl index 4a935627..74026e22 100644 --- a/Formal_ineqs/arith/eval_interval.hl +++ b/Formal_ineqs/arith/eval_interval.hl @@ -45,7 +45,7 @@ let mk_float_interval_decimal = (* Unary interval operations *) -let unary_interval_operations = +let unary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table `--` (fun pp -> float_interval_neg); @@ -66,7 +66,7 @@ let unary_interval_operations = (* Binary interval operations *) -let binary_interval_operations = +let binary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table `+` float_interval_add; @@ -125,7 +125,7 @@ let eval_constants pp ifun = match f with | Int_decimal_const tm -> Int_const (mk_float_interval_decimal pp tm) | Int_named_const tm -> Int_const (c_find tm pp) - | Int_pow (n,f1) -> + | Int_pow (n,f1) -> (let f1_val = rec_eval f1 in match f1_val with | Int_const th -> Int_const (float_interval_pow pp n th) @@ -166,7 +166,7 @@ let rec build_interval_fun expr_tm = if ltm = amp_op_real then let n = dest_numeral r_tm in Int_const (mk_float_interval_num n) - else + else let r_fun = build_interval_fun r_tm in Int_unary (ltm, r_fun) else @@ -237,7 +237,7 @@ let find_and_replace_all f_list acc = if c1 > 1 then expr, (c1, fs) else find_and_replace f2 i f_list | _ -> f, (0, f_list) in if c > 1 then expr, (c, fs) else f, replace_subexpr f i f_list in - + let rec iterate fs acc = let i = length acc in let expr, (c, fs') = find_and_replace (hd fs) i fs in @@ -268,7 +268,7 @@ let eval_interval_fun_list pp (f_list, refs) vars = (* Approximate the bounds of the given interval with floating point numbers *) let interval_to_float_interval = - let th = (UNDISCH_ALL o prove)(`interval_arith x (lo, hi) ==> + let th = (UNDISCH_ALL o prove)(`interval_arith x (lo, hi) ==> interval_arith lo (a, y) ==> interval_arith hi (z, b) ==> interval_arith x (a, b)`, @@ -286,7 +286,7 @@ let interval_to_float_interval = a_tm, a_var_real; y_tm, y_var_real; z_tm, z_var_real; b_tm, b_var_real] th in (MY_PROVE_HYP int_th o MY_PROVE_HYP th_lo o MY_PROVE_HYP th_hi) th1;; - + (* Adds a new constant approximation to the table of constants *) let add_constant_interval int_th = diff --git a/Formal_ineqs/arith/float_pow.hl b/Formal_ineqs/arith/float_pow.hl index 006c47f5..0fc178da 100644 --- a/Formal_ineqs/arith/float_pow.hl +++ b/Formal_ineqs/arith/float_pow.hl @@ -25,7 +25,7 @@ prioritize_real();; (* Power of a float *) (* ------------------------------------------------ *) -let RULE = UNDISCH_ALL o Arith_nat.NUMERALS_TO_NUM o +let RULE = UNDISCH_ALL o Arith_nat.NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def; GSYM IMP_IMP] o SPEC_ALL;; let float_eq n = SYM (FLOAT_TO_NUM_CONV (mk_float n 0));; @@ -82,19 +82,19 @@ let float_pow_pos_double_hi_th = (th_rule o prove) MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[FLOAT_F_POS]);; let float_pow0_hi = (REWRITE_RULE[float_eq 1] o prove) - (`x pow 0 <= &1`, + (`x pow 0 <= &1`, REWRITE_TAC[real_pow; REAL_LE_REFL]);; let float_pow1_hi = (th_rule o prove) - (`x pow 1 <= x`, + (`x pow 1 <= x`, REWRITE_TAC[REAL_POW_1; REAL_LE_REFL]);; let float_pow2_hi = (th_rule o prove) - (`x * x <= hi ==> x pow 2 <= hi`, + (`x * x <= hi ==> x pow 2 <= hi`, REWRITE_TAC[REAL_POW_2]);; let float_pow_pos_suc_lo_th = (th_rule o prove) - (`float_num F n1 e1 <= float_num F n e pow j /\ + (`float_num F n1 e1 <= float_num F n e pow j /\ lo <= float_num F n e * float_num F n1 e1 /\ SUC j = i ==> lo <= float_num F n e pow i`, STRIP_TAC THEN (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN @@ -112,15 +112,15 @@ let float_pow_pos_double_lo_th = (th_rule o prove) MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[FLOAT_F_POS; REAL_LE_REFL]);; let float_pow0_lo = (th_rule o REWRITE_RULE[float_eq 1] o prove) - (`&1 <= x pow 0`, + (`&1 <= x pow 0`, REWRITE_TAC[real_pow; REAL_LE_REFL]);; let float_pow1_lo = (th_rule o prove) - (`x <= x pow 1`, + (`x <= x pow 1`, REWRITE_TAC[REAL_POW_1; REAL_LE_REFL]);; let float_pow2_lo = (th_rule o prove) - (`lo <= x * x ==> lo <= x pow 2`, + (`lo <= x * x ==> lo <= x pow 2`, REWRITE_TAC[REAL_POW_2]);; let float_pow_neg_even_hi_th = (th_rule o prove) @@ -206,7 +206,7 @@ let float_pow_pos_double_lo pp x_tm t_th = let i_tm = rand (concl double_j) in let mul_lo = float_mul_lo pp t_tm t_tm in let lo_tm = lhand (concl mul_lo) in - let th0 = INST[x_tm, x_var_real; n1_tm, n1_var_num; e1_tm, e1_var_num; + let th0 = INST[x_tm, x_var_real; n1_tm, n1_var_num; e1_tm, e1_var_num; j_tm, j_var_num; lo_tm, lo_var_real; i_tm, i_var_num] float_pow_pos_double_lo_th in MY_PROVE_HYP t_th (MY_PROVE_HYP mul_lo (MY_PROVE_HYP double_j th0));; @@ -435,7 +435,7 @@ let float_interval_pow pp n x_th = let x, low, high = dest_float_interval (concl x_th) in match n with | 0 -> INST[x, x_var_real] float_interval_pow0 - | 1 -> + | 1 -> let th0 = INST[x, x_var_real; low, lo_var_real; high, hi_var_real] float_interval_pow1 in MY_PROVE_HYP x_th th0 | _ -> @@ -447,7 +447,7 @@ let float_interval_pow pp n x_th = let hi = rand (concl hi_th) and lo = lhand (concl lo_th) and n_tm = rand (rand (concl lo_th)) in - let even_n = eval_even n_tm in + let even_n = eval_even n_tm in let th0 = INST[x, x_var_real; low, low_var_real; high, high_var_real; hi, hi_var_real; lo, lo_var_real; n_tm, n_var_num] float_interval_pow_odd in MY_PROVE_HYP even_n (MY_PROVE_HYP lo_th (MY_PROVE_HYP hi_th (MY_PROVE_HYP x_th th0))) diff --git a/Formal_ineqs/docs/FormalVerifier.tex b/Formal_ineqs/docs/FormalVerifier.tex index 5604823e..ad48b1fd 100644 --- a/Formal_ineqs/docs/FormalVerifier.tex +++ b/Formal_ineqs/docs/FormalVerifier.tex @@ -36,7 +36,7 @@ \pagebreak % References \begin{thebibliography}{9} -\bibitem{HOL} HOL Light home page\\ +\bibitem{HOL} HOL Light home page\\ \url{http://www.cl.cam.ac.uk/~jrh13/hol-light} \bibitem{HOL-repo} HOL Light repository\\ @@ -109,8 +109,8 @@ \section{Quick Start} needs "verifier/m_verifier_main.hl";; open M_verifier_main;; -let ineq = - `-- &1 / sqrt(&3) <= x /\ x <= sqrt(&2) /\ +let ineq = + `-- &1 / sqrt(&3) <= x /\ x <= sqrt(&2) /\ -- sqrt(pi) <= y /\ y <= &1 ==> x pow 2 * y - x * y pow 4 + y pow 6 - &7 + x pow 4 > -- #7.17995`;; @@ -184,9 +184,9 @@ \section{Verification Functions}\label{verification} The conclusion of the returned theorem is not exactly the same as the third parameter of the verification function: the order of bounds of variables may be altered and variables which are not used in the inequality are eliminated. For example, commands \begin{verbatim} -let th1, _ = verify_ineq default_params 3 +let th1, _ = verify_ineq default_params 3 `&1 <= y /\ y <= &2 /\ &1 <= x /\ x <= &3 ==> x + y < &6`;; -let th2, _ = verify_ineq default_params 3 +let th2, _ = verify_ineq default_params 3 `&1 <= y /\ y <= &2 /\ &1 <= x /\ x <= &3 ==> y < &3`;; \end{verbatim} return @@ -203,7 +203,7 @@ \section{Global Options}\label{global} \begin{enumerate} % base -\item[\bf base] Determines the base for representing natural numbers. Default HOL Light +\item[\bf base] Determines the base for representing natural numbers. Default HOL Light representation of natural numbers is binary (i.e., its base is 2). A higher base increases speed of arithmetic operations but it also requires more memory to remember additional theorems. The default value of the base is \verb|100|. To set a new base, use the command \verb|Arith_options.base := 200;;| @@ -274,7 +274,7 @@ \section{Additional Examples} \end{eqnarray*} % rd -\item[\bf rd] +\item[\bf rd] \begin{eqnarray*} &-36.7126907 < -x_1 + 2 x_2 - x_3 - 0.835634534\, x_2 (1 + x_2)\\ &(x_1, x_2, x_3) \in [(-5,-5,-5),(5,5,5)] diff --git a/Formal_ineqs/examples.hl b/Formal_ineqs/examples.hl index 8b9660ef..d0a0f470 100644 --- a/Formal_ineqs/examples.hl +++ b/Formal_ineqs/examples.hl @@ -54,8 +54,8 @@ let test4 () = (* A polynomial approximation of atn *) (* Taken from: *) -(* Marc Daumas, David Lester, and César Muñoz, - Verified real number calculations: A library for interval arithmetic, +(* Marc Daumas, David Lester, and César Muñoz, + Verified real number calculations: A library for interval arithmetic, IEEE Transactions on Computers, Volume 58, Number 2, 2009. *) let test5 () = let ineq1 = `-- &1 / &30 <= x /\ x <= &1 / &30 ==> x * (&1 - (x * x) * (&11184811 / &33554432 - (x * x) * (&13421773 / &67108864))) - atn x < #0.1 pow 7` in @@ -64,7 +64,7 @@ let test5 () = verify_ineq default_params 5 ineq2];; let test5_abs () = - let ineq_abs = `-- &1 / &30 <= x /\ x <= &1 / &30 + let ineq_abs = `-- &1 / &30 <= x /\ x <= &1 / &30 ==> abs (x * (&1 - (x * x) * (&11184811 / &33554432 - (x * x) * (&13421773 / &67108864))) - atn x) < #0.1 pow 7` in [verify_ineq default_params 10 ineq_abs];; diff --git a/Formal_ineqs/examples_flyspeck.hl b/Formal_ineqs/examples_flyspeck.hl index bd38104f..33d2a8ef 100644 --- a/Formal_ineqs/examples_flyspeck.hl +++ b/Formal_ineqs/examples_flyspeck.hl @@ -113,39 +113,39 @@ let h0 = new_definition `h0 = #1.26`;; let lfun = new_definition `lfun h = (h0 - h)/(h0 - &1)`;; (* lfun_y1 *) -let lfun_y1 = new_definition `lfun_y1 (y1:real) (y2:real) (y3:real) +let lfun_y1 = new_definition `lfun_y1 (y1:real) (y2:real) (y3:real) (y4:real) (y5:real) (y6:real) = lfun y1`;; (* num1 *) let num1 = new_definition `num1 e1 e2 e3 a2 b2 c2 = - -- &4*((a2 pow 2) *e1 + &8*(b2 - c2)*(e2 - e3) - + -- &4*((a2 pow 2) *e1 + &8*(b2 - c2)*(e2 - e3) - a2*(&16*e1 + ( b2 - &8 )*e2 + (c2 - &8)*e3))`;; (* unit6 *) let unit6 = define `unit6 x1 x2 x3 x4 x5 x6 = &1`;; (* arc_hhn *) -let arc_hhn' = new_definition `arc_hhn' = +let arc_hhn' = new_definition `arc_hhn' = arclength' (&2 * h0) (&2 * h0) (&2)`;; (* arclength_y1 *) -let arclength_y1' = new_definition - `arclength_y1' a b +let arclength_y1' = new_definition + `arclength_y1' a b (y1:real) (y2:real) (y3:real) (y4:real) (y5:real) (y6:real) = arclength' y1 a b`;; (* arclength_x1 *) -let arclength_x1' = new_definition - `arclength_x1' a b x1 x2 x3 x4 x5 x6 = +let arclength_x1' = new_definition + `arclength_x1' a b x1 x2 x3 x4 x5 x6 = arclength_y1' a b (sqrt x1) (sqrt x2) (sqrt x3) (sqrt x4) (sqrt x5) (sqrt x6)`;; (* arclength_x_123 *) -let arclength_x_123' = new_definition `arclength_x_123' (x1:real) (x2:real) (x3:real) (x4:real) (x5:real) (x6:real) = +let arclength_x_123' = new_definition `arclength_x_123' (x1:real) (x2:real) (x3:real) (x4:real) (x5:real) (x6:real) = arclength' (sqrt x1) (sqrt x2) (sqrt x3)`;; - -(* acs_sqrt_x1_d4 *) -let acs_sqrt_x1_d4 = new_definition `acs_sqrt_x1_d4 (x1:real) (x2:real) (x3:real) (x4:real) (x5:real) (x6:real) = + +(* acs_sqrt_x1_d4 *) +let acs_sqrt_x1_d4 = new_definition `acs_sqrt_x1_d4 (x1:real) (x2:real) (x3:real) (x4:real) (x5:real) (x6:real) = acs (sqrt(x1)/ &4)`;; let sqrt_x1 = define `sqrt_x1 x1 x2 x3 x4 x5 x6 = sqrt x1`;; @@ -198,7 +198,7 @@ let add_example ex = add_example {id = "2485876245a"; difficulty = Easy; ineq_tm = `ineq - [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #6.3504; + [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #6.3504; #3.0 * #3.0, x5, #2.0 * #2.52 * #2.0 * #2.52; #4.0,x6, #6.3504] (delta_x4 x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; @@ -207,7 +207,7 @@ add_example {id = "2485876245a"; add_example {id = "4559601669b"; difficulty = Easy; ineq_tm = `ineq - [ #4.0,x1, #6.3504; #4.0,x2, #4.0; #4.0,x3, #6.3504; + [ #4.0,x1, #6.3504; #4.0,x2, #4.0; #4.0,x3, #6.3504; #3.01 * #3.01, x4, #3.01 * #3.01; #4.0, x5, #6.3504; #4.0,x6, #4.0] (delta_x4 x1 x2 x3 x4 x5 x6 < &0)`};; @@ -215,8 +215,8 @@ add_example {id = "4559601669b"; (* 5512912661 *) add_example {id = "5512912661"; difficulty = Easy; - ineq_tm = `ineq [&1,x1,&1 + (pi * const1') / pi; &1,x2,&1 + (pi * const1') / pi; - &1, x3, &1 + (pi * const1') / pi; #2.38 * #2.38, x4, #3.01 * #3.01; + ineq_tm = `ineq [&1,x1,&1 + (pi * const1') / pi; &1,x2,&1 + (pi * const1') / pi; + &1, x3, &1 + (pi * const1') / pi; #2.38 * #2.38, x4, #3.01 * #3.01; &2 * &2, x5, #2.52 * #2.52; #3.15 / #1.26 * #3.15 / #1.26,x6, #15.53] (num1 x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; @@ -224,8 +224,8 @@ add_example {id = "5512912661"; (* 6843920790 *) add_example {id = "6843920790"; difficulty = Easy; - ineq_tm = `ineq [&1,x1,&1 + (pi * const1') / pi; &1,x2,&1 + (pi * const1') / pi; - &1, x3, &1 + (pi * const1') / pi; &2 / #1.26 * &2 / #1.26, x4, #3.01 * #3.01; + ineq_tm = `ineq [&1,x1,&1 + (pi * const1') / pi; &1,x2,&1 + (pi * const1') / pi; + &1, x3, &1 + (pi * const1') / pi; &2 / #1.26 * &2 / #1.26, x4, #3.01 * #3.01; #2.38 * #2.38, x5, #15.53; #2.38 * #2.38,x6, #15.53] (num1 x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; @@ -245,8 +245,8 @@ add_example {id = "6096597438a"; add_example {id = "4717061266"; difficulty = Easy; ineq_tm = `ineq - [ #4.0,x1, #2.0 * #1.26 * #2.0 * #1.26; #4.0, x2, #2.0 * #1.26 * #2.0 * #1.26; - #4.0, x3, #2.0 * #1.26 * #2.0 * #1.26; #4.0,x4, #2.0 * #1.26 * #2.0 * #1.26; + [ #4.0,x1, #2.0 * #1.26 * #2.0 * #1.26; #4.0, x2, #2.0 * #1.26 * #2.0 * #1.26; + #4.0, x3, #2.0 * #1.26 * #2.0 * #1.26; #4.0,x4, #2.0 * #1.26 * #2.0 * #1.26; #4.0, x5, #2.0 * #1.26 * #2.0 * #1.26; #4.0,x6, #2.0 * #1.26 * #2.0 * #1.26] (delta_x x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; @@ -254,7 +254,7 @@ add_example {id = "4717061266"; (* SDCCMGA b *) add_example {id = "SDCCMGA b"; difficulty = Easy; - ineq_tm = `ineq [ #4.0,x1, #6.3504; &1 * &1,x2,&1 * &1; &1 * &1,x3,&1 * &1; + ineq_tm = `ineq [ #4.0,x1, #6.3504; &1 * &1,x2,&1 * &1; &1 * &1,x3,&1 * &1; &1 * &1, x4, &1 * &1; &1 * &1, x5, &1 * &1; &1 * &1,x6,&1 * &1] (arclength_x1' #2.0 ( #2.0 * #1.26) x1 x2 x3 x4 x5 x6 + arclength_x1' #2.0 ( #2.0 * #1.26) x1 x2 x3 x4 x5 x6 + @@ -267,7 +267,7 @@ add_example {id = "SDCCMGA b"; add_example {id = "TSKAJXY-TADIAMB"; difficulty = Medium; ineq_tm = `ineq - [ #2.0 * #1.3254 * #2.0 * #1.3254,x1, #8.0; #2.0 * #1.3254 * #2.0 * #1.3254, x2, #8.0; + [ #2.0 * #1.3254 * #2.0 * #1.3254,x1, #8.0; #2.0 * #1.3254 * #2.0 * #1.3254, x2, #8.0; #4.0,x3, #8.0; #4.0, x4, #8.0; #4.0,x5, #8.0; #4.0,x6, #8.0] ((unit6 x1 x2 x3 x4 x5 x6 * #2.0) * (delta_x x1 x2 x3 x4 x5 x6 * &4) < rho_x x1 x2 x3 x4 x5 x6)`};; @@ -275,7 +275,7 @@ add_example {id = "TSKAJXY-TADIAMB"; (* 7067938795 *) add_example {id = "7067938795"; difficulty = Medium; - ineq_tm = `ineq [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #4.0; + ineq_tm = `ineq [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #4.0; #3.01 * #3.01, x5, #3.24 * #3.24; #3.01 * #3.01,x6, #3.24 * #3.24] (dih_x' x1 x2 x3 x4 x5 x6 + unit6 x1 x2 x3 x4 x5 x6 * pi * --(&1 / #2.0) + @@ -286,7 +286,7 @@ add_example {id = "7067938795"; add_example { id = "5490182221"; difficulty = Medium; ineq_tm = `ineq - [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #6.3504; + [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #6.3504; #4.0, x5, #6.3504; #4.0,x6, #6.3504] (dih_x' x1 x2 x3 x4 x5 x6 + unit6 x1 x2 x3 x4 x5 x6 * -- #1.893 < &0)`};; @@ -298,9 +298,9 @@ add_example { id = "3318775219"; ineq_tm = `ineq [&2, y1, #2.52; &2, y2, #2.52; &2, y3, #2.52; #2.52, y4, sqrt(&8); &2, y5, #2.52; &2, y6, #2.52] - ( ((dih_y' y1 y2 y3 y4 y5 y6) - #1.629 + + ( ((dih_y' y1 y2 y3 y4 y5 y6) - #1.629 + (#0.414 * (y2 + y3 + y5 + y6 - #8.0)) - - (#0.763 * (y4 - #2.52)) - + (#0.763 * (y4 - #2.52)) - (#0.315 * (y1 - #2.0))) * (-- &1) < &0)`};; diff --git a/Formal_ineqs/examples_other.hl b/Formal_ineqs/examples_other.hl index 0ebc6cf2..0001d7c9 100644 --- a/Formal_ineqs/examples_other.hl +++ b/Formal_ineqs/examples_other.hl @@ -10,7 +10,7 @@ Verifier_options.info_print_level := 2;; open M_verifier_main;; -verify_ineq default_params 5 +verify_ineq default_params 5 `&0 <= x /\ x <= &1 ==> exp (x pow 3) < &3`;; verify_ineq default_params 5 @@ -19,7 +19,7 @@ verify_ineq default_params 5 (* MetiTarski home page *) verify_ineq default_params 5 - `&0 <= x /\ x <= #1.46 / &10 pow 6 ==> + `&0 <= x /\ x <= #1.46 / &10 pow 6 ==> (#64.42 * sin(#1.71 * &10 pow 6 * x) - #21.08 * cos(#1.71 * &10 pow 6 * x)) * exp(#9.05 * &10 pow 5 * x) + #24.24 * exp(-- #1.86 * &10 pow 6 * x) > &0`;; @@ -30,6 +30,6 @@ verify_ineq default_params 5 verify_ineq default_params 5 `#0.35 <= t /\ t <= &10 /\ &0 <= v /\ v <= &10 ==> - ((#1.565 + #0.313 * v) * cos(#1.16 * v) + + ((#1.565 + #0.313 * v) * cos(#1.16 * v) + (#0.01340 + #0.00268 * v) * sin(#1.16 * t)) * exp(-- #1.34 * t) - (#6.55 + #1.31 * v) * exp(-- #0.318 * t) + v + &10 > &0`;; diff --git a/Formal_ineqs/examples_poly.hl b/Formal_ineqs/examples_poly.hl index 3ab03c92..df076201 100644 --- a/Formal_ineqs/examples_poly.hl +++ b/Formal_ineqs/examples_poly.hl @@ -1,7 +1,7 @@ (* Multivariate polynomial inequalities *) (* Examples are taken from the paper: - César Muñoz and Anthony Narkawicz, - Formalization of a Representation of Bernstein Polynomials and Applications to Global Optimization, + César Muñoz and Anthony Narkawicz, + Formalization of a Representation of Bernstein Polynomials and Applications to Global Optimization, Journal of Automated Reasoning, DOI: 10.1007/s10817-012-9256-3 http://shemesh.larc.nasa.gov/people/cam/Bernstein/ *) @@ -39,13 +39,13 @@ open M_verifier_main;; (* Data *) (* Polynomials *) -let schwefel_poly = `(x1 - x2 pow 2) pow 2 + (x2 - &1) pow 2 + +let schwefel_poly = `(x1 - x2 pow 2) pow 2 + (x2 - &1) pow 2 + (x1 - x3 pow 2) pow 2 + (x3 - &1) pow 2` and rd_poly = `-- x1 + &2 * x2 - x3 - #0.835634534 * x2 * (&1 + x2)` and - caprasse_poly = `-- x1 * x3 pow 3 + &4 * x2 * x3 pow 2 * x4 + - &4 * x1 * x3 * x4 pow 2 + &2 * x2 * x4 pow 3 + &4 * x1 * x3 + &4 * x3 pow 2 - + caprasse_poly = `-- x1 * x3 pow 3 + &4 * x2 * x3 pow 2 * x4 + + &4 * x1 * x3 * x4 pow 2 + &2 * x2 * x4 pow 3 + &4 * x1 * x3 + &4 * x3 pow 2 - &10 * x2 * x4 - &10 * x4 pow 2 + &2` and lv_poly = `x1 * x2 pow 2 + x1 * x3 pow 2 + x1 * x4 pow 2 - #1.1 * x1 + &1` and @@ -57,7 +57,7 @@ let schwefel_poly = `(x1 - x2 pow 2) pow 2 + (x2 - &1) pow 2 + &2 * x5 pow 2 + &2 * x6 pow 2 + &2 * x7 pow 2 - x1` and heart_poly = `-- x1 * x6 pow 3 + &3 * x1 * x6 * x7 pow 2 - x3 * x7 pow 3 + - &3 * x3 * x7 * x6 pow 2 - x2 * x5 pow 3 + &3 * x2 * x5 * x8 pow 2 - x4 * x8 pow 3 + + &3 * x3 * x7 * x6 pow 2 - x2 * x5 pow 3 + &3 * x2 * x5 * x8 pow 2 - x4 * x8 pow 3 + &3 * x4 * x8 * x5 pow 2 - #0.9563453`;; (* Minimal values *) @@ -130,7 +130,7 @@ let test_heart () = verify_ineq {default_params with eps = 1e-10} 5 heart_ineq;; let run_tests () = - [test_schwefel(); test_rd(); test_caprasse(); test_lv(); + [test_schwefel(); test_rd(); test_caprasse(); test_lv(); test_butcher(); test_magnetism(); test_heart()];; let results () = diff --git a/Formal_ineqs/informal/informal_atn.hl b/Formal_ineqs/informal/informal_atn.hl index 762d1473..170b3500 100644 --- a/Formal_ineqs/informal/informal_atn.hl +++ b/Formal_ineqs/informal/informal_atn.hl @@ -69,14 +69,14 @@ let rec x_pow_over_fact x k = x /. (float_of_int k) *. x_pow_over_fact x (k - 1);; (* Computes i such that x^(2 * i + 1) / (2 * i + 1) <= base^(-(p + 1)) and cond(i) *) -let n_of_p_atn x pp cond = +let n_of_p_atn x pp cond = let t = (float_of_int Informal_nat.arith_base) ** (float_of_int (-pp - 1)) in let rec try_i i = let _ = if i > 50 then failwith "n_of_p_atn: cannot find i" else () in if cond i then let d = float_of_int (2 * i + 1) in let r = (x ** d) /. d in - if r <= t then i else try_i (i + 1) + if r <= t then i else try_i (i + 1) else try_i (i + 1) in diff --git a/Formal_ineqs/informal/informal_eval_interval.hl b/Formal_ineqs/informal/informal_eval_interval.hl index 98b91f35..5a70ccca 100644 --- a/Formal_ineqs/informal/informal_eval_interval.hl +++ b/Formal_ineqs/informal/informal_eval_interval.hl @@ -32,7 +32,7 @@ let mk_float_interval_decimal pp decimal_tm = (* Unary interval operations *) -let unary_interval_operations = +let unary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table "real_neg" (fun pp -> neg_interval); @@ -53,7 +53,7 @@ let unary_interval_operations = (* Binary interval operations *) -let binary_interval_operations = +let binary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table "real_add" add_interval; @@ -131,7 +131,7 @@ let eval_constants = match f with | Int_decimal_const tm -> Int_const (mk_float_interval_decimal pp tm) | Int_named_const name -> Int_const (c_find name pp) - | Int_pow (n, f1) -> + | Int_pow (n, f1) -> (let f1_val = rec_eval f1 in match f1_val with | Int_const int -> Int_const (pow_interval pp n int) @@ -174,7 +174,7 @@ let build_interval_fun = if ltm = amp_op_real then let n = dest_numeral r_tm in Int_const (mk_num_interval n) - else + else let r_fun = rec_build r_tm in Int_unary ((fst o dest_const) ltm, r_fun) else @@ -244,7 +244,7 @@ let find_and_replace_all f_list acc = if c1 > 1 then expr, (c1, fs) else find_and_replace f2 i f_list | _ -> f, (0, f_list) in if c > 1 then expr, (c, fs) else f, replace_subexpr f i f_list in - + let rec iterate fs acc = let i = length acc in let expr, (c, fs') = find_and_replace (hd fs) i fs in @@ -281,7 +281,7 @@ let interval_to_float_interval pp int_th = let a, _ = dest_interval int_lo and _, b = dest_interval int_hi in mk_interval (a, b);; - + (* Adds a new constant approximation to the table of constants *) let add_constant_interval int_th = diff --git a/Formal_ineqs/informal/informal_exp.hl b/Formal_ineqs/informal/informal_exp.hl index b4fccf68..4a1ab749 100644 --- a/Formal_ineqs/informal/informal_exp.hl +++ b/Formal_ineqs/informal/informal_exp.hl @@ -47,13 +47,13 @@ let rec x_pow_over_fact x k = x /. (float_of_int k) *. x_pow_over_fact x (k - 1);; (* Computes i such that x^i / i! <= base^(-(p + 1)) and cond(i) *) -let n_of_p_exp x pp cond = +let n_of_p_exp x pp cond = let t = (float_of_int Informal_nat.arith_base) ** (float_of_int (-pp - 1)) in let rec try_i i = let _ = if i > 50 then failwith "n_of_p_exp: cannot find i" else () in if cond i then let r = x_pow_over_fact x i in - if r <= t then i else try_i (i + 1) + if r <= t then i else try_i (i + 1) else try_i (i + 1) in diff --git a/Formal_ineqs/informal/informal_float.hl b/Formal_ineqs/informal/informal_float.hl index 418841ed..9e76ce44 100644 --- a/Formal_ineqs/informal/informal_float.hl +++ b/Formal_ineqs/informal/informal_float.hl @@ -73,7 +73,7 @@ let print_ifloat_fmt fmt (s, n, e) = let k = e - min_exp in let n_str = string_of_num (dest_nat n) in let s_str = if s then "-" else "" in - let str = + let str = if k = 0 then Printf.sprintf "%s%s" s_str n_str else @@ -84,7 +84,7 @@ let print_ifloat = print_ifloat_fmt Format.std_formatter;; (* Creates a floating-point value *) -let mk_float n e : ifloat = +let mk_float n e : ifloat = if n < 0 then true, mk_nat (minus_num (Int n)), e + min_exp else @@ -110,7 +110,7 @@ let num_of_ifloat = let r = (dest_nat n) */ (b **/ Int (e - min_exp)) in if s then minus_num r else r;; -let float_of_ifloat f = +let float_of_ifloat f = let n = num_of_ifloat f in let a = approx_num_exp 30 n in float_of_string a;; @@ -220,7 +220,7 @@ let neg_float (s,n,e) = (not s, n, e);; (* abs *) let abs_float (_,n,e) = (false, n, e);; - + (* lt0, gt0 *) @@ -247,7 +247,7 @@ let lt_float (s1,n1,e1) (s2,n2,e2) = if not s1 then if s2 then false else num_exp_lt (n1,e1) (n2,e2) else - if s2 then num_exp_lt (n2,e2) (n1,e1) + if s2 then num_exp_lt (n2,e2) (n1,e1) else (* TF *) if eq0_nat n1 then gt0_nat n2 else true;; @@ -262,8 +262,8 @@ let le_float (s1,n1,e1) (s2,n2,e2) = (* FT *) if eq0_nat n2 then eq0_nat n1 else false;; - - + + (* min, max *) let min_float f1 f2 = @@ -406,7 +406,7 @@ let add_float_hi pp (s1,n1,e1) (s2,n2,e2) = else let n, e'' = lo_nat pp n' in (true, n, e' + e'');; - + (* sub *) @@ -445,7 +445,7 @@ let rec sqrt_float_hi pp (s,n1,e1) = let x = (big_int_of_num o dest_nat o denormalize_nat) (n1, p2) in let f1' = Big_int.sqrt_big_int x in let f1 = (mk_nat o num_of_big_int) f1' in - let n, e' = + let n, e' = let ( * ) = Big_int.mult_big_int and (==) = Big_int.eq_big_int in hi_nat pp (if f1' * f1' == x then f1 else suc_nat f1) in @@ -488,7 +488,7 @@ let pow_float_pos_lo pp n (x : ifloat) = mul_float_lo pp x t in let _ = assert (n >= 0) in pow n;; - + let pow_float_hi pp n x = match n with | 0 -> float1 diff --git a/Formal_ineqs/informal/informal_interval.hl b/Formal_ineqs/informal/informal_interval.hl index 951cfef6..8d890ad5 100644 --- a/Formal_ineqs/informal/informal_interval.hl +++ b/Formal_ineqs/informal/informal_interval.hl @@ -107,7 +107,7 @@ let sqrt_interval pp (lo,hi) = (sqrt_float_lo pp lo, sqrt_float_hi pp hi);; (* mul *) -let mul_interval pp (l_lo,l_hi) (r_lo,r_hi) = +let mul_interval pp (l_lo,l_hi) (r_lo,r_hi) = let s1 = sign_float l_lo and s2 = sign_float l_hi and s3 = sign_float r_lo and @@ -148,7 +148,7 @@ let mul_interval pp (l_lo,l_hi) (r_lo,r_hi) = (mul_float_lo pp lo1 lo2, mul_float_hi pp hi1 hi2);; (* div *) -let div_interval pp (l_lo,l_hi) (r_lo,r_hi) = +let div_interval pp (l_lo,l_hi) (r_lo,r_hi) = let s1 = sign_float l_lo and s2 = sign_float l_hi and s3 = sign_float r_lo and @@ -216,7 +216,7 @@ let le_interval x (lo, hi) = le_float x lo;; let ge_interval x (lo, hi) = le_float hi x;; (* compare_interval *) -let compare_interval x (lo, hi) = +let compare_interval x (lo, hi) = if le_float x lo then -1 else if le_float hi x then 1 else 0;; @@ -235,7 +235,7 @@ open Informal_interval;; #install_printer print_float;; #install_printer print_interval;; - + let pp = 3;; let n = 41;; let mk_test a b = mk_interval (mk_float a 0, mk_float b 0);; diff --git a/Formal_ineqs/informal/informal_matan.hl b/Formal_ineqs/informal/informal_matan.hl index b8a38c52..0d173902 100644 --- a/Formal_ineqs/informal/informal_matan.hl +++ b/Formal_ineqs/informal/informal_matan.hl @@ -117,7 +117,7 @@ let dmatan_interval = let ddmatan_interval = let v = mk_float_interval_decimal 20 `#0.65` in let v0 = mk_small_num_interval 1 in - let vs = Array.init 20 + let vs = Array.init 20 (fun i -> if i = 0 then v0 else round_interval i v) in fun pp x -> let lo, _ = dest_interval x in @@ -154,7 +154,7 @@ let f = Eval_interval.build_interval_fun `&1 + &3`;; Eval_interval.eval_interval_fun 3 f [] [];; let mk_intervals pp a b = - let inf_mk tm = + let inf_mk tm = let f = Informal_eval_interval.build_interval_fun tm in Informal_eval_interval.eval_interval_fun pp f [] [] in let mk tm = @@ -200,7 +200,7 @@ let ddcheck pp (x, x_th) = ddcheck 3 (List.nth test_ints2 4);; - - + + *) diff --git a/Formal_ineqs/informal/informal_nat.hl b/Formal_ineqs/informal/informal_nat.hl index 0f493349..0c6a967b 100644 --- a/Formal_ineqs/informal/informal_nat.hl +++ b/Formal_ineqs/informal/informal_nat.hl @@ -56,11 +56,11 @@ type nat = big_int;; let arith_base = !Arith_options.base;; -let mk_nat n = +let mk_nat n = let result = big_int_of_num n in if sign_big_int result < 0 then zero_big_int else result;; -let mk_small_nat n = +let mk_small_nat n = if n < 0 then zero_big_int else big_int_of_int n;; let dest_nat = num_of_big_int;; @@ -69,7 +69,7 @@ let eq_nat = eq_big_int;; let suc_nat = succ_big_int;; -let pre_nat n = +let pre_nat n = let result = pred_big_int n in if sign_big_int result < 0 then zero_big_int else result;; @@ -114,7 +114,7 @@ let normalize_nat = (n, e) else normalize q (succ e) in - fun n -> + fun n -> if sign_big_int n = 0 then (n, 0) else normalize n 0;; @@ -125,7 +125,7 @@ let denormalize_nat (n, e) = let lo_nat pp = let max = power_int_positive_int arith_base pp in let rec lo m e = - if lt_big_int m max then + if lt_big_int m max then (m, e) else let q = div_big_int m base_nat in diff --git a/Formal_ineqs/informal/informal_poly.hl b/Formal_ineqs/informal/informal_poly.hl index 2a8cbf07..276afb7e 100644 --- a/Formal_ineqs/informal/informal_poly.hl +++ b/Formal_ineqs/informal/informal_poly.hl @@ -35,10 +35,10 @@ let rec eval_interval_poly_f pp cs x_int = let r = eval_interval_poly_f pp rest x_int in add_interval pp first (mul_interval pp x_int r);; -let rec eval_high_poly_f_pos_pos = +let rec eval_high_poly_f_pos_pos = let zero = mk_small_num_float 0 in - let check_pos c = - if le_interval zero c then () + let check_pos c = + if le_interval zero c then () else failwith "Informal_poly.eval_high_poly_f_pos_pos: negative coefficient" in fun pp cs x -> let _ = check_pos (mk_interval (x, x)) in @@ -59,14 +59,14 @@ let rec eval_high_poly_f_pos_pos = let rec eval_low_poly_f_pos_pos = let zero = mk_small_num_float 0 in let check_pos c = - if le_interval zero c then () + if le_interval zero c then () else failwith "Informal_poly.eval_high_poly_f_pos_pos: negative coefficient" in fun pp cs x -> let _ = check_pos (mk_interval (x, x)) in let rec eval cs = match cs with | [] -> zero - | [first] -> + | [first] -> let _ = check_pos first in fst (dest_interval first) | first :: rest -> diff --git a/Formal_ineqs/informal/informal_search.hl b/Formal_ineqs/informal/informal_search.hl index 07675712..d567fb66 100644 --- a/Formal_ineqs/informal/informal_search.hl +++ b/Formal_ineqs/informal/informal_search.hl @@ -39,7 +39,7 @@ let find_max s = find (hd s) 0 1 (tl s);; (* split_domain *) -let split_domain pp j domain = +let split_domain pp j domain = let n = length domain.w in let t = nth domain.y (j - 1) in let vv = map (fun i -> if i = j then t else nth domain.hi (i - 1)) (1--n) in @@ -64,7 +64,7 @@ type function_info = { index : int; };; -type result = +type result = | Cell_inconclusive | Cell_false | Cell_result of result_tree @@ -133,7 +133,7 @@ let rec check_cell opt dom = let lower = eval_m_taylor_lower_bound pp ti in if ge0_float lower then check flag rest - else + else (if opt.mono_depth > 0 then try try_mono {opt with max_depth = opt.mono_depth} dom f ti @@ -186,10 +186,10 @@ and construct_certificate0 opt = else let result = check_cell opt dom fs in match result with - | Cell_false -> + | Cell_false -> error "False result" dom fs | Cell_result r -> r - | Cell_pass (raw_flag, f) -> + | Cell_pass (raw_flag, f) -> let _ = update_verified_vol dom in Result_pass (f.index, raw_flag) | Cell_inconclusive -> @@ -207,7 +207,7 @@ and construct_certificate0 opt = let construct_certificate opt dom fs_informal = let mk_f (f0, ft) i = { eval0 = f0; - taylor = ft; + taylor = ft; index = i } in let fs = map2 mk_f fs_informal (0--(length fs_informal - 1)) in @@ -249,7 +249,7 @@ let z_inf = [Informal_float.mk_float (Int 10) 0; Informal_float.mk_float (Int 10 let dom_th = mk_m_center_domain 3 5 x_list z_list;; let dom_inf = Informal_taylor.mk_m_center_domain 5 x_inf z_inf;; -let schwefel_poly = `\x:real^3. -- #0.0000001 - ((x$1 - x$2 pow 2) pow 2 + (x$2 - &1) pow 2 + +let schwefel_poly = `\x:real^3. -- #0.0000001 - ((x$1 - x$2 pow 2) pow 2 + (x$2 - &1) pow 2 + (x$1 - x$3 pow 2) pow 2 + (x$3 - &1) pow 2)`;; let f1, f2 = mk_verification_functions_poly 5 schwefel_poly;; diff --git a/Formal_ineqs/informal/informal_sin_cos.hl b/Formal_ineqs/informal/informal_sin_cos.hl index 7c680608..3b8dd9f4 100644 --- a/Formal_ineqs/informal/informal_sin_cos.hl +++ b/Formal_ineqs/informal/informal_sin_cos.hl @@ -42,13 +42,13 @@ let rec x_pow_over_fact x k = x /. (float_of_int k) *. x_pow_over_fact x (k - 1);; (* Computes i such that x^(2(i + 1))/(2(i + 1))! <= base^(-(p + 1)) and cond(i) *) -let n_of_p_cos x pp cond = +let n_of_p_cos x pp cond = let t = (float_of_int Informal_nat.arith_base) ** (float_of_int (-pp - 1)) in let rec try_i i = let _ = if i > 50 then failwith "n_of_p_cos: cannot find i" else () in if cond i then let r = x_pow_over_fact x (2 * (i + 1)) in - if r <= t then i else try_i (i + 1) + if r <= t then i else try_i (i + 1) else try_i (i + 1) in @@ -107,7 +107,7 @@ let pi32_array = Array.init (n - 1) (fun i -> if i = 0 then zero_interval else round_interval i pi32);; (* -pi *) -let neg_pi_array = +let neg_pi_array = let n = Array.length pi_approx_array in Array.init n (fun i -> neg_interval pi_approx_array.(i));; @@ -151,7 +151,7 @@ let eval_high_neg_pi_0 pp x = let eval_low_neg_pi_0 pp x = let y = neg_float x in eval_low_0_pi pp y;; - + let eval_high_pi_2pi pp x = let pi32_lo = fst (dest_interval pi32_array.(pp)) in if le_float x pi32_lo then @@ -207,7 +207,7 @@ let get_i = let k0 = -int_of_float (x /. f_2_pi) in let y = x +. float_of_int k0 *. f_2_pi in if y < -.f_pi then k0 + 1 - else if y > f_pi then k0 - 1 + else if y > f_pi then k0 - 1 else k0;; let reduction_zero a b = a, b;; @@ -331,7 +331,7 @@ let cos_interval pp x_int = mk_interval (low, one) else mk_interval (neg_one, one) - with Correction_failed -> + with Correction_failed -> let _ = warn true (Printf.sprintf "cos_interval: reduction failed") in mk_interval (neg_one, one);; diff --git a/Formal_ineqs/informal/informal_taylor.hl b/Formal_ineqs/informal/informal_taylor.hl index 81b782b2..cbccb318 100644 --- a/Formal_ineqs/informal/informal_taylor.hl +++ b/Formal_ineqs/informal/informal_taylor.hl @@ -23,7 +23,7 @@ open Informal_matan;; open Informal_eval_interval;; -type m_cell_domain = +type m_cell_domain = { lo : ifloat list; hi : ifloat list; @@ -38,7 +38,7 @@ type m_taylor_interval = domain : m_cell_domain; f : interval; df : interval list; - ddf : interval list list; + ddf : interval list list; };; @@ -83,7 +83,7 @@ let eval_m_taylor pp0 f_tm partials partials2 = let f = build f_tm in let n = length partials in (* Verify that the list of second partial derivatives is correct *) - let _ = map2 (fun i list -> if length list <> i then + let _ = map2 (fun i list -> if length list <> i then failwith "eval_m_taylor: incorrect partials2" else ()) (1--n) partials2 in let dfs = map (build o rand o concl) partials in let d2fs = map (build o rand o concl) (List.flatten partials2) in @@ -129,7 +129,7 @@ let eval_m_taylor_error pp ti = let sums2 = (hd o hd) mul_wdd :: map2 (fun list t1 -> last list + float_2 * t1) (tl mul_wdd) sums1 in let sums = map2 ( * ) w sums2 in end_itlist ( + ) sums;; - + (* eval_m_taylor_upper_bound *) let eval_m_taylor_upper_bound pp ti = @@ -172,10 +172,10 @@ let eval_m_taylor_bound pp ti = let eval_m_taylor_partial_upper pp i ti = let df_hi = (snd o dest_interval o List.nth ti.df) (i - 1) in let dd_list = map (fun j -> if j <= i then - List.nth (List.nth ti.ddf (i - 1)) (j - 1) + List.nth (List.nth ti.ddf (i - 1)) (j - 1) else List.nth (List.nth ti.ddf (j - 1)) (i - 1)) (1--ti.n) in - let sum2 = + let sum2 = let mul_dd = map2 (error_mul_f2_hi pp) ti.domain.w dd_list in end_itlist (add_float_hi pp) mul_dd in add_float_hi pp df_hi sum2;; @@ -185,10 +185,10 @@ let eval_m_taylor_partial_upper pp i ti = let eval_m_taylor_partial_lower pp i ti = let df_lo = (fst o dest_interval o List.nth ti.df) (i - 1) in let dd_list = map (fun j -> if j <= i then - List.nth (List.nth ti.ddf (i - 1)) (j - 1) + List.nth (List.nth ti.ddf (i - 1)) (j - 1) else List.nth (List.nth ti.ddf (j - 1)) (i - 1)) (1--ti.n) in - let sum2 = + let sum2 = let mul_dd = map2 (error_mul_f2_hi pp) ti.domain.w dd_list in end_itlist (add_float_hi pp) mul_dd in sub_float_lo pp df_lo sum2;; @@ -198,10 +198,10 @@ let eval_m_taylor_partial_lower pp i ti = let eval_m_taylor_partial_bound pp i ti = let df_lo, df_hi = (dest_interval o List.nth ti.df) (i - 1) in let dd_list = map (fun j -> if j <= i then - List.nth (List.nth ti.ddf (i - 1)) (j - 1) + List.nth (List.nth ti.ddf (i - 1)) (j - 1) else List.nth (List.nth ti.ddf (j - 1)) (i - 1)) (1--ti.n) in - let sum2 = + let sum2 = let mul_dd = map2 (error_mul_f2_hi pp) ti.domain.w dd_list in end_itlist (add_float_hi pp) mul_dd in let lo = sub_float_lo pp df_lo sum2 in @@ -231,7 +231,7 @@ let eval_m_taylor_sub p_lin p_second taylor1 taylor2 = df = map2 (-) taylor1.df taylor2.df; ddf = map2 (map2 (--)) taylor1.ddf taylor2.ddf };; - + (* mul *) let eval_m_taylor_mul p_lin p_second ti1 ti2 = @@ -245,7 +245,7 @@ let eval_m_taylor_mul p_lin p_second ti1 ti2 = let d2_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti2) ns in let f1_bound = eval_m_taylor_bound p_second ti1 in let f2_bound = eval_m_taylor_bound p_second ti2 in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun (list1, list2) i -> let di1 = List.nth d1_bounds (i - 1) in @@ -295,7 +295,7 @@ let eval_m_taylor_pow2 p_lin p_second ti = let ( * ) = mul_interval p_lin in map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> two_interval * (dj1 * di1 + f1_bound * dd)) @@ -320,7 +320,7 @@ let eval_m_taylor_pow k = let ns = 1--n in let f1_bound = eval_m_taylor_bound p_second ti in let bounds_pow_k1 = pow_interval p_lin (k - 1) ti.f in - let bounds = + let bounds = let ( * ) = mul_interval p_lin in ti.f * bounds_pow_k1 in let u_bounds = @@ -334,7 +334,7 @@ let eval_m_taylor_pow k = let ( * ) = mul_interval p_second in let pow_k2 = pow_interval p_second (k - 2) in k_interval * pow_k2 f1_bound in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> d2 * ((k1_interval * dj1) * di1 + f1_bound * dd)) @@ -364,7 +364,7 @@ let eval_m_taylor_inv p_lin p_second ti = let inv, ( * ) = inv_interval p_second, mul_interval p_second in let ff = f1_bound * f1_bound in inv ff, two_interval * inv (f1_bound * ff) in - let ddf = + let ddf = let ( * ), ( - ) = mul_interval p_second, sub_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -392,11 +392,11 @@ let eval_m_taylor_sqrt p_lin p_second ti = map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in let d1, d2 = - let neg, sqrt, inv, ( * ) = neg_interval, sqrt_interval p_second, + let neg, sqrt, inv, ( * ) = neg_interval, sqrt_interval p_second, inv_interval p_second, mul_interval p_second in let two_sqrt_f = two_interval * sqrt f1_bound in inv two_sqrt_f, neg (inv (two_sqrt_f * (two_interval * f1_bound))) in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -426,7 +426,7 @@ let eval_m_taylor_exp p_lin p_second ti = let exp = exp_interval p_second in let exp_f = exp f1_bound in exp_f, exp_f in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -453,11 +453,11 @@ let eval_m_taylor_log p_lin p_second ti = map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in let d1, d2 = - let neg, pow2, inv = + let neg, pow2, inv = neg_interval, pow_interval p_second 2, inv_interval p_second in let inv_f = inv f1_bound in inv_f, neg (pow2 inv_f) in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -487,7 +487,7 @@ let eval_m_taylor_matan p_lin p_second ti = let d1, d2 = let dmatan, ddmatan = dmatan_interval p_second, ddmatan_interval p_second in dmatan f1_bound, ddmatan f1_bound in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -517,12 +517,12 @@ let eval_m_taylor_atn = map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in let d1, d2 = - let neg, inv, ( + ), ( * ) = neg_interval, inv_interval p_second, + let neg, inv, ( + ), ( * ) = neg_interval, inv_interval p_second, add_interval p_second, mul_interval p_second in let pow2 = pow_interval p_second 2 in let inv_one_ff = inv (one_interval + f1_bound * f1_bound) in inv_one_ff, (neg_two_interval * f1_bound) * pow2 inv_one_ff in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -551,7 +551,7 @@ let eval_m_taylor_cos p_lin p_second ti = let d1, d2 = let cos, sin = cos_interval p_second, sin_interval p_second in sin f1_bound, cos f1_bound in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in let neg = neg_interval in map2 (fun dd_list di1 -> @@ -582,7 +582,7 @@ let eval_m_taylor_sin p_lin p_second ti = let cos, sin = cos_interval p_second, sin_interval p_second in let neg = neg_interval in cos f1_bound, neg (sin f1_bound) in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -616,7 +616,7 @@ let eval_m_taylor_asn p_lin p_second ti = let pow3 = pow_interval p_second 3 in let ff_1 = one_interval - f1_bound * f1_bound in inv (sqrt ff_1), f1_bound / sqrt (pow3 ff_1) in - let ddf = + let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -650,7 +650,7 @@ let eval_m_taylor_acs p_lin p_second ti = let pow3 = pow_interval p_second 3 in let ff_1 = one_interval - f1_bound * f1_bound in inv (sqrt ff_1), neg (f1_bound / sqrt (pow3 ff_1)) in - let ddf = + let ddf = let ( * ), ( - ) = mul_interval p_second, sub_interval p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> @@ -662,6 +662,6 @@ let eval_m_taylor_acs p_lin p_second ti = df = df; ddf = ddf; };; - + end;; diff --git a/Formal_ineqs/informal/informal_verifier.hl b/Formal_ineqs/informal/informal_verifier.hl index 7a2ae727..6feb8bf5 100644 --- a/Formal_ineqs/informal/informal_verifier.hl +++ b/Formal_ineqs/informal/informal_verifier.hl @@ -77,7 +77,7 @@ let mk_verification_functions_poly pp0 f partials partials2 = let eval0 = mk_eval_function pp0 f in let eval1 = map (fun i -> mk_eval_function pp0 ((rand o concl o List.nth partials) (i - 1))) (1--n) in let eval2 = map (fun i -> - map (fun j -> + map (fun j -> let d2 = List.nth (List.nth partials2 (i - 1)) (j - 1) in mk_eval_function pp0 ((rand o concl) d2)) (1--i)) (1--n) in { @@ -89,13 +89,13 @@ let mk_verification_functions_poly pp0 f partials partials2 = (* split_domain *) -let split_domain pp j domain = +let split_domain pp j domain = let n = length domain.w in let t = List.nth domain.y (j - 1) in let vv = map (fun i -> if i = j then t else List.nth domain.hi (i - 1)) (1--n) in let uu = map (fun i -> if i = j then t else List.nth domain.lo (i - 1)) (1--n) in mk_m_center_domain pp domain.lo vv, mk_m_center_domain pp uu domain.hi;; - + (* restrict_domain *) let restrict_domain j left_flag domain = @@ -134,24 +134,24 @@ let m_verify_raw (report_start, total_size) p_split p_min p_max fs_list certific let rec find_p p_fun p_list = match p_list with | [] -> failwith "find_p: no good p found" - | p :: ps -> + | p :: ps -> let _ = if !info_print_level >= 2 then report (sprintf "Testing p = %d (other: %d)" p (length ps)) else () in - let flag = - (try p_fun p - with - | Failure msg -> - let _ = if !info_print_level >= 2 then + let flag = + (try p_fun p + with + | Failure msg -> + let _ = if !info_print_level >= 2 then report (sprintf "Failure at p = %d: %s" p msg) else () in - false - | Division_by_zero -> + false + | Division_by_zero -> let _ = if !info_print_level >= 2 then report (sprintf "Failure at p = %d: Division_by_zero" p) else () in false) in - if flag then + if flag then let _ = if !info_print_level >= 2 then report (sprintf "p = %d" p) else () in p else find_p p_fun ps in @@ -188,7 +188,7 @@ let m_verify_raw (report_start, total_size) p_split p_min p_max fs_list certific else map (eval_m_taylor_partial_lower pp m.variable) taylors in let monos = map gen_mono mono in - rev_itlist (fun (m, bounds) pass -> + rev_itlist (fun (m, bounds) pass -> let flag = m.decr_flag in forall (m_mono_pass_gen flag) bounds && pass) (rev (zip mono monos)) true in @@ -205,10 +205,10 @@ let m_verify_raw (report_start, total_size) p_split p_min p_max fs_list certific let rec rec_verify domain certificate = match certificate with | Result_mono (mono, r1) -> - let _ = + let _ = if !info_print_level >= 2 then - let mono_strs = - map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") + let mono_strs = + map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") m.variable m.df0_flag) mono in report (sprintf "Mono: [%s]" (String.concat ";" mono_strs)) else () in @@ -219,9 +219,9 @@ let m_verify_raw (report_start, total_size) p_split p_min p_max fs_list certific P_result_mono ({pp = pp}, mono, tree1), inds with Failure _ -> failwith "mono: failed") - | Result_pass (j, f0_flag) -> + | Result_pass (j, f0_flag) -> let _ = k := !k + 1; kk := !kk + 1 in - let _ = + let _ = if !info_print_level >= 2 then report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag) else () in @@ -265,7 +265,7 @@ let m_verify_raw (report_start, total_size) p_split p_min p_max fs_list certific P_result_ref i, inds | _ -> failwith "False result" in - + rec_verify domain0 certificate;; @@ -276,11 +276,11 @@ let m_verify_raw (report_start, total_size) p_split p_min p_max fs_list certific let m_verify_raw0 p_split p_min p_max fs_list certificate xx zz = m_verify_raw (0, 0) p_split p_min p_max fs_list certificate (mk_m_center_domain p_split xx zz) [];; - + (* m_verify_list *) let m_verify_list p_split p_min p_max fs_list certificate_list xx zz = let domain_hash = Hashtbl.create (length certificate_list * 10) in - let mem, find, add = Hashtbl.mem domain_hash, + let mem, find, add = Hashtbl.mem domain_hash, Hashtbl.find domain_hash, Hashtbl.add domain_hash in let get_m_cell_domain pp domain0 path = @@ -289,7 +289,7 @@ let m_verify_list p_split p_min p_max fs_list certificate_list xx zz = | [] -> domain | (s, j) :: ps -> let hash' = hash^s^(string_of_int j) in - if mem hash' then + if mem hash' then get_rec (find hash') ps hash' else if s = "l" || s = "r" then @@ -313,7 +313,7 @@ let m_verify_list p_split p_min p_max fs_list certificate_list xx zz = let k = ref 0 in let kk = ref 0 in let total_size = end_itlist (+) (map (result_size o snd) certificate_list) in - + let rec rec_verify certificate_list dom_list tree_list = match certificate_list with | [] -> rev tree_list diff --git a/Formal_ineqs/lib/ipow.hl b/Formal_ineqs/lib/ipow.hl index 73293533..f6ac65f1 100644 --- a/Formal_ineqs/lib/ipow.hl +++ b/Formal_ineqs/lib/ipow.hl @@ -18,7 +18,7 @@ prioritize_real();; unparse_as_infix("ipow");; let ipow = new_definition - `ipow (x:real) (e:int) = + `ipow (x:real) (e:int) = (if (&0 <= e) then (x pow (num_of_int e)) else (inv (x pow (num_of_int (--e)))))`;; @@ -57,7 +57,7 @@ let IPOW_INV = prove ASM_REWRITE_TAC[IPOW_0; INT_NEG_0; REAL_INV_1]; ALL_TAC ] THEN - REWRITE_TAC[ipow] THEN REPEAT COND_CASES_TAC THEN + REWRITE_TAC[ipow] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_INV_POW; REAL_INV_INV] THEN ASM_ARITH_TAC);; let INV_IPOW = prove @@ -71,7 +71,7 @@ let IPOW_NEG = prove ASM_REWRITE_TAC[IPOW_0; INT_NEG_0; REAL_INV_1]; ALL_TAC ] THEN - REWRITE_TAC[ipow] THEN REPEAT COND_CASES_TAC THEN + REWRITE_TAC[ipow] THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_NEG_NEG; REAL_INV_INV] THEN ASM_ARITH_TAC);; let IPOW_NEG_NUM = prove @@ -126,7 +126,7 @@ let IPOW_ADD = prove let IPOW_MUL = prove (`!x y u. (x * y) ipow u = x ipow u * y ipow u`, - REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_POW_MUL; REAL_INV_MUL]);; let IPOW_ZERO = prove @@ -150,9 +150,9 @@ let IPOW_ONE = prove let IPOW_IPOW = prove (`!x u v. (x ipow u) ipow v = x ipow (u * v)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL [ - ASM_REWRITE_TAC[IPOW_ZERO] THEN + ASM_REWRITE_TAC[IPOW_ZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_MUL_LZERO; IPOW_ONE] THEN - REWRITE_TAC[IPOW_ZERO] THEN + REWRITE_TAC[IPOW_ZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_ENTIRE; INT_MUL_RZERO]; ALL_TAC ] THEN @@ -349,9 +349,9 @@ let IPOW_EQ_1_IMP = prove ]);; let IPOW_OF_NUM = prove - (`!x i. &x ipow i = + (`!x i. &x ipow i = if &0 <= i then &(x EXP (num_of_int i)) else inv (&(x EXP (num_of_int (--i))))`, - REPEAT STRIP_TAC THEN REWRITE_TAC[ipow] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[ipow] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_OF_NUM_POW]);; let IPOW_EQ_EXP = prove @@ -365,7 +365,7 @@ let IPOW_EQ_EXP_P = prove REWRITE_TAC[NUM_OF_INT_OF_NUM]);; let IPOW_BETWEEN = prove - (`!(x:real) (y:num) (z:num) (e:int). + (`!(x:real) (y:num) (z:num) (e:int). &0 < x /\ &y * x ipow e <= &z * x ipow e /\ &z * x ipow e <= (&y + &1) * x ipow e ==> z = y \/ z = y + 1`, @@ -438,7 +438,7 @@ let IPOW_EXP_MONO_INV_LT = prove MATCH_MP_TAC IPOW_MONO_INV THEN ASM_ARITH_TAC);; let IPOW_MONOTONE = prove - (`!(x:num) (e1:int) (e2:int). + (`!(x:num) (e1:int) (e2:int). 2 <= x /\ &x ipow e1 <= &x ipow e2 ==> e1 <= e2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IPOW_EXP_MONO THEN EXISTS_TAC `&x:real` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN diff --git a/Formal_ineqs/lib/ssreflect/sections.hl b/Formal_ineqs/lib/ssreflect/sections.hl index 6aa677ca..b1d70711 100644 --- a/Formal_ineqs/lib/ssreflect/sections.hl +++ b/Formal_ineqs/lib/ssreflect/sections.hl @@ -2,7 +2,7 @@ module Sections = struct (* Basic commands for working with the goal stack *) (* b() from tactics.ml *) -let revert_proof_step() = +let revert_proof_step() = let l = !current_goalstack in if length l = 1 then failwith "Can't back up any more" else current_goalstack := tl l; @@ -13,7 +13,7 @@ let revert_proof_step() = let fast_load_flag = ref false;; (* Section variables, hypotheses (with labels), implicit types, and auxiliary lemmas *) -type section_info = +type section_info = { vars : term list; hyps : (string * term) list; @@ -109,8 +109,8 @@ let inst_section_vars tm = let inst_var (name, ty) tm = let ty_dst, ty_src = find_var (name, ty) in try (inst (type_match ty_src ty_dst []) tm) - with Failure _ -> - failwith ("Section variable " ^ name ^ + with Failure _ -> + failwith ("Section variable " ^ name ^ " has type " ^ string_of_type ty_dst) in let f_vars = map dest_var (frees tm) in itlist inst_var f_vars tm;; @@ -118,7 +118,7 @@ let inst_section_vars tm = (* Instantiates implicit types in the given term *) (* (free variables and top generalized variables are considered in the term) *) -let inst_section_types tm = +let inst_section_types tm = let s_types = section_types() in let find_type tm = let name, ty = dest_var tm in @@ -130,7 +130,7 @@ let inst_section_types tm = inst ty_inst tm;; -(* Checks if the term contains any free variables +(* Checks if the term contains any free variables which are not section variables *) let check_section_term tm = let f_vars = frees tm in @@ -146,7 +146,7 @@ let check_section_term tm = let str = String.concat ", " (map string_of_term vars) in failwith ("Free variables: " ^ str) else ();; - + (* Adds the given variable to the active section *) let add_section_var var = @@ -269,7 +269,7 @@ let prepare_goal_term tm = (* Prepares a goal term and an initial tactic *) let prepare_section_proof names tm = let f_vars = map dest_var (frees tm) in - let find_type var_name = + let find_type var_name = try assoc var_name f_vars with Failure _ -> failwith ("Unused variable: " ^ var_name) in let g_vars = map (fun name -> mk_var (name, find_type name)) names in let g_tm = list_mk_forall (g_vars, tm) in @@ -312,7 +312,7 @@ let section_proof names tm tac_list = let hyps = section_hyps() in itlist (fun _ th -> UNDISCH th) hyps th0;; - + (* Discharges all assumptions and generalizes all section variables *) let finalize_theorem th = let hyps = map snd (current_section_hyps()) in @@ -323,5 +323,5 @@ let finalize_theorem th = let f_vars = frees (concl th1) in let vars = intersect f_vars s_vars in itlist (fun var th -> GEN var th) vars th1;; - + end;; diff --git a/Formal_ineqs/lib/ssreflect/ssreflect.hl b/Formal_ineqs/lib/ssreflect/ssreflect.hl index c2076eba..98e174ad 100644 --- a/Formal_ineqs/lib/ssreflect/ssreflect.hl +++ b/Formal_ineqs/lib/ssreflect/ssreflect.hl @@ -82,14 +82,14 @@ let (THENL_FIRST),(THENL_LAST) = fun tac1 tac2 g -> let _,gls,_ as gstate = tac1 g in if gls = [] then failwith "No subgoals" - else + else let tac_list = tac2 :: (replicate ALL_TAC (length gls - 1)) in tacsequence gstate tac_list and (thenl_last: tactic -> tactic -> tactic) = fun tac1 tac2 g -> let _,gls,_ as gstate = tac1 g in if gls = [] then failwith "No subgoals" - else + else let tac_list = (replicate ALL_TAC (length gls - 1)) @ [tac2] in tacsequence gstate tac_list in thenl_first, thenl_last;; @@ -138,7 +138,7 @@ let move labels = ALL_TAC with Failure _ -> ALL_TAC in tac g in - + let move1 name (g:goal) = let g_tm = snd g in let tac = @@ -159,7 +159,7 @@ let move labels = failwith "move: not (!) or (==>)" in tac g in fun g -> - let tac = itlist + let tac = itlist (fun name tac -> move_eq THEN move1 name THEN tac) labels ALL_TAC in tac g;; @@ -171,15 +171,15 @@ let in_tac a_list in_goal tac (g:goal) = let tmp_goal_var = mk_var (tmp_goal_name, bool_ty) in let tmp_goal = mk_eq (tmp_goal_var, goal_tm) in let tmp_goal_sym = mk_eq (goal_tm, tmp_goal_var) in - let disch_tac = + let disch_tac = rev_itlist (fun name tac -> REMOVE_THEN name MP_TAC THEN tac) a_list ALL_TAC in let intro_tac = move a_list in - let hide_goal, unfold_goal = - if in_goal then + let hide_goal, unfold_goal = + if in_goal then ALL_TAC, ALL_TAC else - ABBREV_TAC tmp_goal, - EXPAND_TAC tmp_goal_name THEN + ABBREV_TAC tmp_goal, + EXPAND_TAC tmp_goal_name THEN UNDISCH_TAC tmp_goal_sym THEN DISCH_THEN (fun th -> ALL_TAC) in (hide_goal THEN disch_tac THEN tac THEN TRY intro_tac THEN unfold_goal) g;; @@ -187,7 +187,7 @@ let in_tac a_list in_goal tac (g:goal) = (* Finds a subterm in the given term which matches against the given - pattern; local_consts is a list of variable which must be fixed in + pattern; local_consts is a list of variable which must be fixed in the pattern. This function returns the path to the first matched subterm *) let match_subterm local_consts pat tm = @@ -196,7 +196,7 @@ let match_subterm local_consts pat tm = let inst = term_match local_consts pat tm in if instantiate inst pat = tm then path else failwith "Bad instantiation" with x -> - try + try match tm with | Abs(_, b_tm) -> find b_tm (path^"b") | Comb(l_tm, r_tm) -> @@ -224,12 +224,12 @@ let find_all_paths p tm = (* Instantiates types of the given context variables in the given term.*) -let inst_context_vars vars tm_vars tm = +let inst_context_vars vars tm_vars tm = let find_type var = let name, ty = dest_var var in try (ty, type_of (assoc name vars)) - with Failure _ -> + with Failure _ -> failwith (name^" is free in the term `"^(string_of_term tm)^"` and in the context") in let ty_src, ty_dst = unzip (map find_type tm_vars) in let ty_inst = itlist2 type_match ty_src ty_dst [] in @@ -261,7 +261,7 @@ let match_subterm_in_context pat tm (g : goal) = let rec break_conjuncts th : thm list = (* Convert P ==> (!x. Q x) to !x. P ==> Q x and P ==> Q ==> R to P /\ Q ==> R *) let th0 = PURE_REWRITE_RULE[GSYM RIGHT_FORALL_IMP_THM; IMP_IMP] th in - let th1 = SPEC_ALL th0 in + let th1 = SPEC_ALL th0 in (* Break top level conjunctions *) let th_list = CONJUNCTS th1 in if length th_list > 1 then @@ -280,7 +280,7 @@ let rec break_conjuncts th : thm list = [PURE_ONCE_REWRITE_RULE[TAUT `~P <=> (P <=> F)`] th1] else [EQT_INTRO th1];; - + (* Finds an instantination for the given term inside another term *) let rec find_term_inst local_consts tm src_tm path = @@ -336,7 +336,7 @@ let new_rewrite occ pat th g = (* Free variables in the given theorem will not be matched *) let local_consts = frees (concl th) in (* Apply the pattern *) - let goal_subterm_path = + let goal_subterm_path = if pat = [] then "" else match_subterm_in_context (hd pat) goal_tm g in let goal_subterm = follow_path goal_subterm_path goal_tm in @@ -382,7 +382,7 @@ let new_rewrite occ pat th g = (* Try to rewrite with all given theorems *) let th_list = break_conjuncts th in - let rec my_first th_list = + let rec my_first th_list = if length th_list = 1 then rewrite (hd th_list) g else @@ -436,7 +436,7 @@ let rewrite occ pat th g = let match_fun = (if is_eq eq_tm then lhand else I) o (if cond_flag then rand else I) in (* Apply the pattern *) - let goal_subterm_path = + let goal_subterm_path = if pat = [] then "" else match_subterm_in_context (hd pat) goal_tm g in let goal_subterm = follow_path goal_subterm_path goal_tm in @@ -492,8 +492,8 @@ let split_tac = FIRST [CONJ_TAC; EQ_TAC];; (* Creates an abbreviation for the given term with the given name *) let set_tac name tm (g : goal) = let goal_tm = snd g in - let tm0 = - try + let tm0 = + try follow_path (match_subterm_in_context tm goal_tm g) goal_tm with Failure _ -> tm in let tm1 = inst_all_free_vars tm0 g in @@ -503,7 +503,7 @@ let set_tac name tm (g : goal) = (* Generates a fresh name for the given term *) (* taking into account names of the provided variables *) let generate_fresh_name names tm = - let rec find_name prefix n = + let rec find_name prefix n = let name = prefix ^ (if n = 0 then "" else string_of_int n) in if can (find (fun str -> str = name)) names then find_name prefix (n + 1) @@ -533,12 +533,12 @@ let disch_tm_tac occs tm (g : goal) = let tm0 = prepare_term tm g in let name = generate_fresh_name ((fst o unzip) (get_context_vars g)) tm in let new_tm = mk_var (name, type_of tm0) in - let new_tm1 = - if occs = [] && is_var tm then + let new_tm1 = + if occs = [] && is_var tm then mk_var ((fst o dest_var) tm, type_of tm0) - else new_tm in + else new_tm in let abbrev_tm = mk_eq (new_tm, tm0) in - (ABBREV_TAC abbrev_tm THEN + (ABBREV_TAC abbrev_tm THEN EXPAND_TAC name THEN POP_ASSUM (fun th -> TRY (new_rewrite occs [] th)) THEN SPEC_TAC (new_tm, new_tm1)) g;; @@ -639,14 +639,14 @@ let match_mp_th ith n th = let rec rec_match n list head = match list with | ("undisch", (_ as tm0)) :: t -> - (try + (try let ii = term_match lconsts tm0 tm in if n <= 1 then let th1 = INSTANTIATE_ALL ii th0 in let th2 = PROVE_HYP th th1 in let list0 = head @ (("undisch", `T`) :: t) in let f_vars = frees tm0 in - let list1 = filter + let list1 = filter (fun s, tm -> not (s = "spec" && mem tm f_vars)) list0 in let list = map (fun s, tm -> s, instantiate ii tm) list1 in list, th2 @@ -708,7 +708,7 @@ let combine_args arg1 arg2 = let th1 = get_arg_thm arg1 in let th0 = match arg2 with - | Arg_theorem th2 -> + | Arg_theorem th2 -> (try MATCH_MP th1 th2 with Failure _ -> match_mp_th th1 1 th2) | Arg_term tm2 -> (try ISPEC tm2 th1 with Failure _ -> spec_var_th th1 1 tm2) @@ -722,7 +722,7 @@ let use_arg_then_result = ref TRUTH;; (* (* Tests if the given id defines a theorem *) let test_id_thm id = - let lexbuf = + let lexbuf = Lexing.from_string ("use_arg_then_result := " ^ id ^ ";;") in let ast = (!Toploop.parse_toplevel_phrase) lexbuf in try @@ -745,7 +745,7 @@ let use_arg_then id (arg_tac:arg_type->tactic) (g:goal) = let var = assoc id vars in Arg_term var with Failure _ -> - let lexbuf = + let lexbuf = Lexing.from_string ("use_arg_then_result := " ^ id ^ ";;") in let ast = (!Toploop.parse_toplevel_phrase) lexbuf in let _ = @@ -780,15 +780,15 @@ let combine_args_then (tac:arg_type->tactic) arg1 arg2 (g:goal) = let th1 = get_arg_thm arg1 in let th0 = match arg2 with - | Arg_theorem th2 -> + | Arg_theorem th2 -> (try MATCH_MP th1 th2 with Failure _ -> match_mp_th th1 1 th2) | Arg_term tm2 -> let tm0 = prepare_term tm2 g in (try ISPEC tm0 th1 with Failure _ -> spec_var_th th1 1 tm0) | Arg_type ty2 -> inst_first_type th1 ty2 in tac (Arg_theorem th0) g;; - - + + (* Specializes a variable and applies the next tactic *) @@ -832,23 +832,23 @@ let apply_tac th g = if th = th0 then failwith "apply_tac: no match" else try_match th0 in - + try MATCH_ACCEPT_TAC th g with Failure _ -> try_match th;; -(*let apply_tac th = +(*let apply_tac th = FIRST [MATCH_ACCEPT_TAC th; MATCH_MP_TAC th];; *) (* The 'exact' tactic *) -(* TODO: do [done | by move => top; apply top], here apply top +(* TODO: do [done | by move => top; apply top], here apply top works as ACCEPT_TAC with matching (rewriting) in some cases *) let exact_tac = FIRST [done_tac; DISCH_THEN (fun th -> apply_tac th) THEN done_tac];; (* Specializes the theorem using the given set of variables *) -let spec0 names vars = +let spec0 names vars = let find name = try (assoc name vars, true) with Failure _ -> (parse_term name, false) in @@ -857,7 +857,7 @@ let spec0 names vars = let t, flag = find name in if flag then (ty, type_of t) - else + else (`:bool`, `:bool`) in let inst_term tm = let ty_src, ty_dst = unzip (map find_type (frees tm)) in @@ -877,13 +877,13 @@ let spec_mp names th g = MP_TAC (spec0 names (get_context_vars g) th) g;; (* Case theorems *) let bool_cases = ONCE_REWRITE_RULE[CONJ_ACI] bool_INDUCT;; let list_cases = prove(`!P. P [] /\ (!(h:A) t. P (CONS h t)) ==> (!l. P l)`, - REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN MP_TAC (SPEC `l:(A)list` list_CASES) THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (CHOOSE_THEN MP_TAC) THEN DISCH_THEN (CHOOSE_THEN MP_TAC) THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[th]));; let pair_cases = pair_INDUCT;; let num_cases = prove(`!P. P 0 /\ (!n. P (SUC n)) ==> (!m. P m)`, - REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN MP_TAC (SPEC `m:num` num_CASES) THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (CHOOSE_THEN (fun th -> ASM_REWRITE_TAC[th])));; let option_cases = option_INDUCT;; @@ -914,7 +914,7 @@ Hashtbl.add elim_table "option" option_elim;; (* case: works only for (A /\ B) -> C; (A \/ B) -> C; (?x. P) -> Q; !(n:num). P; !(l:list(A)). P *) -let case (g:goal) = +let case (g:goal) = let goal_tm = snd g in if not (is_imp goal_tm) then (* !a. P *) @@ -942,7 +942,7 @@ let case (g:goal) = (* elim: works only for num and list *) -let elim (g:goal) = +let elim (g:goal) = let goal_tm = snd g in (* !a. P *) if is_forall goal_tm then @@ -954,7 +954,7 @@ let elim (g:goal) = failwith "elim: not forall";; - + (* Instantiates the first type variable in the given theorem *) let INST_FIRST_TYPE_THEN ty (then_tac:thm_tactic) th = let ty_vars = type_vars_in_term (concl th) in @@ -969,10 +969,10 @@ let transform_pattern pat_tm = let names = ref (map (fst o dest_var) (frees pat_tm)) in let rec transform tm = match tm with - | Abs(x_tm, b_tm) -> + | Abs(x_tm, b_tm) -> let _ = names := (fst o dest_var) x_tm :: !names in mk_abs (x_tm, transform b_tm) - | Comb(l_tm, r_tm) -> + | Comb(l_tm, r_tm) -> mk_comb (transform l_tm, transform r_tm) | Var ("_", ty) -> let name = generate_fresh_name !names tm in @@ -1002,7 +1002,7 @@ let congr_tac pat_tm goal = let lhs, rhs = dest_eq goal_tm in let lm, rm = term_match const_pat pattern lhs, term_match const_pat pattern rhs in - let eq_tms = map + let eq_tms = map (fun tm -> mk_eq (instantiate lm tm, instantiate rm tm)) wild_pat in let eq_tm = itlist (curry mk_imp) eq_tms goal_tm in let eq_thm = EQT_ELIM (SIMP_CONV[] eq_tm) in @@ -1050,7 +1050,7 @@ let disch_tm_eq_tac eq_name occs tm (g : goal) = let eq_var = mk_var (eq_name, aty) in let new_tm = mk_var (name, type_of tm0) in let abbrev_tm = mk_eq (new_tm, tm0) in - (ABBREV_TAC abbrev_tm THEN + (ABBREV_TAC abbrev_tm THEN EXPAND_TAC name THEN FIRST_ASSUM (fun th -> TRY (new_rewrite occs [] th)) THEN POP_ASSUM (MP_TAC o PURE_ONCE_REWRITE_RULE[GSYM (SPEC eq_var ssreflect_eq_def)]) THEN diff --git a/Formal_ineqs/lib/ssrfun.hl b/Formal_ineqs/lib/ssrfun.hl index c84192d2..c4cb6734 100644 --- a/Formal_ineqs/lib/ssrfun.hl +++ b/Formal_ineqs/lib/ssrfun.hl @@ -324,7 +324,7 @@ Sections.end_section "SopTisR";; Sections.begin_section "SopTisS";; let right_id = new_definition `right_id e op = !x. op x e = x`;; let left_zero = new_definition `left_zero z op = !x. op z x = z`;; -let right_commutative = new_definition +let right_commutative = new_definition `right_commutative op = !x y z. op (op x y) z = op (op x z) y`;; let left_distributive = new_definition `left_distributive op add = !x y z. op (add x y) z = add (op x z) (op y z)`;; @@ -340,13 +340,13 @@ Sections.end_section "SopTisS";; Sections.begin_section "SopTisT";; let left_id = new_definition `left_id e op = !x. op e x = x`;; let right_zero = new_definition `right_zero z op = !x. op x z = z`;; -let left_commutative = new_definition +let left_commutative = new_definition `left_commutative op = !x y z. op x (op y z) = op y (op x z)`;; let right_distributive = new_definition `right_distributive op add = !x y z. op x (add y z) = add (op x y) (op x z)`;; -let left_loop = new_definition +let left_loop = new_definition `left_loop inv op = !x. cancel (op x) (op (inv x))`;; -let rev_left_loop = new_definition +let rev_left_loop = new_definition `rev_left_loop inv op = !x. cancel (op (inv x)) (op x)`;; (* Finalization of the section SopTisT *) diff --git a/Formal_ineqs/list/list_conversions.hl b/Formal_ineqs/list/list_conversions.hl index 1c1556ee..b03e7ec5 100644 --- a/Formal_ineqs/list/list_conversions.hl +++ b/Formal_ineqs/list/list_conversions.hl @@ -67,7 +67,7 @@ let hd_conv hd_tm = let EL_0' = (MY_RULE_NUM o prove)(`EL 0 (CONS (h:A) t) = h`, REWRITE_TAC[EL; HD]);; let EL_n' = (MY_RULE_NUM o prove)(`0 < n /\ PRE n = m ==> EL n (CONS (h:A) t) = EL m t`, - STRIP_TAC THEN SUBGOAL_THEN `n = SUC m` ASSUME_TAC THENL + STRIP_TAC THEN SUBGOAL_THEN `n = SUC m` ASSUME_TAC THENL [ REPEAT (POP_ASSUM MP_TAC) THEN ARITH_TAC; ALL_TAC ] THEN ASM_REWRITE_TAC[EL; TL]);; @@ -88,7 +88,7 @@ let eval_el n_tm list_tm = let n_gt0 = (EQT_ELIM o raw_gt0_hash_conv) n_tm in let pre_n = raw_pre_hash_conv (mk_comb (pre_op_num, n_tm)) in let m_tm = (rand o concl) pre_n in - let th0 = (MY_PROVE_HYP pre_n o MY_PROVE_HYP n_gt0 o + let th0 = (MY_PROVE_HYP pre_n o MY_PROVE_HYP n_gt0 o INST[n_tm, n_var_num; m_tm, m_var_num] o inst0) el_n in let th1 = el_conv_raw m_tm t_tm in TRANS th0 th1 in @@ -198,7 +198,7 @@ let eval_zip list1_tm list2_tm = (******************) let ALL_0' = prove(`ALL P ([]:(A)list) <=> T`, REWRITE_TAC[ALL]) and - ALL_CONS_T' = (MY_RULE o prove)(`(P h <=> T) /\ (ALL P t <=> T) ==> (ALL P (CONS (h:A) t) <=> T)`, + ALL_CONS_T' = (MY_RULE o prove)(`(P h <=> T) /\ (ALL P t <=> T) ==> (ALL P (CONS (h:A) t) <=> T)`, REWRITE_TAC[ALL]) and ALL_CONS_F2' = (MY_RULE o prove)(`(ALL P t <=> F) ==> (ALL P (CONS (h:A) t) <=> F)`, SIMP_TAC[ALL]) and @@ -216,7 +216,7 @@ let all_conv_univ p_conv tm = let ty = (hd o snd o dest_type) list_ty in let inst_t = INST_TYPE[ty, aty] in - let all_0, all_t, all_f1, all_f2 = inst_t ALL_0', inst_t ALL_CONS_T', + let all_0, all_t, all_f1, all_f2 = inst_t ALL_0', inst_t ALL_CONS_T', inst_t ALL_CONS_F1', inst_t ALL_CONS_F2' in let h_var, t_var = mk_var("h", ty), mk_var("t", list_ty) and p_var = mk_var("P", p_ty) in @@ -246,13 +246,13 @@ let all_conv_univ p_conv tm = (*******************) let ALL2_0' = prove(`ALL2 P ([]:(A)list) ([]:(B)list) <=> T`, REWRITE_TAC[ALL2]) and - ALL2_CONS_T' = (MY_RULE o prove)(`(P h1 h2 <=> T) /\ (ALL2 P t1 t2 <=> T) ==> + ALL2_CONS_T' = (MY_RULE o prove)(`(P h1 h2 <=> T) /\ (ALL2 P t1 t2 <=> T) ==> (ALL2 P (CONS (h1:A) t1) (CONS (h2:B) t2) <=> T)`, REWRITE_TAC[ALL2]) and - ALL2_CONS_F2' = (MY_RULE o prove)(`(ALL2 P t1 t2 <=> F) ==> + ALL2_CONS_F2' = (MY_RULE o prove)(`(ALL2 P t1 t2 <=> F) ==> (ALL2 P (CONS (h1:A) t1) (CONS (h2:B) t2) <=> F)`, SIMP_TAC[ALL2]) and - ALL2_CONS_F1' = (MY_RULE o prove)(`(P h1 h2 <=> F) ==> + ALL2_CONS_F1' = (MY_RULE o prove)(`(P h1 h2 <=> F) ==> (ALL2 P (CONS (h1:A) t1) (CONS (h2:B) t2) <=> F)`, SIMP_TAC[ALL2]);; @@ -270,7 +270,7 @@ let all2_conv_univ p_conv tm = ty2 = (hd o snd o dest_type) list2_ty in let inst_t = INST_TYPE[ty1, aty; ty2, bty] in - let all2_0, all2_t, all2_f1, all2_f2 = inst_t ALL2_0', inst_t ALL2_CONS_T', + let all2_0, all2_t, all2_f1, all2_f2 = inst_t ALL2_0', inst_t ALL2_CONS_T', inst_t ALL2_CONS_F1', inst_t ALL2_CONS_F2' in let h1_var, t1_var = mk_var("h1", ty1), mk_var("t1", list1_ty) and h2_var, t2_var = mk_var("h2", ty2), mk_var("t2", list2_ty) and @@ -344,9 +344,9 @@ let mem_conv_univ eq_conv mem_tm = (* FILTER conversions *) let FILTER_A_EMPTY = prove(`FILTER (P:A->bool) [] = []`, REWRITE_TAC[FILTER]) and - FILTER_A_HD = (MY_RULE o prove)(`(P h <=> T) ==> FILTER (P:A->bool) (CONS h t) = CONS h (FILTER P t)`, + FILTER_A_HD = (MY_RULE o prove)(`(P h <=> T) ==> FILTER (P:A->bool) (CONS h t) = CONS h (FILTER P t)`, SIMP_TAC[FILTER]) and - FILTER_A_TL = (MY_RULE o prove)(`(P h <=> F) ==> FILTER (P:A->bool) (CONS h t) = FILTER P t`, + FILTER_A_TL = (MY_RULE o prove)(`(P h <=> F) ==> FILTER (P:A->bool) (CONS h t) = FILTER P t`, SIMP_TAC[FILTER]);; @@ -356,12 +356,12 @@ let filter_conv_univ p_conv tm = let p_ty = type_of p_tm in let ty = (hd o snd o dest_type) p_ty in let inst_t = INST_TYPE[ty, aty] in - let filter_empty, filter_hd, filter_tl = + let filter_empty, filter_hd, filter_tl = inst_t FILTER_A_EMPTY, inst_t FILTER_A_HD, inst_t FILTER_A_TL in let p_var = mk_var("P", p_ty) in let h_var = mk_var("h", ty) in let t_var = mk_var("t", mk_type("list",[ty])) in - + let rec filter_conv_raw = fun list_tm -> if (is_comb list_tm) then let ltm, t_tm = dest_comb list_tm in @@ -381,9 +381,9 @@ let filter_conv_univ p_conv tm = else INST[p_tm, p_var] filter_empty in filter_conv_raw list_tm;; - - - + + + (***************************) (* MAP conversions *) @@ -451,7 +451,7 @@ let get_all th = else [] in get_all_raw th list_tm;; - + (* Given a theorem `ALL P list`, returns (P x_i1),..., (P x_in) @@ -485,7 +485,7 @@ let select_all th indices = else get_all_raw th_tl t_tm (i::is) (n + 1) in get_all_raw th list_tm indices 0;; - + (*****************************************) (* set_of_list conversions *) diff --git a/Formal_ineqs/misc/report.hl b/Formal_ineqs/misc/report.hl index af5bfd58..c1725112 100644 --- a/Formal_ineqs/misc/report.hl +++ b/Formal_ineqs/misc/report.hl @@ -4,7 +4,7 @@ (* Date: 2011-08-21 *) (* =========================================================== *) -(* port of error.cc +(* port of error.cc basic procedures to print messages to the standard output and to count errors. @@ -26,7 +26,7 @@ let (get_corner_count,reset_corner_count,inc_corner_count) = ((fun () -> !corner_count),(fun () -> corner_count := 0), (fun () -> corner_count:= !corner_count + 1));; -let diagnostic_string () = +let diagnostic_string () = let d = get_error_count() in if (d>0) then Printf.sprintf "(errors %d)" (get_error_count()) else "(no errors)";; @@ -35,14 +35,14 @@ let report s = let report_timed s = report (s^" "^(time_string()));; -let report_error = +let report_error = let error_max = 25 in (* was 200, recurse.cc had a separate counter limit at 25 *) fun s -> let ec = get_error_count() in - (inc_error_count(); report_timed (Printf.sprintf "error(%d) --\n%s" ec s); + (inc_error_count(); report_timed (Printf.sprintf "error(%d) --\n%s" ec s); Pervasives.ignore(get_error_count() < error_max || raise Fatal));; - -let report_fatal s = + +let report_fatal s = ( inc_error_count(); report_timed ("error --\n"^s); raise Fatal);; end;; diff --git a/Formal_ineqs/taylor/m_taylor_arith.hl b/Formal_ineqs/taylor/m_taylor_arith.hl index 6d6a3da4..16fb36ba 100644 --- a/Formal_ineqs/taylor/m_taylor_arith.hl +++ b/Formal_ineqs/taylor/m_taylor_arith.hl @@ -92,7 +92,7 @@ let m_lin_approx_components n m_lin_th = let ty = n_type_array.(n) in let f_var = mk_var ("f", type_of f_tm) in let x_var = mk_var ("x", type_of x_tm) in - let th0 = (INST[f_tm, f_var; x_tm, x_var; f_bounds, f_bounds_var; + let th0 = (INST[f_tm, f_var; x_tm, x_var; f_bounds, f_bounds_var; d_bounds_list, df_bounds_list_var] o inst_first_type_var ty) DEST_M_LIN_APPROX' in let th1 = EQ_MP th0 m_lin_th in match (CONJUNCTS th1) with @@ -104,9 +104,9 @@ let m_lin_approx_components n m_lin_th = (* all_n manipulations *) let ALL_N_EMPTY' = prove(`all_n n [] (s:num->A->bool)`, REWRITE_TAC[all_n]);; -let ALL_N_CONS_IMP' = (MY_RULE o prove)(`SUC n = m /\ s n (x:A) ==> +let ALL_N_CONS_IMP' = (MY_RULE o prove)(`SUC n = m /\ s n (x:A) ==> (all_n m t s <=> all_n n (CONS x t) s)`, SIMP_TAC[all_n]);; -let ALL_N_CONS_EQ' = (MY_RULE o prove)(`SUC n = m ==> +let ALL_N_CONS_EQ' = (MY_RULE o prove)(`SUC n = m ==> (all_n n (CONS x t) s <=> (s n (x:A) /\ all_n m t s))`, SIMP_TAC[all_n]);; let dest_all_n all_n_tm = @@ -217,7 +217,7 @@ let eval_all_n all_n1_th beta_flag s = let eval_all_n2 all_n1_th all_n2_th beta_flag s = let ths1', suc_ths = all_n_components all_n1_th in let ths2', _ = all_n_components all_n2_th in - let ths1, ths2 = + let ths1, ths2 = if beta_flag then map MY_BETA_RULE ths1', map MY_BETA_RULE ths2' else ths1', ths2' in let ths1, ths2, suc_ths = List.rev ths1, List.rev ths2, List.rev suc_ths in @@ -255,10 +255,10 @@ let MK_M_TAYLOR_ADD' = (MY_RULE_NUM o prove) diff2c_domain domain g ==> interval_arith (f y + g y) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f y + partial i g y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x + partial2 j i g x) int))) ==> m_taylor_interval (\x. f x + g x) domain y w bounds d_bounds_list dd_bounds_list`, - REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN + REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N) /\ lift o g differentiable at y` ASSUME_TAC THENL [ @@ -270,7 +270,7 @@ let MK_M_TAYLOR_ADD' = (MY_RULE_NUM o prove) MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN - + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_add THEN ASM_REWRITE_TAC[]; @@ -299,9 +299,9 @@ let add_second_lemma' = prove(`interval_arith (partial2 j i f (x:real^N) + parti (\j int. interval_arith (partial2 j i f x + partial2 j i g x) int) j int`, REWRITE_TAC[]);; -let add_second_lemma'' = (NUMERALS_TO_NUM o prove)(`all_n 1 list +let add_second_lemma'' = (NUMERALS_TO_NUM o prove)(`all_n 1 list (\j int. interval_arith (partial2 j i f (x:real^N) + partial2 j i g x) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith (partial2 j i f x + partial2 j i g x) int)) i list`, REWRITE_TAC[]);; @@ -329,7 +329,7 @@ let eval_m_taylor_add n p_lin p_second taylor1_th taylor2_th = let bounds_th = float_interval_add p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in - let add_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, x_var] o + let add_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, x_var] o INST_TYPE[n_type_array.(n), nty]) add_partial_lemma' in let add th1 th2 = @@ -346,10 +346,10 @@ let eval_m_taylor_add n p_lin p_second taylor1_th taylor2_th = let dd1 = second_bounded_components n second1_th in let dd2 = second_bounded_components n second2_th in - let add_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o + let add_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) add_second_lemma' in - let add_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o + let add_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) add_second_lemma'' in @@ -373,11 +373,11 @@ let eval_m_taylor_add n p_lin p_second taylor1_th taylor2_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f2_tm, g_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_ADD' in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var add_op_real in @@ -395,10 +395,10 @@ let MK_M_TAYLOR_SUB' = (MY_RULE_NUM o prove) diff2c_domain domain g ==> interval_arith (f y - g y) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f y - partial i g y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x - partial2 j i g x) int))) ==> m_taylor_interval (\x. f x - g x) domain y w bounds d_bounds_list dd_bounds_list`, - REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN + REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N) /\ lift o g differentiable at y` ASSUME_TAC THENL [ @@ -410,7 +410,7 @@ let MK_M_TAYLOR_SUB' = (MY_RULE_NUM o prove) MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN - + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_sub THEN ASM_REWRITE_TAC[]; @@ -439,9 +439,9 @@ let sub_second_lemma' = prove(`interval_arith (partial2 j i f (x:real^N) - parti (\j int. interval_arith (partial2 j i f x - partial2 j i g x) int) j int`, REWRITE_TAC[]);; -let sub_second_lemma'' = (NUMERALS_TO_NUM o prove)(`all_n 1 list +let sub_second_lemma'' = (NUMERALS_TO_NUM o prove)(`all_n 1 list (\j int. interval_arith (partial2 j i f (x:real^N) - partial2 j i g x) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith (partial2 j i f x - partial2 j i g x) int)) i list`, REWRITE_TAC[]);; @@ -469,7 +469,7 @@ let eval_m_taylor_sub n p_lin p_second taylor1_th taylor2_th = let bounds_th = float_interval_sub p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in - let sub_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, x_var] o + let sub_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, x_var] o INST_TYPE[n_type_array.(n), nty]) sub_partial_lemma' in let sub th1 th2 = @@ -486,10 +486,10 @@ let eval_m_taylor_sub n p_lin p_second taylor1_th taylor2_th = let dd1 = second_bounded_components n second1_th in let dd2 = second_bounded_components n second2_th in - let sub_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o + let sub_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) sub_second_lemma' in - let sub_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o + let sub_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) sub_second_lemma'' in @@ -513,11 +513,11 @@ let eval_m_taylor_sub n p_lin p_second taylor1_th taylor2_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f2_tm, g_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_SUB' in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var sub_op_real in @@ -537,11 +537,11 @@ let MK_M_TAYLOR_MUL' = (MY_RULE_NUM o prove) diff2c_domain domain g ==> interval_arith (f y * g y) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f y * g y + f y * partial i g y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x) int))) ==> m_taylor_interval (\x. f x * g x) domain y w bounds d_bounds_list dd_bounds_list`, - REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN + REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N) /\ lift o g differentiable at y` ASSUME_TAC THENL [ @@ -553,7 +553,7 @@ let MK_M_TAYLOR_MUL' = (MY_RULE_NUM o prove) MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN - + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_mul THEN ASM_REWRITE_TAC[]; @@ -572,12 +572,12 @@ let MK_M_TAYLOR_MUL' = (MY_RULE_NUM o prove) (*************************) -let mul_partial_lemma' = +let mul_partial_lemma' = prove(`interval_arith (partial i f (y:real^N) * g y + f y * partial i g y) int <=> (\i int. interval_arith (partial i f y * g y + f y * partial i g y) int) i int`, REWRITE_TAC[]);; -let mul_second_lemma' = +let mul_second_lemma' = prove(`interval_arith ((partial2 j i f x * g (x:real^N) + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x) int <=> (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + @@ -588,7 +588,7 @@ let mul_second_lemma' = let mul_second_lemma'' = (NUMERALS_TO_NUM o prove) (`all_n 1 list (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f (x:real^N) * partial2 j i g x) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x) int)) i list`, REWRITE_TAC[]);; @@ -617,7 +617,7 @@ let eval_m_taylor_mul n p_lin p_second taylor1_th taylor2_th = let bounds_th = float_interval_mul p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in - let mul_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, y_var] o + let mul_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) mul_partial_lemma' in let mul th1 th2 = @@ -635,20 +635,20 @@ let eval_m_taylor_mul n p_lin p_second taylor1_th taylor2_th = let dd1 = second_bounded_components n second1_th in let dd2 = second_bounded_components n second2_th in - - let mul_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o + + let mul_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) mul_second_lemma' in - let mul_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o + let mul_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) mul_second_lemma'' in let undisch = UNDISCH o SPEC x_var in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in - let d2_bounds = map (fun i -> + let d2_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor2_th in undisch th0) (1--n) in @@ -668,14 +668,14 @@ let eval_m_taylor_mul n p_lin p_second taylor1_th taylor2_th = let dj1 = List.nth d1_bounds (j_int - 1) and dj2 = List.nth d2_bounds (j_int - 1) in - let mul_th = + let mul_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (th1 * f2_bound + di1 * dj2) + (dj1 * di2 + f1_bound * th2) in let int_tm = rand (concl mul_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 mul_th in - + let mul_th = eval_all_n2 th1 th2 true mul_second in let list_tm = (rand o rator o concl) mul_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] mul_second_lemma1 in @@ -686,11 +686,11 @@ let eval_m_taylor_mul n p_lin p_second taylor1_th taylor2_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f2_tm, g_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_MUL' in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var mul_op_real in @@ -707,26 +707,26 @@ let eval_m_taylor_mul n p_lin p_second taylor1_th taylor2_th = -let partial_uni_compose' = +let partial_uni_compose' = REWRITE_RULE[SWAP_FORALL_THM; GSYM RIGHT_IMP_FORALL_THM] partial_uni_compose;; -let second_partial_uni_compose' = +let second_partial_uni_compose' = REWRITE_RULE[SWAP_FORALL_THM; GSYM RIGHT_IMP_FORALL_THM] second_partial_uni_compose;; -let all_n1_raw = (GEN_REWRITE_RULE (RAND_CONV o DEPTH_CONV) [SYM num1_eq] o REFL) +let all_n1_raw = (GEN_REWRITE_RULE (RAND_CONV o DEPTH_CONV) [SYM num1_eq] o REFL) `all_n 1`;; - + (* neg *) let MK_M_TAYLOR_NEG' = (MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> interval_arith (-- (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (-- partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (-- partial2 j i f x) int))) ==> m_taylor_interval (\x. -- (f x)) domain y w bounds d_bounds_list dd_bounds_list`, - REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN + REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N)` ASSUME_TAC THENL [ @@ -737,7 +737,7 @@ let MK_M_TAYLOR_NEG' = (MY_RULE_FLOAT o prove) MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN - + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_neg THEN ASM_REWRITE_TAC[]; @@ -747,7 +747,7 @@ let MK_M_TAYLOR_NEG' = (MY_RULE_FLOAT o prove) ASM_SIMP_TAC[partial_neg]; ALL_TAC ] THEN - + UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN @@ -865,7 +865,7 @@ let MK_M_TAYLOR_ABS_NEG' = (MY_RULE_FLOAT o prove) ASM_REWRITE_TAC[ETA_AX]; ALL_TAC ] THEN - + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN @@ -922,8 +922,8 @@ let MK_M_TAYLOR_POW = prove diff2c_domain domain f ==> interval_arith ((f y) pow k) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith ((&k * (f y) pow (k - 1)) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i - (\j int. interval_arith (((&(k * (k - 1)) * f x pow (k - 2)) * partial j f x) + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (\j int. interval_arith (((&(k * (k - 1)) * f x pow (k - 2)) * partial j f x) * partial i f x + (&k * f x pow (k - 1)) * partial2 j i f x) int))) ==> m_taylor_interval (\x. (f x) pow k) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN @@ -942,7 +942,7 @@ let MK_M_TAYLOR_POW = prove REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC ] THEN - + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN @@ -951,7 +951,7 @@ let MK_M_TAYLOR_POW = prove apply_tac diff_uni_compose THEN ASM_REWRITE_TAC[REAL_DIFFERENTIABLE_AT_POW]; MP_TAC (ISPECL [`y:real^N`; `f:real^N->real`] partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN - DISCH_THEN (MP_TAC o SPEC `(\x:real. x pow k)`) THEN + DISCH_THEN (MP_TAC o SPEC `(\x:real. x pow k)`) THEN REWRITE_TAC[REAL_DIFFERENTIABLE_AT_POW] THEN ASM_SIMP_TAC[derivative_pow_x]; ALL_TAC @@ -971,8 +971,8 @@ let MK_M_TAYLOR_POW2' = (UNDISCH_ALL o PURE_REWRITE_RULE[all_n1_raw] o prove) diff2c_domain domain f ==> interval_arith ((f y) pow 2) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith ((&2 * f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i - (\j int. interval_arith (&2 * (partial j f x * partial i f x + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (\j int. interval_arith (&2 * (partial j f x * partial i f x + f x * partial2 j i f x)) int))) ==> m_taylor_interval (\x. (f x) pow 2) domain y w bounds d_bounds_list dd_bounds_list`, REPEAT STRIP_TAC THEN MP_TAC (INST[`2`, `k:num`] MK_M_TAYLOR_POW) THEN @@ -986,7 +986,7 @@ let MK_M_TAYLOR_POW' = (UNDISCH_ALL o PURE_REWRITE_RULE[all_n1_raw] o prove) interval_arith (f y * f y pow (k - 1)) bounds ==> k >= 2 ==> all_n 1 d_bounds_list (\i int. interval_arith ((&k * f y pow (k - 1)) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f x) * partial i f x + f x * partial2 j i f x)) int))) ==> m_taylor_interval (\x. (f x) pow k) domain y w bounds d_bounds_list dd_bounds_list`, @@ -994,7 +994,7 @@ let MK_M_TAYLOR_POW' = (UNDISCH_ALL o PURE_REWRITE_RULE[all_n1_raw] o prove) ASM_REWRITE_TAC[GSYM REAL_OF_NUM_MUL; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ SUBGOAL_THEN `!x. x pow k = x * x pow (k - 1)` ASSUME_TAC THENL [ - GEN_TAC THEN MP_TAC (ARITH_RULE `k >= 2 ==> k = 1 + (k - 1)`) THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN MP_TAC (ARITH_RULE `k >= 2 ==> k = 1 + (k - 1)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [th]) THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1]; ALL_TAC @@ -1007,11 +1007,11 @@ let MK_M_TAYLOR_POW' = (UNDISCH_ALL o PURE_REWRITE_RULE[all_n1_raw] o prove) REWRITE_TAC[REAL_POW_ADD; REAL_POW_1]; ALL_TAC ] THEN - ASM_REWRITE_TAC[REAL_ARITH `(((k * k1) * f2) * j) * i + (k * f2 * f) * x = + ASM_REWRITE_TAC[REAL_ARITH `(((k * k1) * f2) * j) * i + (k * f2 * f) * x = (k * f2) * ((k1 * j) * i + f * x)`]);; (* inv *) -let MK_M_TAYLOR_INV' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq] o DISCH_ALL o +let MK_M_TAYLOR_INV' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> @@ -1019,11 +1019,11 @@ let MK_M_TAYLOR_INV' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq] o DISCH_ALL o diff2c_domain domain f ==> interval_arith (inv (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (--inv (f y * f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f x - inv (f x * f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. inv (f x)) domain y w bounds d_bounds_list dd_bounds_list`, - REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN + REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N)` ASSUME_TAC THENL [ @@ -1094,7 +1094,7 @@ let MK_M_TAYLOR_INV' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq] o DISCH_ALL o (* sqrt *) -let MK_M_TAYLOR_SQRT' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq; float4_eq] o +let MK_M_TAYLOR_SQRT' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq; float4_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> @@ -1102,7 +1102,7 @@ let MK_M_TAYLOR_SQRT' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq; float4_eq] o diff2c_domain domain f ==> interval_arith (sqrt (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (inv (&2 * sqrt (f y)) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f x + inv (&2 * sqrt (f x)) * partial2 j i f x) int))) ==> m_taylor_interval (\x. sqrt (f x)) domain y w bounds d_bounds_list dd_bounds_list`, @@ -1183,14 +1183,14 @@ let MK_M_TAYLOR_SQRT' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq; float4_eq] o ASM_SIMP_TAC[REAL_ARITH `&4 * a * b = (&2 * a) * (&2 * b)`]);; (* exp *) -let MK_M_TAYLOR_EXP' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq] o DISCH_ALL o +let MK_M_TAYLOR_EXP' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> interval_arith (exp (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (exp (f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i - (\j int. interval_arith ((exp (f x) * partial j f x) + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (\j int. interval_arith ((exp (f x) * partial j f x) * partial i f x + exp (f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. exp (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN @@ -1233,7 +1233,7 @@ let MK_M_TAYLOR_EXP' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq] o DISCH_ALL o ASM_SIMP_TAC[nth_derivative2; second_derivative_exp; derivative_exp]);; (* log *) -let MK_M_TAYLOR_LOG' = (UNDISCH_ALL o PURE_REWRITE_RULE[num2_eq] o +let MK_M_TAYLOR_LOG' = (UNDISCH_ALL o PURE_REWRITE_RULE[num2_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> @@ -1241,7 +1241,7 @@ let MK_M_TAYLOR_LOG' = (UNDISCH_ALL o PURE_REWRITE_RULE[num2_eq] o diff2c_domain domain f ==> interval_arith (log (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (inv (f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((--(inv (f x) pow 2) * partial j f x) * partial i f x + inv (f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. log (f x)) domain y w bounds d_bounds_list dd_bounds_list`, @@ -1314,14 +1314,14 @@ let MK_M_TAYLOR_LOG' = (UNDISCH_ALL o PURE_REWRITE_RULE[num2_eq] o ASM_SIMP_TAC[second_derivative_log; derivative_log; REAL_INV_POW]);; (* atn *) -let MK_M_TAYLOR_ATN' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o DISCH_ALL o +let MK_M_TAYLOR_ATN' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> interval_arith (atn (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (inv (&1 + f y * f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i - (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. atn (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN @@ -1366,14 +1366,14 @@ let MK_M_TAYLOR_ATN' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; nu ASM_SIMP_TAC[]);; (* cos *) -let MK_M_TAYLOR_COS' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o DISCH_ALL o +let MK_M_TAYLOR_COS' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> interval_arith (cos (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (--sin (f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i - (\j int. interval_arith (--((cos (f x) * partial j f x) * partial i f x + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (\j int. interval_arith (--((cos (f x) * partial j f x) * partial i f x + sin (f x) * partial2 j i f x)) int))) ==> m_taylor_interval (\x. cos (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN @@ -1415,13 +1415,13 @@ let MK_M_TAYLOR_COS' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; nu ASM_SIMP_TAC[REAL_ARITH `(--c * p1) * p2 + --s * p3 = --((c * p1) * p2 + s * p3)`]);; (* sin *) -let MK_M_TAYLOR_SIN' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o DISCH_ALL o +let MK_M_TAYLOR_SIN' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> interval_arith (sin (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (cos (f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (((--sin (f x)) * partial j f x) * partial i f x + cos (f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. sin (f x)) domain y w bounds d_bounds_list dd_bounds_list`, @@ -1466,16 +1466,16 @@ let MK_M_TAYLOR_SIN' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; nu let iabs_lemma = GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [GSYM float1_eq] (REFL `iabs f_bounds < &1`);; let MK_M_TAYLOR_ACS' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[iabs_lemma] o - PURE_REWRITE_RULE[float1_eq; num3_eq] o DISCH_ALL o + PURE_REWRITE_RULE[float1_eq; num3_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> iabs f_bounds < &1 ==> diff2c_domain domain f ==> interval_arith (acs (f y)) bounds ==> - all_n 1 d_bounds_list + all_n 1 d_bounds_list (\i int. interval_arith (--inv (sqrt (&1 - f y * f y)) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f x - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int))) ==> m_taylor_interval (\x. acs (f x)) domain y w bounds d_bounds_list dd_bounds_list`, @@ -1550,16 +1550,16 @@ let MK_M_TAYLOR_ACS' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[iabs_lemma] o (* asn *) let MK_M_TAYLOR_ASN' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[iabs_lemma] o - PURE_REWRITE_RULE[float1_eq; num3_eq] o DISCH_ALL o + PURE_REWRITE_RULE[float1_eq; num3_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> iabs f_bounds < &1 ==> diff2c_domain domain f ==> interval_arith (asn (f y)) bounds ==> - all_n 1 d_bounds_list + all_n 1 d_bounds_list (\i int. interval_arith (inv (sqrt (&1 - f y * f y)) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (((f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f x + inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int))) ==> m_taylor_interval (\x. asn (f x)) domain y w bounds d_bounds_list dd_bounds_list`, @@ -1636,17 +1636,17 @@ let MK_M_TAYLOR_ASN' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[iabs_lemma] o let float_neg1_eq = FLOAT_TO_NUM_CONV (mk_float (-1) 0);; -let MK_M_TAYLOR_MATAN' = (UNDISCH_ALL o - PURE_REWRITE_RULE[float1_eq; SYM float_neg1_eq] o DISCH_ALL o +let MK_M_TAYLOR_MATAN' = (UNDISCH_ALL o + PURE_REWRITE_RULE[float1_eq; SYM float_neg1_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> interval_gt (-- &1) f_bounds ==> diff2c_domain domain f ==> interval_arith (matan (f y)) bounds ==> - all_n 1 d_bounds_list + all_n 1 d_bounds_list (\i int. interval_arith (dmatan (f y) * partial i f y) int) ==> - (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i + (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((ddmatan (f x) * partial j f x) * partial i f x + dmatan (f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. matan (f x)) domain y w bounds d_bounds_list dd_bounds_list`, @@ -1717,30 +1717,30 @@ let MK_M_TAYLOR_MATAN' = (UNDISCH_ALL o (* eval_m_taylor_pow2 *) (* ----------------------- *) -let pow2_partial_lemma' = +let pow2_partial_lemma' = prove(`interval_arith ((&2 * f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith ((&2 * f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let pow2_second_lemma' = - prove(`interval_arith (&2 * (partial j f (x:real^N) * partial i f x + +let pow2_second_lemma' = + prove(`interval_arith (&2 * (partial j f (x:real^N) * partial i f x + f x * partial2 j i f x)) int <=> - (\j int. interval_arith (&2 * (partial j f x * partial i f x + + (\j int. interval_arith (&2 * (partial j f x * partial i f x + f x * partial2 j i f x)) int) j int`, REWRITE_TAC[]);; let pow2_second_lemma'' = (PURE_REWRITE_RULE[all_n1_raw] o prove) - (`all_n 1 list - (\j int. interval_arith (&2 * (partial j f (x:real^N) * partial i f x + + (`all_n 1 list + (\j int. interval_arith (&2 * (partial j f (x:real^N) * partial i f x + f x * partial2 j i f x)) int) <=> - (\i list. all_n 1 list - (\j int. interval_arith (&2 * (partial j f x * partial i f x + + (\i list. all_n 1 list + (\j int. interval_arith (&2 * (partial j f x * partial i f x + f x * partial2 j i f x)) int)) i list`, REWRITE_TAC[]);; -let eval_m_taylor_pow2 n p_lin p_second taylor1_th = +let eval_m_taylor_pow2 n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in @@ -1758,15 +1758,15 @@ let eval_m_taylor_pow2 n p_lin p_second taylor1_th = let f1_bound = undisch f1_bound0 in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_pow p_lin 2 bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) pow2_partial_lemma' in - let u_bounds = + let u_bounds = let ( * ) = float_interval_mul p_lin in two_interval * bounds1_th in @@ -1784,15 +1784,15 @@ let eval_m_taylor_pow2 n p_lin p_second taylor1_th = let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) pow2_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) pow2_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -1808,14 +1808,14 @@ let eval_m_taylor_pow2 n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in two_interval * (dj1 * di1 + f1_bound * th1) in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -1825,11 +1825,11 @@ let eval_m_taylor_pow2 n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_POW2' in let k_tm = rand (rand (rator (concl bounds_th))) in @@ -1840,26 +1840,26 @@ let eval_m_taylor_pow2 n p_lin p_second taylor1_th = (* eval_m_taylor_pow *) (* ----------------------- *) -let pow_partial_lemma' = +let pow_partial_lemma' = prove(`interval_arith ((&k * f y pow (k - 1)) * partial i f (y:real^N)) int <=> (\i int. interval_arith ((&k * f y pow (k - 1)) * partial i f y) int) i int`, REWRITE_TAC[]);; -let pow_second_lemma' = - prove(`interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) +let pow_second_lemma' = + prove(`interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) * partial i f x + f x * partial2 j i f x)) int <=> - (\j int. interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) + (\j int. interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) * partial i f x + f x * partial2 j i f x)) int) j int`, REWRITE_TAC[]);; let pow_second_lemma'' = (PURE_REWRITE_RULE[all_n1_raw] o prove) - (`all_n 1 list - (\j int. interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) + (`all_n 1 list + (\j int. interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) * partial i f x + f x * partial2 j i f x)) int) <=> - (\i list. all_n 1 list - (\j int. interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) + (\i list. all_n 1 list + (\j int. interval_arith ((&k * f x pow (k - 2)) * ((&(k - 1) * partial j f (x:real^N)) * partial i f x + f x * partial2 j i f x)) int)) i list`, REWRITE_TAC[]);; @@ -1898,16 +1898,16 @@ let eval_m_taylor_pow k = let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_pow_k1 = float_interval_pow p_lin (k - 1) bounds1_th in - let bounds_th = + let bounds_th = let ( * ) = float_interval_mul p_lin in bounds1_th * bounds_pow_k1 in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) pow_partial_lemma' in - let u_bounds = + let u_bounds = let ( * ) = float_interval_mul p_lin in k_interval * bounds_pow_k1 in @@ -1925,15 +1925,15 @@ let eval_m_taylor_pow k = let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) pow_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) pow_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -1955,14 +1955,14 @@ let eval_m_taylor_pow k = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in d2_th0 * ((k1_interval * dj1) * di1 + f1_bound * th1) in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -1972,11 +1972,11 @@ let eval_m_taylor_pow k = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_POW in let eq_th = pow_beta_gen_eq f1_tm x_var k_tm in @@ -1987,12 +1987,12 @@ let eval_m_taylor_pow k = (* eval_m_taylor_inv *) (* ----------------------- *) -let inv_partial_lemma' = +let inv_partial_lemma' = prove(`interval_arith (--inv (f y * f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (--inv (f y * f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let inv_second_lemma' = +let inv_second_lemma' = prove(`interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f (x:real^N) - inv (f x * f x) * partial2 j i f x) int <=> (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f x - @@ -2001,10 +2001,10 @@ let inv_second_lemma' = let inv_second_lemma'' = (PURE_REWRITE_RULE[GSYM num1_eq] o prove) - (`all_n 1 list + (`all_n 1 list (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f (x:real^N) - inv (f x * f x) * partial2 j i f x) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f x - inv (f x * f x) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; @@ -2034,15 +2034,15 @@ let eval_m_taylor_inv n p_lin p_second taylor1_th = let cond_th = check_interval_not_zero f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_inv p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) inv_partial_lemma' in - let u_bounds = + let u_bounds = let neg, inv, ( * ) = float_interval_neg, float_interval_inv p_lin, float_interval_mul p_lin in neg (inv (bounds1_th * bounds1_th)) in @@ -2062,16 +2062,16 @@ let eval_m_taylor_inv n p_lin p_second taylor1_th = let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) inv_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) inv_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -2079,7 +2079,7 @@ let eval_m_taylor_inv n p_lin p_second taylor1_th = let d1_th0, d2_th0 = let inv, ( * ) = float_interval_inv p_second, float_interval_mul p_second in let ff = f1_bound * f1_bound in - inv ff, + inv ff, two_interval * inv (f1_bound * ff) in @@ -2095,14 +2095,14 @@ let eval_m_taylor_inv n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( - ) = float_interval_mul p_second, float_interval_sub p_second in (d2_th0 * dj1) * di1 - d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -2112,12 +2112,12 @@ let eval_m_taylor_inv n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_INV' in let eq_th = unary_beta_gen_eq f1_tm x_var inv_op_real in @@ -2127,13 +2127,13 @@ let eval_m_taylor_inv n p_lin p_second taylor1_th = (* eval_m_taylor_sqrt *) (* ----------------------- *) -let sqrt_partial_lemma' = +let sqrt_partial_lemma' = prove(`interval_arith (inv (&2 * sqrt (f y)) * partial i f (y:real^N)) int <=> (\i int. interval_arith (inv (&2 * sqrt (f y)) * partial i f y) int) i int`, REWRITE_TAC[]);; -let sqrt_second_lemma' = +let sqrt_second_lemma' = prove(`interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f (x:real^N) + inv (&2 * sqrt (f x)) * partial2 j i f x) int <=> (\j int. interval_arith ((--inv ((&2 * sqrt (f x))*(&2 * f x)) * partial j f x) * partial i f x + @@ -2142,10 +2142,10 @@ let sqrt_second_lemma' = let sqrt_second_lemma'' = (PURE_REWRITE_RULE[GSYM num1_eq] o prove) - (`all_n 1 list + (`all_n 1 list (\j int. interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f x + inv (&2 * sqrt (f x)) * partial2 j i f (x:real^N)) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f x + inv (&2 * sqrt (f x)) * partial2 j i f (x:real^N)) int)) i list`, REWRITE_TAC[]);; @@ -2173,15 +2173,15 @@ let eval_m_taylor_sqrt n p_lin p_second taylor1_th = let cond_th = check_interval_pos f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_sqrt p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) sqrt_partial_lemma' in - let u_bounds = + let u_bounds = let inv, ( * ) = float_interval_inv p_lin, float_interval_mul p_lin in inv (two_interval * bounds_th) in @@ -2200,15 +2200,15 @@ let eval_m_taylor_sqrt n p_lin p_second taylor1_th = let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) sqrt_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) sqrt_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -2232,14 +2232,14 @@ let eval_m_taylor_sqrt n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -2249,12 +2249,12 @@ let eval_m_taylor_sqrt n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_SQRT' in let eq_th = unary_beta_gen_eq f1_tm x_var sqrt_tm in @@ -2265,32 +2265,32 @@ let eval_m_taylor_sqrt n p_lin p_second taylor1_th = (* eval_m_taylor_exp *) (* ----------------------- *) -let exp_partial_lemma' = +let exp_partial_lemma' = prove(`interval_arith (exp (f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (exp (f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let exp_second_lemma' = - prove(`interval_arith ((exp (f x) * partial j f (x:real^N)) +let exp_second_lemma' = + prove(`interval_arith ((exp (f x) * partial j f (x:real^N)) * partial i f x + exp (f x) * partial2 j i f x) int <=> - (\j int. interval_arith ((exp (f x) * partial j f x) + (\j int. interval_arith ((exp (f x) * partial j f x) * partial i f x + exp (f x) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; -let exp_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o +let exp_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) - (`all_n 1 list - (\j int. interval_arith ((exp (f x) * partial j f (x:real^N)) + (`all_n 1 list + (\j int. interval_arith ((exp (f x) * partial j f (x:real^N)) * partial i f x + exp (f x) * partial2 j i f x) int) <=> - (\i list. all_n 1 list - (\j int. interval_arith ((exp (f x) * partial j f x) + (\i list. all_n 1 list + (\j int. interval_arith ((exp (f x) * partial j f x) * partial i f x + exp (f x) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; -let eval_m_taylor_exp n p_lin p_second taylor1_th = +let eval_m_taylor_exp n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in @@ -2308,15 +2308,15 @@ let eval_m_taylor_exp n p_lin p_second taylor1_th = let f1_bound = undisch f1_bound0 in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_exp p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) exp_partial_lemma' in - let u_bounds = + let u_bounds = let exp = float_interval_exp p_lin in exp (bounds1_th) in @@ -2334,15 +2334,15 @@ let eval_m_taylor_exp n p_lin p_second taylor1_th = let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) exp_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) exp_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -2364,14 +2364,14 @@ let eval_m_taylor_exp n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -2381,11 +2381,11 @@ let eval_m_taylor_exp n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_EXP' in let eq_th = unary_beta_gen_eq f1_tm x_var exp_tm in @@ -2396,13 +2396,13 @@ let eval_m_taylor_exp n p_lin p_second taylor1_th = (* eval_m_taylor_log *) (* ----------------------- *) -let log_partial_lemma' = +let log_partial_lemma' = prove(`interval_arith (inv (f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (inv (f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let log_second_lemma' = +let log_second_lemma' = prove(`interval_arith ((--(inv (f x) pow 2) * partial j f x) * partial i f (x:real^N) + inv (f x) * partial2 j i f x) int <=> (\j int. interval_arith ((--(inv (f x) pow 2) * partial j f x) * partial i f x + @@ -2411,10 +2411,10 @@ let log_second_lemma' = let log_second_lemma'' = (PURE_REWRITE_RULE[GSYM num1_eq] o prove) - (`all_n 1 list + (`all_n 1 list (\j int. interval_arith ((--(inv (f x) pow 2) * partial j f x) * partial i f x + inv (f x) * partial2 j i f (x:real^N)) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith ((--(inv (f x) pow 2) * partial j f x) * partial i f x + inv (f x) * partial2 j i f (x:real^N)) int)) i list`, REWRITE_TAC[]);; @@ -2442,15 +2442,15 @@ let eval_m_taylor_log n p_lin p_second taylor1_th = let cond_th = check_interval_pos f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_log p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) log_partial_lemma' in - let u_bounds = + let u_bounds = let inv = float_interval_inv p_lin in inv (bounds1_th) in @@ -2468,21 +2468,21 @@ let eval_m_taylor_log n p_lin p_second taylor1_th = let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) log_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) log_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = - let neg, pow2, inv = + let neg, pow2, inv = float_interval_neg, float_interval_pow p_second 2, float_interval_inv p_second in let inv_f = inv f1_bound in inv_f, neg (pow2 inv_f) in @@ -2499,14 +2499,14 @@ let eval_m_taylor_log n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -2516,12 +2516,12 @@ let eval_m_taylor_log n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_LOG' in let eq_th = unary_beta_gen_eq f1_tm x_var log_tm in @@ -2533,33 +2533,33 @@ let eval_m_taylor_log n p_lin p_second taylor1_th = (* eval_m_taylor_atn *) (* ----------------------- *) -let atn_partial_lemma' = +let atn_partial_lemma' = prove(`interval_arith (inv (&1 + f y * f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (inv (&1 + f y * f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let atn_second_lemma' = - prove(`interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f (x:real^N)) +let atn_second_lemma' = + prove(`interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f (x:real^N)) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int <=> - (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) + (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; -let atn_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o +let atn_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) - (`all_n 1 list - (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f (x:real^N)) + (`all_n 1 list + (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f (x:real^N)) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int) <=> - (\i list. all_n 1 list - (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) + (\i list. all_n 1 list + (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; -let eval_m_taylor_atn n p_lin p_second taylor1_th = +let eval_m_taylor_atn n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in @@ -2577,15 +2577,15 @@ let eval_m_taylor_atn n p_lin p_second taylor1_th = let f1_bound = undisch f1_bound0 in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_atn p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) atn_partial_lemma' in - let u_bounds = + let u_bounds = let inv, ( + ), ( * ) = float_interval_inv p_lin, float_interval_add p_lin, float_interval_mul p_lin in inv (one_interval + bounds1_th * bounds1_th) in @@ -2604,15 +2604,15 @@ let eval_m_taylor_atn n p_lin p_second taylor1_th = let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) atn_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) atn_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -2637,14 +2637,14 @@ let eval_m_taylor_atn n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -2654,11 +2654,11 @@ let eval_m_taylor_atn n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_ATN' in let eq_th = unary_beta_gen_eq f1_tm x_var atn_tm in @@ -2669,13 +2669,13 @@ let eval_m_taylor_atn n p_lin p_second taylor1_th = (* eval_m_taylor_cos *) (* ----------------------- *) -let cos_partial_lemma' = +let cos_partial_lemma' = prove(`interval_arith (--sin (f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (--sin (f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let cos_second_lemma' = +let cos_second_lemma' = prove(`interval_arith (--((cos (f x) * partial j f (x:real^N)) * partial i f x + sin (f x) * partial2 j i f x)) int <=> (\j int. interval_arith (--((cos (f x) * partial j f x) * partial i f x @@ -2683,18 +2683,18 @@ let cos_second_lemma' = REWRITE_TAC[]);; -let cos_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o +let cos_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) - (`all_n 1 list + (`all_n 1 list (\j int. interval_arith (--((cos (f x) * partial j f (x:real^N)) * partial i f x + sin (f x) * partial2 j i f x)) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith (--((cos (f x) * partial j f (x:real^N)) * partial i f x + sin (f x) * partial2 j i f x)) int)) i list`, REWRITE_TAC[]);; -let eval_m_taylor_cos n p_lin p_second taylor1_th = +let eval_m_taylor_cos n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in @@ -2712,15 +2712,15 @@ let eval_m_taylor_cos n p_lin p_second taylor1_th = let f1_bound = undisch f1_bound0 in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_cos p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) cos_partial_lemma' in - let u_bounds = + let u_bounds = let sin, neg = float_interval_sin p_lin, float_interval_neg in neg (sin bounds1_th) in @@ -2738,15 +2738,15 @@ let eval_m_taylor_cos n p_lin p_second taylor1_th = let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) cos_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) cos_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -2767,7 +2767,7 @@ let eval_m_taylor_cos n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in let neg = float_interval_neg in neg ((d2_th0 * dj1) * di1 + d1_th0 * th1) in @@ -2775,7 +2775,7 @@ let eval_m_taylor_cos n p_lin p_second taylor1_th = let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -2785,11 +2785,11 @@ let eval_m_taylor_cos n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_COS' in let eq_th = unary_beta_gen_eq f1_tm x_var cos_tm in @@ -2800,13 +2800,13 @@ let eval_m_taylor_cos n p_lin p_second taylor1_th = (* eval_m_taylor_sin *) (* ----------------------- *) -let sin_partial_lemma' = +let sin_partial_lemma' = prove(`interval_arith (cos (f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (cos (f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let sin_second_lemma' = +let sin_second_lemma' = prove(`interval_arith ((--sin (f x) * partial j f (x:real^N)) * partial i f x + cos (f x) * partial2 j i f x) int <=> (\j int. interval_arith ((--sin (f x) * partial j f x) * partial i f x @@ -2814,18 +2814,18 @@ let sin_second_lemma' = REWRITE_TAC[]);; -let sin_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o +let sin_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) - (`all_n 1 list + (`all_n 1 list (\j int. interval_arith ((--sin (f x) * partial j f (x:real^N)) * partial i f x + cos (f x) * partial2 j i f x) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith ((--sin (f x) * partial j f (x:real^N)) * partial i f x + cos (f x) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; -let eval_m_taylor_sin n p_lin p_second taylor1_th = +let eval_m_taylor_sin n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in @@ -2843,15 +2843,15 @@ let eval_m_taylor_sin n p_lin p_second taylor1_th = let f1_bound = undisch f1_bound0 in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_sin p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) sin_partial_lemma' in - let u_bounds = + let u_bounds = let cos = float_interval_cos p_lin in cos bounds1_th in @@ -2869,15 +2869,15 @@ let eval_m_taylor_sin n p_lin p_second taylor1_th = let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) sin_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) sin_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -2899,14 +2899,14 @@ let eval_m_taylor_sin n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -2916,11 +2916,11 @@ let eval_m_taylor_sin n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_SIN' in let eq_th = unary_beta_gen_eq f1_tm x_var sin_tm in @@ -2931,24 +2931,24 @@ let eval_m_taylor_sin n p_lin p_second taylor1_th = (* eval_m_taylor_asn *) (* ----------------------- *) -let asn_partial_lemma' = +let asn_partial_lemma' = prove(`interval_arith (inv (sqrt (&1 - f y * f y)) * partial i f (y:real^N)) int <=> (\i int. interval_arith (inv (sqrt (&1 - f y * f y)) * partial i f y) int) i int`, REWRITE_TAC[]);; -let asn_second_lemma' = +let asn_second_lemma' = prove(`interval_arith (((f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) + inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int <=> (\j int. interval_arith (((f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) + inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; -let asn_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num3_eq; num2_eq] o NUMERALS_TO_NUM o +let asn_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num3_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) - (`all_n 1 list + (`all_n 1 list (\j int. interval_arith (((f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) + inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith (((f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) + inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; @@ -2975,15 +2975,15 @@ let eval_m_taylor_asn n p_lin p_second taylor1_th = let cond_th = EQT_ELIM (check_interval_iabs f_bounds_tm one_float) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_asn p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) asn_partial_lemma' in - let u_bounds = + let u_bounds = let inv, sqrt = float_interval_inv p_lin, float_interval_sqrt p_lin in let ( * ), (-) = float_interval_mul p_lin, float_interval_sub p_lin in inv (sqrt (one_interval - bounds1_th * bounds1_th)) in @@ -3003,15 +3003,15 @@ let eval_m_taylor_asn n p_lin p_second taylor1_th = let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) asn_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) asn_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -3036,14 +3036,14 @@ let eval_m_taylor_asn n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -3053,12 +3053,12 @@ let eval_m_taylor_asn n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_ASN' in let eq_th = unary_beta_gen_eq f1_tm x_var asn_tm in @@ -3069,24 +3069,24 @@ let eval_m_taylor_asn n p_lin p_second taylor1_th = (* eval_m_taylor_acs *) (* ----------------------- *) -let acs_partial_lemma' = +let acs_partial_lemma' = prove(`interval_arith (--inv (sqrt (&1 - f y * f y)) * partial i f (y:real^N)) int <=> (\i int. interval_arith (--inv (sqrt (&1 - f y * f y)) * partial i f y) int) i int`, REWRITE_TAC[]);; -let acs_second_lemma' = +let acs_second_lemma' = prove(`interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int <=> (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; -let acs_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num3_eq; num2_eq] o NUMERALS_TO_NUM o +let acs_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num3_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) - (`all_n 1 list + (`all_n 1 list (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int) <=> - (\i list. all_n 1 list + (\i list. all_n 1 list (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; @@ -3113,15 +3113,15 @@ let eval_m_taylor_acs n p_lin p_second taylor1_th = let cond_th = EQT_ELIM (check_interval_iabs f_bounds_tm one_float) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_acs p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) acs_partial_lemma' in - let u_bounds = + let u_bounds = let inv, sqrt, neg = float_interval_inv p_lin, float_interval_sqrt p_lin, float_interval_neg in let ( * ), (-) = float_interval_mul p_lin, float_interval_sub p_lin in neg (inv (sqrt (one_interval - bounds1_th * bounds1_th))) in @@ -3141,15 +3141,15 @@ let eval_m_taylor_acs n p_lin p_second taylor1_th = let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) acs_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) acs_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -3174,14 +3174,14 @@ let eval_m_taylor_acs n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( - ) = float_interval_mul p_second, float_interval_sub p_second in (d2_th0 * dj1) * di1 - d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -3191,12 +3191,12 @@ let eval_m_taylor_acs n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_ACS' in let eq_th = unary_beta_gen_eq f1_tm x_var acs_tm in @@ -3207,27 +3207,27 @@ let eval_m_taylor_acs n p_lin p_second taylor1_th = (* eval_m_taylor_matan *) (* ----------------------- *) -let matan_partial_lemma' = +let matan_partial_lemma' = prove(`interval_arith (dmatan (f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (dmatan (f y) * partial i f y) int) i int`, REWRITE_TAC[]);; -let matan_second_lemma' = - prove(`interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + +let matan_second_lemma' = + prove(`interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + dmatan (f x) * partial2 j i f x) int <=> - (\j int. interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + + (\j int. interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + dmatan (f x) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; -let matan_second_lemma'' = (NUMERALS_TO_NUM o +let matan_second_lemma'' = (NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) - (`all_n 1 list - (\j int. interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + (`all_n 1 list + (\j int. interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + dmatan (f x) * partial2 j i f x) int) <=> - (\i list. all_n 1 list - (\j int. interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + (\i list. all_n 1 list + (\j int. interval_arith ((ddmatan (f x) * partial j f x) * partial i f (x:real^N) + dmatan (f x) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; @@ -3256,15 +3256,15 @@ let eval_m_taylor_matan n p_lin p_second taylor1_th = let cond_th = check_interval_gt neg_one_float f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_matan p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) - let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o + let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) matan_partial_lemma' in - let u_bounds = + let u_bounds = float_interval_dmatan p_lin bounds1_th in let u_lin th1 = @@ -3282,15 +3282,15 @@ let eval_m_taylor_matan n p_lin p_second taylor1_th = let dd1 = second_bounded_components n second1_th in - + (* second_lemma', second_lemma'' *) - let u_second_lemma0 = (INST[f1_tm, f_var] o + let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) matan_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) matan_second_lemma'' in - let d1_bounds = map (fun i -> + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -3311,14 +3311,14 @@ let eval_m_taylor_matan n p_lin p_second taylor1_th = let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) - let u_th = + let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in - + let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in @@ -3328,12 +3328,12 @@ let eval_m_taylor_matan n p_lin p_second taylor1_th = let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in - let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o + let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o - INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; + MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o + INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; + bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_MATAN' in let eq_th = unary_beta_gen_eq f1_tm x_var matan_tm in @@ -3442,15 +3442,15 @@ let f_bounds_tm = (rand o concl) f1_bound;; let cond_th = check_interval_gt neg_one_float f_bounds_tm;; let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th;; - + let bounds_th = float_interval_matan p_lin bounds1_th;; let bounds_tm = (rand o concl) bounds_th;; (* partial_lemma' *) -let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o +let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) matan_partial_lemma';; -let u_bounds = +let u_bounds = float_interval_dmatan p_lin bounds1_th;; let u_lin th1 = @@ -3462,7 +3462,7 @@ let u_lin th1 = let i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] u_lemma0 in EQ_MP th0 u_th;; - + let df_th = eval_all_n df1_th true u_lin;; let d_bounds_list = (rand o rator o concl) df_th;; *) diff --git a/Formal_ineqs/taylor/m_taylor_arith2.hl b/Formal_ineqs/taylor/m_taylor_arith2.hl index 90f09a7b..162e50d4 100644 --- a/Formal_ineqs/taylor/m_taylor_arith2.hl +++ b/Formal_ineqs/taylor/m_taylor_arith2.hl @@ -63,7 +63,7 @@ let gen_taylor_arith_thm arith_th final_rule n = let dd_bounds_list = mk_list (ddfs, type_of (hd ddfs)) in let th1 = INST[d_bounds_list, d_bounds_list_var; dd_bounds_list, dd_bounds_list_var] th0 in let th2 = (CONV_RULE NUM_REDUCE_CONV o REWRITE_RULE[all_n]) th1 in - (UNDISCH_ALL o final_rule o REWRITE_RULE[GSYM CONJ_ASSOC] o + (UNDISCH_ALL o final_rule o REWRITE_RULE[GSYM CONJ_ASSOC] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def]) th2;; let gen_add_thm = gen_taylor_arith_thm MK_M_TAYLOR_ADD' (CONV_RULE ALL_CONV);; @@ -74,18 +74,18 @@ let gen_inv_thm = gen_taylor_arith_thm MK_M_TAYLOR_INV' (REWRITE_RULE[float2_eq] let gen_sqrt_thm = gen_taylor_arith_thm MK_M_TAYLOR_SQRT' (REWRITE_RULE[float2_eq]);; let gen_exp_thm = gen_taylor_arith_thm MK_M_TAYLOR_EXP' (CONV_RULE ALL_CONV);; -let gen_log_thm = +let gen_log_thm = let pow2_th = (SYM o REWRITE_CONV[SYM num2_eq]) `x pow 2` in gen_taylor_arith_thm MK_M_TAYLOR_LOG' (REWRITE_RULE[pow2_th]);; -let gen_atn_thm = +let gen_atn_thm = let pow2_th = (SYM o REWRITE_CONV[SYM num2_eq]) `x pow 2` in gen_taylor_arith_thm MK_M_TAYLOR_ATN' (REWRITE_RULE[float2_eq; float1_eq; pow2_th]);; -let gen_cos_thm = +let gen_cos_thm = gen_taylor_arith_thm MK_M_TAYLOR_COS' (CONV_RULE ALL_CONV);; -let gen_sin_thm = +let gen_sin_thm = gen_taylor_arith_thm MK_M_TAYLOR_SIN' (CONV_RULE ALL_CONV);; let gen_acs_thm = @@ -179,10 +179,10 @@ let eval_m_taylor_add2 n p_lin p_second taylor1_th taylor2_th = let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in - let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o + let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o - INST([f1_tm, f_var; f2_tm, g_var; + INST([f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) add_ths_array.(n) in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var add_op_real in @@ -237,10 +237,10 @@ let eval_m_taylor_sub2 n p_lin p_second taylor1_th taylor2_th = let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in - let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o + let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o - INST([f1_tm, f_var; f2_tm, g_var; + INST([f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) sub_ths_array.(n) in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var sub_op_real in @@ -316,10 +316,10 @@ let eval_m_taylor_mul2 n p_lin p_second taylor1_th taylor2_th = let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in - let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o - MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o + let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o + MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o - INST([f1_tm, f_var; f2_tm, g_var; + INST([f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) mul_ths_array.(n) in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var mul_op_real in @@ -367,9 +367,9 @@ let eval_m_taylor_neg2_raw norm_flag n taylor1_th = let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in - let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP bounds_th o + let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o - INST([f1_tm, f_var; + INST([f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) neg_ths_array.(n) in if norm_flag then @@ -385,11 +385,11 @@ let eval_m_taylor_neg2 = eval_m_taylor_neg2_raw true;; (* abs *) (* ----------------------- *) -let eval_m_taylor_abs2 n p_second taylor1_th = +let eval_m_taylor_abs2 n p_second taylor1_th = let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f_bounds_tm = (rand o rand o snd o dest_forall o concl) f1_bound0 in - let cond_th, taylor_th, th0, - (f1_tm, domain_tm, y_tm, w_tm, bounds_tm, d_tm, dd_tm) = + let cond_th, taylor_th, th0, + (f1_tm, domain_tm, y_tm, w_tm, bounds_tm, d_tm, dd_tm) = try let cond_th = check_interval_pos f_bounds_tm in cond_th, taylor1_th, MK_M_TAYLOR_ABS_POS', dest_m_taylor (concl taylor1_th) @@ -407,12 +407,12 @@ let eval_m_taylor_abs2 n p_second taylor1_th = w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in - let th1 = (MY_PROVE_HYP f1_bound0 o + let th1 = (MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP cond_th o MY_PROVE_HYP taylor_th o - INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; - bounds_tm, bounds_var; d_tm, d_bounds_list_var; + bounds_tm, bounds_var; d_tm, d_bounds_list_var; dd_tm, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) th0 in let eq_th = unary_beta_gen_eq f1_tm x_var abs_tm in @@ -445,19 +445,19 @@ let eval_m_taylor_inv2 n p_lin p_second taylor1_th = let cond_th = check_interval_not_zero f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_inv p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let neg, inv, ( * ) = float_interval_neg, float_interval_inv p_lin, float_interval_mul p_lin in neg (inv (bounds1_th * bounds1_th)) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -467,8 +467,8 @@ let eval_m_taylor_inv2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -476,7 +476,7 @@ let eval_m_taylor_inv2 n p_lin p_second taylor1_th = let d1_th0, d2_th0 = let inv, ( * ) = float_interval_inv p_second, float_interval_mul p_second in let ff = f1_bound * f1_bound in - inv ff, + inv ff, two_interval * inv (f1_bound * ff) in let dd_ths = @@ -499,7 +499,7 @@ let eval_m_taylor_inv2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) inv_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var inv_op_real in @@ -533,19 +533,19 @@ let eval_m_taylor_sqrt2 n p_lin p_second taylor1_th = let cond_th = check_interval_pos f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_sqrt p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let inv, ( * ) = float_interval_inv p_lin, float_interval_mul p_lin in inv (two_interval * bounds_th) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -555,8 +555,8 @@ let eval_m_taylor_sqrt2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -587,7 +587,7 @@ let eval_m_taylor_sqrt2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) sqrt_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var sqrt_tm in @@ -616,19 +616,19 @@ let eval_m_taylor_exp2 n p_lin p_second taylor1_th = let f_bounds_tm = (rand o concl) f1_bound in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_exp p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let exp = float_interval_exp p_lin in exp bounds1_th in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -638,8 +638,8 @@ let eval_m_taylor_exp2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -669,7 +669,7 @@ let eval_m_taylor_exp2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) exp_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var exp_tm in @@ -701,19 +701,19 @@ let eval_m_taylor_log2 n p_lin p_second taylor1_th = let cond_th = check_interval_pos f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_log p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let inv = float_interval_inv p_lin in inv (bounds1_th) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -723,14 +723,14 @@ let eval_m_taylor_log2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = - let neg, pow2, inv = + let neg, pow2, inv = float_interval_neg, float_interval_pow p_second 2, float_interval_inv p_second in let inv_f = inv f1_bound in inv_f, neg (pow2 inv_f) in @@ -755,7 +755,7 @@ let eval_m_taylor_log2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) log_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var log_tm in @@ -784,20 +784,20 @@ let eval_m_taylor_atn2 n p_lin p_second taylor1_th = let f_bounds_tm = (rand o concl) f1_bound in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_atn p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = - let inv, ( + ), ( * ) = float_interval_inv p_lin, + let u_bounds = + let inv, ( + ), ( * ) = float_interval_inv p_lin, float_interval_add p_lin, float_interval_mul p_lin in inv (one_interval + bounds1_th * bounds1_th) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -807,14 +807,14 @@ let eval_m_taylor_atn2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = - let neg, inv, ( + ), ( * ), pow2 = float_interval_neg, float_interval_inv p_second, + let neg, inv, ( + ), ( * ), pow2 = float_interval_neg, float_interval_inv p_second, float_interval_add p_second, float_interval_mul p_second, float_interval_pow p_second 2 in let inv_one_ff = inv (one_interval + f1_bound * f1_bound) in inv_one_ff, (neg_two_interval * f1_bound) * pow2 inv_one_ff in @@ -839,7 +839,7 @@ let eval_m_taylor_atn2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) atn_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var atn_tm in @@ -869,19 +869,19 @@ let eval_m_taylor_cos2 n p_lin p_second taylor1_th = let f_bounds_tm = (rand o concl) f1_bound in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_cos p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let sin, neg = float_interval_sin p_lin, float_interval_neg in neg (sin bounds1_th) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -891,8 +891,8 @@ let eval_m_taylor_cos2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -922,7 +922,7 @@ let eval_m_taylor_cos2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) cos_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var cos_tm in @@ -952,19 +952,19 @@ let eval_m_taylor_sin2 n p_lin p_second taylor1_th = let f_bounds_tm = (rand o concl) f1_bound in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_sin p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let cos = float_interval_cos p_lin in cos bounds1_th in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -974,8 +974,8 @@ let eval_m_taylor_sin2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -1005,7 +1005,7 @@ let eval_m_taylor_sin2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) sin_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var sin_tm in @@ -1038,12 +1038,12 @@ let eval_m_taylor_asn2 n p_lin p_second taylor1_th = let cond_th = EQT_ELIM (check_interval_iabs f_bounds_tm one_float) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_asn p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let inv, sqrt = float_interval_inv p_lin, float_interval_sqrt p_lin in let ( * ), ( - ) = float_interval_mul p_lin, float_interval_sub p_lin in inv (sqrt (one_interval - bounds1_th * bounds1_th)) in @@ -1051,7 +1051,7 @@ let eval_m_taylor_asn2 n p_lin p_second taylor1_th = let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -1061,8 +1061,8 @@ let eval_m_taylor_asn2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -1094,7 +1094,7 @@ let eval_m_taylor_asn2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) asn_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var asn_tm in @@ -1128,12 +1128,12 @@ let eval_m_taylor_acs2 n p_lin p_second taylor1_th = let cond_th = EQT_ELIM (check_interval_iabs f_bounds_tm one_float) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_acs p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = let inv, sqrt, neg = float_interval_inv p_lin, float_interval_sqrt p_lin, float_interval_neg in let ( * ), ( - ) = float_interval_mul p_lin, float_interval_sub p_lin in neg (inv (sqrt (one_interval - bounds1_th * bounds1_th))) in @@ -1141,7 +1141,7 @@ let eval_m_taylor_acs2 n p_lin p_second taylor1_th = let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -1151,8 +1151,8 @@ let eval_m_taylor_acs2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -1184,7 +1184,7 @@ let eval_m_taylor_acs2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) acs_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var acs_tm in @@ -1217,18 +1217,18 @@ let eval_m_taylor_matan2 n p_lin p_second taylor1_th = let cond_th = check_interval_gt neg_one_float f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in - + let bounds_th = float_interval_matan p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) - let u_bounds = + let u_bounds = float_interval_dmatan p_lin bounds1_th in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in - let df_ths = + let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in @@ -1238,8 +1238,8 @@ let eval_m_taylor_matan2 n p_lin p_second taylor1_th = let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in - - let d1_bounds = map (fun i -> + + let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in @@ -1268,7 +1268,7 @@ let eval_m_taylor_matan2 n p_lin p_second taylor1_th = let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o - INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; + INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) matan_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var matan_tm in diff --git a/Formal_ineqs/taylor/theory/multivariate_taylor-compiled.hl b/Formal_ineqs/taylor/theory/multivariate_taylor-compiled.hl index 5fa5bb00..409833c6 100644 --- a/Formal_ineqs/taylor/theory/multivariate_taylor-compiled.hl +++ b/Formal_ineqs/taylor/theory/multivariate_taylor-compiled.hl @@ -19,7 +19,7 @@ let IMAGE_DELETE_INJ_COMPAT = prove SET_TAC[]);; let partial = new_definition `partial i f x = derivative (f o (\t. (x:real^N) + t % basis i)) (&0)`;; let all_n = define `(all_n n [] s <=> T) /\ (all_n n (CONS h t) s <=> s n h /\ all_n (SUC n) t s)`;; -let m_lin_approx = new_definition `m_lin_approx (f:real^N->real) x f_bounds df_bounds_list <=> +let m_lin_approx = new_definition `m_lin_approx (f:real^N->real) x f_bounds df_bounds_list <=> (lift o f) differentiable at x /\ interval_arith (f x) f_bounds /\ all_n 1 df_bounds_list (\i int. interval_arith (partial i f x) int)`;; @@ -126,7 +126,7 @@ let frechet_scale = Sections.section_proof ["c"] (* Lemma frechet_add *) let frechet_add = Sections.section_proof [] -`frechet_derivative (\x. f x + g x) (at x) = +`frechet_derivative (\x. f x + g x) (at x) = (\y. frechet_derivative f (at x) y + frechet_derivative g (at x) y)` [ ((((use_arg_then2 ("EQ_SYM_EQ", [EQ_SYM_EQ]))(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then2 ("FRECHET_DERIVATIVE_AT", [FRECHET_DERIVATIVE_AT])) (thm_tac apply_tac)) THEN ((use_arg_then2 ("HAS_DERIVATIVE_ADD", [HAS_DERIVATIVE_ADD])) (thm_tac apply_tac))); @@ -135,7 +135,7 @@ let frechet_add = Sections.section_proof [] (* Lemma frechet_sub *) let frechet_sub = Sections.section_proof [] -`frechet_derivative (\x. f x - g x) (at x) = +`frechet_derivative (\x. f x - g x) (at x) = (\y. frechet_derivative f (at x) y - frechet_derivative g (at x) y)` [ ((((use_arg_then2 ("EQ_SYM_EQ", [EQ_SYM_EQ]))(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then2 ("FRECHET_DERIVATIVE_AT", [FRECHET_DERIVATIVE_AT])) (thm_tac apply_tac)) THEN ((use_arg_then2 ("HAS_DERIVATIVE_SUB", [HAS_DERIVATIVE_SUB])) (thm_tac apply_tac))); @@ -223,7 +223,7 @@ let has_derivative_x12 = Sections.section_proof ["y"] (* Lemma lambda_eq_vsum *) let lambda_eq_vsum = Sections.section_proof ["f"] -`(\x:A. lambda i. f i x) = +`(\x:A. lambda i. f i x) = (\x. vsum (1..dimindex (:N)) (\i. f i x % (basis i:real^N)))` [ (((((use_arg_then2 ("eq_ext", [eq_ext]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["x"])); @@ -283,7 +283,7 @@ let has_derivative_mul = Sections.section_proof ["f";"g";"f'";"g'";"y"] ((fun arg_tac -> arg_tac (Arg_term (`lift o (\x. f x * g x) = (lift o (\p. p$1 * p$2)) o (\x. vector [f x; g x]:real^2)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((((((use_arg_then2 ("eq_ext", [eq_ext]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("o_THM", [o_THM]))(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["x"])) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_2)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`vector [f y; g y]:real^2`))) (term_tac (set_tac "q"))); - ((fun arg_tac -> arg_tac (Arg_term (`lift o (\x. f' x * g y + f y * g' x) = + ((fun arg_tac -> arg_tac (Arg_term (`lift o (\x. f' x * g y + f y * g' x) = (lift o (\x:real^2. q$2 * x$1 + q$1 * x$2)) o (\x. vector [f' x; g' x])`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then2 ("eq_ext", [eq_ext]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("o_THM", [o_THM]))(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then2 ("q_def", []))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_2)))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("REAL_MUL_SYM", [REAL_MUL_SYM]))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then2 ("DIFF_CHAIN_AT", [DIFF_CHAIN_AT])) (thm_tac apply_tac)) THEN (simp_tac)) THEN ((((use_arg_then2 ("q_def", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("has_derivative_x12", [has_derivative_x12]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("has_derivative_vector2", [has_derivative_vector2]))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); @@ -313,7 +313,7 @@ let frechet_mul = Sections.section_proof ["f";"g";"y"] `lift o f differentiable at y ==> lift o g differentiable at y ==> frechet_derivative (lift o (\x. f x * g x)) (at y) = - (\x. g y % frechet_derivative (lift o f) (at y) x + + (\x. g y % frechet_derivative (lift o f) (at y) x + f y % frechet_derivative (lift o g) (at y) x)` [ (((repeat_tactic 1 9 (((use_arg_then2 ("FRECHET_DERIVATIVE_WORKS", [FRECHET_DERIVATIVE_WORKS]))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("f_eq_lift_drop", [f_eq_lift_drop]))(thm_tac (new_rewrite [] [(`frechet_derivative _1 _2`)]))))) THEN (move ["df"])); @@ -373,7 +373,7 @@ Sections.begin_section "Partial";; let real_derivative_compose_frechet = Sections.section_proof ["f";"h";"t"] `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> - ((f o h) has_real_derivative (drop o (frechet_derivative (lift o f) (at (h t)) o + ((f o h) has_real_derivative (drop o (frechet_derivative (lift o f) (at (h t)) o frechet_derivative (h o drop) (at (lift t))) o lift) (&1)) (atreal t)` [ (BETA_TAC THEN (move ["diff_f"]) THEN (move ["diff_h"])); @@ -397,7 +397,7 @@ let real_derivative_compose_frechet = Sections.section_proof ["f";"h";"t"] let real_derivative_compose_jacobian = Sections.section_proof ["f";"h";"t"] `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> - ((f o h) has_real_derivative (jacobian (lift o f) (at (h t)) ** + ((f o h) has_real_derivative (jacobian (lift o f) (at (h t)) ** jacobian (h o drop) (at (lift t)))$1$1) (atreal t)` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dh"])); @@ -409,7 +409,7 @@ let real_derivative_compose_jacobian = Sections.section_proof ["f";"h";"t"] (* Lemma diff_imp_real_diff *) let diff_imp_real_diff = Sections.section_proof ["f";"h";"t"] -`(lift o f) differentiable at (h t) ==> +`(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> (f o h) real_differentiable atreal t` [ @@ -442,7 +442,7 @@ let frechet_direction = Sections.section_proof ["y";"e";"t"] (* Lemma real_dir_derivative_frechet *) let real_dir_derivative_frechet = Sections.section_proof ["f";"y";"e";"t"] `(lift o f) differentiable at (y + t % e) ==> - ((f o (\t. y + t % e)) has_real_derivative + ((f o (\t. y + t % e)) has_real_derivative (drop (frechet_derivative (lift o f) (at (y + t % e)) e))) (atreal t)` [ (BETA_TAC THEN (move ["df"])); @@ -453,7 +453,7 @@ let real_dir_derivative_frechet = Sections.section_proof ["f";"y";"e";"t"] (* Lemma real_dir_derivative_jacobian *) let real_dir_derivative_jacobian = Sections.section_proof ["f";"y";"e";"t"] `(lift o f) differentiable at (y + t % e) ==> - ((f o (\t. y + t % e)) has_real_derivative + ((f o (\t. y + t % e)) has_real_derivative drop (jacobian (lift o f) (at (y + t % e)) ** e)) (atreal t)` [ (BETA_TAC THEN (move ["df"])); @@ -914,7 +914,7 @@ let real_taylor2_bound = Sections.section_proof ["f";"dd_bound"] (* Lemma real_taylor1_bound *) let real_taylor1_bound = Sections.section_proof ["f";"d_bound"] -`(!t. interval_arith t (&0, &1) ==> f real_differentiable atreal t /\ +`(!t. interval_arith t (&0, &1) ==> f real_differentiable atreal t /\ abs (derivative f t) <= d_bound) ==> abs (f (&1) - f (&0)) <= d_bound` [ @@ -1040,7 +1040,7 @@ let open_contains_open_interval = Sections.section_proof ["e";"s";"x"] (* Lemma diff2_dir *) let diff2_dir = Sections.section_proof ["f";"x";"e";"t"] -`diff2 f (x + t % e:real^N) ==> +`diff2 f (x + t % e:real^N) ==> nth_diff_strong 2 (f o (\t. x + t % e)) t` [ (((((use_arg_then2 ("diff2_eq_diff2_on_open", [diff2_eq_diff2_on_open]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("nth_diff_strong2_eq", [nth_diff_strong2_eq]))(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); @@ -1072,7 +1072,7 @@ let diff2_dir = Sections.section_proof ["f";"x";"e";"t"] let diff2_dir_derivative2 = Sections.section_proof ["f";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> nth_derivative 2 (f o (\t. x + t % e)) t = - sum (1..dimindex (:N)) (\i. sum (1..dimindex (:N)) + sum (1..dimindex (:N)) (\i. sum (1..dimindex (:N)) (\j. e$i * e$j * (partial j (partial i f) o (\t. x + t % e)) t))` [ ((((use_arg_then2 ("diff2_eq_diff2_on_open", [diff2_eq_diff2_on_open]))(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); @@ -1095,7 +1095,7 @@ let diff2_dir_derivative2 = Sections.section_proof ["f";"x";"e";"t"] (* Lemma diff2_has_derivative_partial *) let diff2_has_derivative_partial = Sections.section_proof ["f";"i";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> - (partial i f o (\t. x + t % e) has_real_derivative + (partial i f o (\t. x + t % e) has_real_derivative sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)) (atreal t)` [ ((((use_arg_then2 ("diff2", [diff2]))(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); @@ -1105,7 +1105,7 @@ let diff2_has_derivative_partial = Sections.section_proof ["f";"i";"x";"e";"t"] (* Lemma diff2_derivative_partial *) let diff2_derivative_partial = Sections.section_proof ["f";"i";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> - derivative (partial i f o (\t. x + t % e)) t = + derivative (partial i f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)` [ ((BETA_TAC THEN (move ["df"])) THEN (((use_arg_then2 ("derivative_unique", [derivative_unique])) (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then2 ("diff2_has_derivative_partial", [diff2_has_derivative_partial])) (disch_tac [])) THEN (clear_assumption "diff2_has_derivative_partial") THEN (exact_tac)) THEN (done_tac)); @@ -1204,7 +1204,7 @@ let mixed_second_partials = Sections.section_proof ["f";"x";"i";"j"] ((fun arg_tac -> arg_tac (Arg_term (`!y e. (f o (\k. y + k % e)) o (\t. k + t) = f o (\t. (y + k % e) + t % e)`))) (term_tac (have_gen_tac [](move ["eq"])))); (((((use_arg_then2 ("eq_ext", [eq_ext]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("o_THM", [o_THM]))(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then2 ("eq", []))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("partial", [partial]))(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); - ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> + ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> (?t1. G h k = k * derivative (F1 h) t1 /\ abs t1 <= abs k)`))) (term_tac (have_gen_tac [](move ["Gh"])))); ((BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])) THEN ((((use_arg_then2 ("G_def", []))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("real_mvt0", [real_mvt0])) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`F1 h`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative (F1 h)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("k", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); @@ -1214,7 +1214,7 @@ let mixed_second_partials = Sections.section_proof ["f";"x";"i";"j"] (BETA_TAC THEN (case THEN (move ["t1"])) THEN (case THEN (move ["t1_ineq"])) THEN (move ["eq"])); (((use_arg_then2 ("t1", [])) (term_tac exists_tac)) THEN (((use_arg_then2 ("eq", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("ineq", [])) (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then2 ("t1_ineq", [])) (disch_tac [])) THEN (clear_assumption "t1_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> - (?t1 t2. G h k = h * k * partial i (partial j f) (x + t1 % basis j + t2 % basis i) + (?t1 t2. G h k = h * k * partial i (partial j f) (x + t1 % basis j + t2 % basis i) /\ abs t1 <= abs k /\ abs t2 <= abs h)`))) (term_tac (have_gen_tac [](move ["Ghk"])))); (BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("Gh", [])) (fun fst_arg -> (use_arg_then2 ("h", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("k", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then2 ("ineq", []))(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["t1"])) THEN (case THEN ((move ["eq"]) THEN (move ["t1k"]))))); @@ -1250,7 +1250,7 @@ let mixed_second_partials = Sections.section_proof ["f";"x";"i";"j"] ((fun arg_tac -> arg_tac (Arg_term (`!y e. (f o (\h. y + h % e)) o (\t. h + t) = f o (\t. (y + h % e) + t % e)`))) (term_tac (have_gen_tac [](move ["eq"])))); (((((use_arg_then2 ("eq_ext", [eq_ext]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("o_THM", [o_THM]))(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then2 ("eq", []))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("partial", [partial]))(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); - ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> + ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> (?t3. G h k = h * derivative (F2 k) t3 /\ abs t3 <= abs h)`))) (term_tac (have_gen_tac [](move ["Gk"])))); ((BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])) THEN ((((use_arg_then2 ("G_eq", []))(thm_tac (new_rewrite [] [])))) THEN (simp_tac))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("real_mvt0", [real_mvt0])) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`F2 k`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative (F2 k)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("h", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); @@ -1260,7 +1260,7 @@ let mixed_second_partials = Sections.section_proof ["f";"x";"i";"j"] (BETA_TAC THEN (case THEN (move ["t3"])) THEN (case THEN (move ["t3_ineq"])) THEN (move ["eq"])); (((use_arg_then2 ("t3", [])) (term_tac exists_tac)) THEN (((use_arg_then2 ("eq", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("ineq", [])) (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then2 ("t3_ineq", [])) (disch_tac [])) THEN (clear_assumption "t3_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> - (?t3 t4. G h k = h * k * partial j (partial i f) (x + t4 % basis j + t3 % basis i) + (?t3 t4. G h k = h * k * partial j (partial i f) (x + t4 % basis j + t3 % basis i) /\ abs t3 <= abs h /\ abs t4 <= abs k)`))) (term_tac (have_gen_tac [](move ["Gkh"])))); (BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("Gk", [])) (fun fst_arg -> (use_arg_then2 ("h", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("k", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then2 ("ineq", []))(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["t3"])) THEN (case THEN ((move ["eq"]) THEN (move ["t3h"]))))); @@ -1302,7 +1302,7 @@ let mixed_second_partials = Sections.section_proof ["f";"x";"i";"j"] (((((fun arg_tac -> (use_arg_then2 ("REAL_MUL_LINV", [REAL_MUL_LINV])) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("REAL_LT_LMUL", [REAL_LT_LMUL]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("REAL_LT_INV", [REAL_LT_INV]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("andTb", [andTb]))(thm_tac (new_rewrite [] [])))))) THEN (TRY ((arith_tac)))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`&2 = sqrt (&2 * &2)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [2] []))))))) (((((use_arg_then2 ("REAL_POW_2", [REAL_POW_2]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("POW_2_SQRT_ABS", [POW_2_SQRT_ABS]))(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then2 ("SQRT_MONO_LT", [SQRT_MONO_LT]))(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); - ((fun arg_tac -> arg_tac (Arg_term (`((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial j (partial i f) x)) + ((fun arg_tac -> arg_tac (Arg_term (`((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial j (partial i f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`))) (term_tac (have_gen_tac [](move ["lim_ji"])))); ((((use_arg_then2 ("LIM_WITHIN", [LIM_WITHIN]))(thm_tac (new_rewrite [] [])))) THEN (move ["e"]) THEN (move ["e_gt0"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("pc", [])) (fun fst_arg -> (use_arg_then2 ("i", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("j", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL continuous_at)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("dist", [dist]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("o_THM", [o_THM]))(thm_tac (new_rewrite [] [])))))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then2 ("e_gt0", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["e_ineq"]))); @@ -1322,7 +1322,7 @@ let mixed_second_partials = Sections.section_proof ["f";"x";"i";"j"] ((((use_arg_then2 ("REAL_LET_TRANS", [REAL_LET_TRANS])) (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`norm (t2 % basis j:real^N) + norm (t1 % basis i:real^N)`))) (term_tac exists_tac))); ((((use_arg_then2 ("NORM_TRIANGLE", [NORM_TRIANGLE]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("andTb", [andTb]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("NORM_MUL", [NORM_MUL]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("NORM_BASIS", [NORM_BASIS]))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then2 ("REAL_MUL_RID", [REAL_MUL_RID]))(thm_tac (new_rewrite [] [])))))); ((((use_arg_then2 ("yr", [])) (disch_tac [])) THEN (clear_assumption "yr") THEN ((use_arg_then2 ("t_ineq", [])) (disch_tac [])) THEN (clear_assumption "t_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); - ((fun arg_tac -> arg_tac (Arg_term (`((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial i (partial j f) x)) + ((fun arg_tac -> arg_tac (Arg_term (`((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial i (partial j f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`))) (term_tac (have_gen_tac [](move ["lim_ij"])))); ((((use_arg_then2 ("LIM_WITHIN", [LIM_WITHIN]))(thm_tac (new_rewrite [] [])))) THEN (move ["e"]) THEN (move ["e_gt0"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("pc", [])) (fun fst_arg -> (use_arg_then2 ("j", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("i", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL continuous_at)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("dist", [dist]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("o_THM", [o_THM]))(thm_tac (new_rewrite [] [])))))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then2 ("e_gt0", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["e_ineq"]))); @@ -1375,7 +1375,7 @@ let y_in_domain = Sections.section_proof ["domain";"y";"w"] (* Lemma domain_width *) let domain_width = Sections.section_proof ["p";"domain";"y";"w"] -`m_cell_domain domain y (w:real^N) ==> +`m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> !i. i IN 1..dimindex (:N) ==> abs (p$i - y$i) <= w$i` [ @@ -1385,7 +1385,7 @@ let domain_width = Sections.section_proof ["p";"domain";"y";"w"] (* Lemma sum_swap1 *) let sum_swap1 = Sections.section_proof ["g";"n"] -`sum (1..n) (\i. sum (i + 1..n) (\j. g i j)) = +`sum (1..n) (\i. sum (i + 1..n) (\j. g i j)) = sum (1..n) (\i. sum (1..i - 1) (\j. g j i))` [ ((repeat_tactic 1 9 (((use_arg_then2 ("SUM_SUM_PRODUCT", [SUM_SUM_PRODUCT]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("FINITE_NUMSEG", [FINITE_NUMSEG]))(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then2 ("IN_NUMSEG", [IN_NUMSEG]))(thm_tac (new_rewrite [] [])))))); @@ -1406,14 +1406,14 @@ let sum_swap1 = Sections.section_proof ["g";"n"] (* Lemma m_taylor_error_eq *) let m_taylor_error_eq = Sections.section_proof ["f";"domain";"w";"error"] -`diff2c_domain domain f ==> +`diff2c_domain domain f ==> (m_taylor_error f domain (w:real^N) error <=> - (!x. x IN interval [domain] ==> + (!x. x IN interval [domain] ==> sum (1..dimindex (:N)) (\i. w$i * (w$i * abs (partial2 i i f x) + &2 * sum (1..i - 1) (\j. w$j * abs (partial2 j i f x)))) <= error))` [ (((((use_arg_then2 ("diff2c_domain", [diff2c_domain]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("m_taylor_error", [m_taylor_error]))(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"])); - ((fun arg_tac -> arg_tac (Arg_term (`!g1 g2. (!x. x IN interval [domain] ==> g1 x = g2 x) ==> + ((fun arg_tac -> arg_tac (Arg_term (`!g1 g2. (!x. x IN interval [domain] ==> g1 x = g2 x) ==> ((!x. x IN interval [domain] ==> g1 x <= error) <=> (!x. x IN interval [domain] ==> g2 x <= error))`))) (term_tac (have_gen_tac [](move ["eq"])))); ((BETA_TAC THEN (move ["g1"]) THEN (move ["g2"]) THEN (move ["eq"])) THEN ((split_tac) THEN (move ["cond"]) THEN (move ["x"]) THEN (move ["Px"]))); (((((use_arg_then2 ("eq", []))(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then2 ("cond", []))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); @@ -1447,7 +1447,7 @@ let diff2_derivative2_bound = Sections.section_proof ["domain";"y";"w";"p";"f";" p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> - (!t. interval_arith t (&0, &1) ==> + (!t. interval_arith t (&0, &1) ==> abs (nth_derivative 2 (f o (\t. y + t % (p - y))) t) <= dd_bound)` [ (((((use_arg_then2 ("diff2_domain", [diff2_domain]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("m_taylor_error", [m_taylor_error]))(thm_tac (new_rewrite [] []))))) THEN (move ["domainH"]) THEN (move ["p_in"]) THEN (move ["df"]) THEN (move ["boundedH"]) THEN (move ["t"]) THEN (move ["t_in"])); @@ -1551,7 +1551,7 @@ let diff2_derivative_partial_bound = Sections.section_proof ["domain";"y";"w";"p p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w d_bound ==> - (!t. interval_arith t (&0, &1) ==> + (!t. interval_arith t (&0, &1) ==> abs (derivative (partial i f o (\t. y + t % (p - y))) t) <= d_bound)` [ (((((use_arg_then2 ("diff2_domain", [diff2_domain]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("m_taylor_partial_error", [m_taylor_partial_error]))(thm_tac (new_rewrite [] []))))) THEN (move ["domainH"]) THEN (move ["p_in"]) THEN (move ["df"]) THEN (move ["boundedH"]) THEN (move ["t"]) THEN (move ["t_in"])); @@ -1727,7 +1727,7 @@ let has_derivative_uni_compose = Sections.section_proof ["u";"f";"u'";"f'";"x"] (* Lemma diff_uni_compose *) let diff_uni_compose = Sections.section_proof ["u";"f";"x"] -`lift o f differentiable at x ==> +`lift o f differentiable at x ==> u real_differentiable atreal (f x) ==> lift o u o f differentiable at x` [ @@ -2149,7 +2149,7 @@ let second_partial_neg = Sections.section_proof ["f"] (* Lemma second_partial_add *) let second_partial_add = Sections.section_proof ["f";"g"] -`diff2 f x ==> diff2 g x ==> +`diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x + g x) x = partial2 i j f x + partial2 i j g x` [ ((repeat_tactic 1 9 (((use_arg_then2 ("diff2", [diff2]))(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["ys"])) THEN (move ["dg"])); @@ -2162,7 +2162,7 @@ let second_partial_add = Sections.section_proof ["f";"g"] (* Lemma second_partial_sub *) let second_partial_sub = Sections.section_proof ["f";"g"] -`diff2 f x ==> diff2 g x ==> +`diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x - g x) x = partial2 i j f x - partial2 i j g x` [ ((BETA_TAC THEN (move ["d2f"]) THEN (move ["d2g"])) THEN ((((use_arg_then2 ("real_sub", [real_sub]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("second_partial_add", [second_partial_add]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("diff2_neg", [diff2_neg]))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then2 ("second_partial_neg", [second_partial_neg]))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then2 ("real_sub", [real_sub]))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); @@ -2170,7 +2170,7 @@ let second_partial_sub = Sections.section_proof ["f";"g"] (* Lemma second_partial_mul *) let second_partial_mul = Sections.section_proof ["f";"g"] -`diff2 f x ==> diff2 g x ==> +`diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x * g x) x = (partial2 i j f x * g x + partial j f x * partial i g x) + (partial i f x * partial j g x + f x * partial2 i j g x)` [ @@ -2675,7 +2675,7 @@ let diff2c_mul = Sections.section_proof ["f";"g"] ((use_arg_then2 ("real_cont_at_local", [real_cont_at_local])) (thm_tac apply_tac)); ((((use_arg_then2 ("d2g", [])) (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then2 ("d2f", [])) (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((((use_arg_then2 ("diff2_eq_diff2_on_open", [diff2_eq_diff2_on_open]))(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["d2f"]))); ((((use_arg_then2 ("diff2_eq_diff2_on_open", [diff2_eq_diff2_on_open]))(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["d2g"])); - (((fun arg_tac -> arg_tac (Arg_term (`(\x. (partial2 j i f x * g x + partial i f x * partial j g x) + + (((fun arg_tac -> arg_tac (Arg_term (`(\x. (partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x)`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac))); ((THENL_ROT (-1)) (((repeat_tactic 1 9 (((use_arg_then2 ("IN_INTER", [IN_INTER]))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("xs", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("xt", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("OPEN_INTER", [OPEN_INTER]))(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))) THEN (split_tac))); ((BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["yt"])))) THEN ((((use_arg_then2 ("second_partial_mul", [second_partial_mul]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("d2f", []))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("d2g", []))(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); @@ -3004,7 +3004,7 @@ Sections.end_section "M_LinApprox";; let second_bounded = new_definition `second_bounded f domain dd_bounds_list <=> !x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x) int))`;; -let m_taylor_interval = +let m_taylor_interval = new_definition `m_taylor_interval f domain y w f_bounds d_bounds_list dd_bounds_list <=> m_cell_domain domain y w /\ diff2c_domain domain f /\ @@ -3410,7 +3410,7 @@ let partial_x_lemma = Sections.section_proof ["k";"i"] (* Lemma partial_x *) let partial_x = Sections.section_proof ["k";"i"] -`k IN 1..dimindex (:N) ==> +`k IN 1..dimindex (:N) ==> partial i (\x:real^N. x$k) = (\x. if i = k then &1 else &0)` [ ((BETA_TAC THEN (move ["k_ineq"])) THEN ((((use_arg_then2 ("partial_x_lemma", [partial_x_lemma]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("BASIS_COMPONENT", [BASIS_COMPONENT]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("IN_NUMSEG", [IN_NUMSEG]))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac))) THEN (arith_tac) THEN (done_tac)); diff --git a/Formal_ineqs/taylor/theory/multivariate_taylor.vhl b/Formal_ineqs/taylor/theory/multivariate_taylor.vhl index 40af41f1..9ca7f9a1 100644 --- a/Formal_ineqs/taylor/theory/multivariate_taylor.vhl +++ b/Formal_ineqs/taylor/theory/multivariate_taylor.vhl @@ -30,7 +30,7 @@ module Multivariate_taylor. "let all_n = define `(all_n n [] s <=> T) /\ (all_n n (CONS h t) s <=> s n h /\ all_n (SUC n) t s)`". -"let m_lin_approx = new_definition `m_lin_approx (f:real^N->real) x f_bounds df_bounds_list <=> +"let m_lin_approx = new_definition `m_lin_approx (f:real^N->real) x f_bounds df_bounds_list <=> (lift o f) differentiable at x /\ interval_arith (f x) f_bounds /\ all_n 1 df_bounds_list (\i int. interval_arith (partial i f x) int)`". @@ -39,7 +39,7 @@ module Multivariate_taylor. Section Misc. -Lemma f_lift_neg f : `lift o (\x. --f x) = (\x. --(lift o f) x)`. +Lemma f_lift_neg f : `lift o (\x. --f x) = (\x. --(lift o f) x)`. by rewrite -eq_ext !o_THM /= LIFT_NEG. Qed. Lemma f_lift_scale f c : `lift o (\x. c * f x) = (\x. c % (lift o f) x)`. @@ -100,13 +100,13 @@ Qed. Hypothesis dg : `g differentiable at x`. -Lemma frechet_add : `frechet_derivative (\x. f x + g x) (at x) = +Lemma frechet_add : `frechet_derivative (\x. f x + g x) (at x) = (\y. frechet_derivative f (at x) y + frechet_derivative g (at x) y)`. rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; apply HAS_DERIVATIVE_ADD. by rewr ETA_AX; rewrite -!FRECHET_DERIVATIVE_WORKS. Qed. -Lemma frechet_sub : `frechet_derivative (\x. f x - g x) (at x) = +Lemma frechet_sub : `frechet_derivative (\x. f x - g x) (at x) = (\y. frechet_derivative f (at x) y - frechet_derivative g (at x) y)`. rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; apply HAS_DERIVATIVE_SUB. by rewr ETA_AX; rewrite -!FRECHET_DERIVATIVE_WORKS. @@ -115,7 +115,7 @@ Qed. End MoreFrechet. -Lemma differentiable_compose_at f g x : +Lemma differentiable_compose_at f g x : `f differentiable at (g x) ==> g differentiable at x ==> (f o g) differentiable at x`. @@ -153,7 +153,7 @@ by rewrite REAL_LT_MUL2; move: ineq wnx; arith. Qed. -Lemma has_derivative_x12 y : +Lemma has_derivative_x12 y : `(lift o (\x:real^2. x$1 * x$2) has_derivative lift o (\x. y$2 * x$1 + y$1 * x$2)) (at y)`. rewrite has_derivative_at; split. rewrite linear !o_THM /= !VECTOR_ADD_COMPONENT !VECTOR_MUL_COMPONENT !LIFT_ADD !LIFT_CMUL !LIFT_ADD. @@ -178,7 +178,7 @@ by case => <-; first rewrite REAL_MUL_SYM; rewrite REAL_LT_LMUL ineq // DIMINDEX Qed. -Lemma lambda_eq_vsum f : `(\x:A. lambda i. f i x) = +Lemma lambda_eq_vsum f : `(\x:A. lambda i. f i x) = (\x. vsum (1..dimindex (:N)) (\i. f i x % (basis i:real^N)))`. rewrite -eq_ext /= => x. rewrite CART_EQ => i ineq; rewrite "GEN_ALL LAMBDA_BETA" // VSUM_COMPONENT //=. @@ -228,7 +228,7 @@ by rewrite "ARITH_RULE `~(2 = 1)`" /=; rewr ETA_AX. Qed. -Lemma has_derivative_mul f g f' g' y : +Lemma has_derivative_mul f g f' g' y : `(lift o f has_derivative lift o f') (at y) ==> (lift o g has_derivative lift o g') (at y) ==> (lift o (\x. f x * g x) has_derivative lift o (\x. f' x * g y + f y * g' x)) (at y)`. @@ -236,7 +236,7 @@ move => df dg. have ->: `lift o (\x. f x * g x) = (lift o (\p. p$1 * p$2)) o (\x. vector [f x; g x]:real^2)`. by rewrite -eq_ext !o_THM /= => x; rewrite !"GEN_ALL VECTOR_2". set q := `vector [f y; g y]:real^2`. -have ->: `lift o (\x. f' x * g y + f y * g' x) = +have ->: `lift o (\x. f' x * g y + f y * g' x) = (lift o (\x:real^2. q$2 * x$1 + q$1 * x$2)) o (\x. vector [f' x; g' x])`. by rewrite -eq_ext !o_THM /= -q_def !"GEN_ALL VECTOR_2" REAL_MUL_SYM. by apply DIFF_CHAIN_AT => /=; rewrite q_def has_derivative_x12 has_derivative_vector2. @@ -262,7 +262,7 @@ Lemma frechet_mul f g y : `lift o f differentiable at y ==> lift o g differentiable at y ==> frechet_derivative (lift o (\x. f x * g x)) (at y) = - (\x. g y % frechet_derivative (lift o f) (at y) x + + (\x. g y % frechet_derivative (lift o f) (at y) x + f y % frechet_derivative (lift o g) (at y) x)`. rewrite !FRECHET_DERIVATIVE_WORKS [`frechet_derivative _1 _2`]f_eq_lift_drop => df. rewrite [`frechet_derivative _1 _2`]f_eq_lift_drop => dg. @@ -285,7 +285,7 @@ Section Partial. Lemma real_derivative_compose_frechet f h t : `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> - ((f o h) has_real_derivative (drop o (frechet_derivative (lift o f) (at (h t)) o + ((f o h) has_real_derivative (drop o (frechet_derivative (lift o f) (at (h t)) o frechet_derivative (h o drop) (at (lift t))) o lift) (&1)) (atreal t)`. move => diff_f diff_h. move: (diff_f) (diff_h); rewrite !FRECHET_DERIVATIVE_WORKS. @@ -309,7 +309,7 @@ Qed. Lemma real_derivative_compose_jacobian f h t : `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> - ((f o h) has_real_derivative (jacobian (lift o f) (at (h t)) ** + ((f o h) has_real_derivative (jacobian (lift o f) (at (h t)) ** jacobian (h o drop) (at (lift t)))$1$1) (atreal t)`. move => df dh. move: (real_derivative_compose_frechet df dh). @@ -320,8 +320,8 @@ Qed. -Lemma diff_imp_real_diff f h t : - `(lift o f) differentiable at (h t) ==> +Lemma diff_imp_real_diff f h t : + `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> (f o h) real_differentiable atreal t`. move => diff_f diff_h. @@ -339,7 +339,7 @@ by exists `\x. drop x % e`; apply HAS_DERIVATIVE_VMUL_DROP; rewrite HAS_DERIVATI Qed. -Lemma frechet_direction y e t : +Lemma frechet_direction y e t : `frechet_derivative ((\t. y + t % e) o drop) (at (lift t)) = (\x. drop x % e)`. rewrite f_unary_drop frechet_add. rewrite DIFFERENTIABLE_CONST andTb; apply HAS_DERIVATIVE_IMP_DIFFERENTIABLE. @@ -350,7 +350,7 @@ Qed. Lemma real_dir_derivative_frechet f y e t : `(lift o f) differentiable at (y + t % e) ==> - ((f o (\t. y + t % e)) has_real_derivative + ((f o (\t. y + t % e)) has_real_derivative (drop (frechet_derivative (lift o f) (at (y + t % e)) e))) (atreal t)`. move => df. move: (real_derivative_compose_frechet f `\t. y + t % e` t). @@ -359,7 +359,7 @@ Qed. Lemma real_dir_derivative_jacobian f y e t : `(lift o f) differentiable at (y + t % e) ==> - ((f o (\t. y + t % e)) has_real_derivative + ((f o (\t. y + t % e)) has_real_derivative drop (jacobian (lift o f) (at (y + t % e)) ** e)) (atreal t)`. move => df. move: (real_dir_derivative_frechet f e df). @@ -420,7 +420,7 @@ by rewrite derivative_composition // REAL_MUL_SYM. Qed. -Lemma projection_has_derivative i net : +Lemma projection_has_derivative i net : `i IN 1..dimindex (:N) ==> (lift o (\x:real^N. x$i) has_derivative lift o (\x. x$i)) net`. rewrite IN_NUMSEG => ineq. @@ -577,7 +577,7 @@ End Partial. Section PartialMonotone. -Lemma derivative_translation f x : +Lemma derivative_translation f x : `f real_differentiable atreal x ==> derivative f x = derivative (f o (\t. x + t)) (&0)`. move => diff_f. @@ -589,7 +589,7 @@ Qed. Implicit Type f : `:real^N->real`. -Lemma partial_increasing_left f j u x z lo : +Lemma partial_increasing_left f j u x z lo : `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> @@ -636,7 +636,7 @@ have ds : `!t. t IN s ==> (g has_real_derivative (partial j f (y' + t % basis j) by rewrite -derivative_translation ?has_derivative_alt -g_def diff_imp_real_diff; rewrite diff_f //= diff_direction. have pos: `&0 <= y$j - x$j`; first by move: (y_in j_in); arith. -have := HAS_REAL_DERIVATIVE_INCREASING_IMP +have := HAS_REAL_DERIVATIVE_INCREASING_IMP g `\t. partial j f (y' + t % basis j)` s `&0` `y$j - x$j`. rewrite -{1}s_def IS_REALINTERVAL_INTERVAL /=; rewr ds /=; apply. rewrite -{2 3}s_def !IN_REAL_INTERVAL pos !REAL_LE_REFL /=. @@ -644,7 +644,7 @@ by move => t /in_s /partial_pos. Qed. -Lemma partial_decreasing_left f j u x z hi : +Lemma partial_decreasing_left f j u x z hi : `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> @@ -685,7 +685,7 @@ by rewrite LINEAR_NEG ?LINEAR_FRECHET_DERIVATIVE // DROP_NEG. Qed. -Lemma partial_increasing_right f j u x z hi : +Lemma partial_increasing_right f j u x z hi : `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i) ==> u$j = z$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> @@ -755,8 +755,8 @@ by rewrite -R_def /= !arithH. Qed. -Lemma real_taylor1_bound f d_bound: - `(!t. interval_arith t (&0, &1) ==> f real_differentiable atreal t /\ +Lemma real_taylor1_bound f d_bound: + `(!t. interval_arith t (&0, &1) ==> f real_differentiable atreal t /\ abs (derivative f t) <= d_bound) ==> abs (f (&1) - f (&0)) <= d_bound`. move => df. @@ -875,7 +875,7 @@ by move: t_in; rewrite IN_REAL_INTERVAL; arith. Qed. -Lemma diff2_dir f x e t : `diff2 f (x + t % e:real^N) ==> +Lemma diff2_dir f x e t : `diff2 f (x + t % e:real^N) ==> nth_diff_strong 2 (f o (\t. x + t % e)) t`. Proof. rewrite diff2_eq_diff2_on_open nth_diff_strong2_eq => [] [s] [open_s] [xs] df. @@ -907,7 +907,7 @@ Qed. Lemma diff2_dir_derivative2 f x e t : `diff2 f (x + t % e:real^N) ==> nth_derivative 2 (f o (\t. x + t % e)) t = - sum (1..dimindex (:N)) (\i. sum (1..dimindex (:N)) + sum (1..dimindex (:N)) (\i. sum (1..dimindex (:N)) (\j. e$i * e$j * (partial j (partial i f) o (\t. x + t % e)) t))`. Proof. rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] df. @@ -929,7 +929,7 @@ Qed. Lemma diff2_has_derivative_partial f i x e t : `diff2 f (x + t % e:real^N) ==> - (partial i f o (\t. x + t % e) has_real_derivative + (partial i f o (\t. x + t % e) has_real_derivative sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)) (atreal t)`. rewrite diff2 => [] [s] [open_s] [xs] df. by rewrite real_dir_derivative_partial df. @@ -937,7 +937,7 @@ Qed. Lemma diff2_derivative_partial f i x e t : `diff2 f (x + t % e:real^N) ==> - derivative (partial i f o (\t. x + t % e)) t = + derivative (partial i f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)`. by move => df; apply: derivative_unique; exact: diff2_has_derivative_partial. Qed. @@ -1025,7 +1025,7 @@ have F1_der : `!h k. abs h <= r /\ abs k <= r ==> have eq: `!y e. (f o (\k. y + k % e)) o (\t. k + t) = f o (\t. (y + k % e) + t % e)`. by rewrite -eq_ext !o_THM /= "GEN_ALL VECTOR_ADD_RDISTRIB" "GEN_ALL VECTOR_ADD_ASSOC". by rewrite !eq -!partial. -have Gh: `!h k. abs h <= r /\ abs k <= r ==> +have Gh: `!h k. abs h <= r /\ abs k <= r ==> (?t1. G h k = k * derivative (F1 h) t1 /\ abs t1 <= abs k)`. move => h k ineq; rewrite -G_def /=. have := real_mvt0 `F1 h` `derivative (F1 h)` k. @@ -1035,7 +1035,7 @@ have Gh: `!h k. abs h <= r /\ abs k <= r ==> move => [t1] [t1_ineq] eq. by exists t1; rewrite eq; move: t1_ineq ineq; arith. have Ghk: `!h k. abs h <= r /\ abs k <= r ==> - (?t1 t2. G h k = h * k * partial i (partial j f) (x + t1 % basis j + t2 % basis i) + (?t1 t2. G h k = h * k * partial i (partial j f) (x + t1 % basis j + t2 % basis i) /\ abs t1 <= abs k /\ abs t2 <= abs h)`. move => h k ineq. move: (Gh h k); rewrite !ineq /= => [] [t1] [eq t1k]. @@ -1072,7 +1072,7 @@ have F2_der : `!h k. abs h <= r /\ abs k <= r ==> have eq: `!y e. (f o (\h. y + h % e)) o (\t. h + t) = f o (\t. (y + h % e) + t % e)`. by rewrite -eq_ext !o_THM /= "GEN_ALL VECTOR_ADD_RDISTRIB" "GEN_ALL VECTOR_ADD_ASSOC". by rewrite !eq -!partial. -have Gk: `!h k. abs h <= r /\ abs k <= r ==> +have Gk: `!h k. abs h <= r /\ abs k <= r ==> (?t3. G h k = h * derivative (F2 k) t3 /\ abs t3 <= abs h)`. move => h k ineq; rewrite G_eq /=. have := real_mvt0 `F2 k` `derivative (F2 k)` h. @@ -1082,7 +1082,7 @@ have Gk: `!h k. abs h <= r /\ abs k <= r ==> move => [t3] [t3_ineq] eq. by exists t3; rewrite eq; move: t3_ineq ineq; arith. have Gkh: `!h k. abs h <= r /\ abs k <= r ==> - (?t3 t4. G h k = h * k * partial j (partial i f) (x + t4 % basis j + t3 % basis i) + (?t3 t4. G h k = h * k * partial j (partial i f) (x + t4 % basis j + t3 % basis i) /\ abs t3 <= abs h /\ abs t4 <= abs k)`. move => h k ineq. move: (Gk h k); rewrite !ineq /= => [] [t3] [eq t3h]. @@ -1124,7 +1124,7 @@ have lim0: `(vec 0:real^2) limit_point_of {y | &0 < y$1 /\ &0 < y$2}`. rewrite -(REAL_MUL_LINV `&2`) ?REAL_LT_LMUL ?REAL_LT_INV ?andTb; try arith. have {2}->: `&2 = sqrt (&2 * &2)`; first by rewrite -REAL_POW_2 POW_2_SQRT_ABS; arith. by rewrite SQRT_MONO_LT; arith. -have lim_ji: `((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial j (partial i f) x)) +have lim_ji: `((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial j (partial i f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`. rewrite LIM_WITHIN => e e_gt0. move: (pc i j); rewrite "GEN_ALL continuous_at" !dist !o_THM => /(_ e_gt0) [d] [d0] e_ineq. @@ -1144,7 +1144,7 @@ have lim_ji: `((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial apply: REAL_LET_TRANS; exists `norm (t2 % basis j:real^N) + norm (t1 % basis i:real^N)`. rewrite NORM_TRIANGLE andTb !NORM_MUL !NORM_BASIS // !REAL_MUL_RID. by move: t_ineq yr; arith. -have lim_ij: `((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial i (partial j f) x)) +have lim_ij: `((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial i (partial j f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`. rewrite LIM_WITHIN => e e_gt0. move: (pc j i); rewrite "GEN_ALL continuous_at" !dist !o_THM => /(_ e_gt0) [d] [d0] e_ineq. @@ -1198,7 +1198,7 @@ by move/ineqs => /=. Qed. -Lemma domain_width p domain y w : `m_cell_domain domain y (w:real^N) ==> +Lemma domain_width p domain y w : `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> !i. i IN 1..dimindex (:N) ==> abs (p$i - y$i) <= w$i`. case: domain => x z; rewrite m_cell_domain => ineqs p_in i i_in. @@ -1206,7 +1206,7 @@ by move: p_in (ineqs i_in); rewrite "GEN_ALL IN_INTERVAL" -IN_NUMSEG => /(_ i_in Qed. -Lemma sum_swap1 g n : `sum (1..n) (\i. sum (i + 1..n) (\j. g i j)) = +Lemma sum_swap1 g n : `sum (1..n) (\i. sum (i + 1..n) (\j. g i j)) = sum (1..n) (\i. sum (1..i - 1) (\j. g j i))`. Proof. rewrite !SUM_SUM_PRODUCT ?FINITE_NUMSEG //= !IN_NUMSEG. @@ -1227,14 +1227,14 @@ Qed. (* Computation of the taylor error *) -Lemma m_taylor_error_eq f domain w error : `diff2c_domain domain f ==> +Lemma m_taylor_error_eq f domain w error : `diff2c_domain domain f ==> (m_taylor_error f domain (w:real^N) error <=> - (!x. x IN interval [domain] ==> + (!x. x IN interval [domain] ==> sum (1..dimindex (:N)) (\i. w$i * (w$i * abs (partial2 i i f x) + &2 * sum (1..i - 1) (\j. w$j * abs (partial2 j i f x)))) <= error))`. Proof. rewrite diff2c_domain m_taylor_error => d2f. -have eq: `!g1 g2. (!x. x IN interval [domain] ==> g1 x = g2 x) ==> +have eq: `!g1 g2. (!x. x IN interval [domain] ==> g1 x = g2 x) ==> ((!x. x IN interval [domain] ==> g1 x <= error) <=> (!x. x IN interval [domain] ==> g2 x <= error))`. move => g1 g2 eq; split => cond x Px. by rewrite -eq // cond. @@ -1269,7 +1269,7 @@ Lemma diff2_derivative2_bound domain y w p f dd_bound : p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> - (!t. interval_arith t (&0, &1) ==> + (!t. interval_arith t (&0, &1) ==> abs (nth_derivative 2 (f o (\t. y + t % (p - y))) t) <= dd_bound)`. Proof. rewrite diff2_domain m_taylor_error => domainH p_in df boundedH t t_in. @@ -1285,7 +1285,7 @@ rewrite -SUM_LMUL SUM_ABS_LE FINITE_NUMSEG andTb => j j_ineq /=. by rewrite !REAL_ABS_MUL !REAL_LE_MUL2 ?REAL_LE_MUL !REAL_ABS_POS // VECTOR_SUB_COMPONENT; rewrite (domain_width domainH p_in) // REAL_LE_REFL. Qed. - + Lemma m_taylor_error_lemma domain y w p f dd_bound : `m_cell_domain domain y (w:real^N) ==> @@ -1372,7 +1372,7 @@ Lemma diff2_derivative_partial_bound domain y w p f i d_bound : p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w d_bound ==> - (!t. interval_arith t (&0, &1) ==> + (!t. interval_arith t (&0, &1) ==> abs (derivative (partial i f o (\t. y + t % (p - y))) t) <= d_bound)`. Proof. rewrite diff2_domain m_taylor_partial_error => domainH p_in df boundedH t t_in. @@ -1510,7 +1510,7 @@ by rewrite DIFF_CHAIN_AT o_THM -"GEN_ALL HAS_REAL_FRECHET_DERIVATIVE_AT". Qed. -Lemma diff_uni_compose u f x : `lift o f differentiable at x ==> +Lemma diff_uni_compose u f x : `lift o f differentiable at x ==> u real_differentiable atreal (f x) ==> lift o u o f differentiable at x`. rewrite !differentiable real_differentiable => [] [f'] df [u'] du. @@ -1547,7 +1547,7 @@ Proof. by move => /diff2_abs_neg du df; rewrite diff2_uni_compose. Qed. (* pow *) Lemma diff2_pow_compose n : `diff2 f x ==> diff2 ((\x. x pow n) o f) x`. Proof. by move => df; rewrite diff2_uni_compose diff2_pow_x. Qed. - + (* inv *) Lemma diff2_inv_compose : `~(f x = &0) ==> diff2 f x ==> diff2 (inv o f) x`. Proof. by move => /diff2_inv du df; rewrite diff2_uni_compose. Qed. @@ -1763,7 +1763,7 @@ move: (open_contains_open_interval open_s xs `basis i:real^N`) => [a] [b] [ab0]; exists `real_interval (a, b)`; rewrite ab0 REAL_OPEN_REAL_INTERVAL !andTb => y y_in. by rewrite !o_THM /= eq // sub IN_IMAGE /=; exists y. Qed. - + Variables i j : `:num`. @@ -1785,7 +1785,7 @@ Proof. by move/(second_partial_scale f `--(&1)`); rewrite -!REAL_NEG_MINUS1. Qed (* Binary operations *) (* add *) -Lemma second_partial_add f g : `diff2 f x ==> diff2 g x ==> +Lemma second_partial_add f g : `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x + g x) x = partial2 i j f x + partial2 i j g x`. Proof. rewrite !diff2 => [] [s] [open_s] [xs] df [t] [open_t] [ys] dg. @@ -1798,14 +1798,14 @@ Qed. (* sub *) -Lemma second_partial_sub f g : `diff2 f x ==> diff2 g x ==> +Lemma second_partial_sub f g : `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x - g x) x = partial2 i j f x - partial2 i j g x`. -Proof. +Proof. by move => d2f d2g; rewrite real_sub second_partial_add ?diff2_neg // second_partial_neg // -real_sub. Qed. (* mul *) -Lemma second_partial_mul f g : `diff2 f x ==> diff2 g x ==> +Lemma second_partial_mul f g : `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x * g x) x = (partial2 i j f x * g x + partial j f x * partial i g x) + (partial i f x * partial j g x + f x * partial2 i j g x)`. rewrite !diff2 => [] [s] [open_s] [xs] df [t] [open_t] [ys] dg. @@ -1950,7 +1950,7 @@ rewrite open_r -r_def !IN_ELIM_THM /= o_THM LIFT_IN_IMAGE_LIFT; split; last firs move => y [z] [] [zs] fzt yz. by rewrite second_partial_uni_compose // yz d2s // d2t. split; last by exists x. -rewrite REAL_CONTINUOUS_ADD !REAL_CONTINUOUS_MUL //=; rewr ETA_AX; +rewrite REAL_CONTINUOUS_ADD !REAL_CONTINUOUS_MUL //=; rewr ETA_AX; rewrite ?(diff2_imp_partial_cont, d2s) //. rewrite andbT -[`nth_derivative 2 u _1`]o_THM; rewr ETA_AX. rewrite "GEN_ALL REAL_CONTINUOUS_CONTINUOUS1". @@ -2208,11 +2208,11 @@ move: (p2f i j) (p2g i j); rewrite -!"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" => p2 apply real_cont_at_local. move: d2f d2g; rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] d2f. rewrite diff2_eq_diff2_on_open => [] [t] [open_t] [xt] d2g. -exists `(\x. (partial2 j i f x * g x + partial i f x * partial j g x) + +exists `(\x. (partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x)` `s INTER t`. rewrite !IN_INTER xs xt OPEN_INTER //=; split; last first. by move => y [ys yt]; rewrite second_partial_mul ?d2f ?d2g. -by rewrite !REAL_CONTINUOUS_ADD // !REAL_CONTINUOUS_MUL; rewr ETA_AX //; +by rewrite !REAL_CONTINUOUS_ADD // !REAL_CONTINUOUS_MUL; rewr ETA_AX //; rewrite ?p2gij ?p2fij /= ?diff2_imp_partial_cont ?diff2_imp_cont ?d2f ?d2g. Qed. @@ -2408,7 +2408,7 @@ End M_LinApprox. !x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x) int))`". -"let m_taylor_interval = +"let m_taylor_interval = new_definition `m_taylor_interval f domain y w f_bounds d_bounds_list dd_bounds_list <=> m_cell_domain domain y w /\ diff2c_domain domain f /\ @@ -2641,7 +2641,7 @@ have ->: `f y1 = g (&0)`. have y_eq : `y = y1 + (y$j - x$j) % basis j /\ y2 = y1 + (z$j - x$j) % basis j`. rewrite !CART_EQ; split => i i_in; rewrite VECTOR_ADD_COMPONENT VECTOR_MUL_COMPONENT BASIS_COMPONENT //; - case: (EXCLUDED_MIDDLE `i = j`) => /= ij; + case: (EXCLUDED_MIDDLE `i = j`) => /= ij; rewrite -?(y1_def, y2_def) !"GEN_ALL LAMBDA_BETA" //= ?REAL_MUL_RID ?REAL_SUB_ADD2 //. by rewrite ij /=; arith. by rewrite ij /=; arith. @@ -2760,7 +2760,7 @@ rewrite derivative_const /= derivative_mul ?REAL_DIFFERENTIABLE_ID ?REAL_DIFFERE by rewrite derivative_x derivative_const; arith. Qed. -Lemma partial_x k i : `k IN 1..dimindex (:N) ==> +Lemma partial_x k i : `k IN 1..dimindex (:N) ==> partial i (\x:real^N. x$k) = (\x. if i = k then &1 else &0)`. by move => k_ineq; rewrite partial_x_lemma BASIS_COMPONENT -?IN_NUMSEG //; arith. Qed. diff --git a/Formal_ineqs/taylor/theory/taylor_interval-compiled.hl b/Formal_ineqs/taylor/theory/taylor_interval-compiled.hl index c6273217..3e98bdfc 100644 --- a/Formal_ineqs/taylor/theory/taylor_interval-compiled.hl +++ b/Formal_ineqs/taylor/theory/taylor_interval-compiled.hl @@ -17,15 +17,15 @@ prioritize_real();; let derivative = new_definition `derivative f = \y. @d. (f has_real_derivative d) (atreal y)`;; let nth_derivative = new_definition `nth_derivative n f = iter n derivative f`;; let nth_differentiable = define `(nth_differentiable 0 f x <=> f real_continuous atreal x) /\ - (nth_differentiable (SUC n) f x <=> nth_differentiable n f x /\ + (nth_differentiable (SUC n) f x <=> nth_differentiable n f x /\ nth_derivative n f real_differentiable atreal x)`;; let nth_differentiable_on = new_definition `nth_differentiable_on n s f <=> !x. x IN s ==> nth_differentiable n f x`;; let nth_differentiable_on_int = new_definition `nth_differentiable_on_int n int f <=> !x. interval_arith x int ==> nth_differentiable n f x`;; -let nth_diff_weak = new_definition `nth_diff_weak n f x <=> f real_continuous atreal x /\ +let nth_diff_weak = new_definition `nth_diff_weak n f x <=> f real_continuous atreal x /\ ?F. F 0 = f /\ !i. i < n ==> (F i has_real_derivative F (SUC i) x) (atreal x)`;; -let nth_diff_strong = new_definition `nth_diff_strong n f x <=> +let nth_diff_strong = new_definition `nth_diff_strong n f x <=> ?s. real_open s /\ x IN s /\ nth_differentiable_on n s f`;; let nth_diff_strong_int = new_definition `nth_diff_strong_int n int f <=> !x. interval_arith x int ==> nth_diff_strong n f x`;; @@ -150,7 +150,7 @@ let nth_differentiable_cond = Sections.section_proof ["n";"f";"x"] (* Lemma nth_differentiable_on_cond *) let nth_differentiable_on_cond = Sections.section_proof ["n";"s";"f"] `nth_differentiable_on n s f ==> - !x. x IN s ==> + !x. x IN s ==> !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)` [ ((((use_arg_then2 ("nth_differentiable_on", [nth_differentiable_on]))(thm_tac (new_rewrite [] [])))) THEN (move ["cond"]) THEN (move ["x"])); @@ -735,7 +735,7 @@ let derivative_sub = Sections.section_proof [] (* Lemma derivative_div *) let derivative_div = Sections.section_proof [] -`~(g x = &0) ==> +`~(g x = &0) ==> derivative (\x. f x / g x) x = (derivative f x * g x - f x * derivative g x) / (g x * g x)` [ ((BETA_TAC THEN (move ["gn0"])) THEN (((use_arg_then2 ("derivative_unique", [derivative_unique])) (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then2 ("REAL_POW_2", [REAL_POW_2]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("HAS_REAL_DERIVATIVE_DIV_ATREAL", [HAS_REAL_DERIVATIVE_DIV_ATREAL]))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); @@ -865,7 +865,7 @@ Sections.begin_section "NthDerivativeArith";; (* Lemma nth_derivative_scale_strong *) let nth_derivative_scale_strong = Sections.section_proof ["c";"i";"x"] `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y` [ ((((use_arg_then2 ("df", [])) (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((((use_arg_then2 ("nth_diff_strong_int", [nth_diff_strong_int]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("nth_diff_strong", [nth_diff_strong]))(thm_tac (new_rewrite [] []))))) THEN (move ["df"]))); @@ -886,11 +886,11 @@ let nth_derivative_scale_strong = Sections.section_proof ["c";"i";"x"] (* Lemma nth_derivative_scale_strong_all *) let nth_derivative_scale_strong_all = Sections.section_proof ["c";"x"] `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then2 ("nth_derivative_scale_strong", [nth_derivative_scale_strong])) (fun fst_arg -> (use_arg_then2 ("c", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); - ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ + ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y)`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then2 ("SELECT_AX", [SELECT_AX])) (thm_tac apply_tac))); @@ -944,7 +944,7 @@ let nth_diff_scale = Sections.section_proof ["c"] (* Lemma nth_derivative_add_strong *) let nth_derivative_add_strong = Sections.section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y` [ ((((use_arg_then2 ("dg", [])) (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then2 ("df", [])) (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then2 ("nth_diff_strong_int", [nth_diff_strong_int]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("nth_diff_strong", [nth_diff_strong]))(thm_tac (new_rewrite [] [])))))) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["ineq"]))); @@ -968,12 +968,12 @@ let nth_derivative_add_strong = Sections.section_proof ["i";"x"] (* Lemma nth_derivative_add_strong_all *) let nth_derivative_add_strong_all = Sections.section_proof ["x"] `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ - !i y. i <= n /\ y IN s ==> + ?s. real_open s /\ x IN s /\ + !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then2 ("nth_derivative_add_strong", [nth_derivative_add_strong])) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); - ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ + ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y)`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then2 ("SELECT_AX", [SELECT_AX])) (thm_tac apply_tac))); @@ -1029,7 +1029,7 @@ let nth_diff_add = Sections.section_proof [] (* Lemma nth_derivative_sub_strong *) let nth_derivative_sub_strong = Sections.section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y` [ ((((use_arg_then2 ("dg", [])) (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then2 ("df", [])) (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then2 ("nth_diff_strong_int", [nth_diff_strong_int]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("nth_diff_strong", [nth_diff_strong]))(thm_tac (new_rewrite [] [])))))) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["ineq"]))); @@ -1053,12 +1053,12 @@ let nth_derivative_sub_strong = Sections.section_proof ["i";"x"] (* Lemma nth_derivative_sub_strong_all *) let nth_derivative_sub_strong_all = Sections.section_proof ["x"] `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ - !i y. i <= n /\ y IN s ==> + ?s. real_open s /\ x IN s /\ + !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then2 ("nth_derivative_sub_strong", [nth_derivative_sub_strong])) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); - ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ + ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y)`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then2 ("SELECT_AX", [SELECT_AX])) (thm_tac apply_tac))); @@ -1114,8 +1114,8 @@ let nth_diff_sub = Sections.section_proof [] (* Lemma nth_derivative_mul_strong *) let nth_derivative_mul_strong = Sections.section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ - !y. y IN s ==> nth_derivative i (\y. f y * g y) y = + ?s. real_open s /\ x IN s /\ + !y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)` [ ((((use_arg_then2 ("dg", [])) (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then2 ("df", [])) (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then2 ("nth_diff_strong_int", [nth_diff_strong_int]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("nth_diff_strong", [nth_diff_strong]))(thm_tac (new_rewrite [] [])))))) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["ineq"]))); @@ -1144,7 +1144,7 @@ let nth_derivative_mul_strong = Sections.section_proof ["i";"x"] ((((use_arg_then2 ("i_lt_n", [])) (disch_tac [])) THEN (clear_assumption "i_lt_n") THEN ((use_arg_then2 ("ineq", [])) (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`nth_derivative (SUC (i - k)) g y`))) (term_tac exists_tac)) THEN (((fun arg_tac -> (use_arg_then2 ("diff_g", [])) (fun fst_arg -> (use_arg_then2 ("ysg", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then2 ("i_lt_n", [])) (disch_tac [])) THEN (clear_assumption "i_lt_n") THEN ((use_arg_then2 ("ineq", [])) (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); - ((fun arg_tac -> arg_tac (Arg_term (`!k. k IN 0..i ==> + ((fun arg_tac -> arg_tac (Arg_term (`!k. k IN 0..i ==> (\y. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y) real_differentiable atreal y`))) (term_tac (have_gen_tac [](move ["diff_cond2"])))); (BETA_TAC THEN (move ["k"]) THEN (move ["k_in"]) THEN (simp_tac)); @@ -1177,14 +1177,14 @@ let nth_derivative_mul_strong = Sections.section_proof ["i";"x"] (* Lemma nth_derivative_mul_strong_all *) let nth_derivative_mul_strong_all = Sections.section_proof ["x"] `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ - !i y. i <= n /\ y IN s ==> - nth_derivative i (\y. f y * g y) y = + ?s. real_open s /\ x IN s /\ + !i y. i <= n /\ y IN s ==> + nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then2 ("nth_derivative_mul_strong", [nth_derivative_mul_strong])) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); - ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ - (!y. y IN s ==> nth_derivative i (\y. f y * g y) y = + ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ + (!y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y))`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then2 ("SELECT_AX", [SELECT_AX])) (thm_tac apply_tac))); @@ -1207,7 +1207,7 @@ let nth_derivative_mul_strong_all = Sections.section_proof ["x"] (* Lemma nth_derivative_mul *) let nth_derivative_mul = Sections.section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> - nth_derivative i (\x. f x * g x) x = + nth_derivative i (\x. f x * g x) x = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f x * nth_derivative (i - k) g x)` [ (BETA_TAC THEN (move ["ineq"]) THEN (move ["i_le_n"])); @@ -1353,13 +1353,13 @@ let nth_derivative_mul_strong_all = Sections.finalize_theorem nth_derivative_mul let nth_derivative_mul = Sections.finalize_theorem nth_derivative_mul;; let nth_diff_mul = Sections.finalize_theorem nth_diff_mul;; Sections.end_section "NthDerivatives";; -let lin_approx = new_definition `lin_approx f x f_bounds df_bounds <=> +let lin_approx = new_definition `lin_approx f x f_bounds df_bounds <=> interval_arith (f x) f_bounds /\ (?f'. (f has_real_derivative f') (atreal x) /\ interval_arith f' df_bounds)`;; let has_bounded_second_derivative = new_definition `has_bounded_second_derivative f int dd_bounds <=> - nth_diff_strong_int 2 int f /\ + nth_diff_strong_int 2 int f /\ bounded_on_int (nth_derivative 2 f) int dd_bounds`;; -let taylor_interval = new_definition +let taylor_interval = new_definition `taylor_interval f x y z w f_bounds df_bounds ddf_bounds <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w /\ lin_approx f y f_bounds df_bounds /\ @@ -1496,7 +1496,7 @@ let f_continuous = Sections.section_proof [] (* Lemma taylor_error *) let taylor_error = Sections.section_proof ["t"] -`x <= t /\ t <= z ==> +`x <= t /\ t <= z ==> abs (f t - f y) <= w * iabs df_bounds + w * w * dd_bound / &2` [ (BETA_TAC THEN (move ["t_ineqs"])); @@ -1524,7 +1524,7 @@ let taylor_error = Sections.section_proof ["t"] ((((use_arg_then2 ("andTb", [andTb]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("andbT", [andbT]))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("REAL_MUL_SYM", [REAL_MUL_SYM]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("REAL_POW_2", [REAL_POW_2]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("REAL_LE_MUL2", [REAL_LE_MUL2]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("REAL_LE_REFL", [REAL_LE_REFL]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("dd_prop", []))(thm_tac (new_rewrite [] []))))); (((((use_arg_then2 ("REAL_LE_POW_2", [REAL_LE_POW_2]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("andTb", [andTb]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("andbT", [andbT]))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("REAL_LE_SQUARE_ABS", [REAL_LE_SQUARE_ABS]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("REAL_ABS_ABS", [REAL_ABS_ABS]))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("abs_ty", [])) (disch_tac [])) THEN (clear_assumption "abs_ty") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`\i. if i = 0 then f else if i = 1 then f' else if i = 2 then f'' else I`))) (term_tac (set_tac "Df"))); - ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ + ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`))) (fun arg -> thm_tac MP_TAC arg THEN (move ["arith"]))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("REAL_TAYLOR", [REAL_TAYLOR])) (fun fst_arg -> (use_arg_then2 ("Df", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`real_interval [x, z]`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("dd_bound", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); @@ -1564,7 +1564,7 @@ let taylor_lower_bound = Sections.section_proof [] (* Lemma taylor_derivative_error *) let taylor_derivative_error = Sections.section_proof [] -`!t. x <= t /\ t <= z ==> +`!t. x <= t /\ t <= z ==> abs (derivative f t - derivative f y) <= w * dd_bound` [ (BETA_TAC THEN (move ["t"]) THEN (move ["t_ineqs"])); @@ -1581,7 +1581,7 @@ let taylor_derivative_error = Sections.section_proof [] ((((fun arg_tac -> (use_arg_then2 ("df", [])) (fun fst_arg -> (use_arg_then2 ("y", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((fun arg_tac -> (use_arg_then2 ("pair_eq", [pair_eq])) (fun fst_arg -> (use_arg_then2 ("ddf_bounds", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("interval_arith", [interval_arith]))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("iabs", [iabs]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("domain_ineqs", []))(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ((BETA_TAC THEN (move ["p"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then2 ("df", [])) (thm_tac (match_mp_then snd_th MP_TAC))))) THEN ((((use_arg_then2 ("pair_eq", [pair_eq]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("interval_arith", [interval_arith]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("iabs", [iabs]))(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`\i. if i = 0 then f' else if i = 1 then f'' else I`))) (term_tac (set_tac "Df"))); - ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ + ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`))) (fun arg -> thm_tac MP_TAC arg THEN (move ["arith"]))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then2 ("REAL_TAYLOR", [REAL_TAYLOR])) (fun fst_arg -> (use_arg_then2 ("Df", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`real_interval [x, z]`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then2 ("dd_bound", [])) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); @@ -2114,7 +2114,7 @@ let second_derivative_pow3_x = Sections.section_proof [] (* Lemma second_derivative_atn_eq *) let second_derivative_atn_eq = Sections.section_proof ["x"] -`((\x. inv (&1 + x pow 2)) has_real_derivative +`((\x. inv (&1 + x pow 2)) has_real_derivative (-- &2 * x) * inv (&1 + x pow 2) pow 2) (atreal x)` [ (((((use_arg_then2 ("REAL_POW_INV", [REAL_POW_INV]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("real_div", [real_div]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("REAL_NEG_LMUL", [REAL_NEG_LMUL]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then2 ("HAS_REAL_DERIVATIVE_INV_ATREAL", [HAS_REAL_DERIVATIVE_INV_ATREAL]))(thm_tac (new_rewrite [] []))))) THEN (split_tac)); @@ -2321,7 +2321,7 @@ let real_powS = Sections.section_proof ["x";"n"] (* Lemma second_derivative_acs *) let second_derivative_acs = Sections.section_proof ["x"] -`abs x < &1 ==> +`abs x < &1 ==> nth_derivative 2 acs x = --(x / sqrt ((&1 - x * x) pow 3))` [ ((((use_arg_then2 ("nth_derivative2", [nth_derivative2]))(thm_tac (new_rewrite [] [])))) THEN (move ["x_ineq"])); @@ -2376,7 +2376,7 @@ let diff2_acs = Sections.section_proof ["x"] (* Lemma second_derivative_asn *) let second_derivative_asn = Sections.section_proof ["x"] -`abs x < &1 ==> +`abs x < &1 ==> nth_derivative 2 asn x = x / sqrt ((&1 - x * x) pow 3)` [ ((((use_arg_then2 ("nth_derivative2", [nth_derivative2]))(thm_tac (new_rewrite [] [])))) THEN (move ["x_ineq"])); @@ -2475,7 +2475,7 @@ let REAL_CONTINUOUS_OPEN_PREIMAGE = Sections.section_proof ["f";"s";"t"] [ (BETA_TAC THEN (move ["f_cont"]) THEN (move ["open_s"]) THEN (move ["open_t"])); (((use_arg_then2 ("REAL_OPEN", [REAL_OPEN]))(thm_tac (new_rewrite [] [])))); - (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`IMAGE lift {x | x IN s /\ f x IN t} = + (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`IMAGE lift {x | x IN s /\ f x IN t} = {x | x IN (IMAGE lift s) /\ (lift o f o drop) x IN (IMAGE lift t)}`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))); (((((use_arg_then2 ("CONTINUOUS_OPEN_PREIMAGE", [CONTINUOUS_OPEN_PREIMAGE]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("REAL_OPEN", [REAL_OPEN]))(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (((use_arg_then2 ("ETA_AX", [ETA_AX]))(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then2 ("REAL_CONTINUOUS_ON", [REAL_CONTINUOUS_ON]))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((((use_arg_then2 ("EXTENSION", [EXTENSION]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("IN_IMAGE_LIFT_DROP", [IN_IMAGE_LIFT_DROP]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("IN_ELIM_THM", [IN_ELIM_THM]))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("IN_IMAGE_LIFT_DROP", [IN_IMAGE_LIFT_DROP]))(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (simp_tac)) THEN (split_tac)); @@ -2488,7 +2488,7 @@ let REAL_CONTINUOUS_OPEN_PREIMAGE = Sections.section_proof ["f";"s";"t"] (* Lemma second_derivative_compose *) let second_derivative_compose = Sections.section_proof ["f";"g";"x"] `nth_diff_strong 2 g x ==> nth_diff_strong 2 f (g x) ==> - nth_derivative 2 (\x. f (g x)) x = + nth_derivative 2 (\x. f (g x)) x = nth_derivative 2 f (g x) * (derivative g x) pow 2 + derivative f (g x) * nth_derivative 2 g x` [ (BETA_TAC THEN (move ["dg"]) THEN (move ["df"])); @@ -2602,7 +2602,7 @@ let second_derivative_compose_abs_neg = Sections.section_proof [] (* Lemma second_derivative_compose_pow *) let second_derivative_compose_pow = Sections.section_proof ["n"] `nth_derivative 2 (\x. f x pow n) x = - &n * (nth_derivative 2 f x * f x pow (n - 1) + &n * (nth_derivative 2 f x * f x pow (n - 1) + &(n - 1) * f x pow (n - 2) * derivative f x pow 2)` [ ((fun arg_tac -> arg_tac (Arg_term (`\x. x pow n`))) (term_tac (set_tac "g"))); @@ -2632,7 +2632,7 @@ let second_derivative_compose_pow3 = Sections.section_proof [] (* Lemma second_derivative_compose_atn *) let second_derivative_compose_atn = Sections.section_proof [] -`nth_derivative 2 (\x. atn (f x)) x = +`nth_derivative 2 (\x. atn (f x)) x = (nth_derivative 2 f x * (&1 + f x * f x) - &2 * f x * derivative f x pow 2) / (&1 + f x * f x) pow 2` [ ((((use_arg_then2 ("second_derivative_compose", [second_derivative_compose]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("diff2_atn", [diff2_atn]))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then2 ("nth_derivative2", [nth_derivative2]))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("second_derivative_atn", [second_derivative_atn]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then2 ("derivative_atn", [derivative_atn]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); @@ -2649,7 +2649,7 @@ let second_derivative_compose_atn = Sections.section_proof [] (* Lemma second_derivative_compose_cos *) let second_derivative_compose_cos = Sections.section_proof [] -`nth_derivative 2 (\x. cos (f x)) x = +`nth_derivative 2 (\x. cos (f x)) x = --(nth_derivative 2 f x * sin (f x) + cos (f x) * derivative f x pow 2)` [ ((((use_arg_then2 ("second_derivative_compose", [second_derivative_compose]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("diff2_cos", [diff2_cos]))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then2 ("second_derivative_cos", [second_derivative_cos]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then2 ("derivative_cos", [derivative_cos]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); @@ -2658,7 +2658,7 @@ let second_derivative_compose_cos = Sections.section_proof [] (* Lemma second_derivative_compose_sin *) let second_derivative_compose_sin = Sections.section_proof [] -`nth_derivative 2 (\x. sin (f x)) x = +`nth_derivative 2 (\x. sin (f x)) x = nth_derivative 2 f x * cos (f x) - sin (f x) * derivative f x pow 2` [ ((((use_arg_then2 ("second_derivative_compose", [second_derivative_compose]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("diff2_sin", [diff2_sin]))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then2 ("second_derivative_sin", [second_derivative_sin]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then2 ("derivative_sin", [derivative_sin]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); @@ -2667,7 +2667,7 @@ let second_derivative_compose_sin = Sections.section_proof [] (* Lemma second_derivative_compose_exp *) let second_derivative_compose_exp = Sections.section_proof [] -`nth_derivative 2 (\x. exp (f x)) x = +`nth_derivative 2 (\x. exp (f x)) x = nth_derivative 2 f x * exp (f x) + exp (f x) * derivative f x pow 2` [ ((((use_arg_then2 ("second_derivative_compose", [second_derivative_compose]))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then2 ("diff2_exp", [diff2_exp]))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then2 ("second_derivative_exp", [second_derivative_exp]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then2 ("derivative_exp", [derivative_exp]))(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); @@ -2721,7 +2721,7 @@ let second_derivative_compose_sqrt = Sections.section_proof [] let second_derivative_compose_acs = Sections.section_proof [] `abs (f x) < &1 ==> nth_derivative 2 (\x. acs (f x)) x = - -- ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / + -- ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))` [ (BETA_TAC THEN (move ["f_ineq"])); @@ -2742,7 +2742,7 @@ let second_derivative_compose_acs = Sections.section_proof [] let second_derivative_compose_asn = Sections.section_proof [] `abs (f x) < &1 ==> nth_derivative 2 (\x. asn (f x)) x = - ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / + ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))` [ (BETA_TAC THEN (move ["f_ineq"])); @@ -2922,7 +2922,7 @@ let second_derivative_div = Sections.section_proof ["f";"g";"x"] `~(g x = &0) ==> nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> - nth_derivative 2 (\x. f x / g x) x = + nth_derivative 2 (\x. f x / g x) x = ((nth_derivative 2 f x * g x - f x * nth_derivative 2 g x) * g x - &2 * derivative g x * (derivative f x * g x - f x * derivative g x)) / (g x pow 3)` [ @@ -2934,7 +2934,7 @@ let second_derivative_div = Sections.section_proof ["f";"g";"x"] ((((use_arg_then2 ("diff_g", [])) (disch_tac [])) THEN (clear_assumption "diff_g") THEN BETA_TAC) THEN ((((use_arg_then2 ("nth_diff_strong2_eq", [nth_diff_strong2_eq]))(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (done_tac)); ((((use_arg_then2 ("ddf_def", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("ddg_def", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("df_def", []))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then2 ("dg_def", []))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then2 ("real_div", [real_div]))(thm_tac (new_rewrite [] [])))))); ((fun arg_tac -> arg_tac (Arg_term (`_1 + _2`))) (term_tac (set_tac "lhs"))); - (((fun arg_tac -> arg_tac (Arg_theorem (REAL_RING `!f g x. ((ddf * g x - f x * ddg) * g x - &2 * dg * (df * g x - f x * dg)) * + (((fun arg_tac -> arg_tac (Arg_theorem (REAL_RING `!f g x. ((ddf * g x - f x * ddg) * g x - &2 * dg * (df * g x - f x * dg)) * inv (g x pow 3) = f x * (&2 * dg pow 2 - ddg * g x) * inv (g x pow 3) + &2 * df * --(g x * inv (g x pow 3)) * dg + @@ -3004,7 +3004,7 @@ let second_derivative_compose_bounds = Sections.section_proof ["f";"g";"int";"g_ `nth_diff_strong_int 2 int g ==> bounded_on_int g int g_bounds ==> nth_diff_strong_int 2 g_bounds f ==> - bounded_on_int (\x. nth_derivative 2 f (g x) * derivative g x pow 2 + + bounded_on_int (\x. nth_derivative 2 f (g x) * derivative g x pow 2 + derivative f (g x) * nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f (g x)) int dd_bounds` [ @@ -3165,7 +3165,7 @@ let second_derivative_cos_bounds = Sections.section_proof ["dd_bounds"] (* Lemma second_derivative_compose_cos_bounds *) let second_derivative_compose_cos_bounds = Sections.section_proof ["f";"dd_bounds"] `nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. --(nth_derivative 2 f x * sin (f x) + bounded_on_int (\x. --(nth_derivative 2 f x * sin (f x) + cos (f x) * derivative f x pow 2)) int dd_bounds ==> has_bounded_second_derivative (\x. cos (f x)) int dd_bounds` [ @@ -3187,7 +3187,7 @@ let second_derivative_sin_bounds = Sections.section_proof ["dd_bounds"] (* Lemma second_derivative_compose_sin_bounds *) let second_derivative_compose_sin_bounds = Sections.section_proof ["f";"dd_bounds"] `nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. nth_derivative 2 f x * cos (f x) + bounded_on_int (\x. nth_derivative 2 f x * cos (f x) - sin (f x) * derivative f x pow 2) int dd_bounds ==> has_bounded_second_derivative (\x. sin (f x)) int dd_bounds` [ @@ -3209,7 +3209,7 @@ let second_derivative_exp_bounds = Sections.section_proof ["dd_bounds"] (* Lemma second_derivative_compose_exp_bounds *) let second_derivative_compose_exp_bounds = Sections.section_proof ["f";"dd_bounds"] `nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. nth_derivative 2 f x * exp (f x) + bounded_on_int (\x. nth_derivative 2 f x * exp (f x) + exp (f x) * derivative f x pow 2) int dd_bounds ==> has_bounded_second_derivative (\x. exp (f x)) int dd_bounds` [ @@ -3261,7 +3261,7 @@ let second_derivative_inv_bounds = Sections.section_proof ["dd_bounds"] let second_derivative_compose_inv_bounds = Sections.section_proof ["f";"f_bounds";"dd_bounds"] `bounded_on_int f int f_bounds ==> interval_not_zero f_bounds ==> nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / f x pow 3) + bounded_on_int (\x. (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / f x pow 3) int dd_bounds ==> has_bounded_second_derivative (\x. inv (f x)) int dd_bounds` [ @@ -3290,7 +3290,7 @@ let second_derivative_compose_sqrt_bounds = Sections.section_proof ["f";"f_bound `bounded_on_int f int f_bounds ==> interval_pos f_bounds ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (&2 * nth_derivative 2 f x * f x - derivative f x pow 2) / - (&4 * sqrt (f x pow 3))) + (&4 * sqrt (f x pow 3))) int dd_bounds ==> has_bounded_second_derivative (\x. sqrt (f x)) int dd_bounds` [ @@ -3578,7 +3578,7 @@ Sections.end_section "SecondDerivativeBound";; (* Section TaylorArith *) Sections.begin_section "TaylorArith";; -let cell_domain = new_definition `cell_domain x y z w <=> +let cell_domain = new_definition `cell_domain x y z w <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w`;; (* Lemma taylor_x *) diff --git a/Formal_ineqs/taylor/theory/taylor_interval.vhl b/Formal_ineqs/taylor/theory/taylor_interval.vhl index 4a4f0e1b..51fb7c2c 100644 --- a/Formal_ineqs/taylor/theory/taylor_interval.vhl +++ b/Formal_ineqs/taylor/theory/taylor_interval.vhl @@ -27,7 +27,7 @@ module Taylor_interval. "let nth_differentiable = define `(nth_differentiable 0 f x <=> f real_continuous atreal x) /\ - (nth_differentiable (SUC n) f x <=> nth_differentiable n f x /\ + (nth_differentiable (SUC n) f x <=> nth_differentiable n f x /\ nth_derivative n f real_differentiable atreal x)`". "let nth_differentiable_on = new_definition `nth_differentiable_on n s f <=> @@ -36,11 +36,11 @@ module Taylor_interval. "let nth_differentiable_on_int = new_definition `nth_differentiable_on_int n int f <=> !x. interval_arith x int ==> nth_differentiable n f x`". -"let nth_diff_weak = new_definition `nth_diff_weak n f x <=> f real_continuous atreal x /\ +"let nth_diff_weak = new_definition `nth_diff_weak n f x <=> f real_continuous atreal x /\ ?F. F 0 = f /\ !i. i < n ==> (F i has_real_derivative F (SUC i) x) (atreal x)`". -"let nth_diff_strong = new_definition `nth_diff_strong n f x <=> +"let nth_diff_strong = new_definition `nth_diff_strong n f x <=> ?s. real_open s /\ x IN s /\ nth_differentiable_on n s f`". "let nth_diff_strong_int = new_definition `nth_diff_strong_int n int f <=> @@ -70,7 +70,7 @@ move => df; apply: (REAL_DERIVATIVE_UNIQUE_ATREAL f x). by rewrite df has_derivative_cond //; exists f'. Qed. -Lemma derivative_unique_on s f f': +Lemma derivative_unique_on s f f': `(!x. x IN s ==> (f has_real_derivative f' x) (atreal x)) ==> (!x. x IN s ==> f' x = derivative f x)`. move => df x xs. @@ -98,7 +98,7 @@ by rewrite ONE nth_derivativeS nth_derivative0. Qed. Lemma nth_derivative2 f : `nth_derivative 2 f = derivative (derivative f)`. by rewrite "ARITH_RULE `2 = SUC(SUC 0)`" nth_derivative !iterS "GEN_ALL iter". Qed. -Lemma nth_derivative_add n m f : +Lemma nth_derivative_add n m f : `nth_derivative n (nth_derivative m f) = nth_derivative (n + m) f`. by rewrite !nth_derivative iter_add. Qed. @@ -117,7 +117,7 @@ by rewrite nth_derivativeS has_derivative_alt. Qed. Lemma nth_differentiable_on_cond n s f : `nth_differentiable_on n s f ==> - !x. x IN s ==> + !x. x IN s ==> !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)`. rewrite nth_differentiable_on => cond x. by move/cond => /nth_differentiable_cond. @@ -176,7 +176,7 @@ by rewrite !nth_derivative_add addSn cond; move: j_lt_ni; arith. Qed. -Lemma nth_diff_strong_imp_diff n f x : +Lemma nth_diff_strong_imp_diff n f x : `nth_diff_strong n f x ==> nth_differentiable n f x`. rewrite nth_diff_strong => [] [s] [_] [xs]; rewrite nth_differentiable_on => h. exact: h. @@ -310,7 +310,7 @@ Lemma derivative_composition f g x: `f real_differentiable atreal x ==> derivative (\x. g (f x)) x = derivative f x * derivative g (f x)`. Proof. move => /has_derivative_alt df /has_derivative_alt dg; apply: derivative_unique. -have := "GEN_ALL HAS_REAL_DERIVATIVE_CHAIN" +have := "GEN_ALL HAS_REAL_DERIVATIVE_CHAIN" `derivative f x` `derivative g` `\y. y = f x` f g; "ANTS_TAC"; first by move => y ->. by move => [_]; apply. @@ -511,14 +511,14 @@ Hypothesis dg : `g real_differentiable atreal x`. Lemma derivative_add : `derivative (\x. f x + g x) x = derivative f x + derivative g x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_ADD !has_derivative_alt. Qed. -Lemma derivative_mul : +Lemma derivative_mul : `derivative (\x. f x * g x) x = f x * derivative g x + derivative f x * g x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_MUL_ATREAL !has_derivative_alt. Qed. Lemma derivative_sub : `derivative (\x. f x - g x) x = derivative f x - derivative g x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_SUB !has_derivative_alt. Qed. -Lemma derivative_div : `~(g x = &0) ==> +Lemma derivative_div : `~(g x = &0) ==> derivative (\x. f x / g x) x = (derivative f x * g x - f x * derivative g x) / (g x * g x)`. move => gn0; apply: derivative_unique; rewrite -REAL_POW_2 HAS_REAL_DERIVATIVE_DIV_ATREAL //. by rewrite !has_derivative_alt. @@ -530,7 +530,7 @@ End DerivativeArith. Section MoreDerivativeArith. -Lemma differentiable_sum_numseg G n m x : +Lemma differentiable_sum_numseg G n m x : `(!i. i IN n..m ==> G i real_differentiable atreal x) ==> (\x. sum (n..m) (\i. G i x)) real_differentiable atreal x`. elim: m => [|m IHm] dG; rewrite !"GEN_ALL SUM_CLAUSES_NUMSEG". @@ -594,7 +594,7 @@ Variable n : `:num`. Hypothesis df : `nth_diff_strong_int n int f`. Lemma nth_derivative_scale_strong c i x : `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y`. move: df; rewrite nth_diff_strong_int nth_diff_strong => df. move/df => [s] [open_s] [xs]; rewrite nth_differentiable_on nth_differentiable_eq => diff. @@ -612,10 +612,10 @@ by rewrite eq. Qed. Lemma nth_derivative_scale_strong_all c x : `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y`. move => /(nth_derivative_scale_strong c) h. -set P := `\i s. real_open s /\ x IN s /\ +set P := `\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y)`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. @@ -667,7 +667,7 @@ Hypothesis dg : `nth_diff_strong_int n int g`. (* Addition *) Lemma nth_derivative_add_strong i x : `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y`. move: df dg; rewrite !nth_diff_strong_int !nth_diff_strong => df dg ineq. move: (df ineq) => [sf] [open_sf] [xsf]; move: df => _. @@ -688,11 +688,11 @@ by move => z z_in /=; rewrite eq. Qed. Lemma nth_derivative_add_strong_all x : `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ - !i y. i <= n /\ y IN s ==> + ?s. real_open s /\ x IN s /\ + !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y`. move => /(nth_derivative_add_strong) h. -set P := `\i s. real_open s /\ x IN s /\ +set P := `\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y)`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. @@ -723,7 +723,7 @@ Qed. Lemma nth_diff_add : `nth_diff_strong_int n int (\x. f x + g x)`. -move: (df) (dg). +move: (df) (dg). rewrite !nth_diff_strong_int !nth_diff_strong !nth_differentiable_on !nth_differentiable_eq. move => df dg x ineq. have := nth_derivative_add_strong_all ineq. @@ -744,7 +744,7 @@ Qed. (* Subtraction *) Lemma nth_derivative_sub_strong i x : `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ + ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y`. move: df dg; rewrite !nth_diff_strong_int !nth_diff_strong => df dg ineq. move: (df ineq) => [sf] [open_sf] [xsf]; move: df => _. @@ -765,11 +765,11 @@ by move => z z_in /=; rewrite eq. Qed. Lemma nth_derivative_sub_strong_all x : `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ - !i y. i <= n /\ y IN s ==> + ?s. real_open s /\ x IN s /\ + !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y`. move => /(nth_derivative_sub_strong) h. -set P := `\i s. real_open s /\ x IN s /\ +set P := `\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y)`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. @@ -800,7 +800,7 @@ Qed. Lemma nth_diff_sub : `nth_diff_strong_int n int (\x. f x - g x)`. -move: (df) (dg). +move: (df) (dg). rewrite !nth_diff_strong_int !nth_diff_strong !nth_differentiable_on !nth_differentiable_eq. move => df dg x ineq. have := nth_derivative_sub_strong_all ineq. @@ -820,8 +820,8 @@ Qed. (* Multiplication *) Lemma nth_derivative_mul_strong i x : `interval_arith x int ==> i <= n ==> - ?s. real_open s /\ x IN s /\ - !y. y IN s ==> nth_derivative i (\y. f y * g y) y = + ?s. real_open s /\ x IN s /\ + !y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)`. move: df dg; rewrite !nth_diff_strong_int !nth_diff_strong => df dg ineq. move: (df ineq) => [sf] [open_sf] [xsf]; move: df => _. @@ -849,7 +849,7 @@ have diff_cond : `!k. k IN 0..i ==> by move: ineq i_lt_n; arith. exists `nth_derivative (SUC (i - k)) g y`; rewrite (diff_g ysg). by move: ineq i_lt_n; arith. -have diff_cond2 : `!k. k IN 0..i ==> +have diff_cond2 : `!k. k IN 0..i ==> (\y. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y) real_differentiable atreal y`. move => k k_in /=. @@ -881,13 +881,13 @@ Qed. Lemma nth_derivative_mul_strong_all x : `interval_arith x int ==> - ?s. real_open s /\ x IN s /\ - !i y. i <= n /\ y IN s ==> - nth_derivative i (\y. f y * g y) y = + ?s. real_open s /\ x IN s /\ + !i y. i <= n /\ y IN s ==> + nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)`. move => /(nth_derivative_mul_strong) h. -set P := `\i s. real_open s /\ x IN s /\ - (!y. y IN s ==> nth_derivative i (\y. f y * g y) y = +set P := `\i s. real_open s /\ x IN s /\ + (!y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y))`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. @@ -909,7 +909,7 @@ Qed. Lemma nth_derivative_mul i x : `interval_arith x int ==> i <= n ==> - nth_derivative i (\x. f x * g x) x = + nth_derivative i (\x. f x * g x) x = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f x * nth_derivative (i - k) g x)`. move => ineq i_le_n. have := nth_derivative_mul_strong ineq i_le_n. @@ -950,16 +950,16 @@ End NthDerivatives. (* Linear approximation and Taylor interval *) -"let lin_approx = new_definition `lin_approx f x f_bounds df_bounds <=> +"let lin_approx = new_definition `lin_approx f x f_bounds df_bounds <=> interval_arith (f x) f_bounds /\ (?f'. (f has_real_derivative f') (atreal x) /\ interval_arith f' df_bounds)`". "let has_bounded_second_derivative = new_definition `has_bounded_second_derivative f int dd_bounds <=> - nth_diff_strong_int 2 int f /\ + nth_diff_strong_int 2 int f /\ bounded_on_int (nth_derivative 2 f) int dd_bounds`". -"let taylor_interval = new_definition +"let taylor_interval = new_definition `taylor_interval f x y z w f_bounds df_bounds ddf_bounds <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w /\ lin_approx f y f_bounds df_bounds /\ @@ -975,7 +975,7 @@ by move: (h ineq) => [s] [_] [xs]; exact. Qed. -Lemma has_bounded_second_derivative_old f int dd_bounds : +Lemma has_bounded_second_derivative_old f int dd_bounds : `has_bounded_second_derivative f int dd_bounds ==> ?f' f''. (!x. interval_arith x int ==> (f has_real_derivative f' x) (atreal x) /\ (f' has_real_derivative f'' x) (atreal x) /\ interval_arith (f'' x) dd_bounds)`. @@ -1026,7 +1026,7 @@ by move: (cond `--y`); rewrite REAL_NEG_NEG; apply; move: ineqs; arith. Qed. -Lemma continuous_leq_segment f c a b : +Lemma continuous_leq_segment f c a b : `a < b ==> f real_continuous atreal a ==> f real_continuous atreal b ==> (!x. x IN real_interval (a, b) ==> f x <= c) ==> (!x. x IN real_interval [a, b] ==> f x <= c)`. @@ -1079,7 +1079,7 @@ Qed. -Lemma taylor_error t : `x <= t /\ t <= z ==> +Lemma taylor_error t : `x <= t /\ t <= z ==> abs (f t - f y) <= w * iabs df_bounds + w * w * dd_bound / &2`. move => t_ineqs. have := tif; rewrite taylor_interval !andbA => [] [] [domain_ineqs] lin_app. @@ -1106,7 +1106,7 @@ suff: `abs (f t - (f y + f' y * (t - y) pow 1)) <= dd_bound * abs (t - y) pow (1 rewrite andTb !andbT REAL_MUL_SYM -REAL_POW_2 REAL_LE_MUL2 REAL_LE_REFL dd_prop. by rewrite REAL_LE_POW_2 andTb !andbT -REAL_LE_SQUARE_ABS REAL_ABS_ABS; move: abs_ty; arith. set Df := `\i. if i = 0 then f else if i = 1 then f' else if i = 2 then f'' else I`. -have arith := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ +have arith := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`". have := REAL_TAYLOR Df `1` `real_interval [x, z]` dd_bound. "ANTS_TAC". @@ -1140,7 +1140,7 @@ move: tif; rewrite {1}eq taylor_interval !andbA lin_approx => [] [] [_] [f_int] move: f_int; rewrite interval_arith; arith. Qed. -Lemma taylor_derivative_error : `!t. x <= t /\ t <= z ==> +Lemma taylor_derivative_error : `!t. x <= t /\ t <= z ==> abs (derivative f t - derivative f y) <= w * dd_bound`. move => t t_ineqs. have := tif; rewrite taylor_interval !andbA => [] [] [domain_ineqs] _. @@ -1156,7 +1156,7 @@ have dd_prop : `&0 <= dd_bound /\ !p. p IN real_interval [x, z] ==> abs (f'' p) by move: (df y); rewrite (pair_eq ddf_bounds) !interval_arith iabs !domain_ineqs; arith. by move => p /df; rewrite pair_eq interval_arith iabs; arith. set Df := `\i. if i = 0 then f' else if i = 1 then f'' else I`. -have arith := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ +have arith := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`". have := REAL_TAYLOR Df `0` `real_interval [x, z]` dd_bound. "ANTS_TAC". @@ -1212,7 +1212,7 @@ rewrite lin_approx real_differentiable; split => [[-> [f'] [df' int_f']] | [[f'] by rewrite (derivative_unique f f'). by rewrite andTb; exists f'; rewrite df -(derivative_unique f f' x). Qed. - + Hypothesis approx_f : `lin_approx f x f_bounds df_bounds`. @@ -1454,7 +1454,7 @@ by rewrite !h REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL. Qed. -Lemma lin_approx_compose f g y g_bounds f_bounds d_bounds: +Lemma lin_approx_compose f g y g_bounds f_bounds d_bounds: `nth_diff_strong_int 2 g_bounds f ==> g real_differentiable atreal y ==> interval_arith (g y) g_bounds ==> @@ -1528,7 +1528,7 @@ rewrite -[`x pow (n - 1)`]REAL_MUL_RID HAS_REAL_DERIVATIVE_POW_ATREAL. by rewrite HAS_REAL_DERIVATIVE_ID. Qed. -Lemma second_derivative_pow_x n : +Lemma second_derivative_pow_x n : `derivative (derivative (\x. x pow n)) = (\x. &(n * (n - 1)) * x pow (n - 2))`. Proof. rewrite derivative_pow_x -eq_ext => x /=; apply: derivative_unique. @@ -1562,7 +1562,7 @@ Qed. (* atn *) -Lemma second_derivative_atn_eq x : `((\x. inv (&1 + x pow 2)) has_real_derivative +Lemma second_derivative_atn_eq x : `((\x. inv (&1 + x pow 2)) has_real_derivative (-- &2 * x) * inv (&1 + x pow 2) pow 2) (atreal x)`. Proof. rewrite REAL_POW_INV -real_div -REAL_NEG_LMUL HAS_REAL_DERIVATIVE_INV_ATREAL; split. @@ -1572,10 +1572,10 @@ rewrite REAL_POW_INV -real_div -REAL_NEG_LMUL HAS_REAL_DERIVATIVE_INV_ATREAL; sp by rewrite REAL_LT_IMP_NZ // REAL_ADD_SYM REAL_LT_ADD1 REAL_LE_POW_2. Qed. -Lemma second_derivative_atn : +Lemma second_derivative_atn : `derivative (derivative atn) = (\x. (-- &2 * x) * inv (&1 + x pow 2) pow 2)`. Proof. -rewrite derivative_atn -eq_ext => x /=; apply: derivative_unique. +rewrite derivative_atn -eq_ext => x /=; apply: derivative_unique. by rewrite -REAL_POW_2 second_derivative_atn_eq. Qed. @@ -1747,7 +1747,7 @@ Qed. Lemma real_powS x n : `x pow (SUC n) = x * x pow n`. by rewrite real_pow. Qed. -Lemma second_derivative_acs x : `abs x < &1 ==> +Lemma second_derivative_acs x : `abs x < &1 ==> nth_derivative 2 acs x = --(x / sqrt ((&1 - x * x) pow 3))`. Proof. rewrite nth_derivative2 => x_ineq. @@ -1801,7 +1801,7 @@ Qed. (* asn *) -Lemma second_derivative_asn x : `abs x < &1 ==> +Lemma second_derivative_asn x : `abs x < &1 ==> nth_derivative 2 asn x = x / sqrt ((&1 - x * x) pow 3)`. Proof. rewrite nth_derivative2 => x_ineq. @@ -1892,7 +1892,7 @@ Lemma REAL_CONTINUOUS_OPEN_PREIMAGE f s t : `f real_continuous_on s ==> real_ope real_open {x | x IN s /\ f x IN t}`. move => f_cont open_s open_t. rewrite REAL_OPEN. -suff ->: `IMAGE lift {x | x IN s /\ f x IN t} = +suff ->: `IMAGE lift {x | x IN s /\ f x IN t} = {x | x IN (IMAGE lift s) /\ (lift o f o drop) x IN (IMAGE lift t)}`. by rewrite CONTINUOUS_OPEN_PREIMAGE -!REAL_OPEN; rewr ETA_AX; rewrite -REAL_CONTINUOUS_ON. rewrite EXTENSION IN_IMAGE_LIFT_DROP !IN_ELIM_THM !IN_IMAGE_LIFT_DROP => z /=; split. @@ -1904,7 +1904,7 @@ Qed. Lemma second_derivative_compose f g x : `nth_diff_strong 2 g x ==> nth_diff_strong 2 f (g x) ==> - nth_derivative 2 (\x. f (g x)) x = + nth_derivative 2 (\x. f (g x)) x = nth_derivative 2 f (g x) * (derivative g x) pow 2 + derivative f (g x) * nth_derivative 2 g x`. move => dg df. rewrite nth_derivative2; apply: derivative_unique; apply: HAS_REAL_DERIVATIVE_LOCAL. @@ -2010,7 +2010,7 @@ Qed. Lemma second_derivative_compose_pow n : `nth_derivative 2 (\x. f x pow n) x = - &n * (nth_derivative 2 f x * f x pow (n - 1) + &n * (nth_derivative 2 f x * f x pow (n - 1) + &(n - 1) * f x pow (n - 2) * derivative f x pow 2)`. Proof. set g := `\x. x pow n`. @@ -2038,11 +2038,11 @@ Qed. (* atn *) -Lemma second_derivative_compose_atn : - `nth_derivative 2 (\x. atn (f x)) x = +Lemma second_derivative_compose_atn : + `nth_derivative 2 (\x. atn (f x)) x = (nth_derivative 2 f x * (&1 + f x * f x) - &2 * f x * derivative f x pow 2) / (&1 + f x * f x) pow 2`. Proof. -rewrite second_derivative_compose ?diff2_atn // +rewrite second_derivative_compose ?diff2_atn // nth_derivative2 second_derivative_atn /= derivative_atn /=. rewrite REAL_ADD_SYM !REAL_MUL_LNEG -real_sub. set lhs1 := `_1 * _2`; set lhs2 := `_1 * _2`. @@ -2056,8 +2056,8 @@ by move: (REAL_LE_SQUARE `f x`); arith. Qed. (* cos *) -Lemma second_derivative_compose_cos : - `nth_derivative 2 (\x. cos (f x)) x = +Lemma second_derivative_compose_cos : + `nth_derivative 2 (\x. cos (f x)) x = --(nth_derivative 2 f x * sin (f x) + cos (f x) * derivative f x pow 2)`. Proof. rewrite second_derivative_compose ?diff2_cos // second_derivative_cos /= derivative_cos /=. @@ -2065,8 +2065,8 @@ by arith. Qed. (* sin *) -Lemma second_derivative_compose_sin : - `nth_derivative 2 (\x. sin (f x)) x = +Lemma second_derivative_compose_sin : + `nth_derivative 2 (\x. sin (f x)) x = nth_derivative 2 f x * cos (f x) - sin (f x) * derivative f x pow 2`. Proof. rewrite second_derivative_compose ?diff2_sin // second_derivative_sin /= derivative_sin /=. @@ -2074,8 +2074,8 @@ by arith. Qed. (* exp *) -Lemma second_derivative_compose_exp : - `nth_derivative 2 (\x. exp (f x)) x = +Lemma second_derivative_compose_exp : + `nth_derivative 2 (\x. exp (f x)) x = nth_derivative 2 f x * exp (f x) + exp (f x) * derivative f x pow 2`. Proof. rewrite second_derivative_compose ?diff2_exp // second_derivative_exp /= derivative_exp /=. @@ -2101,7 +2101,7 @@ move => fn0. rewrite second_derivative_compose ?diff2_inv // second_derivative_inv // derivative_inv //. rewrite REAL_MUL_LNEG -real_sub real_div REAL_SUB_RDISTRIB. apply: "REAL_ARITH `!a b c d. a = c /\ b = d ==> a - b = c - d`"; split; first by arith. -rewrite REAL_INV_POW "ARITH_RULE `3 = SUC 2`" real_powS. +rewrite REAL_INV_POW "ARITH_RULE `3 = SUC 2`" real_powS. rewrite "REAL_ARITH `!a b c d. (a * b) * c * d = a * (b * c) * d`" REAL_MUL_RINV // REAL_MUL_LID. by rewrite REAL_INV_MUL -REAL_POW_2 REAL_MUL_SYM. Qed. @@ -2125,7 +2125,7 @@ Qed. (* acs *) Lemma second_derivative_compose_acs : `abs (f x) < &1 ==> nth_derivative 2 (\x. acs (f x)) x = - -- ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / + -- ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))`. Proof. move => f_ineq. @@ -2145,7 +2145,7 @@ Qed. (* asn *) Lemma second_derivative_compose_asn : `abs (f x) < &1 ==> nth_derivative 2 (\x. asn (f x)) x = - ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / + ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))`. Proof. move => f_ineq. @@ -2253,7 +2253,7 @@ Qed. Lemma second_derivative_div f g x : `~(g x = &0) ==> nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> - nth_derivative 2 (\x. f x / g x) x = + nth_derivative 2 (\x. f x / g x) x = ((nth_derivative 2 f x * g x - f x * nth_derivative 2 g x) * g x - &2 * derivative g x * (derivative f x * g x - f x * derivative g x)) / (g x pow 3)`. move => gn0 diff_f diff_g. @@ -2264,7 +2264,7 @@ rewrite derivative_compose_inv. by move: diff_g; rewrite nth_diff_strong2_eq => [] [s] [open_s] [xs] -> //. rewrite ddf_def ddg_def df_def dg_def !real_div. set lhs := `_1 + _2`. -rewrite "REAL_RING `!f g x. ((ddf * g x - f x * ddg) * g x - &2 * dg * (df * g x - f x * dg)) * +rewrite "REAL_RING `!f g x. ((ddf * g x - f x * ddg) * g x - &2 * dg * (df * g x - f x * dg)) * inv (g x pow 3) = f x * (&2 * dg pow 2 - ddg * g x) * inv (g x pow 3) + &2 * df * --(g x * inv (g x pow 3)) * dg + @@ -2336,7 +2336,7 @@ Lemma second_derivative_compose_bounds f g int g_bounds dd_bounds : `nth_diff_strong_int 2 int g ==> bounded_on_int g int g_bounds ==> nth_diff_strong_int 2 g_bounds f ==> - bounded_on_int (\x. nth_derivative 2 f (g x) * derivative g x pow 2 + + bounded_on_int (\x. nth_derivative 2 f (g x) * derivative g x pow 2 + derivative f (g x) * nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f (g x)) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /=. @@ -2347,7 +2347,7 @@ Qed. (* abs *) -Lemma second_derivative_abs_pos_bounds dd_bounds : +Lemma second_derivative_abs_pos_bounds dd_bounds : `interval_pos int ==> bounded_on_int (\x. &0) int dd_bounds ==> has_bounded_second_derivative abs int dd_bounds`. @@ -2358,7 +2358,7 @@ split => x ineq. rewrite second_derivative_abs_pos ?(interval_arith_pos x int) // (bounded ineq). Qed. -Lemma second_derivative_abs_neg_bounds dd_bounds : +Lemma second_derivative_abs_neg_bounds dd_bounds : `interval_neg int ==> bounded_on_int (\x. &0) int dd_bounds ==> has_bounded_second_derivative abs int dd_bounds`. @@ -2399,7 +2399,7 @@ Qed. (* pow *) -Lemma second_derivative_pow_bounds n dd_bounds : +Lemma second_derivative_pow_bounds n dd_bounds : `bounded_on_int (\x. &(n * (n - 1)) * x pow (n - 2)) int dd_bounds ==> has_bounded_second_derivative (\x. x pow n) int dd_bounds`. Proof. @@ -2414,13 +2414,13 @@ Lemma second_derivative_compose_pow_bounds n f dd_bounds : &(n - 1) * f x pow (n - 2) * derivative f x pow 2)) int dd_bounds ==> has_bounded_second_derivative (\x. f x pow n) int dd_bounds`. Proof. -rewrite has_bounded_second_derivative !bounded_on_int +rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => df bounded; split => x ineq. by rewrite diff2_compose_pow df. by rewrite second_derivative_compose_pow ?df // bounded. Qed. -Lemma second_derivative_pow2_bounds dd_bounds : +Lemma second_derivative_pow2_bounds dd_bounds : `bounded_on_int (\x. &2) int dd_bounds ==> has_bounded_second_derivative (\x. x pow 2) int dd_bounds`. Proof. @@ -2438,7 +2438,7 @@ move => df bounded; rewrite second_derivative_compose_pow_bounds df andTb. by rewrite "ARITH_RULE `2 - 1 = 1`" subnn "GEN_ALL real_pow" !REAL_MUL_LID REAL_POW_1. Qed. -Lemma second_derivative_pow3_bounds dd_bounds : +Lemma second_derivative_pow3_bounds dd_bounds : `bounded_on_int (\x. &6 * x) int dd_bounds ==> has_bounded_second_derivative (\x. x pow 3) int dd_bounds`. Proof. @@ -2458,7 +2458,7 @@ Qed. (* atn *) -Lemma second_derivative_atn_bounds dd_bounds : +Lemma second_derivative_atn_bounds dd_bounds : `bounded_on_int (\x. (-- &2 * x) * inv(&1 + x pow 2) pow 2) int dd_bounds ==> has_bounded_second_derivative atn int dd_bounds`. Proof. @@ -2480,7 +2480,7 @@ Qed. (* cos *) -Lemma second_derivative_cos_bounds dd_bounds : +Lemma second_derivative_cos_bounds dd_bounds : `bounded_on_int (\x. -- cos x) int dd_bounds ==> has_bounded_second_derivative cos int dd_bounds`. Proof. @@ -2491,7 +2491,7 @@ Qed. Lemma second_derivative_compose_cos_bounds f dd_bounds : `nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. --(nth_derivative 2 f x * sin (f x) + bounded_on_int (\x. --(nth_derivative 2 f x * sin (f x) + cos (f x) * derivative f x pow 2)) int dd_bounds ==> has_bounded_second_derivative (\x. cos (f x)) int dd_bounds`. Proof. @@ -2502,7 +2502,7 @@ Qed. (* sin *) -Lemma second_derivative_sin_bounds dd_bounds : +Lemma second_derivative_sin_bounds dd_bounds : `bounded_on_int (\x. -- sin x) int dd_bounds ==> has_bounded_second_derivative sin int dd_bounds`. Proof. @@ -2513,7 +2513,7 @@ Qed. Lemma second_derivative_compose_sin_bounds f dd_bounds : `nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. nth_derivative 2 f x * cos (f x) + bounded_on_int (\x. nth_derivative 2 f x * cos (f x) - sin (f x) * derivative f x pow 2) int dd_bounds ==> has_bounded_second_derivative (\x. sin (f x)) int dd_bounds`. Proof. @@ -2524,7 +2524,7 @@ Qed. (* exp *) -Lemma second_derivative_exp_bounds dd_bounds : +Lemma second_derivative_exp_bounds dd_bounds : `bounded_on_int exp int dd_bounds ==> has_bounded_second_derivative exp int dd_bounds`. Proof. @@ -2535,7 +2535,7 @@ Qed. Lemma second_derivative_compose_exp_bounds f dd_bounds : `nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. nth_derivative 2 f x * exp (f x) + bounded_on_int (\x. nth_derivative 2 f x * exp (f x) + exp (f x) * derivative f x pow 2) int dd_bounds ==> has_bounded_second_derivative (\x. exp (f x)) int dd_bounds`. Proof. @@ -2547,7 +2547,7 @@ Qed. (* log *) -Lemma second_derivative_log_bounds dd_bounds : +Lemma second_derivative_log_bounds dd_bounds : `interval_pos int ==> bounded_on_int (\x. --inv (x pow 2)) int dd_bounds ==> has_bounded_second_derivative log int dd_bounds`. @@ -2576,7 +2576,7 @@ Qed. (* inv *) -Lemma second_derivative_inv_bounds dd_bounds : +Lemma second_derivative_inv_bounds dd_bounds : `interval_not_zero int ==> bounded_on_int (\x. &2 * inv (x pow 3)) int dd_bounds ==> has_bounded_second_derivative inv int dd_bounds`. @@ -2589,7 +2589,7 @@ Qed. Lemma second_derivative_compose_inv_bounds f f_bounds dd_bounds : `bounded_on_int f int f_bounds ==> interval_not_zero f_bounds ==> nth_diff_strong_int 2 int f ==> - bounded_on_int (\x. (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / f x pow 3) + bounded_on_int (\x. (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / f x pow 3) int dd_bounds ==> has_bounded_second_derivative (\x. inv (f x)) int dd_bounds`. Proof. @@ -2604,7 +2604,7 @@ Qed. (* sqrt *) -Lemma second_derivative_sqrt_bounds dd_bounds : +Lemma second_derivative_sqrt_bounds dd_bounds : `interval_pos int ==> bounded_on_int (\x. --inv (&4 * sqrt (x pow 3))) int dd_bounds ==> has_bounded_second_derivative sqrt int dd_bounds`. @@ -2619,7 +2619,7 @@ Lemma second_derivative_compose_sqrt_bounds f f_bounds dd_bounds : `bounded_on_int f int f_bounds ==> interval_pos f_bounds ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (&2 * nth_derivative 2 f x * f x - derivative f x pow 2) / - (&4 * sqrt (f x pow 3))) + (&4 * sqrt (f x pow 3))) int dd_bounds ==> has_bounded_second_derivative (\x. sqrt (f x)) int dd_bounds`. Proof. @@ -2633,7 +2633,7 @@ Qed. (* acs *) -Lemma second_derivative_acs_bounds dd_bounds : +Lemma second_derivative_acs_bounds dd_bounds : `iabs int < &1 ==> bounded_on_int (\x. --(x / sqrt ((&1 - x * x) pow 3))) int dd_bounds ==> has_bounded_second_derivative acs int dd_bounds`. @@ -2661,7 +2661,7 @@ Qed. (* asn *) -Lemma second_derivative_asn_bounds dd_bounds : +Lemma second_derivative_asn_bounds dd_bounds : `iabs int < &1 ==> bounded_on_int (\x. x / sqrt ((&1 - x * x) pow 3)) int dd_bounds ==> has_bounded_second_derivative asn int dd_bounds`. @@ -2693,7 +2693,7 @@ Qed. Lemma interval_arith_gt x int f : `interval_arith x int /\ interval_gt f int ==> f < x`. Proof. by rewrite (pair_eq int) interval_arith interval_gt; arith. Qed. -Lemma second_derivative_matan_bounds dd_bounds : +Lemma second_derivative_matan_bounds dd_bounds : `interval_gt (-- &1) int ==> bounded_on_int ddmatan int dd_bounds ==> has_bounded_second_derivative matan int dd_bounds`. @@ -2774,7 +2774,7 @@ Qed. (* div *) -Lemma second_derivative_div_bounds f g g_bounds dd_bounds : +Lemma second_derivative_div_bounds f g g_bounds dd_bounds : `bounded_on_int g int g_bounds ==> interval_not_zero g_bounds ==> nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> @@ -2796,7 +2796,7 @@ End SecondDerivativeBound. Section TaylorArith. -"let cell_domain = new_definition `cell_domain x y z w <=> +"let cell_domain = new_definition `cell_domain x y z w <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w`". @@ -2942,7 +2942,7 @@ by rewrite {2}REAL_ABS_NEG REAL_LE_ADD2 ?ddf1 ?ddf2 // REAL_ABS_TRIANGLE. Qed. -Lemma second_derivative_mul dd bf1 bf2 bdf1 bdf2 : +Lemma second_derivative_mul dd bf1 bf2 bdf1 bdf2 : `bounded_on f1 s bf1 ==> bounded_on f2 s bf2 ==> bounded_on (derivative f1) s bdf1 ==> bounded_on (derivative f2) s bdf2 ==> dd1 * bf2 + &2 * bdf1 * bdf2 + dd2 * bf1 <= dd ==> @@ -2967,13 +2967,13 @@ rewrite HAS_REAL_DERIVATIVE_MUL_ATREAL ?ddf1 ?ddf2 // andTb; split; last first. apply: REAL_LE_TRANS; exists `dd1 * bf2 + &2 * bdf1 * bdf2 + dd2 * bf1`. rewrite ineq andbT. apply: REAL_LE_TRANS; exists `abs (f1'' x * f2 x) + abs (&2 * f1' x * f2' x + f1 x * f2'' x)`. - rewrite REAL_ABS_TRIANGLE andTb REAL_LE_ADD2 REAL_ABS_MUL. + rewrite REAL_ABS_TRIANGLE andTb REAL_LE_ADD2 REAL_ABS_MUL. rewrite REAL_LE_MUL2 ?REAL_ABS_POS ?ddf1 ?b_f2 // andTb. apply: REAL_LE_TRANS; exists `abs (&2 * f1' x * f2' x) + abs (f1 x * f2'' x)`. rewrite REAL_ABS_TRIANGLE andTb REAL_LE_ADD2 !REAL_ABS_MUL [`dd2 * _`]REAL_MUL_SYM. rewrite !REAL_LE_MUL2 ?REAL_ABS_POS ?b_f1' ?b_f2' ?b_f1 ?ddf2 // REAL_LE_MUL ?REAL_ABS_POS //. by arith. -rewrite "REAL_ARITH `f1'' (x:real) * f2 x + &2 * f1' x * f2' x + f1 x * f2'' x = +rewrite "REAL_ARITH `f1'' (x:real) * f2 x + &2 * f1' x * f2' x + f1 x * f2'' x = (f1 x * f2'' x + f1' x * f2' x) + (f1' x * f2' x + f1'' x * f2 x)`". by rewrite HAS_REAL_DERIVATIVE_ADD !HAS_REAL_DERIVATIVE_MUL_ATREAL ?ddf1 ?ddf2. Qed. diff --git a/Formal_ineqs/tests/log.hl b/Formal_ineqs/tests/log.hl index 14b491fa..cf0badbb 100644 --- a/Formal_ineqs/tests/log.hl +++ b/Formal_ineqs/tests/log.hl @@ -12,7 +12,7 @@ module Log : Log_sig = struct (* Creates a directory if it doesn't exist and returns its name *) let get_dir dir_name = - let _ = + let _ = if Sys.file_exists dir_name then () else Unix.mkdir dir_name 0o777 in dir_name;; @@ -21,7 +21,7 @@ let get_dir dir_name = let open_log, close_log, close_all_logs, append_to_log, log_fmt = (* [name, (channel, formatter)] *) let logs = ref [] in - let log_for_name name = + let log_for_name name = try Some (assoc name !logs) with Failure _ -> diff --git a/Formal_ineqs/tests/nat_test.hl b/Formal_ineqs/tests/nat_test.hl index b403a5f6..f5c7f388 100644 --- a/Formal_ineqs/tests/nat_test.hl +++ b/Formal_ineqs/tests/nat_test.hl @@ -81,21 +81,21 @@ let run_tests = let start = Unix.gettimeofday() in let result = map f data in let finish = Unix.gettimeofday() in - finish -. start, result + finish -. start, result in let rec repeat n data f ((ts, r) as acc) = if n <= 0 then acc else let time, result = run data f in - repeat (n - 1) data f (time :: ts, result) + repeat (n - 1) data f (time :: ts, result) in let mean n s = let sum = itlist (+.) s 0.0 in sum /. (float_of_int n) in - let var n s = + let var n s = let m = mean n s in let m2 = mean n (map (fun x -> x *. x) s) in - m2 -. m *. m + m2 -. m *. m in fun n data_file pre mk post ?(result = true) f -> let strs = read_file data_file in @@ -110,7 +110,7 @@ let run_tests = let show_result = ref true;; let arith_test1d n data op f = - run_tests n data mk_nums (rand o Arith_nat.mk_numeral_array) + run_tests n data mk_nums (rand o Arith_nat.mk_numeral_array) (create_op op) ~result:!show_result f;; let arith_test2d n data op f = @@ -118,11 +118,11 @@ let arith_test2d n data op f = (create_binop op o data_to_pairs) ~result:!show_result f;; let new_arith_test1d n data f = - run_tests n data mk_nums Nat_arith.mk_nat + run_tests n data mk_nums Nat_arith.mk_nat I ~result:!show_result f;; let new_arith_test2d n data f = - run_tests n data mk_nums Nat_arith.mk_nat data_to_pairs + run_tests n data mk_nums Nat_arith.mk_nat data_to_pairs ~result:!show_result (uncurry f);; @@ -136,7 +136,7 @@ show_result := false;; let rep = 10;; -arith_test1d rep "data/nat15.txt" +arith_test1d rep "data/nat15.txt" `SUC` Arith_nat.raw_suc_conv_hash;; new_arith_test1d rep "data/nat15.txt" @@ -146,7 +146,7 @@ new_arith_test1d rep "data/nat15.txt" (* Addition *) (* 100: 2.189 +/- 0.053 *) -arith_test2d rep "data/nat10.txt" +arith_test2d rep "data/nat10.txt" `(+):num->num->num` Arith_nat.raw_add_conv_hash;; @@ -158,7 +158,7 @@ new_arith_test2d rep "data/nat10.txt" (* Subtraction *) (* 100: 3.482 +/- 0.043 *) -arith_test2d rep "data/nat10.txt" +arith_test2d rep "data/nat10.txt" `(-):num->num->num` Arith_nat.raw_sub_hash_conv;; @@ -170,7 +170,7 @@ new_arith_test2d rep "data/nat10.txt" (* Multiplication *) (* 100: 36.875 +/- 0.184 *) -arith_test2d rep "data/nat10.txt" +arith_test2d rep "data/nat10.txt" `( * ):num->num->num` Arith_nat.raw_mul_conv_hash;; @@ -182,7 +182,7 @@ new_arith_test2d rep "data/nat10.txt" (* Division *) (* 100: +/- *) -arith_test2d rep "data/nat10_small.txt" +arith_test2d rep "data/nat10_small.txt" `DIV:num->num->num` Arith_nat.raw_div_hash_conv;; diff --git a/Formal_ineqs/tests/results.hl b/Formal_ineqs/tests/results.hl index 52977f3c..f8450f35 100644 --- a/Formal_ineqs/tests/results.hl +++ b/Formal_ineqs/tests/results.hl @@ -45,7 +45,7 @@ ftest2 rep "log_big/div_hi.log" Arith_float.float_div_hi;; ftest2 rep "log_big/div_lo.log" Arith_float.float_div_lo;; -arith_test1d rep "data/nat15.txt" +arith_test1d rep "data/nat15.txt" `SUC` Arith_nat.raw_suc_conv_hash;; new_arith_test1d rep "data/nat15.txt" @@ -55,7 +55,7 @@ new_arith_test1d rep "data/nat15.txt" (* Addition *) (* 100: 2.189 +/- 0.053 *) -arith_test2d rep "data/nat10.txt" +arith_test2d rep "data/nat10.txt" `(+):num->num->num` Arith_nat.raw_add_conv_hash;; @@ -67,7 +67,7 @@ new_arith_test2d rep "data/nat10.txt" (* Subtraction *) (* 100: 3.482 +/- 0.043 *) -arith_test2d rep "data/nat10.txt" +arith_test2d rep "data/nat10.txt" `(-):num->num->num` Arith_nat.raw_sub_hash_conv;; @@ -79,7 +79,7 @@ new_arith_test2d rep "data/nat10.txt" (* Multiplication *) (* 100: 36.875 +/- 0.184 *) -arith_test2d rep "data/nat10.txt" +arith_test2d rep "data/nat10.txt" `( * ):num->num->num` Arith_nat.raw_mul_conv_hash;; @@ -91,7 +91,7 @@ new_arith_test2d rep "data/nat10.txt" (* Division *) (* 100: +/- *) -arith_test2d rep "data/nat10_small.txt" +arith_test2d rep "data/nat10_small.txt" `DIV:num->num->num` Arith_nat.raw_div_hash_conv;; diff --git a/Formal_ineqs/tests/test_utils.hl b/Formal_ineqs/tests/test_utils.hl index 38194594..91a48728 100644 --- a/Formal_ineqs/tests/test_utils.hl +++ b/Formal_ineqs/tests/test_utils.hl @@ -47,7 +47,7 @@ let write_file path buf = (* Splits a string into two substrings separated by a given character. *) (* The separator is not included in returned substrings. *) -let split_at str ch = +let split_at str ch = let n = String.length str in let i = try String.index str ch with Not_found -> -1 in if i < 0 || i >= n then @@ -56,7 +56,7 @@ let split_at str ch = String.sub str 0 i, String.sub str (i + 1) (n - i - 1);; -(* Returns n first elements of a list *) +(* Returns n first elements of a list *) let rec take n = function | [] -> [] | h :: t -> @@ -94,21 +94,21 @@ let run_tests_raw = let start = Unix.gettimeofday() in let result = map f data in let finish = Unix.gettimeofday() in - finish -. start, result + finish -. start, result in let rec repeat n data f ((ts, r) as acc) = if n <= 0 then acc else let time, result = run data f in - repeat (n - 1) data f (time :: ts, result) + repeat (n - 1) data f (time :: ts, result) in let mean n s = let sum = itlist (+.) s 0.0 in sum /. (float_of_int n) in - let var n s = + let var n s = let m = mean n s in let m2 = mean n (map (fun x -> x *. x) s) in - m2 -. m *. m + m2 -. m *. m in fun n data ?(result = true) f -> let time, r = repeat n data f ([], []) in @@ -159,7 +159,7 @@ let convert_float_binop_data str = let show_result = ref true;; let ntest1 n data op f = - run_tests n data mk_nums (rand o Arith_nat.mk_numeral_array) + run_tests n data mk_nums (rand o Arith_nat.mk_numeral_array) (create_op op) ~result:!show_result f;; let ntest2 n data op f = @@ -167,11 +167,11 @@ let ntest2 n data op f = (create_binop op o data_to_pairs) ~result:!show_result f;; let ntest1_new n data f = - run_tests n data mk_nums Nat_arith.mk_nat + run_tests n data mk_nums Nat_arith.mk_nat I ~result:!show_result f;; let ntest2_new n data f = - run_tests n data mk_nums Nat_arith.mk_nat data_to_pairs + run_tests n data mk_nums Nat_arith.mk_nat data_to_pairs ~result:!show_result (uncurry f);; let ftest2 n data f = diff --git a/Formal_ineqs/trig/asn_acs_eval.hl b/Formal_ineqs/trig/asn_acs_eval.hl index a917abff..c78ba306 100644 --- a/Formal_ineqs/trig/asn_acs_eval.hl +++ b/Formal_ineqs/trig/asn_acs_eval.hl @@ -82,7 +82,7 @@ let asn_pos_lo_th = (th_rule o prove) MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `atn t` THEN ASM_REWRITE_TAC[ATN_MONO_LE_EQ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x / r` THEN ASM_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[SQRT_LT_0] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[SQRT_LT_0] THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `&0 < &1 - a <=> a < &1`; ABS_SQUARE_LT_1] THEN ASM_ARITH_TAC; @@ -107,7 +107,7 @@ let asn_neg_hi_th = (th_rule o prove) MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--x / r` THEN ASM_REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_LE_NEG2; REAL_POW_NEG; ARITH_RULE `EVEN 2`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[SQRT_LT_0] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[SQRT_LT_0] THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `&0 < &1 - a <=> a < &1`; ABS_SQUARE_LT_1] THEN ASM_ARITH_TAC; @@ -154,7 +154,7 @@ let acs_hi_th = (th_rule o prove) c <= asn x /\ b - c <= hi ==> acs x <= hi`, - REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN + REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN ASM_SIMP_TAC[ACS_ASN] THEN ASM_ARITH_TAC);; let acs_lo_th = (th_rule o prove) @@ -164,11 +164,11 @@ let acs_lo_th = (th_rule o prove) asn x <= c /\ lo <= a - c ==> lo <= acs x`, - REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN + REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN ASM_SIMP_TAC[ACS_ASN] THEN ASM_ARITH_TAC);; let asn_interval = (th_rule o prove) - (`interval_arith x (a, b) /\ + (`interval_arith x (a, b) /\ (-- &1 <= a <=> T) /\ (b <= &1 <=> T) /\ lo <= asn a /\ @@ -182,7 +182,7 @@ let asn_interval = (th_rule o prove) ]);; let acs_interval = (th_rule o prove) - (`interval_arith x (a, b) /\ + (`interval_arith x (a, b) /\ (-- &1 <= a <=> T) /\ (b <= &1 <=> T) /\ lo <= acs b /\ @@ -196,7 +196,7 @@ let acs_interval = (th_rule o prove) ]);; let acs_interval2 = (th_rule o prove) - (`interval_arith x (a, b) /\ + (`interval_arith x (a, b) /\ (-- &1 <= a <=> T) /\ (b <= &1 <=> T) /\ interval_arith (pi / &2) (low, high) /\ diff --git a/Formal_ineqs/trig/atn.hl b/Formal_ineqs/trig/atn.hl index aecf9ffb..0fececd2 100644 --- a/Formal_ineqs/trig/atn.hl +++ b/Formal_ineqs/trig/atn.hl @@ -44,7 +44,7 @@ let halfatn_half = prove (`!x t. abs x < t ==> abs (halfatn x) < t / &2`, REWRITE_TAC[halfatn; REAL_ABS_DIV] THEN REPEAT STRIP_TAC THEN SIMP_TAC[abs_lemma; pos_lemma2; REAL_LT_LDIV_EQ] THEN - MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `t:real` THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[REAL_ARITH `t / &2 * a = t * (a / &2)`] THEN MATCH_MP_TAC (REAL_ARITH `t * (&1 + &1) <= t * a ==> t <= t * (a / &2)`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN @@ -151,7 +151,7 @@ let halfatn_mono_lt = prove ASM_ARITH_TAC; ALL_TAC ] THEN - REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `y < &0` THENL [ ONCE_REWRITE_TAC[REAL_ARITH `a < b <=> --b < --a`] THEN REWRITE_TAC[GSYM halfatn_odd] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; @@ -163,7 +163,7 @@ let halfatn_mono_lt = prove ALL_TAC ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; - + let halfatn_mono = prove (`!x y. x <= y ==> halfatn x <= halfatn y`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[halfatn_mono_lt]);; @@ -183,7 +183,7 @@ let atn_series_alt_sign = prove let f = (\i. (-- &1) pow i / &(2 * i + 1) * x pow (2 * i + 1)) in (!n. abs (f (n + 1)) <= abs (f n) /\ f (n + 1) * f n <= &0) /\ ((f ---> &0) sequentially)`, - REPEAT STRIP_TAC THEN CONV_TAC let_CONV THEN + REPEAT STRIP_TAC THEN CONV_TAC let_CONV THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV] THEN REWRITE_TAC[abs_neg_one_pow; ARITH_RULE `2 * (n + 1) + 1 = 2 * n + 3`] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ARITH `&1 / a * b = b / a`; REAL_ABS_NUM] THEN @@ -210,7 +210,7 @@ let atn_series_alt_sign = prove MAP_EVERY EXISTS_TAC [`atn x`; `0`] THEN ASM_SIMP_TAC[FROM_0; atn_series] ]);; - + let atn_poly_bound = prove (`!n x. abs x < &1 ==> abs (atn x - sum (0..n) (\i. (-- &1 pow i / &(2 * i + 1)) * x pow (2 * i + 1))) @@ -272,7 +272,7 @@ let atn_poly_pos_lower_bound = prove let atn_halfatn4_pos_upper_bound = prove (`!x n. EVEN n /\ &0 <= x - ==> atn (halfatn4 x) + ==> atn (halfatn4 x) <= sum (0..n) (\i. ((-- &1) pow i / &(2 * i + 1)) * (halfatn4 x) pow (2 * i + 1))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC atn_poly_pos_upper_bound THEN ASM_SIMP_TAC[halfatn4_pos; halfatn4_bound; REAL_ARITH `abs x < inv (&8) ==> x < &1`]);; @@ -285,8 +285,8 @@ let atn_halfatn4_pos_lower_bound = prove ASM_SIMP_TAC[halfatn4_pos; halfatn4_bound; REAL_ARITH `abs x < inv (&8) ==> x < &1`]);; let real_taylor_atn_halfatn4 = prove - (`!n x. abs (atn(halfatn4 x) - - sum (0..n) (\j. (-- &1 pow j) * halfatn4 x pow (2 * j + 1) / &(2 * j+ 1))) + (`!n x. abs (atn(halfatn4 x) - + sum (0..n) (\j. (-- &1 pow j) * halfatn4 x pow (2 * j + 1) / &(2 * j+ 1))) <= inv (&8 pow (2 * n + 3) * &(2 * n + 3))`, REPEAT GEN_TAC THEN ABBREV_TAC `y = halfatn4 x` THEN SUBGOAL_THEN `abs y < inv (&8)` ASSUME_TAC THENL [ diff --git a/Formal_ineqs/trig/atn_eval.hl b/Formal_ineqs/trig/atn_eval.hl index f418d2a8..28590f61 100644 --- a/Formal_ineqs/trig/atn_eval.hl +++ b/Formal_ineqs/trig/atn_eval.hl @@ -92,7 +92,7 @@ let halfatn_pos_lo_th = (th_rule o prove) ASM_REWRITE_TAC[REAL_LE_LADD; REAL_POW_2]);; let halfatn4_eq = prove - (`halfatn(halfatn(halfatn(halfatn x))) = halfatn4 x`, + (`halfatn(halfatn(halfatn(halfatn x))) = halfatn4 x`, REWRITE_TAC[halfatn4; o_THM]);; let float16 = mk_float 16 0;; @@ -130,7 +130,7 @@ let atn_interval_th = (th_rule o prove) ASM_REWRITE_TAC[ATN_MONO_LE_EQ] ]);; -let bound_high_transformation = (PURE_REWRITE_RULE[SYM float16_eq] o +let bound_high_transformation = (PURE_REWRITE_RULE[SYM float16_eq] o GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [SYM float1_eq] o prove) (`(&0 <= t /\ t < &1 ==> atn t <= t * (p1 - t pow 2 * p2)) ==> @@ -161,7 +161,7 @@ let bound_high_transformation = (PURE_REWRITE_RULE[SYM float16_eq] o MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `m * b` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]);; -let bound_low_transformation = (PURE_REWRITE_RULE[SYM float16_eq] o +let bound_low_transformation = (PURE_REWRITE_RULE[SYM float16_eq] o GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [SYM float1_eq] o prove) (`(&0 <= t /\ t < &1 ==> t * (p1 - t pow 2 * p2) <= atn t) ==> @@ -215,7 +215,7 @@ let eval_halfatn_pos_hi pp x_th = let c1_th = float_add_lo pp c_tm one_float in let f_tm = lhand (concl c1_th) in let s, n1_tm, e1_tm = dest_float f_tm in - let _ = + let _ = if s <> "F" then failwith ("eval_halfatn_pos_hi: s <> F: " ^ string_of_term (concl x_th)) else () in @@ -247,7 +247,7 @@ let eval_halfatn_pos_lo pp x_th = let div_th = float_div_lo pp t_tm r_tm in let lo_tm = lhand (concl div_th) in let s, n_tm, e_tm = dest_float lo_tm in - let _ = + let _ = if s <> "F" then failwith ("eval_halfatn_pos_lo: s <> F: " ^ string_of_term (concl x_th)) else () in @@ -273,19 +273,19 @@ let eval_halfatn4_pos_lo pp x_th = let eq_th = INST[x_tm, x_var_real] halfatn4_eq in let ltm, bounds = dest_comb (concl th0) in EQ_MP (AP_TERM ltm (AP_TERM (rator bounds) eq_th)) th0;; - + (* ---------------------------------- *) (* atn upper/lower bounds *) (* ---------------------------------- *) let mk_bound_tables bound_th = - let bound = (SPEC_ALL o + let bound = (SPEC_ALL o REWRITE_RULE[poly_f_even; poly_f_odd; GSYM REAL_POW_2; REAL_POW_POW] o REWRITE_RULE[alt_sum_eq_poly_f_even; alt_sum_eq_poly_f_odd; real_div]) bound_th in (* This rule does not simplify factorials *) let reduce_rule = CONV_RULE (DEPTH_CONV (FIRST_CONV [NUM_SUC_CONV; NUM_ADD_CONV; NUM_MULT_CONV])) in - let find_poly_f = rev o find_terms (fun tm -> + let find_poly_f = rev o find_terms (fun tm -> try (rator o rator) tm = `poly_f` with Failure _ -> false) in fun pp n -> let n_tm = mk_small_numeral n in @@ -301,14 +301,14 @@ let mk_bound_tables bound_th = bound_th, zip cs_tms cs_lists;; (* Computes i such that x^(2 * i + 1) / (2 * i + 1) <= base^(-(p + 1)) and cond(i) *) -let n_of_p_atn x pp cond = +let n_of_p_atn x pp cond = let t = (float_of_int Arith_num.arith_base) ** (float_of_int (-pp - 1)) in let rec try_i i = let _ = if i > 50 then failwith "n_of_p_atn: cannot find i" else () in if cond i then let d = float_of_int (2 * i + 1) in let r = (x ** d) /. d in - if r <= t then i else try_i (i + 1) + if r <= t then i else try_i (i + 1) else try_i (i + 1) in @@ -357,13 +357,13 @@ let float_atn_pos_high = let r16_le_hi = float_mul_hi pp float16 r_tm in let hi_tm = rand (concl r16_le_hi) in let cmp_1 = float_lt t_tm one_float in - if (fst o dest_const o rand o concl) cmp_1 = "F" then + if (fst o dest_const o rand o concl) cmp_1 = "F" then failwith ("float_atn_pos_high: t >= 1: " ^ string_of_term x_tm) - else + else let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; c_tm, c_var_real; n_tm, n_var_real; m_tm, m_var_real; r_tm, r_var_real; x_tm, x_var_real; t_tm, t_var_real; hi_tm, hi_var_real] bound_th in - itlist MY_PROVE_HYP [p1_high; p2_low; t_pow2_low; n_le_mb; an_le_c; + itlist MY_PROVE_HYP [p1_high; p2_low; t_pow2_low; n_le_mb; an_le_c; tc_le_r; r16_le_hi; cmp_1; h4] th0;; (* x_th = |- interval_arith x (&0, x) *) @@ -395,13 +395,13 @@ let float_atn_pos_low = MY_PROVE_HYP h4 th0 else let cmp_1 = float_lt t_tm one_float in - if (fst o dest_const o rand o concl) cmp_1 = "F" then + if (fst o dest_const o rand o concl) cmp_1 = "F" then failwith ("float_atn_pos_low: t >= 1: " ^ string_of_term x_tm) else let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; c_tm, c_var_real; n_tm, n_var_real; m_tm, m_var_real; r_tm, r_var_real; x_tm, x_var_real; t_tm, t_var_real; lo_tm, lo_var_real] bound_th in - itlist MY_PROVE_HYP [p1_low; p2_high; t_pow2_high; mb_le_n; c_le_an; + itlist MY_PROVE_HYP [p1_low; p2_high; t_pow2_high; mb_le_n; c_le_an; r_le_tc; lo_le_r16; cmp_1; h4] th0;; (* Computes an upper bound of atn for a given floating-point number *) diff --git a/Formal_ineqs/trig/cos_bounds_eval.hl b/Formal_ineqs/trig/cos_bounds_eval.hl index 5f40c0e7..63195481 100644 --- a/Formal_ineqs/trig/cos_bounds_eval.hl +++ b/Formal_ineqs/trig/cos_bounds_eval.hl @@ -39,7 +39,7 @@ let bound_high_transformation = prove(`!c x p1 p2 a b m n r. c <= p1 - x * p2 == interval_arith m (&0, x) /\ n <= m * b /\ a - n <= r - ==> c <= r`, + ==> c <= r`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a - n:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `p1 - x * p2:real` THEN ASM_REWRITE_TAC[] THEN @@ -53,7 +53,7 @@ let bound_low_transformation = prove(`!c x p1 p2 a b m n r. p1 - x * p2 <= c ==> interval_arith x (&0, m) /\ m * b <= n /\ r <= a - n - ==> r <= c`, + ==> r <= c`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a - n:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `p1 - x * p2:real` THEN ASM_REWRITE_TAC[] THEN @@ -63,12 +63,12 @@ let bound_low_transformation = prove(`!c x p1 p2 a b m n r. p1 - x * p2 <= c ==> let mk_cos_bound_tables cos_bound_th = - let cos_bound = (SPEC_ALL o + let cos_bound = (SPEC_ALL o REWRITE_RULE[poly_f_even; poly_f_odd; GSYM REAL_POW_2; REAL_POW_POW] o REWRITE_RULE[alt_sum_eq_poly_f_even; real_div]) cos_bound_th in (* This rule does not simplify factorials *) let reduce_rule = CONV_RULE (DEPTH_CONV (FIRST_CONV [NUM_SUC_CONV; NUM_ADD_CONV; NUM_MULT_CONV])) in - let find_poly_f = rev o find_terms (fun tm -> + let find_poly_f = rev o find_terms (fun tm -> try (rator o rator) tm = `poly_f` with Failure _ -> false) in fun pp n -> let n_tm = mk_small_numeral n in @@ -91,13 +91,13 @@ let rec x_pow_over_fact x k = (* Computes i such that x^(2(i + 1))/(2(i + 1))! <= base^(-(p + 1)) and cond(i) *) -let n_of_p_cos x pp cond = +let n_of_p_cos x pp cond = let t = (float_of_int Arith_num.arith_base) ** (float_of_int (-pp - 1)) in let rec try_i i = let _ = if i > 50 then failwith "n_of_p_cos: cannot find i" else () in if cond i then let r = x_pow_over_fact x (2 * (i + 1)) in - if r <= t then i else try_i (i + 1) + if r <= t then i else try_i (i + 1) else try_i (i + 1) in @@ -142,10 +142,10 @@ let float_cos_high_raw = let an_le_r_th = float_sub_hi pp a_tm n_tm in let r_tm = (rand o concl) an_le_r_th in let cmp_1 = float_le r_tm one_float in - if (fst o dest_const o rand o concl) cmp_1 = "F" then + if (fst o dest_const o rand o concl) cmp_1 = "F" then INST[x_tm, x_var_real] cos_high_trivial - else - let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; m_tm, m_var_real; + else + let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; m_tm, m_var_real; n_tm, n_var_real; r_tm, r_var_real; x_tm, x_var_real] bound_th in itlist MY_PROVE_HYP [p1_high_th; p2_low_th; x_pow2_low; n_le_mb_th; an_le_r_th] th0;; @@ -169,10 +169,10 @@ let float_cos_low_raw = let r_le_an = float_sub_lo pp a_tm n_tm in let r_tm = (rand o rator o concl) r_le_an in let cmp_1 = float_le neg_one_tm r_tm in - if (fst o dest_const o rand o concl) cmp_1 = "F" then + if (fst o dest_const o rand o concl) cmp_1 = "F" then INST[x_tm, x_var_real] cos_low_trivial - else - let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; m_tm, m_var_real; + else + let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; m_tm, m_var_real; n_tm, n_var_real; r_tm, r_var_real; x_tm, x_var_real] bound_th in itlist MY_PROVE_HYP [p1_low_th; p2_high_th; x_pow2_high; mb_le_n; r_le_an] th0;; diff --git a/Formal_ineqs/trig/cos_eval.hl b/Formal_ineqs/trig/cos_eval.hl index 0e93fdf6..fc68868d 100644 --- a/Formal_ineqs/trig/cos_eval.hl +++ b/Formal_ineqs/trig/cos_eval.hl @@ -25,11 +25,11 @@ prioritize_real();; (* Interval approximations of 2 * pi: *) (* (|- interval_arith (&2 * pi) (lo, hi), |- hi - lo <= t, (lo, hi)) *) -let two_pi_array = +let two_pi_array = let n = Array.length pi_approx_array in let pi = pi_approx_array.(n - 1) in let two_pi = float_interval_mul n two_interval pi in - Array.init (n - 1) (fun i -> + Array.init (n - 1) (fun i -> let th = float_interval_round i two_pi in let _, bounds = dest_interval_arith (concl th) in let lo_tm, hi_tm = dest_pair bounds in @@ -40,7 +40,7 @@ let pi32_array = let pi = pi_approx_array.(n - 1) in let three = mk_float_interval_small_num 3 in let pi32 = float_interval_div n (float_interval_mul n three pi) two_interval in - Array.init (n - 1) (fun i -> + Array.init (n - 1) (fun i -> let th = float_interval_round i pi32 in let _, bounds = dest_interval_arith (concl th) in let lo_tm, hi_tm = dest_pair bounds in @@ -63,9 +63,9 @@ let neg_pi_le_pi_lo_array = (* Theorems of the form: |- &2 * pi <= high, |- &0 <= low *) let two_pi_high, two_pi_low = - let interval_pos = prove(`interval_arith x (float_num F n e, f) + let interval_pos = prove(`interval_arith x (float_num F n e, f) ==> x <= f /\ &0 <= (float_num F n e)`, - REWRITE_TAC[interval_arith] THEN + REWRITE_TAC[interval_arith] THEN MP_TAC (SPECL[`n:num`; `e:num`] FLOAT_F_POS) THEN REAL_ARITH_TAC) in let two_pi_list = Array.to_list two_pi_array in @@ -73,8 +73,8 @@ let two_pi_high, two_pi_low = let list1, list2 = unzip (map pair_of_list ths1) in Array.of_list list1, Array.of_list list2;; - -(**********) + +(**********) let f_pi = 3.14159265358979323846 and f_2_pi = 6.28318530717958647693 and @@ -105,10 +105,10 @@ let cos_full_interval = prove(`!x. interval_arith (cos x) (-- &1, &1)`, let cos_case_neg1 = case_rule cos_full_interval;; - + (* 0 *) let cos_reduction_0_pi_1 = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (&0, pi) /\ b1 <= pi /\ @@ -128,7 +128,7 @@ let cos_case0 = case_rule cos_reduction_0_pi_1;; (* 1 *) let cos_reduction_0_pi_2 = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (&0, pi) /\ b1 <= &2 * pi /\ @@ -160,7 +160,7 @@ let cos_case1 = case_rule cos_reduction_0_pi_2;; (* 2 *) let cos_reduction_0_pi_2a = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (&0, pi) /\ a1 + b1 <= &2 * pi /\ @@ -193,7 +193,7 @@ let cos_case2 = case_rule cos_reduction_0_pi_2a;; (* 3 *) let cos_reduction_0_pi_2b = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (&0, pi) /\ b1 <= &2 * pi /\ &2 * pi <= a1 + b1 /\ @@ -217,10 +217,10 @@ let cos_reduction_0_pi_2b = prove(`interval_arith x (a,b) /\ REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; let cos_case3 = case_rule cos_reduction_0_pi_2b;; - + (* 4 *) let cos_reduction_neg_pi_0_1 = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (--pi, &0) /\ (b1 <= &0 <=> T) /\ @@ -241,7 +241,7 @@ let cos_case4 = case_rule cos_reduction_neg_pi_0_1;; (* 5 (not used in computations) *) let cos_reduction_neg_pi_0_2 = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (--pi, &0) /\ b1 <= pi /\ @@ -261,9 +261,9 @@ let cos_reduction_neg_pi_0_2 = prove(`interval_arith x (a,b) /\ let cos_case5 = case_rule cos_reduction_neg_pi_0_2;; -(* 6 *) +(* 6 *) let cos_reduction_neg_pi_0_2a = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (--pi, &0) /\ b2 = --b1 /\ (a1 <= b2 <=> T) /\ @@ -284,7 +284,7 @@ let cos_case6 = case_rule cos_reduction_neg_pi_0_2a;; (* 7 *) let cos_reduction_neg_pi_0_2b = prove(`interval_arith x (a,b) /\ - (?k. integer k /\ a1 <= a + (&2 * pi) * k + (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) /\ interval_arith a1 (--pi, &0) /\ b1 <= pi /\ b2 = --b1 /\ (a1 <= b2 <=> F) /\ @@ -336,7 +336,7 @@ let reduction_high_0_pi = (case_rule o prove) ==> cos x <= high`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--cos t` THEN ASM_REWRITE_TAC[REAL_LE_NEG2] THEN - REWRITE_TAC[GSYM cos_pi_minus] THEN + REWRITE_TAC[GSYM cos_pi_minus] THEN MATCH_MP_TAC COS_MONO_LE THEN ASM_REWRITE_TAC[] THEN REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);; @@ -348,7 +348,7 @@ let reduction_low_0_pi = (case_rule o prove) ==> low <= cos x`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--cos t` THEN ASM_REWRITE_TAC[REAL_LE_NEG2] THEN - REWRITE_TAC[GSYM cos_pi_minus] THEN + REWRITE_TAC[GSYM cos_pi_minus] THEN MATCH_MP_TAC COS_MONO_LE THEN ASM_REWRITE_TAC[] THEN REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);; @@ -428,7 +428,7 @@ let reduction_neg_th = (th_rule o prove) z * hi <= m /\ a1 <= a - m /\ n <= z * lo /\ b - n <= b1 ==> ?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1`, - REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `-- &i` THEN SIMP_TAC[INTEGER_CLOSED] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a - m:real` THEN @@ -450,7 +450,7 @@ let reduction_pos_th = (th_rule o prove) m <= z * lo /\ a1 <= a + m /\ z * hi <= n /\ b + n <= b1 ==> ?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1`, - REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `&i` THEN SIMP_TAC[INTEGER_CLOSED] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a + m:real` THEN @@ -502,13 +502,13 @@ let ab_sum3_correction = (th_rule o prove) b1 + z <= b2 ==> b1 <= b2 /\ &2 * pi <= a1 + b2`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; - + let ab_sum4_correction = (th_rule o prove) (`interval_arith (&2 * pi) (lo, hi) /\ m <= a1 + b1 /\ (hi <= m <=> T) ==> &2 * pi <= a1 + b1`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; - + let a_b_correction = (th_rule o prove) (`a2 <= a1 /\ b1 <= b2 /\ (?k. integer k /\ a1 <= a + (&2 * pi) * k /\ b + (&2 * pi) * k <= b1) @@ -656,7 +656,7 @@ let eval_high_pi_2pi pp x_pi_2pi x_tm = else let cos_t = float_cos_high_raw pp t_tm in let r_tm = rand (concl cos_t) in - let th0 = INST[x_tm, x_var_real; + let th0 = INST[x_tm, x_var_real; lo_tm, lo_var_real; hi_tm, hi_var_real; r_tm, r_var_real; t_tm, t_var_real] reduction_high_pi_2pi_1 in itlist MY_PROVE_HYP [t_ge0; x_pi_2pi; two_pi; lo_sub_x; cos_t] th0;; @@ -697,7 +697,7 @@ let eval_low_pi_2pi pp x_pi_2pi x_tm = else let cos_t = float_cos_low_raw pp t_tm in let r_tm = rand (rator (concl cos_t)) in - let th0 = INST[x_tm, x_var_real; + let th0 = INST[x_tm, x_var_real; lo_tm, lo_var_real; hi_tm, hi_var_real; r_tm, r_var_real; t_tm, t_var_real] reduction_low_pi_2pi_1 in itlist MY_PROVE_HYP [t_le_pi; x_pi_2pi; two_pi; hi_sub_x; cos_t] th0;; @@ -714,7 +714,7 @@ let get_i f_tm = let k0 = -int_of_float (x /. f_2_pi) in let y = x +. float_of_int k0 *. f_2_pi in if y < -.f_pi then k0 + 1 - else if y > f_pi then k0 - 1 + else if y > f_pi then k0 - 1 else k0;; (* i = 0 *) @@ -744,7 +744,7 @@ let reduction_neg pp i a_tm b_tm = a_tm, a_var_real; a1_tm, a1_var_real; b_tm, b_var_real; b1_tm, b1_var_real; m_tm, m_var_real; n_tm, n_var_real] reduction_neg_th in - let th1 = itlist MY_PROVE_HYP [i_eq_th; two_pi_th; lo_ge0_th; + let th1 = itlist MY_PROVE_HYP [i_eq_th; two_pi_th; lo_ge0_th; z_hi_th; z_lo_th; a_sub_m_th; b_sub_n_th] th0 in a1_tm, b1_tm, th1;; @@ -767,7 +767,7 @@ let reduction_pos pp i a_tm b_tm = a_tm, a_var_real; a1_tm, a1_var_real; b_tm, b_var_real; b1_tm, b1_var_real; m_tm, m_var_real; n_tm, n_var_real] reduction_pos_th in - let th1 = itlist MY_PROVE_HYP [i_eq_th; two_pi_th; lo_ge0_th; + let th1 = itlist MY_PROVE_HYP [i_eq_th; two_pi_th; lo_ge0_th; z_hi_th; z_lo_th; a_add_m_th; b_add_n_th] th0 in a1_tm, b1_tm, th1;; @@ -831,7 +831,7 @@ let correct_ab_sum pp a1_tm b1_tm = let z_tm = rand (concl r_add_t) in let b1_add_z = float_add_hi pp b1_tm z_tm in let b2_tm = rand (concl b1_add_z) in - let th0 = INST[lo_tm, lo_var_real; hi_tm, hi_var_real; + let th0 = INST[lo_tm, lo_var_real; hi_tm, hi_var_real; n_tm, n_var_real; m_tm, m_var_real; a1_tm, a1_var_real; b1_tm, b1_var_real; t_tm, t_var_real; r_tm, r_var_real; @@ -872,8 +872,8 @@ let float_interval_cos pp x_th = try (* Reduce the interval of x *) let i = get_i a_tm in - let a1_tm, b1_tm, red_th = - if i = 0 then reduction_zero a_tm b_tm + let a1_tm, b1_tm, red_th = + if i = 0 then reduction_zero a_tm b_tm else if i < 0 then reduction_neg pp i a_tm b_tm else reduction_pos pp i a_tm b_tm in @@ -904,7 +904,7 @@ let float_interval_cos pp x_th = (* a1 in [0, pi] *) let ab_sum_case, b1_le0, b1_tm, ab_sum_th = correct_ab_sum pp a1_tm b1_tm in let red_th = correct_ab red_th a_tm b_tm a1_tm b1_tm a1_le0 b1_le0 in - let inst_tms = [x_tm, x_var_real; a_tm, a_var_real; b_tm, b_var_real; + let inst_tms = [x_tm, x_var_real; a_tm, a_var_real; b_tm, b_var_real; a1_tm, a1_var_real; b1_tm, b1_var_real] in let flag_b_pi, b_le_pi = float_prove_le_interval b1_tm pi_approx_array.(pp) in let two_pi_th, _, _ = two_pi_array.(pp) in @@ -912,7 +912,7 @@ let float_interval_cos pp x_th = if flag_b_pi then (* b1 in [0, pi] *) let b1_ge0 = float_ge0 b1_tm in - let b1_int = + let b1_int = let th0 = INST[b1_tm, b1_var_real] b1_interval_0_pi_1 in MY_PROVE_HYP b1_ge0 (MY_PROVE_HYP b_le_pi th0) in let cos_b1 = eval_low_0_pi pp b1_int b1_tm and @@ -940,7 +940,7 @@ let float_interval_cos pp x_th = INST[x_tm, x_var_real] cos_case_neg1 else (* a1 in [-pi, 0] *) - let inst_tms = [x_tm, x_var_real; a_tm, a_var_real; b_tm, b_var_real; + let inst_tms = [x_tm, x_var_real; a_tm, a_var_real; b_tm, b_var_real; a1_tm, a1_var_real; b1_tm, b1_var_real] in let b1_0 = float_le0 b1_tm in if (fst o dest_const o rand o concl) b1_0 = "T" then @@ -972,7 +972,7 @@ let float_interval_cos pp x_th = if flag_b_pi then (* b1 <= pi ==> b1 in [0, pi] *) let b1_int = - let th0 = INST[b1_tm, b1_var_real; a1_tm, a1_var_real; + let th0 = INST[b1_tm, b1_var_real; a1_tm, a1_var_real; b2_tm, b2_var_real] b1_interval_0_pi_2 in itlist MY_PROVE_HYP [b_le_pi; a1_0_th; neg_b_eq; ab_cmp] th0 in let cos_b1 = eval_low_0_pi pp b1_int b1_tm in @@ -981,7 +981,7 @@ let float_interval_cos pp x_th = itlist MY_PROVE_HYP [red_th; a1_case_th; neg_b_eq; ab_cmp; b_le_pi; x_th; cos_b1] th0 else INST[x_tm, x_var_real] cos_case_neg1 - with Correction_failed -> + with Correction_failed -> let _ = warn true (Printf.sprintf "float_interval_cos: reduction failed (%s, %s)" (string_of_term a_tm) (string_of_term b_tm)) in INST[x_tm, x_var_real] cos_case_neg1;; @@ -1051,18 +1051,18 @@ eval_low_0_pi 3 a_th x_tm;; eval_high_0_pi 4 a_th x_tm;; float_neg (mk_float 1 0);; - - + + ;; - + (**************) let i = get_i a_tm;; -let a1_tm, b1_tm, red_th = - if i = 0 then reduction_zero a_tm b_tm +let a1_tm, b1_tm, red_th = + if i = 0 then reduction_zero a_tm b_tm else if i < 0 then reduction_neg pp i a_tm b_tm else reduction_pos pp i a_tm b_tm;; (* Prove -pi <= a1; otherwise correct the value of a1 *) @@ -1125,7 +1125,7 @@ let flag_b_2pi, b_le_2pi = float_prove_le_interval b1_tm two_pi_th in 7, itlist MY_PROVE_HYP [red_th; a1_case_th; neg_b_eq; ab_cmp; b_le_pi] th0 else -1, cos_case_neg1 - with Correction_failed -> + with Correction_failed -> let _ = warn true (Printf.sprintf "cos_reduction: reduction failed (%s, %s)" (string_of_term a_tm) (string_of_term b_tm)) in -1, cos_case_neg1;; @@ -1152,7 +1152,7 @@ let flag, n_le_th = float_prove_le n_tm lo_tm;; let z_tm = rand (concl r_add_t) in let b1_add_z = float_add_hi pp b1_tm z_tm in let b2_tm = rand (concl b1_add_z) in - let th0 = INST[lo_tm, lo_var_real; hi_tm, hi_var_real; + let th0 = INST[lo_tm, lo_var_real; hi_tm, hi_var_real; n_tm, n_var_real; m_tm, m_var_real; a1_tm, a1_var_real; b1_tm, b1_var_real; t_tm, t_var_real; r_tm, r_var_real; @@ -1166,8 +1166,8 @@ let flag, n_le_th = float_prove_le n_tm lo_tm;; let reduce_cos pp a_tm b_tm = try let i = get_i a_tm in - let a1_tm, b1_tm, red_th = - if i = 0 then reduction_zero a_tm b_tm + let a1_tm, b1_tm, red_th = + if i = 0 then reduction_zero a_tm b_tm else if i < 0 then reduction_neg pp i a_tm b_tm else reduction_pos pp i a_tm b_tm in (* Prove -pi <= a1; otherwise correct the value of a1 *) @@ -1229,7 +1229,7 @@ let reduce_cos pp a_tm b_tm = 7, itlist MY_PROVE_HYP [red_th; a1_case_th; neg_b_eq; ab_cmp; b_le_pi] th0 else -1, cos_case_neg1 - with Correction_failed -> + with Correction_failed -> let _ = warn true (Printf.sprintf "cos_reduction: reduction failed (%s, %s)" (string_of_term a_tm) (string_of_term b_tm)) in -1, cos_case_neg1;; diff --git a/Formal_ineqs/trig/exp_eval.hl b/Formal_ineqs/trig/exp_eval.hl index 401a45d1..44830a0c 100644 --- a/Formal_ineqs/trig/exp_eval.hl +++ b/Formal_ineqs/trig/exp_eval.hl @@ -55,7 +55,7 @@ let exp_interval = (th_rule o prove) ]);; let bound_pos_low_trans = prove - (`a <= e ==> + (`a <= e ==> interval_arith r (&0, a) ==> r <= e`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; @@ -66,7 +66,7 @@ let bound_neg_low_trans = prove(`p1 - x * p2 <= e ==> &0 <= x /\ x * b <= n /\ r <= a - n - ==> r <= e`, + ==> r <= e`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a - n:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `p1 - x * p2:real` THEN ASM_REWRITE_TAC[] THEN @@ -80,7 +80,7 @@ let bound_neg_high_trans = prove(`e <= p1 - x * p2 ==> &0 <= x /\ n <= x * b /\ a - n <= r - ==> e <= r`, + ==> e <= r`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a - n:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `p1 - x * p2:real` THEN ASM_REWRITE_TAC[] THEN @@ -91,17 +91,17 @@ let bound_neg_high_trans = prove(`e <= p1 - x * p2 ==> (* Argument reduction *) let exp_neg_low = (th_rule o prove) - (`r <= exp (-- float_num F n e) + (`r <= exp (-- float_num F n e) ==> r <= exp (float_num T n e)`, REWRITE_TAC[FLOAT_NEG]);; let exp_neg_high = (th_rule o prove) - (`exp (-- float_num F n e) <= r + (`exp (-- float_num F n e) <= r ==> exp (float_num T n e) <= r`, REWRITE_TAC[FLOAT_NEG]);; let exp_pos_high = (th_rule o prove) - (`&0 < t /\ t <= exp (--x) /\ inv t <= r + (`&0 < t /\ t <= exp (--x) /\ inv t <= r ==> exp x <= r`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv t` THEN ASM_REWRITE_TAC[] THEN @@ -147,13 +147,13 @@ let exp_reduce_high = (th_rule o prove) (* ----------------- *) let mk_exp_bound_tables exp_bound_th = - let exp_bound = (SPEC_ALL o + let exp_bound = (SPEC_ALL o REWRITE_RULE[poly_f_even; poly_f_odd; GSYM REAL_POW_2; REAL_POW_POW] o REWRITE_RULE[sum_eq_poly_f] o REWRITE_RULE[alt_sum_eq_poly_f; real_div]) exp_bound_th in - let reduce_rule = CONV_RULE (DEPTH_CONV + let reduce_rule = CONV_RULE (DEPTH_CONV (FIRST_CONV [NUM_SUC_CONV; NUM_ADD_CONV; NUM_MULT_CONV])) in - let find_poly_f = rev o find_terms (fun tm -> try (rator o rator) tm = `poly_f` + let find_poly_f = rev o find_terms (fun tm -> try (rator o rator) tm = `poly_f` with Failure _ -> false) in fun pp n -> let n_tm = mk_small_numeral n in @@ -175,13 +175,13 @@ let rec x_pow_over_fact x k = x /. (float_of_int k) *. x_pow_over_fact x (k - 1);; (* Computes i such that x^i / i! <= base^(-(p + 1)) and cond(i) *) -let n_of_p_exp x pp cond = +let n_of_p_exp x pp cond = let t = (float_of_int Arith_num.arith_base) ** (float_of_int (-pp - 1)) in let rec try_i i = let _ = if i > 50 then failwith "n_of_p_exp: cannot find i" else () in if cond i then let r = x_pow_over_fact x i in - if r <= t then i else try_i (i + 1) + if r <= t then i else try_i (i + 1) else try_i (i + 1) in @@ -252,7 +252,7 @@ let float_exp_neg_low_raw = let r_tm = (rand o rator o concl) r_le_an in let cmp_1 = EQT_ELIM (float_le x_tm one_float) in let cmp_0 = EQT_ELIM (float_ge0 x_tm) in - let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; + let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; r_tm, r_var_real; x_tm, x_var_real] bound_th in itlist MY_PROVE_HYP [p1_low_th; p2_high_th; xb_le_n; r_le_an; cmp_0; cmp_1] th0;; @@ -275,7 +275,7 @@ let float_exp_neg_high_raw = let r_tm = (rand o concl) an_le_r in let cmp_1 = EQT_ELIM (float_le x_tm one_float) in let cmp_0 = EQT_ELIM (float_ge0 x_tm) in - let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; + let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; r_tm, r_var_real; x_tm, x_var_real] bound_th in itlist MY_PROVE_HYP [p1_high_th; p2_low_th; n_le_xb; an_le_r; cmp_1; cmp_0] th0;; @@ -365,8 +365,8 @@ let float_exp_hi pp x_tm = let hi_tm = rand (concl exp_y) in let hi_pow = float_pow_hi pp k hi_tm in let high_tm = rand (concl hi_pow) in - let th0 = INST[t_tm, t_var_real; k_tm, k_var_num; - y_tm, y_var_real; hi_tm, hi_var_real; + let th0 = INST[t_tm, t_var_real; k_tm, k_var_num; + y_tm, y_var_real; hi_tm, hi_var_real; high_tm, high_var_real; x_tm, x_var_real] exp_reduce_high in itlist MY_PROVE_HYP [t_gt0; k_eq; div_th; exp_y; hi_pow] th0;; @@ -387,8 +387,8 @@ let float_exp_lo pp x_tm = let lo_pow = float_pow_lo pp k lo_tm in let low_tm = rand (rator (concl lo_pow)) in let lo_ge0 = EQT_ELIM (float_ge0 lo_tm) in - let th0 = INST[t_tm, t_var_real; k_tm, k_var_num; - y_tm, y_var_real; lo_tm, lo_var_real; + let th0 = INST[t_tm, t_var_real; k_tm, k_var_num; + y_tm, y_var_real; lo_tm, lo_var_real; low_tm, low_var_real; x_tm, x_var_real] exp_reduce_low in itlist MY_PROVE_HYP [t_gt0; k_eq; div_th; exp_y; lo_pow; lo_ge0] th0;; diff --git a/Formal_ineqs/trig/exp_log.hl b/Formal_ineqs/trig/exp_log.hl index 8e268a39..c4b1f3ec 100644 --- a/Formal_ineqs/trig/exp_log.hl +++ b/Formal_ineqs/trig/exp_log.hl @@ -11,7 +11,7 @@ prioritize_real();; (* --------------------- *) let exp_pos_poly_lower_bound = prove - (`!x n. &0 <= x ==> + (`!x n. &0 <= x ==> sum (0..n) (\k. inv (&(FACT k)) * x pow k) <= exp x`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM exp_infsum] THEN @@ -27,7 +27,7 @@ let exp_pos_poly_lower_bound = prove EXISTS_TAC `0` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN - REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_POW_LE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_POW_LE] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS]);; let exp_ge1 = prove @@ -63,9 +63,9 @@ let n_le_fact = prove let exp_alt_sign_lemma = prove (`!x. &0 <= x /\ x <= &1 - ==> (!k. abs ((-- &1) pow (k + 1) / &(FACT (k + 1)) * x pow (k + 1)) + ==> (!k. abs ((-- &1) pow (k + 1) / &(FACT (k + 1)) * x pow (k + 1)) <= abs ((-- &1) pow k / &(FACT k) * x pow k) /\ - ((-- &1) pow (k + 1) / &(FACT (k + 1)) * x pow (k + 1)) * + ((-- &1) pow (k + 1) / &(FACT (k + 1)) * x pow (k + 1)) * ((-- &1) pow k / &(FACT k) * x pow k) <= &0) /\ ((\k. (-- &1) pow k / &(FACT k) * x pow k) ---> &0) sequentially`, REPEAT STRIP_TAC THENL [ @@ -79,9 +79,9 @@ let exp_alt_sign_lemma = prove MATCH_MP_TAC FACT_MONO THEN ARITH_TAC; ALL_TAC ] THEN - REWRITE_TAC[REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_ARITH_TAC; - REWRITE_TAC[REAL_ARITH `(a / b * r) * (c / d * t) <= &0 + REWRITE_TAC[REAL_ARITH `(a / b * r) * (c / d * t) <= &0 <=> &0 <= ((-- &1 pow 1 * a * c) * (r * t)) / b / d`] THEN MATCH_MP_TAC REAL_LE_DIV THEN SIMP_TAC[REAL_OF_NUM_LE; FACT_LT; LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_DIV THEN SIMP_TAC[REAL_OF_NUM_LE; FACT_LT; LT_IMP_LE] THEN @@ -151,7 +151,7 @@ let exp_neg_poly_lower_bound = prove ] THEN EXPAND_TAC "f" THEN ASM_REWRITE_TAC[neg_exp_infsum] THEN REWRITE_TAC[ARITH_RULE `SUC a - 1 = a`; SUM_CLAUSES_NUMSEG; LE_0] THEN - SUBGOAL_THEN `abs (-- &1 pow (SUC (2 * m)) / &(FACT (SUC (2 * m))) * x pow SUC (2 * m)) = + SUBGOAL_THEN `abs (-- &1 pow (SUC (2 * m)) / &(FACT (SUC (2 * m))) * x pow SUC (2 * m)) = --f (SUC (2 * m))` ASSUME_TAC THENL [ EXPAND_TAC "f" THEN REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG; REAL_ABS_NUM] THEN @@ -161,7 +161,7 @@ let exp_neg_poly_lower_bound = prove ALL_TAC ] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; - + let exp_reduce = prove (`!x k. 0 < k ==> exp (x / &k) pow k = exp x`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_EXP_N; REAL_ARITH `a * b / a = b * (a / a)`] THEN @@ -197,7 +197,7 @@ let log_alt_sign_lemma = prove ] THEN REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_ARITH_TAC; - REWRITE_TAC[REAL_ARITH `(a / b * r) * (c / d * t) <= &0 + REWRITE_TAC[REAL_ARITH `(a / b * r) * (c / d * t) <= &0 <=> &0 <= ((-- &1 pow 1 * a * c) * (r * t)) / b / d`] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `0 <= t + 1`] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `0 <= t + 1`] THEN @@ -226,7 +226,7 @@ let log_poly_upper_bound = prove log (&1 + x) <= x * sum (0..n) (\k. (-- &1) pow k / &(k + 1) * x pow k)`, REWRITE_TAC[EVEN_EXISTS] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `f = \k. (-- &1) pow k / &(k + 1) * x pow (k + 1)` THEN - SUBGOAL_THEN `x * sum (0..n) (\k. -- &1 pow k / &(k + 1) * x pow k) + SUBGOAL_THEN `x * sum (0..n) (\k. -- &1 pow k / &(k + 1) * x pow k) = sum (0..n) f` ASSUME_TAC THENL [ REWRITE_TAC[GSYM SUM_LMUL; REAL_ARITH `a * b / c * d = b / c * (a * d)`] THEN REWRITE_TAC[GSYM real_pow; ARITH_RULE `SUC k = k + 1`] THEN @@ -265,7 +265,7 @@ let log_poly_lower_bound = prove x * sum (0..n) (\k. (-- &1) pow k / &(k + 1) * x pow k) <= log (&1 + x)`, REWRITE_TAC[ODD_EXISTS] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `f = \k. (-- &1) pow k / &(k + 1) * x pow (k + 1)` THEN - SUBGOAL_THEN `x * sum (0..n) (\k. -- &1 pow k / &(k + 1) * x pow k) + SUBGOAL_THEN `x * sum (0..n) (\k. -- &1 pow k / &(k + 1) * x pow k) = sum (0..n) f` ASSUME_TAC THENL [ REWRITE_TAC[GSYM SUM_LMUL; REAL_ARITH `a * b / c * d = b / c * (a * d)`] THEN REWRITE_TAC[GSYM real_pow; ARITH_RULE `SUC k = k + 1`] THEN diff --git a/Formal_ineqs/trig/log_eval.hl b/Formal_ineqs/trig/log_eval.hl index 6d18a515..89ad32a3 100644 --- a/Formal_ineqs/trig/log_eval.hl +++ b/Formal_ineqs/trig/log_eval.hl @@ -64,7 +64,7 @@ let log_reduce = prove ASM_SIMP_TAC[LOG_DIV; REAL_EXP_POS_LT; LOG_EXP] THEN REAL_ARITH_TAC);; let log_reduce_exp_high = prove - (`t <= exp k /\ x / t <= r /\ r - &1 <= a /\ + (`t <= exp k /\ x / t <= r /\ r - &1 <= a /\ &0 < x /\ &0 < t /\ log (&1 + a) <= hi /\ hi + k <= high ==> log x <= high`, @@ -94,7 +94,7 @@ let log_reduce_exp_high = prove MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[]);; let log_reduce_exp_low = prove - (`exp k <= t /\ r <= x / t /\ a <= r - &1 /\ + (`exp k <= t /\ r <= x / t /\ a <= r - &1 /\ &0 < x /\ -- &1 < a /\ lo <= log (&1 + a) /\ low <= lo + k ==> low <= log x`, @@ -117,7 +117,7 @@ let log_reduce_exp_low = prove MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_EXP_POS_LT]);; let log_reduce_simple_high = (th_rule o REWRITE_RULE[GSYM float1_eq] o prove) - (`t <= exp b /\ x / t <= r /\ r - &1 <= a /\ + (`t <= exp b /\ x / t <= r /\ r - &1 <= a /\ &0 < x /\ &0 < t /\ a + b <= high ==> log x <= high`, @@ -132,7 +132,7 @@ let log_reduce_simple_high = (th_rule o REWRITE_RULE[GSYM float1_eq] o prove) ASM_ARITH_TAC);; let log_reduce_simple_low = (th_rule o prove) - (`inv x <= t /\ log t <= r /\ + (`inv x <= t /\ log t <= r /\ low = --r /\ &0 < x ==> low <= log x`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= b <=> --b <= --a`] THEN diff --git a/Formal_ineqs/trig/matan.hl b/Formal_ineqs/trig/matan.hl index 2a67acbb..5cc37bae 100644 --- a/Formal_ineqs/trig/matan.hl +++ b/Formal_ineqs/trig/matan.hl @@ -8,9 +8,9 @@ prioritize_real();; (* matan *) -let matan = new_definition `matan x = +let matan = new_definition `matan x = if (x = &0) then &1 - else if (x > &0) then atn (sqrt x) / (sqrt x) + else if (x > &0) then atn (sqrt x) / (sqrt x) else (log ((&1 + sqrt( -- x))/(&1 - sqrt( -- x)))) / (&2 * sqrt (-- x))`;; (* Auxiliary definitions for matan derivatives *) @@ -126,7 +126,7 @@ let matan_power_series = prove(`!x. abs x < &1 ] THEN REWRITE_TAC[GSYM REAL_POW_POW; REAL_SQRT_POW_2] THEN ASM_SIMP_TAC[REAL_ARITH `~(x > &0) ==> abs (--x) = --x`] THEN - ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN + ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN REWRITE_TAC[REAL_POW_MUL; REAL_POW_ONE; REAL_MUL_RID; real_div; REAL_MUL_AC]);; @@ -181,7 +181,7 @@ let matan_has_derivative_gt0 = prove(`!x. &0 < x ==> ASM_REWRITE_TAC[matan]; ALL_TAC ] THEN - REAL_DIFF_TAC THEN + REAL_DIFF_TAC THEN SUBGOAL_THEN `~(sqrt x = &0)` ASSUME_TAC THENL [ ASM_SIMP_TAC[SQRT_EQ_0; REAL_ARITH `&0 < x ==> ~(x = &0)`]; ALL_TAC @@ -200,7 +200,7 @@ let matan_real_derivative_gt0 = prove(`!x. &0 < x ==> let matan_real_derivative_abs1 = prove(`!x. abs x < &1 ==> matan real_differentiable atreal x - /\ ((\i. ((-- &1) pow (SUC i) * &(SUC i) / &(2 * i + 3)) * x pow i) + /\ ((\i. ((-- &1) pow (SUC i) * &(SUC i) / &(2 * i + 3)) * x pow i) real_sums (real_derivative matan x)) (from 0)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC (MATCH_MP power_series_has_derivative2 matan_power_series) THEN @@ -220,7 +220,7 @@ let matan_real_derivative_abs1 = prove(`!x. abs x < &1 ==> let matan_real_derivative_abs1_bound = prove(`!x m. abs x < &1 ==> - abs (real_derivative matan x + abs (real_derivative matan x - sum (0..m) (\i. ((-- &1) pow (SUC i) * &(SUC i) / &(2 * i + 3)) * x pow i)) <= abs x pow (SUC m) / (&2 * (&1 - abs x))`, REPEAT STRIP_TAC THEN @@ -246,13 +246,13 @@ let matan_real_derivative_abs1_bound = prove(`!x m. abs x < &1 ==> REWRITE_TAC[REAL_FIELD `inv (&2) * (&2 * a + b) = a + inv(&2) * b`] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD; REAL_LE_LADD] THEN REAL_ARITH_TAC);; - + (* matan second derivative *) let matan_has_derivative2_gt0 = prove(`!x. &0 < x ==> - ((\x. inv (&2 * x * (x + &1)) - atn(sqrt(x)) / (&2 * x * sqrt(x))) has_real_derivative - (&3 / &4) * (atn(sqrt(x)) / (x pow 2 * sqrt(x))) + ((\x. inv (&2 * x * (x + &1)) - atn(sqrt(x)) / (&2 * x * sqrt(x))) has_real_derivative + (&3 / &4) * (atn(sqrt(x)) / (x pow 2 * sqrt(x))) - (&3 / &4) * inv(x pow 2 * (x + &1)) - (&1 / &2) * inv(x * (x + &1) pow 2)) (atreal x)`, REPEAT STRIP_TAC THEN @@ -277,7 +277,7 @@ let matan_has_derivative2_gt0 = prove(`!x. &0 < x ==> let matan_second_derivative_gt0 = prove(`!x. &0 < x ==> real_derivative (real_derivative matan) x = - (&3 / &4) * (atn(sqrt(x)) / (x pow 2 * sqrt(x))) + (&3 / &4) * (atn(sqrt(x)) / (x pow 2 * sqrt(x))) - (&3 / &4) * inv(x pow 2 * (x + &1)) - (&1 / &2) * inv(x * (x + &1) pow 2)`, REPEAT STRIP_TAC THEN @@ -382,14 +382,14 @@ let matan_second_derivative_abs1_alt = prove(`!x. abs x < &1 ==> REMOVE_THEN "a" (MP_TAC o MATCH_MP REAL_INFSUM_UNIQUE) THEN REMOVE_THEN "b" (MP_TAC o MATCH_MP REAL_INFSUM_UNIQUE) THEN ASM_SIMP_TAC[] THEN REAL_ARITH_TAC);; - - + + (* matan second derivative bound *) let matan_d2_bound_ge1_high = prove(`!x. &1 <= x ==> real_derivative (real_derivative matan) x <= #0.65`, - REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&1 <= x ==> &0 < x`; matan_second_derivative_gt0] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&3 / &4) * atn(sqrt x) / (x pow 2 * sqrt x)` THEN @@ -417,7 +417,7 @@ let matan_d2_bound_ge1_high = prove(`!x. &1 <= x ==> EXPAND_TAC "y" THEN MATCH_MP_TAC REAL_LE_RSQRT THEN ASM_REWRITE_TAC[REAL_POW_ONE]; ALL_TAC ] THEN - MATCH_MP_TAC REAL_LE_TRANS THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `atn (&1) / (&1 pow 5)` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN ABBREV_TAC `f = \y. --(atn y / y pow 5)` THEN @@ -435,7 +435,7 @@ let matan_d2_bound_ge1_high = prove(`!x. &1 <= x ==> EXPAND_TAC "f" THEN REAL_DIFF_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&1 <= x' ==> ~(x' = &0)`; REAL_POW_NZ] THEN REWRITE_TAC[ARITH_RULE `5 - 1 = 4 /\ 5 * 2 = 10`; REAL_POW_POW] THEN - SUBGOAL_THEN `!n. ~(x' pow n = &0)` ASSUME_TAC THENL [ + SUBGOAL_THEN `!n. ~(x' pow n = &0)` ASSUME_TAC THENL [ GEN_TAC THEN MATCH_MP_TAC REAL_POW_NZ THEN UNDISCH_TAC `&1 <= x'` THEN REAL_ARITH_TAC; ALL_TAC @@ -485,7 +485,7 @@ let matan_d2_bound_ge1_high = prove(`!x. &1 <= x ==> let matan_d2_bound_ge1_low = prove(`!x. &1 <= x ==> -- #0.65 <= real_derivative (real_derivative matan) x`, - REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&1 <= x ==> &0 < x`; matan_second_derivative_gt0] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `-- (&3 / &4) * inv (x pow 2 * (x + &1)) - (&1 / &2) * inv (x * (x + &1) pow 2)` THEN @@ -493,7 +493,7 @@ let matan_d2_bound_ge1_low = prove(`!x. &1 <= x ==> REWRITE_TAC[REAL_ARITH `-- #0.65 <= --(&3 / &4) * a - (&1 / &2) * b <=> &3 * a + &2 * b <= #2.6`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&3 * inv(&2) + &2 * inv(&2)` THEN CONJ_TAC THENL [ ALL_TAC; REAL_ARITH_TAC ] THEN - MATCH_MP_TAC REAL_LE_ADD2 THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN ONCE_REWRITE_TAC[REAL_ARITH `&2 = &1 * &2`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_POS] THENL [ ASM_SIMP_TAC[REAL_POW_LE_1] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC @@ -504,7 +504,7 @@ let matan_d2_bound_ge1_low = prove(`!x. &1 <= x ==> ] THEN REWRITE_TAC[REAL_ARITH `--(&3 / &4) * a - b <= c - (&3 / &4) * a - b <=> &0 <= c`] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ REAL_ARITH_TAC; ALL_TAC ] THEN - MATCH_MP_TAC REAL_LE_DIV THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[ATN_POS_LE; SQRT_POS_LE; REAL_ARITH `&1 <= x ==> &0 <= x`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_POW_2; SQRT_POS_LE; REAL_ARITH `&1 <= x ==> &0 <= x`]);; @@ -520,12 +520,12 @@ let matan_d2_bound_01 = prove(`!x. &0 <= x /\ x < &1 ==> STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &4 + &3 / &20` THEN CONJ_TAC THEN TRY REAL_ARITH_TAC THEN - ABBREV_TAC `f = (&1 - x) / (&4 * (&1 + x) pow 2)` THEN + ABBREV_TAC `f = (&1 - x) / (&4 * (&1 + x) pow 2)` THEN ABBREV_TAC `r = real_infsum (:num) (\i. -- &1 pow i / &(2 * i + 5) * x pow i)` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs f + abs (&3 / &4 * r)` THEN REWRITE_TAC[REAL_ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [ - EXPAND_TAC "f" THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NUM] THEN + EXPAND_TAC "f" THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NUM] THEN SUBGOAL_THEN `&0 < &4 /\ &0 < &4 * abs ((&1 + x) pow 2)` ASSUME_TAC THENL [ CONJ_TAC THEN TRY REAL_ARITH_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN TRY REAL_ARITH_TAC THEN @@ -608,7 +608,7 @@ let matan_d2_bound_01 = prove(`!x. &0 <= x /\ x < &1 ==> ALL_TAC ] THEN REWRITE_TAC[REALLIM_1_OVER_N]);; - + let matan_d2_bound_neg_low = prove(`!x. -- &1 < x /\ x < &0 ==> &0 <= real_derivative (real_derivative matan) x`, @@ -688,9 +688,9 @@ let matan_d2_bound_neg_high = prove(`!x. -- #0.2 <= x /\ x < &0 ==> ] THEN REWRITE_TAC[ARITH_RULE `2 * 1 + 5 = 7`] THEN REAL_ARITH_TAC);; - + (* The main bound result *) - + let matan_d2_bound = prove(`!x. -- #0.2 <= x ==> abs (real_derivative (real_derivative matan) x) <= #0.65`, REPEAT STRIP_TAC THEN diff --git a/Formal_ineqs/trig/matan_eval.hl b/Formal_ineqs/trig/matan_eval.hl index cd8d0483..cc299951 100644 --- a/Formal_ineqs/trig/matan_eval.hl +++ b/Formal_ineqs/trig/matan_eval.hl @@ -67,12 +67,12 @@ let matan_gt0 = (th_rule o prove)( ASM_REWRITE_TAC[]);; -let matan_abs1 = - let aux_th = (REWRITE_CONV[FLOAT_OF_NUM; min_exp_def] THENC - DEPTH_CONV Arith_nat.NUMERAL_TO_NUM_CONV THENC +let matan_abs1 = + let aux_th = (REWRITE_CONV[FLOAT_OF_NUM; min_exp_def] THENC + DEPTH_CONV Arith_nat.NUMERAL_TO_NUM_CONV THENC REWRITE_CONV[Arith_num.NUM_THM]) `r1 <= &1 - u` in (th_rule o PURE_REWRITE_RULE[SYM (FLOAT_TO_NUM_CONV seven_float); aux_th] o prove)( - `!x. + `!x. interval_arith x (lo, hi) /\ interval_arith ((&1 - x / &3) + (x * x) / &5) (a, b) /\ iabs (lo, hi) = u /\ @@ -83,7 +83,7 @@ let matan_abs1 = r2 <= &7 * r1 /\ (&0 < r2 <=> T) /\ u3 / r2 <= e /\ low <= a - e /\ - b + e <= high + b + e <= high ==> interval_arith (matan x) (low, high)`, REWRITE_TAC[interval_arith; GSYM IMP_IMP; iabs] THEN GEN_TAC THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs x <= u` (LABEL_TAC "u") THENL [ @@ -143,14 +143,14 @@ let dmatan_gt0 = (th_rule o prove)( ASM_SIMP_TAC[matan_real_derivative_gt0; REAL_MUL_ASSOC]);; -let dmatan_abs1 = - let aux_conv = (REWRITE_CONV[FLOAT_OF_NUM; min_exp_def] THENC - DEPTH_CONV Arith_nat.NUMERAL_TO_NUM_CONV THENC +let dmatan_abs1 = + let aux_conv = (REWRITE_CONV[FLOAT_OF_NUM; min_exp_def] THENC + DEPTH_CONV Arith_nat.NUMERAL_TO_NUM_CONV THENC REWRITE_CONV[Arith_num.NUM_THM]) in let aux1 = aux_conv `r1 <= &1 - u` and aux2 = aux_conv `r2 <= &2 * r1` in (th_rule o PURE_REWRITE_RULE[aux1; aux2] o prove)( - `!x. + `!x. interval_arith x (lo, hi) /\ interval_arith (&2 * (x / &5) - &1 / &3) (a, b) /\ iabs (lo, hi) = u /\ @@ -160,7 +160,7 @@ let dmatan_abs1 = r2 <= &2 * r1 /\ (&0 < r2 <=> T) /\ u2 / r2 <= e /\ low <= a - e /\ - b + e <= high + b + e <= high ==> interval_arith (dmatan x) (low, high)`, REWRITE_TAC[interval_arith; GSYM IMP_IMP; iabs; dmatan] THEN GEN_TAC THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs x <= u` (LABEL_TAC "u") THENL [ @@ -204,7 +204,7 @@ let dmatan_abs1 = (* ddmatan *) let ddmatan_ge_neg02 = (th_rule o prove)( - `!x. interval_arith x (lo, hi) /\ + `!x. interval_arith x (lo, hi) /\ -- #0.2 <= lo /\ interval_arith (#0.65) (a, b) /\ b2 = --b @@ -244,7 +244,7 @@ let float_interval_matan = if not flag then failwith "float_interval_matan: the argument is out of range" else - let s_th = + let s_th = let ( * ) = float_interval_mul pp and ( / ) = float_interval_div pp and ( + ) = float_interval_add pp and @@ -286,7 +286,7 @@ let float_interval_matan = itlist MY_PROVE_HYP [x_th; lo_gt0; th1] th0;; -(* dmatan *) +(* dmatan *) let float_interval_dmatan = let e_var_real = `e:real` and @@ -307,7 +307,7 @@ let float_interval_dmatan = if not flag then failwith "float_interval_dmatan: the argument is out of range" else - let s_th = + let s_th = let ( * ) = float_interval_mul pp and ( / ) = float_interval_div pp and ( - ) = float_interval_sub pp in @@ -338,7 +338,7 @@ let float_interval_dmatan = (* inv ((2 * x) * (x + 1)) - atn (sqrt x) / ((2 * x) * (sqrt x)) *) let lo_gt0 = float_gt0 lo_tm in let r = float_interval_sqrt pp x_th in - let th1 = + let th1 = let ( * ) = float_interval_mul pp and ( / ) = float_interval_div pp and ( + ) = float_interval_add pp and diff --git a/Formal_ineqs/trig/poly.hl b/Formal_ineqs/trig/poly.hl index 4c3a7df2..c6d94611 100644 --- a/Formal_ineqs/trig/poly.hl +++ b/Formal_ineqs/trig/poly.hl @@ -22,16 +22,16 @@ let poly_f_even = new_definition `poly_f_even cs x = poly_f cs (x * x)`;; let poly_f_odd = new_definition `poly_f_odd cs x = x * poly_f_even cs x`;; -let poly_f_empty = prove(`!x. poly_f [] x = &0`, +let poly_f_empty = prove(`!x. poly_f [] x = &0`, REWRITE_TAC[poly_f; ITLIST]);; -let poly_f_cons = prove(`!x h t. poly_f (CONS h t) x = h + x * poly_f t x`, +let poly_f_cons = prove(`!x h t. poly_f (CONS h t) x = h + x * poly_f t x`, REWRITE_TAC[poly_f; ITLIST]);; let poly_f_even_empty = prove(`!x. poly_f_even [] x = &0`, REWRITE_TAC[poly_f_even; poly_f_empty]);; -let poly_f_even_cons = prove(`!x h t. poly_f_even (CONS h t) x = h + (x * x) * poly_f_even t x`, +let poly_f_even_cons = prove(`!x h t. poly_f_even (CONS h t) x = h + (x * x) * poly_f_even t x`, REWRITE_TAC[poly_f_even; poly_f_cons]);; let poly_f_odd_empty = prove(`!x. poly_f_odd [] x = &0`, @@ -46,18 +46,18 @@ let poly_f_append = prove(`!x b a. poly_f (APPEND a b) x = poly_f a x + x pow (L REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_ADD_LID]; ALL_TAC ] THEN - + REWRITE_TAC[APPEND; poly_f; ITLIST] THEN ASM_REWRITE_TAC[GSYM poly_f] THEN REWRITE_TAC[LENGTH; real_pow] THEN REAL_ARITH_TAC);; -let poly_f_even_append = prove(`!x b a. poly_f_even (APPEND a b) x +let poly_f_even_append = prove(`!x b a. poly_f_even (APPEND a b) x = poly_f_even a x + x pow (2 * LENGTH a) * poly_f_even b x`, - REWRITE_TAC[poly_f_even; poly_f_append] THEN + REWRITE_TAC[poly_f_even; poly_f_append] THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_POW_POW]);; -let poly_f_odd_append = prove(`!x b a. poly_f_odd (APPEND a b) x +let poly_f_odd_append = prove(`!x b a. poly_f_odd (APPEND a b) x = poly_f_odd a x + x pow (2 * LENGTH a) * poly_f_odd b x`, REPEAT GEN_TAC THEN REWRITE_TAC[poly_f_odd] THEN @@ -78,14 +78,14 @@ let poly_f_odd_sing = prove(`!c x. poly_f_odd [c] x = c * x`, (* bounds *) -let poly_f_empty_high_pos = prove(`!x. interval_arith (poly_f [] x) (real_zero, &0)`, +let poly_f_empty_high_pos = prove(`!x. interval_arith (poly_f [] x) (real_zero, &0)`, REWRITE_TAC[real_zero; interval_arith; poly_f_empty; REAL_LE_REFL]);; let poly_f_sing_high_pos = prove(`!c x bounds. interval_arith c bounds ==> interval_arith (poly_f [c] x) bounds`, SIMP_TAC[poly_f_sing]);; -let poly_f_cons_high_pos_pos = prove(`!x h t a b c m r. +let poly_f_cons_high_pos_pos = prove(`!x h t a b c m r. interval_arith (poly_f t x) (real_zero, a) /\ interval_arith h (real_zero, b) /\ interval_arith x (real_zero, c) /\ @@ -102,14 +102,14 @@ let poly_f_cons_high_pos_pos = prove(`!x h t a b c m r. MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * a:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]);; -let poly_f_empty_low_pos = prove(`!x. interval_arith (&0) (real_zero, poly_f [] x)`, +let poly_f_empty_low_pos = prove(`!x. interval_arith (&0) (real_zero, poly_f [] x)`, REWRITE_TAC[real_zero; interval_arith; poly_f_empty; REAL_LE_REFL]);; let poly_f_sing_low_pos = prove(`!c b x. interval_arith b (real_zero, c) ==> interval_arith b (real_zero, poly_f [c] x)`, SIMP_TAC[poly_f_sing]);; -let poly_f_cons_low_pos_pos = prove(`!x h t a b c m r. +let poly_f_cons_low_pos_pos = prove(`!x h t a b c m r. interval_arith a (real_zero, poly_f t x) /\ interval_arith b (real_zero, h) /\ interval_arith c (real_zero, x) /\ @@ -117,7 +117,7 @@ let poly_f_cons_low_pos_pos = prove(`!x h t a b c m r. r <= b + m /\ real_zero <= r ==> interval_arith r (real_zero, poly_f (CONS h t) x)`, - REWRITE_TAC[poly_f_cons; interval_arith; real_zero] THEN + REWRITE_TAC[poly_f_cons; interval_arith; real_zero] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b + m:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN @@ -135,11 +135,11 @@ let sum_eq_poly_f = prove(`!a x n. sum (0..n) (\i. a i * x pow i) = poly_f (TABL ONCE_REWRITE_TAC[TABLE_SUC] THEN ASM_REWRITE_TAC[poly_f_append; LENGTH_TABLE; poly_f_sing; REAL_MUL_AC]);; -let sum_eq_poly_f_even = prove(`!a x n. sum (0..n) (\i. a i * x pow (2 * i)) +let sum_eq_poly_f_even = prove(`!a x n. sum (0..n) (\i. a i * x pow (2 * i)) = poly_f_even (TABLE a (SUC n)) x`, REWRITE_TAC[GSYM REAL_POW_POW; sum_eq_poly_f; poly_f_even; REAL_POW_2]);; -let sum_eq_poly_f_odd = prove(`!a x n. sum (0..n) (\i. a i * x pow (2 * i + 1)) +let sum_eq_poly_f_odd = prove(`!a x n. sum (0..n) (\i. a i * x pow (2 * i + 1)) = poly_f_odd (TABLE a (SUC n)) x`, REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; SUM_RMUL; REAL_POW_1] THEN REWRITE_TAC[GSYM REAL_POW_POW; sum_eq_poly_f; poly_f_odd; poly_f_even] THEN @@ -150,7 +150,7 @@ let two_induct = prove(`!P. P 0 /\ P 1 /\ (!k. P k /\ P (k + 1) ==> P (k + 2)) = SUBGOAL_THEN `!k. P k /\ P (k + 1)` (fun th -> REWRITE_TAC[th]) THEN INDUCT_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[ADD1] THEN ASM_SIMP_TAC[ARITH_RULE `(k + 1) + 1 = k + 2`]);; - + let alt_sum_eq_poly_f = prove(`!a x n. sum (0..n) (\i. ((-- &1) pow i * a i) * x pow i) = poly_f_even (TABLE (\i. a (2 * i)) (n DIV 2 + 1)) x diff --git a/Formal_ineqs/trig/poly_eval.hl b/Formal_ineqs/trig/poly_eval.hl index bcdb4870..75adde26 100644 --- a/Formal_ineqs/trig/poly_eval.hl +++ b/Formal_ineqs/trig/poly_eval.hl @@ -79,15 +79,15 @@ type poly_coeff = { };; (* Creates polynomial coefficients from the given list of constant expressions *) -let mk_poly_coeffs = - let interval_pos = prove(`interval_arith x (float_num F n e, f) +let mk_poly_coeffs = + let interval_pos = prove(`interval_arith x (float_num F n e, f) ==> interval_arith x (&0, f) /\ interval_arith (float_num F n e) (&0, x)`, - REWRITE_TAC[interval_arith] THEN + REWRITE_TAC[interval_arith] THEN MP_TAC (SPECL[`n:num`; `e:num`] FLOAT_F_POS) THEN REAL_ARITH_TAC) and - interval_neg = prove(`interval_arith x (f, float_num T n e) + interval_neg = prove(`interval_arith x (f, float_num T n e) ==> interval_arith x (f, &0) /\ interval_arith (float_num T n e) (x, &0)`, - REWRITE_TAC[interval_arith] THEN + REWRITE_TAC[interval_arith] THEN MP_TAC (SPECL[`n:num`; `e:num`] FLOAT_T_NEG) THEN REAL_ARITH_TAC) in let mk_poly_coeff pp cs_tm = @@ -104,7 +104,7 @@ let mk_poly_coeffs = match (s1, s2) with | "F", _ -> 1, MATCH_MP interval_pos int_th | _, "T" -> -1, MATCH_MP interval_neg int_th - | _ -> 0, TRUTH in + | _ -> 0, TRUTH in let sign_high, sign_low = pair_of_list (CONJUNCTS sign_th) in { c_tm = c_tm; @@ -129,7 +129,7 @@ let eval_interval_poly_f = fun pp (cs_tm, cs_list) x_th -> let rec eval cs_tm cs_list x_tm x_th = match cs_list with - | [] -> + | [] -> INST[x_tm, x_var_real] poly_f_empty' | [first] -> let th0 = INST[first.c_tm, c_var_real; x_tm, x_var_real] poly_f_sing' in @@ -157,8 +157,8 @@ let eval_high_poly_f_pos_pos = poly_f_cons_high' = RULE' poly_f_cons_high_pos_pos in let check_pos c = if c.sign = 1 then () else - failwith (Printf.sprintf "eval_high_poly_f_pos_pos: non-positive coefficient: %s, %s" - (string_of_term c.c_tm) + failwith (Printf.sprintf "eval_high_poly_f_pos_pos: non-positive coefficient: %s, %s" + (string_of_term c.c_tm) (string_of_term c.bounds_tm)) in fun pp (cs_tm, cs_list) x_th -> let rec eval cs_tm cs_list x_tm x_th = @@ -167,7 +167,7 @@ let eval_high_poly_f_pos_pos = | [first] -> let _ = check_pos first in let bounds_tm = rand (concl first.sign_high_th) in - let th0 = INST[first.c_tm, c_var_real; bounds_tm, bounds_var; x_tm, x_var_real] + let th0 = INST[first.c_tm, c_var_real; bounds_tm, bounds_var; x_tm, x_var_real] poly_f_sing_high' in MY_PROVE_HYP first.sign_high_th th0 | first :: rest -> @@ -185,9 +185,9 @@ let eval_high_poly_f_pos_pos = let th0 = INST[h_tm, h_var_real; t_tm, t_var_real_list; x_tm, x_var_real; a_tm, a_var_real; b_tm, b_var_real; c_tm, c_var_real; m_tm, m_var_real; r_tm, r_var_real] poly_f_cons_high' in - MY_PROVE_HYP r_bound_th - (MY_PROVE_HYP m_bound_th - (MY_PROVE_HYP first.sign_high_th + MY_PROVE_HYP r_bound_th + (MY_PROVE_HYP m_bound_th + (MY_PROVE_HYP first.sign_high_th (MY_PROVE_HYP rest_th (MY_PROVE_HYP x_th th0)))) in let x_tm = rand (rator (concl x_th)) in @@ -197,15 +197,15 @@ let eval_high_poly_f_pos_pos = (* Evaluates a lower bound of a polynomial on a given non-negative number. * All coefficients of the polynomial must be non-negative. * The argument x should be in the form: |- interval_arith f (&0, x) *) -let eval_low_poly_f_pos_pos = +let eval_low_poly_f_pos_pos = let RULE' = (UNDISCH_ALL o REWRITE_RULE[real_zero] o DISCH_ALL o RULE) in let poly_f_empty_low' = RULE' poly_f_empty_low_pos and poly_f_sing_low' = RULE' poly_f_sing_low_pos and poly_f_cons_low' = RULE' poly_f_cons_low_pos_pos in let check_pos c = if c.sign = 1 then () else - failwith (Printf.sprintf "eval_low_poly_f_pos_pos: non-positive coefficient: %s, %s" - (string_of_term c.c_tm) + failwith (Printf.sprintf "eval_low_poly_f_pos_pos: non-positive coefficient: %s, %s" + (string_of_term c.c_tm) (string_of_term c.bounds_tm)) in fun pp (cs_tm, cs_list) x_th -> let rec eval cs_tm cs_list x_tm x_th = @@ -214,7 +214,7 @@ let eval_low_poly_f_pos_pos = | [first] -> let _ = check_pos first in let b_tm = (rand o rator o concl) first.sign_low_th in - let th0 = INST[first.c_tm, c_var_real; b_tm, b_var_real; x_tm, x_var_real] + let th0 = INST[first.c_tm, c_var_real; b_tm, b_var_real; x_tm, x_var_real] poly_f_sing_low' in MY_PROVE_HYP first.sign_low_th th0 | first :: rest -> @@ -234,9 +234,9 @@ let eval_low_poly_f_pos_pos = a_tm, a_var_real; b_tm, b_var_real; c_tm, c_var_real; m_tm, m_var_real; r_tm, r_var_real] poly_f_cons_low' in MY_PROVE_HYP r_ge0_th - (MY_PROVE_HYP r_bound_th - (MY_PROVE_HYP m_bound_th - (MY_PROVE_HYP first.sign_low_th + (MY_PROVE_HYP r_bound_th + (MY_PROVE_HYP m_bound_th + (MY_PROVE_HYP first.sign_low_th (MY_PROVE_HYP rest_th (MY_PROVE_HYP x_th th0))))) in let x_tm = rand (rand (concl x_th)) in @@ -253,7 +253,7 @@ let eval_pow2_high = MY_PROVE_HYP mul_th th0;; let eval_pow2_low = - let pow2_th = (UNDISCH_ALL o prove)(`(&0 <= a <=> T) ==> a <= x * x + let pow2_th = (UNDISCH_ALL o prove)(`(&0 <= a <=> T) ==> a <= x * x ==> interval_arith a (&0, x pow 2)`, SIMP_TAC[interval_arith; REAL_POW_2]) in fun pp f_tm -> @@ -292,7 +292,7 @@ let eval_pow4_low = REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * a:real` THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_POW_2; REAL_POW_2]) + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_POW_2; REAL_POW_2]) in fun pp f_tm -> let mul1_th = float_mul_lo pp f_tm f_tm in @@ -306,7 +306,7 @@ let eval_pow4_low = let eval_pow2_pow4_high = let pow4_th = (UNDISCH_ALL o prove)(`interval_arith (x pow 2) (&0, a) ==> - a * a <= b ==> + a * a <= b ==> interval_arith (x pow 4) (&0, b)`, REWRITE_TAC[interval_arith; ARITH_RULE `4 = 2 + 2`; REAL_POW_ADD] THEN REPEAT STRIP_TAC THENL [ @@ -325,8 +325,8 @@ let eval_pow2_pow4_high = let eval_pow2_pow4_low = let pow4_th = (UNDISCH_ALL o prove)(`interval_arith a (&0, x pow 2) ==> - b <= a * a ==> - (&0 <= b <=> T) ==> + b <= a * a ==> + (&0 <= b <=> T) ==> interval_arith b (&0, x pow 4)`, REWRITE_TAC[interval_arith; ARITH_RULE `4 = 2 + 2`; REAL_POW_ADD] THEN REPEAT STRIP_TAC THENL [ diff --git a/Formal_ineqs/trig/series.hl b/Formal_ineqs/trig/series.hl index 95a309ca..439102d8 100644 --- a/Formal_ineqs/trig/series.hl +++ b/Formal_ineqs/trig/series.hl @@ -13,7 +13,7 @@ let abs_neg_one_pow = prove REWRITE_TAC[abs_neg_pow; REAL_ARITH `abs (&1) = &1`; REAL_POW_ONE]);; let real_infsum_offset = prove - (`!m k f. real_summable (from m) f /\ m <= k + (`!m k f. real_summable (from m) f /\ m <= k ==> real_infsum (from m) f = sum (m..k) f + real_infsum (from (k + 1)) f`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `k + 1` o MATCH_MP REAL_SUMMABLE_FROM_ELSEWHERE) THEN @@ -26,7 +26,7 @@ let real_infsum_offset = prove REAL_ARITH_TAC);; let real_infsum_offset_alt = prove - (`!m k f. real_summable (from m) f /\ m < k + (`!m k f. real_summable (from m) f /\ m < k ==> real_infsum (from m) f = sum (m..k - 1) f + real_infsum (from k) f`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?t. k = t + 1 /\ m <= t` STRIP_ASSUME_TAC THENL [ @@ -40,7 +40,7 @@ let power_series_simple_bound = prove (`!a u x m. real_summable (from m) (\i. a i * x pow i) /\ (!i. m <= i ==> abs (a i) <= u) /\ abs x < &1 - ==> abs (real_infsum (from m) (\i. a i * x pow i)) + ==> abs (real_infsum (from m) (\i. a i * x pow i)) <= u * abs x pow m / (&1 - abs x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SERIES_BOUND THEN @@ -62,7 +62,7 @@ let power_series_simple_bound2 = prove (`!a x m. real_summable (from m) (\i. a i * x pow i) /\ (!i. m <= i ==> abs (a (SUC i)) <= abs (a i)) /\ abs x < &1 - ==> abs (real_infsum (from m) (\i. a i * x pow i)) + ==> abs (real_infsum (from m) (\i. a i * x pow i)) <= abs (a m) * abs x pow m / (&1 - abs x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC power_series_simple_bound THEN ASM_REWRITE_TAC[] THEN @@ -75,7 +75,7 @@ let real_sums_simple_bound = prove /\ n < m /\ (!i. m <= i ==> abs (a i) <= u) /\ abs x < &1 - ==> abs (t - sum (n..m - 1) (\i. a i * x pow i)) + ==> abs (t - sum (n..m - 1) (\i. a i * x pow i)) <= u * abs x pow m / (&1 - abs x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM (ASSUME_TAC o MATCH_MP REAL_SUMS_SUMMABLE) THEN @@ -93,7 +93,7 @@ let real_sums_simple_bound2 = prove /\ n < m /\ (!i. m <= i ==> abs (a (SUC i)) <= abs (a i)) /\ abs x < &1 - ==> abs (t - sum (n..m - 1) (\i. a i * x pow i)) + ==> abs (t - sum (n..m - 1) (\i. a i * x pow i)) <= abs (a m) * abs x pow m / (&1 - abs x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM (ASSUME_TAC o MATCH_MP REAL_SUMS_SUMMABLE) THEN @@ -123,9 +123,9 @@ let sign_mul_lemma = prove POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM REAL_LT_SQUARE]) THEN ONCE_REWRITE_TAC[REAL_ARITH `(b * b) * x <= &0 <=> &0 <= (--(b * b) * x)`] THEN REWRITE_TAC[REAL_MUL_POS_LE] THEN REAL_ARITH_TAC);; - + let sum_bound_lemma = prove - (`!m n f. + (`!m n f. (!k. abs (f (k + 1)) <= abs (f k) /\ f (k + 1) * f k <= &0) ==> abs (sum (m..n) f) <= abs (f m) /\ &0 <= sum (m..n) f * f m`, GEN_TAC THEN GEN_TAC THEN @@ -191,9 +191,9 @@ let sum_bound_lemma = prove let alt_sign_converges = prove (`!f k. (!n. abs (f (n + 1)) <= abs (f n) /\ f (n + 1) * f n <= &0) /\ - ((f ---> &0) sequentially) + ((f ---> &0) sequentially) ==> ?l. (f real_sums l) (from k)`, - REWRITE_TAC[REAL_SERIES_CAUCHY; REALLIM_SEQUENTIALLY; GSYM IMP_IMP; REAL_SUB_RZERO] THEN + REWRITE_TAC[REAL_SERIES_CAUCHY; REALLIM_SEQUENTIALLY; GSYM IMP_IMP; REAL_SUB_RZERO] THEN REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "h1") THEN REPEAT STRIP_TAC THEN REWRITE_TAC[FROM_INTER_NUMSEG_GEN] THEN FIRST_X_ASSUM (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN @@ -213,13 +213,13 @@ let alt_sign_converges = prove let alt_sign_summable = prove (`!f k. (!n. abs (f (n + 1)) <= abs (f n) /\ f (n + 1) * f n <= &0) /\ - ((f ---> &0) sequentially) + ((f ---> &0) sequentially) ==> real_summable (from k) f`, ASM_SIMP_TAC[real_summable; alt_sign_converges]);; let alt_sign_converges2 = prove (`!f k. (!n. abs (f (n + 1)) <= abs (f n) /\ f (n + 1) * f n <= &0) /\ - ((f ---> &0) sequentially) + ((f ---> &0) sequentially) ==> ?l. (f real_sums l) (from k) /\ abs l <= abs (f k) /\ &0 <= l * f k`, REPEAT STRIP_TAC THEN @@ -258,7 +258,7 @@ let alt_sign_converges2 = prove let alt_sign_bound = prove (`!f k. (!n. abs (f (n + 1)) <= abs (f n) /\ f (n + 1) * f n <= &0) /\ - ((f ---> &0) sequentially) + ((f ---> &0) sequentially) ==> abs (real_infsum (from k) f) <= abs (f k)`, REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL alt_sign_converges2) THEN ASM_REWRITE_TAC[] THEN @@ -273,7 +273,7 @@ let alt_sign_abs_bound = prove MP_TAC (SPEC_ALL alt_sign_bound) THEN ASM_SIMP_TAC[alt_sign_summable] THEN REAL_ARITH_TAC);; - + let alt_sign_upper_bound = prove (`!f m k. (!n. abs (f (n + 1)) <= abs (f n) /\ f (n + 1) * f n <= &0) /\ (f ---> &0) sequentially /\ m < k @@ -353,7 +353,7 @@ let integral_uniform_limit = prove let integral_series = prove (`!f g s r a b. - (!e. &0 < e ==> ?N. !n x. N <= n /\ x IN real_interval[a,b] + (!e. &0 < e ==> ?N. !n x. N <= n /\ x IN real_interval[a,b] ==> abs (sum (s INTER (0..n)) (\i. f i x) - g x) < e) /\ (!n. ((f n) has_real_integral (r n)) (real_interval[a,b])) ==> (?v. (g has_real_integral v) (real_interval[a,b]) /\ (r real_sums v) s)`, @@ -368,7 +368,7 @@ let integral_series = prove let power_series_uniform = prove (`!a s t y. real_summable s (\i. a i * y pow i) /\ abs t < abs y ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ x IN real_interval[--abs t, abs t] - ==> abs (sum (s INTER (0..n)) (\i. a i * x pow i) + ==> abs (sum (s INTER (0..n)) (\i. a i * x pow i) - real_infsum s (\i. a i * x pow i)) < e)`, REPEAT STRIP_TAC THEN ABBREV_TAC `M = (abs y + abs t) / (abs y - abs t)` THEN @@ -473,7 +473,7 @@ let has_real_integral_pow_neg = prove let power_series_integral = prove (`!f a s r. (!x. abs x < r ==> ((\i. a i * x pow i) real_sums f x) s) ==> (!x. abs x < r ==> - let v = if x < &0 then --real_integral (real_interval[x, &0]) f + let v = if x < &0 then --real_integral (real_interval[x, &0]) f else real_integral (real_interval[&0, x]) f in ((\i. a i * x pow (i + 1) / &(i + 1)) real_sums v) s)`, REPEAT STRIP_TAC THEN LET_TAC THEN @@ -535,12 +535,12 @@ let power_series_integral = prove ALL_TAC ] THEN REWRITE_TAC[REAL_MUL_LID]);; - + let power_series_integral2 = prove - (`!f f' a s r. + (`!f f' a s r. (!x. abs x < r ==> (f has_real_derivative f' x) (atreal x)) /\ (!x. abs x < r ==> ((\i. a i * x pow i) real_sums f' x) s) - ==> (!x. abs x < r + ==> (!x. abs x < r ==> ((\i. a i * x pow (i + 1) / &(i + 1)) real_sums f x - f (&0)) s)`, REWRITE_TAC[GSYM IMP_IMP] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP power_series_integral) THEN REPEAT STRIP_TAC THEN @@ -578,7 +578,7 @@ let strict_increasing_num_le = prove GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN TRY ARITH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[ADD1] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; - + let strict_increasing_num_lt = prove (`!h:num->num. (!n. h n < h (n + 1)) ==> (!n m. n < m ==> h n < h m)`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN INDUCT_TAC THEN TRY ARITH_TAC THENL [ @@ -612,11 +612,11 @@ let strict_increasing_num_le2 = prove let real_sums_image = prove - (`!f h s l. (!n. h n < h (n + 1)) + (`!f h s l. (!n. h n < h (n + 1)) ==> ((f real_sums l) (IMAGE h s) <=> ((f o h) real_sums l) s)`, REWRITE_TAC[real_sums; REALLIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ - POP_ASSUM (fun th -> FIRST_X_ASSUM (STRIP_ASSUME_TAC o C MATCH_MP th)) THEN + POP_ASSUM (fun th -> FIRST_X_ASSUM (STRIP_ASSUME_TAC o C MATCH_MP th)) THEN EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?m. N <= m /\ IMAGE (h:num->num) s INTER (0..m) = IMAGE h (s INTER (0..n))` STRIP_ASSUME_TAC THENL [ EXISTS_TAC `(h:num->num) n` THEN @@ -681,7 +681,7 @@ let real_sums_image = prove POP_ASSUM (MP_TAC o MATCH_MP SUM_IMAGE) THEN SIMP_TAC[]);; let real_summable_image = prove - (`!f h s. (!n. h n < h (n + 1)) + (`!f h s. (!n. h n < h (n + 1)) ==> (real_summable (IMAGE h s) f <=> real_summable s (f o h))`, REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP real_sums_image) THEN REWRITE_TAC[real_summable] THEN DISCH_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ @@ -792,7 +792,7 @@ let n_le_pow_lemma = prove MATCH_MP_TAC REAL_POW_LE THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 <= e`]);; let real_summable_lmul_eq = prove - (`!c f s. ~(c = &0) + (`!c f s. ~(c = &0) ==> (real_summable s (\i. c * f i) <=> real_summable s f)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [ SUBGOAL_THEN `f = (\i:num. inv c * c * f i)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ @@ -970,7 +970,7 @@ let power_series_has_derivative = prove ==> ?f'. (!x. abs x < r ==> (f has_real_derivative f' x) (atreal x) /\ ((\i. (&i * a i) * x pow (i - 1)) real_sums f' x) s)`, REPEAT STRIP_TAC THEN - SUBGOAL_THEN `(!w. &0 < w /\ abs w < r /\ w < r /\ abs w < abs r ==> + SUBGOAL_THEN `(!w. &0 < w /\ abs w < r /\ w < r /\ abs w < abs r ==> ?f'. (!x. abs x < w ==> (f has_real_derivative f' x) (atreal x) /\ ((\i. (&i * a i) * x pow (i - 1)) real_sums f' x) s)) ==> ?f'. (!x. abs x < r ==> (f has_real_derivative f' x) (atreal x) /\ @@ -983,7 +983,7 @@ let power_series_has_derivative = prove ALL_TAC ] THEN REWRITE_TAC[] THEN - DISCH_THEN MATCH_MP_TAC THEN + DISCH_THEN MATCH_MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC ] THEN @@ -1096,7 +1096,7 @@ let power_series_has_derivative = prove ASM_REWRITE_TAC[]);; let power_series_has_derivative2 = prove - (`!f a r. + (`!f a r. (!x. abs x < r ==> ((\i. a i * x pow i) real_sums f x) (:num)) ==> ?f'. (!x. abs x < r ==> (f has_real_derivative f' x) (atreal x) /\ @@ -1142,7 +1142,7 @@ let real_sums_i_xi = prove let real_sums_neg_i_xi = prove (`!x. abs x < &1 - ==> ((\i. ((-- &1) pow i * &i) * x pow i) real_sums + ==> ((\i. ((-- &1) pow i * &i) * x pow i) real_sums --(x / (&1 + x) pow 2)) (:num)`, REPEAT STRIP_TAC THEN MP_TAC (SPEC `--x` real_sums_i_xi) THEN ANTS_TAC THENL [ @@ -1215,7 +1215,7 @@ let log_series = prove REWRITE_TAC[REAL_ARITH `a * x / b = a / b * x`]);; let log_infsum = prove - (`!x. abs x < &1 ==> + (`!x. abs x < &1 ==> real_infsum (from 0) (\k. ((-- &1) pow k / &(k + 1)) * x pow (k + 1)) = log (&1 + x)`, GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP REAL_INFSUM_UNIQUE o MATCH_MP log_series) THEN REWRITE_TAC[FROM_0]);; @@ -1224,7 +1224,7 @@ let log_infsum = prove let atn_derivative_series = prove (`!x. abs x < &1 - ==> ((\k. (if EVEN k then (-- &1) pow (k DIV 2) else &0) * x pow k) + ==> ((\k. (if EVEN k then (-- &1) pow (k DIV 2) else &0) * x pow k) real_sums inv (&1 + x pow 2)) (:num)`, REPEAT STRIP_TAC THEN MP_TAC (SPECL[`0`; `(-- &1) * x pow 2`] REAL_SUMS_GP) THEN @@ -1249,7 +1249,7 @@ let atn_series = prove REWRITE_TAC[ARITH_RULE `(2 * i) DIV 2 = i`; real_div; REAL_MUL_AC]);; let atn_infsum = prove - (`!x. abs x < &1 ==> + (`!x. abs x < &1 ==> real_infsum (from 0) (\k. ((-- &1) pow k / &(2 * k + 1)) * x pow (2 * k + 1)) = atn x`, GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP REAL_INFSUM_UNIQUE o MATCH_MP atn_series) THEN REWRITE_TAC[FROM_0]);; diff --git a/Formal_ineqs/trig/sin_cos.hl b/Formal_ineqs/trig/sin_cos.hl index bfa5727d..6bd9ede7 100644 --- a/Formal_ineqs/trig/sin_cos.hl +++ b/Formal_ineqs/trig/sin_cos.hl @@ -7,7 +7,7 @@ prioritize_real();; let cos_pi_2 = prove(`!x. cos (x + pi / &2) = --sin x`, REWRITE_TAC[COS_SIN; REAL_ARITH `a - (b + a) = --b:real`; SIN_NEG]);; -let cos_derivatives = prove(`!x n. ((\x. cos (x + &n * pi / &2)) +let cos_derivatives = prove(`!x n. ((\x. cos (x + &n * pi / &2)) has_real_derivative cos (x + &(n + 1) * pi / &2)) (atreal x)`, REPEAT GEN_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[REAL_ARITH `(&1 + &0) * --a = --a`] THEN @@ -15,8 +15,8 @@ let cos_derivatives = prove(`!x n. ((\x. cos (x + &n * pi / &2)) REWRITE_TAC[REAL_ARITH `x + (a + &1) * t = (x + a * t) + t`] THEN REWRITE_TAC[cos_pi_2]);; -let taylor_cos_raw = prove(`!x n. - abs (cos x - sum (0..n) (\k. if (EVEN k) then ((-- &1) pow (k DIV 2) * x pow k) / &(FACT k) else &0)) +let taylor_cos_raw = prove(`!x n. + abs (cos x - sum (0..n) (\k. if (EVEN k) then ((-- &1) pow (k DIV 2) * x pow k) / &(FACT k) else &0)) <= abs x pow (n + 1) / &(FACT (n + 1))`, REPEAT GEN_TAC THEN MP_TAC (SPECL [`(\i x. cos (x + &i * pi / &2))`; `n:num`; `(:real)`; `&1`] REAL_TAYLOR) THEN @@ -62,8 +62,8 @@ let sum_pair_from_0 = prove(`!f n. sum (0..2 * n + 1) f = sum(0..n) (\i. f (2 * MP_TAC (SPECL [`f:num->real`; `0`; `n:num`] SUM_PAIR) THEN REWRITE_TAC[ARITH_RULE `2 * 0 = 0`]);; -let taylor_cos = prove(`!x n. abs (cos x - - sum (0..n) (\i. ((-- &1) pow i / &(FACT (2 * i))) * x pow (2 * i))) +let taylor_cos = prove(`!x n. abs (cos x - + sum (0..n) (\i. ((-- &1) pow i / &(FACT (2 * i))) * x pow (2 * i))) <= abs x pow (2*n + 2) / &(FACT (2*n + 2))`, REPEAT GEN_TAC THEN MP_TAC (SPECL [`x:real`; `2 * n + 1`] taylor_cos_raw) THEN @@ -137,7 +137,7 @@ let cos_poly_lower_bound = prove(`!x n. ODD n ==> let sin_pi_2 = prove(`!x. sin (x + pi / &2) = cos x`, REWRITE_TAC[SIN_COS; REAL_ARITH `a - (b + a) = --b:real`; COS_NEG]);; -let sin_derivatives = prove(`!x n. ((\x. sin (x + &n * pi / &2)) +let sin_derivatives = prove(`!x n. ((\x. sin (x + &n * pi / &2)) has_real_derivative sin (x + &(n + 1) * pi / &2)) (atreal x)`, REPEAT GEN_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[REAL_ARITH `(&1 + &0) * a = a`] THEN @@ -145,8 +145,8 @@ let sin_derivatives = prove(`!x n. ((\x. sin (x + &n * pi / &2)) REWRITE_TAC[REAL_ARITH `x + (a + &1) * t = (x + a * t) + t`] THEN REWRITE_TAC[sin_pi_2]);; -let taylor_sin_raw = prove(`!x n. - abs (sin x - sum (0..n) (\k. if (ODD k) then ((-- &1) pow (k DIV 2) * x pow k) / &(FACT k) else &0)) +let taylor_sin_raw = prove(`!x n. + abs (sin x - sum (0..n) (\k. if (ODD k) then ((-- &1) pow (k DIV 2) * x pow k) / &(FACT k) else &0)) <= abs x pow (n + 1) / &(FACT (n + 1))`, REPEAT GEN_TAC THEN MP_TAC (SPECL [`(\i x. sin (x + &i * pi / &2))`; `n:num`; `(:real)`; `&1`] REAL_TAYLOR) THEN @@ -185,8 +185,8 @@ let taylor_sin_raw = prove(`!x n. REWRITE_TAC[REAL_MUL_LZERO]);; -let taylor_sin = prove(`!x n. abs (sin x - - sum (0..n) (\i. ((-- &1) pow i / &(FACT (2 * i + 1))) * x pow (2 * i + 1))) +let taylor_sin = prove(`!x n. abs (sin x - + sum (0..n) (\i. ((-- &1) pow i / &(FACT (2 * i + 1))) * x pow (2 * i + 1))) <= abs x pow (2 * n + 3) / &(FACT (2 * n + 3))`, REPEAT GEN_TAC THEN MP_TAC (SPECL [`x:real`; `2 * n + 2`] taylor_sin_raw) THEN diff --git a/Formal_ineqs/trig/sin_eval.hl b/Formal_ineqs/trig/sin_eval.hl index 6e7369c4..dd051c38 100644 --- a/Formal_ineqs/trig/sin_eval.hl +++ b/Formal_ineqs/trig/sin_eval.hl @@ -70,12 +70,12 @@ let float_interval_sin pp x_th = let bounds = rand (concl cos_x_pi2) in let ltm, high_tm = dest_comb bounds in let low_tm = rand ltm in - let th0 = INST[x_tm, x_var_real; low_tm, low_var_real; + let th0 = INST[x_tm, x_var_real; low_tm, low_var_real; high_tm, high_var_real] sin_reduce_th in MY_PROVE_HYP cos_x_pi2 th0;; -end;; +end;; (* diff --git a/Formal_ineqs/trig/test.hl b/Formal_ineqs/trig/test.hl index 42a378f8..83fc3dc0 100644 --- a/Formal_ineqs/trig/test.hl +++ b/Formal_ineqs/trig/test.hl @@ -41,7 +41,7 @@ let float_interval_halfatn pp x_th = let float_interval_halfatn4 pp x_th = let x_tm = (rand o rator o concl) x_th in - let r_th = float_interval_halfatn pp + let r_th = float_interval_halfatn pp (float_interval_halfatn pp (float_interval_halfatn pp (float_interval_halfatn pp x_th))) in let th0 = INST[x_tm, x_var_real] HALFATN4' in diff --git a/Formal_ineqs/trig/unused.hl b/Formal_ineqs/trig/unused.hl index 4ca0a9b5..59cf29ec 100644 --- a/Formal_ineqs/trig/unused.hl +++ b/Formal_ineqs/trig/unused.hl @@ -17,7 +17,7 @@ let float_interval_halfatn pp x_th = let float_interval_halfatn4 pp x_th = let x_tm = (rand o rator o concl) x_th in - let r_th = float_interval_halfatn pp + let r_th = float_interval_halfatn pp (float_interval_halfatn pp (float_interval_halfatn pp (float_interval_halfatn pp x_th))) in let th0 = INST[x_tm, x_var_real] HALFATN4' in @@ -79,7 +79,7 @@ let bound_low_trans = prove x * b <= n /\ t <= a - n /\ r <= x * t - ==> r <= e`, + ==> r <= e`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x * (p1 - x * p2)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x * (a - n)` THEN CONJ_TAC THENL [ @@ -91,7 +91,7 @@ let bound_low_trans = prove REWRITE_TAC[real_sub] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[REAL_LE_NEG2] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x * b:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]);; - + let bound_high_trans = prove (`e <= x * (p1 - x * p2) ==> interval_arith p1 (&0, a) /\ @@ -100,7 +100,7 @@ let bound_high_trans = prove n <= x * b /\ a - n <= t /\ x * t <= r - ==> e <= r`, + ==> e <= r`, REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x * (p1 - x * p2)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x * (a - n)` THEN CONJ_TAC THENL [ @@ -113,13 +113,13 @@ let bound_high_trans = prove ]);; let mk_log_bound_tables log_bound_th = - let log_bound = (SPEC_ALL o + let log_bound = (SPEC_ALL o REWRITE_RULE[poly_f_even; poly_f_odd; GSYM REAL_POW_2; REAL_POW_POW] o REWRITE_RULE[sum_eq_poly_f] o REWRITE_RULE[alt_sum_eq_poly_f; real_div]) log_bound_th in - let reduce_rule = CONV_RULE (DEPTH_CONV + let reduce_rule = CONV_RULE (DEPTH_CONV (FIRST_CONV [NUM_SUC_CONV; NUM_ADD_CONV; NUM_MULT_CONV])) in - let find_poly_f = rev o find_terms (fun tm -> try (rator o rator) tm = `poly_f` + let find_poly_f = rev o find_terms (fun tm -> try (rator o rator) tm = `poly_f` with Failure _ -> false) in fun pp n -> let n_tm = mk_small_numeral n in @@ -135,7 +135,7 @@ let mk_log_bound_tables log_bound_th = bound_th, zip cs_tms cs_lists;; (* Computes i such that x^i / i <= base^(-(p + 1)) and cond(i) *) -let n_of_p_log x pp cond = +let n_of_p_log x pp cond = let t = (float_of_int Arith_num.arith_base) ** (float_of_int (-pp - 1)) in let rec try_i i = let _ = if i > 50 then failwith "n_of_p_exp: cannot find i" else () in @@ -143,7 +143,7 @@ let n_of_p_log x pp cond = (* let d = float_of_int (2 * i + 1) in *) let d = float_of_int i in let r = (x ** d) /. d in - if r <= t then i else try_i (i + 1) + if r <= t then i else try_i (i + 1) else try_i (i + 1) in @@ -204,7 +204,7 @@ let log1_pos_low = let r_tm = rand (rator (concl r_le_xt)) in let cmp_1 = EQT_ELIM (float_lt x_tm one_float) in let cmp_0 = EQT_ELIM (float_ge0 x_tm) in - let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; + let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; t_tm, t_var_real; r_tm, r_var_real; x_tm, x_var_real] bound_th in itlist MY_PROVE_HYP [p1_low_th; p2_high_th; xb_le_n; t_le_an; r_le_xt; cmp_0; cmp_1] th0;; @@ -229,7 +229,7 @@ let log1_pos_high = let r_tm = rand (concl xt_le_r) in let cmp_1 = EQT_ELIM (float_lt x_tm one_float) in let cmp_0 = EQT_ELIM (float_ge0 x_tm) in - let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; + let th0 = INST[a_tm, a_var_real; b_tm, b_var_real; n_tm, n_var_real; t_tm, t_var_real; r_tm, r_var_real; x_tm, x_var_real] bound_th in itlist MY_PROVE_HYP [p1_high_th; p2_low_th; n_le_xb; an_le_t; xt_le_r; cmp_1; cmp_0] th0;; diff --git a/Formal_ineqs/verifier/certificate.hl b/Formal_ineqs/verifier/certificate.hl index 634d9627..2c4e3e6b 100644 --- a/Formal_ineqs/verifier/certificate.hl +++ b/Formal_ineqs/verifier/certificate.hl @@ -18,7 +18,7 @@ type mono_status = { type result_tree = | Result_false of (float list * float list) (* function number, raw flag *) - | Result_pass of (int * bool) + | Result_pass of (int * bool) | Result_pass_mono of mono_status | Result_pass_ref of int | Result_mono of mono_status list * result_tree @@ -28,7 +28,7 @@ type result_tree = type p_status = { pp : int; };; - + type p_result_tree = | P_result_pass of p_status * int * bool | P_result_mono of p_status * mono_status list * p_result_tree @@ -67,11 +67,11 @@ type certificate_stats = { };; let dummy_stats = { - pass = 0; - pass_raw = 0; + pass = 0; + pass_raw = 0; pass_mono = 0; - mono = 0; - glue = 0; + mono = 0; + glue = 0; glue_convex = 0; };; @@ -84,7 +84,7 @@ let result_stats result = pass_mono = ref 0 and pass_raw = ref 0 and glue_convex = ref 0 in - + let rec count r = match r with | Result_false _ -> failwith "False result" @@ -126,7 +126,7 @@ let result_p_stats glue_flag p_result = count r1; count r2 in let _ = count p_result in - let s = Hashtbl.fold + let s = Hashtbl.fold (fun p c s -> (sprintf "p = %d: %d\n" p c) ^ s) p_table "" in report s;; @@ -198,7 +198,7 @@ let transform_result x z r = (* get_domain *) (* Subdivides the given domain (x,z) according to the given path *) let domain_hash = Hashtbl.create 1000 in - let find_hash, mem_hash, add_hash = + let find_hash, mem_hash, add_hash = Hashtbl.find domain_hash, Hashtbl.mem domain_hash, Hashtbl.add domain_hash in let get_domain path = @@ -218,7 +218,7 @@ let transform_result x z r = let ( ++ ), ( / ) = (+.), (/.) in let yj = (List.nth x j ++ List.nth z j) / 2.0 in let delta b v = table (fun i -> if i = j && b then yj else List.nth v i) in - if s = "l" then + if s = "l" then delta false x, delta true z else delta true x, delta false z @@ -259,11 +259,11 @@ let transform_result x z r = let t1 = rec_transform p1 r1 in let t2 = rec_transform p2 r2 in Result_glue (j, convex_flag, t1, t2) - | Result_pass_mono m -> + | Result_pass_mono m -> let path' = rev (get_m m :: path) in let x', z' = get_domain path' in let _, i = find_domain x' z' in - (* let _ = report (sprintf "p = %s, d = %s, found: %d" + (* let _ = report (sprintf "p = %s, d = %s, found: %d" (domain_str x' z') (path_str path') i) in *) if i >= 0 then Result_mono ([m], Result_pass_ref (-i)) else r | _ -> r in diff --git a/Formal_ineqs/verifier/m_verifier.hl b/Formal_ineqs/verifier/m_verifier.hl index 3832b76f..c88de178 100644 --- a/Formal_ineqs/verifier/m_verifier.hl +++ b/Formal_ineqs/verifier/m_verifier.hl @@ -81,7 +81,7 @@ let eval_subset_trans = s_var = mk_var ("s", type_of s_tm) and t_var = mk_var ("t", type_of t_tm) and u_var = mk_var ("u", type_of u_tm) in - (MY_PROVE_HYP st_th o MY_PROVE_HYP tu_th o + (MY_PROVE_HYP st_th o MY_PROVE_HYP tu_th o INST[s_tm, s_var; t_tm, t_var; u_tm, u_var] o inst_first_type_var ty) SUBSET_TRANS';; let eval_subset_refl = @@ -90,7 +90,7 @@ let eval_subset_refl = let ty = (hd o snd o dest_type o type_of) s_tm and s_var = mk_var ("s", type_of s_tm) in (INST[s_tm, s_var] o inst_first_type_var ty) SUBSET_REFL';; - + let SUBSET_INTERVAL_IMP = prove(`!a b c d. (!i. i IN 1..dimindex (:N) ==> a$i <= c$i /\ d$i <= b$i) ==> @@ -115,7 +115,7 @@ let gen_subset_interval_lemma n = MY_RULE th2;; -let subset_interval_thms_array = Array.init (max_dim + 1) +let subset_interval_thms_array = Array.init (max_dim + 1) (fun n -> if n < 1 then TRUTH else gen_subset_interval_lemma n);; @@ -131,7 +131,7 @@ let m_subset_interval n a_tm b_tm c_tm d_tm = c_s = dest_vector c_tm and d_s = dest_vector d_tm in - let th0 = (INST (zip a_s a_vars) o INST (zip b_s b_vars) o + let th0 = (INST (zip a_s a_vars) o INST (zip b_s b_vars) o INST (zip c_s c_vars) o INST (zip d_s d_vars)) subset_interval_thms_array.(n) in let prove_le tm = let ltm, rtm = dest_binop le_op_real tm in @@ -143,9 +143,9 @@ let m_subset_interval n a_tm b_tm c_tm d_tm = (*************************************) let M_RESTRICT_RIGHT_LEMMA = prove(`!j x z y w u y' w'. m_cell_domain (x:real^N,z) y w /\ - (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> + (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i /\ y'$i = y$i /\ w'$i = w$i) /\ - u$j = z$j /\ y'$j = z$j /\ w'$j = &0 ==> + u$j = z$j /\ y'$j = z$j /\ w'$j = &0 ==> m_cell_domain (u,z) y' w' /\ interval [u,z] SUBSET interval [x,z]`, REWRITE_TAC[m_cell_domain; SUBSET_INTERVAL; GSYM IN_NUMSEG] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL @@ -173,9 +173,9 @@ let M_RESTRICT_RIGHT_LEMMA = prove(`!j x z y w u y' w'. m_cell_domain (x:real^N, let M_RESTRICT_LEFT_LEMMA = prove(`!j x z y w u y' w'. m_cell_domain (x:real^N,z) y w /\ - (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> + (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i /\ y'$i = y$i /\ w'$i = w$i) /\ - u$j = x$j /\ y'$j = x$j /\ w'$j = &0 ==> + u$j = x$j /\ y'$j = x$j /\ w'$j = &0 ==> m_cell_domain (x,u) y' w' /\ interval [x,u] SUBSET interval [x,z]`, REWRITE_TAC[m_cell_domain; SUBSET_INTERVAL; GSYM IN_NUMSEG] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL @@ -216,19 +216,19 @@ let gen_restrict_lemma n j left_flag = y'_tm = mk_vector_list (map (fun i -> List.nth (if i = j then b else ys) (i - 1)) (1--n)) and w'_tm = mk_vector_list (map (fun i -> if i = j then `&0` else List.nth ws (i - 1)) (1--n)) in - let th0 = (SPEC_ALL o ISPECL [j_tm; x_tm; z_tm; y_tm; w_tm; u_tm; y'_tm; w'_tm]) + let th0 = (SPEC_ALL o ISPECL [j_tm; x_tm; z_tm; y_tm; w_tm; u_tm; y'_tm; w'_tm]) (if left_flag then M_RESTRICT_LEFT_LEMMA else M_RESTRICT_RIGHT_LEMMA) in let th1 = REWRITE_RULE[dimindex_array.(n); IN_NUMSEG; gen_in_interval n; ARITH] th0 in let th2 = REWRITE_RULE (Array.to_list comp_thms_array.(n)) th1 in MY_RULE_FLOAT th2;; -let left_restrict_thms_array = Array.init (max_dim + 1) +let left_restrict_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_restrict_lemma n j true));; -let right_restrict_thms_array = Array.init (max_dim + 1) +let right_restrict_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_restrict_lemma n j false));; @@ -303,7 +303,7 @@ let m_taylor_cell_pass n pp m_taylor_th = failwith "m_taylor_cell_pass: hi < &0 <=> F" else (MY_PROVE_HYP upper_th o MY_PROVE_HYP hi_lt0_th o - INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real] o + INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real] o inst_first_type_var n_type_array.(n)) M_CELL_PASS_LEMMA';; let m_taylor_cell_list_pass n pp m_taylor_th = @@ -321,7 +321,7 @@ let m_taylor_cell_list_pass n pp m_taylor_th = failwith "m_taylor_cell_list_pass: hi < &0 <=> F" else (MY_PROVE_HYP upper_th o MY_PROVE_HYP hi_lt0_th o - INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real] o + INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real] o inst_first_type_var n_type_array.(n)) M_CELL_LIST_PASS1_LEMMA';; @@ -398,8 +398,8 @@ let m_cell_list_pass_subdomain domain2_tm pass_th = (******************************) -let GLUE_LEMMA = prove(`!j x z v u P Q. - (!i. 1 <= i /\ i <= dimindex (:N) ==> ~(i = j) ==> +let GLUE_LEMMA = prove(`!j x z v u P Q. + (!i. 1 <= i /\ i <= dimindex (:N) ==> ~(i = j) ==> u$i = x$i /\ v$i = z$i) ==> v$j = u$j ==> (!p. p IN interval [x,v] ==> P p) ==> @@ -433,11 +433,11 @@ let GLUE_LEMMA = prove(`!j x z v u P Q. USE_THEN "eq1" (new_rewrite [] []) THEN ASM_REWRITE_TAC[] THEN USE_THEN "ineq" (new_rewrite [] []) THEN ASM_REWRITE_TAC[]);; -let M_CELL_PASS_GLUE_LEMMA = prove(`!j x z v u f. - (!i. 1 <= i /\ i <= dimindex (:N) ==> ~(i = j) ==> +let M_CELL_PASS_GLUE_LEMMA = prove(`!j x z v u f. + (!i. 1 <= i /\ i <= dimindex (:N) ==> ~(i = j) ==> u$i = x$i /\ v$i = z$i) ==> v$j = u$j ==> - m_cell_pass f (x,v) ==> + m_cell_pass f (x,v) ==> m_cell_pass f (u,z) ==> m_cell_pass f (x,z:real^N)`, REPEAT GEN_TAC THEN REWRITE_TAC[m_cell_pass] THEN @@ -450,11 +450,11 @@ let ITLIST_DISJ_APPEND = prove(`!P l1 l2. ITLIST (\a r. P a \/ r) (APPEND l1 l2) GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[APPEND; ITLIST; APPEND_NIL] THEN ASM_REWRITE_TAC[ITLIST; DISJ_ACI]);; -let M_CELL_LIST_PASS_GLUE_LEMMA = prove(`!j x z v u fs1 fs2. - (!i. 1 <= i /\ i <= dimindex (:N) ==> ~(i = j) ==> +let M_CELL_LIST_PASS_GLUE_LEMMA = prove(`!j x z v u fs1 fs2. + (!i. 1 <= i /\ i <= dimindex (:N) ==> ~(i = j) ==> u$i = x$i /\ v$i = z$i) ==> v$j = u$j ==> - m_cell_list_pass fs1 (x,v) ==> + m_cell_list_pass fs1 (x,v) ==> m_cell_list_pass fs2 (u,z) ==> m_cell_list_pass (APPEND fs1 fs2) (x,z:real^N)`, REPEAT GEN_TAC THEN REWRITE_TAC[m_cell_list_pass; ITLIST_DISJ_APPEND] THEN @@ -479,7 +479,7 @@ let gen_glue_lemma n j = gen_th M_CELL_PASS_GLUE_LEMMA, gen_th M_CELL_LIST_PASS_GLUE_LEMMA;; -let glue_thms_array = Array.init (max_dim + 1) +let glue_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH, TRUTH else gen_glue_lemma n j));; @@ -492,15 +492,15 @@ let CELL_LIST_PASS_ACC_INTRO = prove(`m_cell_list_pass fs1 domain <=> m_cell_lis let CELL_LIST_PASS_ACC_ELIM = SYM CELL_LIST_PASS_ACC_INTRO;; -let CELL_LIST_PASS_ACC_REV = prove(`m_cell_list_pass (APPEND acc (CONS h fs2)) domain +let CELL_LIST_PASS_ACC_REV = prove(`m_cell_list_pass (APPEND acc (CONS h fs2)) domain <=> m_cell_list_pass (APPEND (CONS h acc) fs2) domain`, REWRITE_TAC[m_cell_list_pass; ITLIST_DISJ_APPEND; ITLIST; DISJ_ACI]);; -let CELL_LIST_PASS_NIL1 = prove(`m_cell_list_pass (APPEND (APPEND [] fs2) acc) domain +let CELL_LIST_PASS_NIL1 = prove(`m_cell_list_pass (APPEND (APPEND [] fs2) acc) domain <=> m_cell_list_pass (APPEND fs2 acc) domain`, REWRITE_TAC[APPEND]);; -let CELL_LIST_PASS_NIL2 = prove(`m_cell_list_pass (APPEND (APPEND fs1 []) acc) domain +let CELL_LIST_PASS_NIL2 = prove(`m_cell_list_pass (APPEND (APPEND fs1 []) acc) domain <=> m_cell_list_pass (APPEND fs1 acc) domain`, REWRITE_TAC[APPEND_NIL]);; @@ -602,7 +602,7 @@ let DIFF2_DOMAIN_IMP_CONTINUOUS_ON = prove(`!(f:real^N->real) domain. diff2_doma -let M_CELL_INCREASING_PASS_LEMMA = prove(`!j x z u domain lo f. +let M_CELL_INCREASING_PASS_LEMMA = prove(`!j x z u domain lo f. interval [x,z] SUBSET interval [domain] ==> diff2c_domain domain f ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i) ==> @@ -669,7 +669,7 @@ let M_CELL_INCREASING_PASS_LEMMA = prove(`!j x z u domain lo f. -let M_CELL_DECREASING_PASS_LEMMA = prove(`!j x z u domain hi f. +let M_CELL_DECREASING_PASS_LEMMA = prove(`!j x z u domain hi f. interval [x,z] SUBSET interval [domain] ==> diff2c_domain domain f ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> @@ -735,7 +735,7 @@ let M_CELL_DECREASING_PASS_LEMMA = prove(`!j x z u domain hi f. -let M_CELL_CONVEX_PASS_LEMMA = prove(`!j x z u v lo f. +let M_CELL_CONVEX_PASS_LEMMA = prove(`!j x z u v lo f. diff2c_domain (x,z) f ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i /\ v$i = x$i) ==> u$j = x$j ==> v$j = z$j ==> @@ -837,7 +837,7 @@ let ITLIST_DISJ_EXISTS = prove(`!P l. ITLIST (\x r. P x \/ r) l F <=> ?x:A. MEM DISJ2_TAC THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] ]);; -let M_CELL_LIST_PASS_ALT = prove(`!fs domain. m_cell_list_pass fs domain <=> +let M_CELL_LIST_PASS_ALT = prove(`!fs domain. m_cell_list_pass fs domain <=> (!y:real^N. y IN interval [domain] ==> ?f. MEM f fs /\ f y < &0)`, REWRITE_TAC[m_cell_list_pass; ITLIST_DISJ_EXISTS]);; @@ -855,18 +855,18 @@ let ONE_POINT_INTERVAL = prove(`!x:real^N. interval [x,x] = {x}`, ARITH_TAC);; -let M_CELL_LIST_INCREASING_PASS_LEMMA = prove(`!j x z u domain fs. +let M_CELL_LIST_INCREASING_PASS_LEMMA = prove(`!j x z u domain fs. interval [x,z] SUBSET interval [domain] ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i) ==> u$j = z$j ==> - ALL (\f. diff2c_domain domain f /\ + ALL (\f. diff2c_domain domain f /\ (!y. y IN interval [domain] ==> &0 <= partial j f y)) fs ==> m_cell_list_pass fs (u,z) ==> m_cell_list_pass fs (x,z:real^N)`, - REWRITE_TAC[SUBSET; M_CELL_LIST_PASS_ALT] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SUBSET; M_CELL_LIST_PASS_ALT] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `(xx:real^N) = lambda i. if i = j then (x:real^N)$i else (y:real^N)$i` THEN ABBREV_TAC `(zz:real^N) = lambda i. if i = j then (z:real^N)$i else (y:real^N)$i` THEN - + SUBGOAL_THEN `interval [xx:real^N,zz] SUBSET interval [domain]` ASSUME_TAC THENL [ MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `interval [x:real^N,z]` THEN ASM_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `t:real^N` THEN DISCH_THEN (LABEL_TAC "in1") THEN @@ -879,7 +879,7 @@ let M_CELL_LIST_INCREASING_PASS_LEMMA = prove(`!j x z u domain fs. ARITH_TAC; ALL_TAC ] THEN - + SUBGOAL_THEN `y IN interval [xx:real^N,zz]` ASSUME_TAC THENL [ REWRITE_TAC[IN_INTERVAL] THEN GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "xx" THEN EXPAND_TAC "zz" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN @@ -888,7 +888,7 @@ let M_CELL_LIST_INCREASING_PASS_LEMMA = prove(`!j x z u domain fs. DISCH_THEN (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN - + FIRST_X_ASSUM (MP_TAC o SPEC `zz:real^N`) THEN ANTS_TAC THENL [ REWRITE_TAC[IN_INTERVAL] THEN GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "zz" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN @@ -914,15 +914,15 @@ let M_CELL_LIST_INCREASING_PASS_LEMMA = prove(`!j x z u domain fs. -let M_CELL_LIST_DECREASING_PASS_LEMMA = prove(`!j x z u domain fs. +let M_CELL_LIST_DECREASING_PASS_LEMMA = prove(`!j x z u domain fs. interval [x,z] SUBSET interval [domain] ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> - ALL (\f. diff2c_domain domain f /\ + ALL (\f. diff2c_domain domain f /\ (!y. y IN interval [domain] ==> partial j f y <= &0)) fs ==> m_cell_list_pass fs (x,u) ==> m_cell_list_pass fs (x,z:real^N)`, - REWRITE_TAC[SUBSET; M_CELL_LIST_PASS_ALT] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SUBSET; M_CELL_LIST_PASS_ALT] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `(xx:real^N) = lambda i. if i = j then (x:real^N)$i else (y:real^N)$i` THEN ABBREV_TAC `(zz:real^N) = lambda i. if i = j then (z:real^N)$i else (y:real^N)$i` THEN SUBGOAL_THEN `interval [xx:real^N,zz] SUBSET interval [domain]` ASSUME_TAC THENL [ @@ -967,7 +967,7 @@ let M_CELL_LIST_DECREASING_PASS_LEMMA = prove(`!j x z u domain fs. ] THEN ASM_SIMP_TAC[ONE_POINT_INTERVAL; IN_SING]);; - + (*********************) @@ -994,11 +994,11 @@ let gen_mono_lemma0 th = let domain_var = mk_var ("domain", type_of domain_tm) in (UNDISCH_ALL o REWRITE_RULE[SUBSET_REFL] o DISCH_ALL o INST[domain_tm, domain_var]) th;; -let incr_gen_thms_array = Array.init (max_dim + 1) +let incr_gen_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_increasing_lemma n j));; -let incr_thms_array = Array.init (max_dim + 1) +let incr_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_mono_lemma0 incr_gen_thms_array.(n).(j)));; @@ -1019,11 +1019,11 @@ let gen_decreasing_lemma n j = (UNDISCH_ALL o ONCE_REWRITE_RULE[GSYM ZERO_EQ_ZERO_CONST] o DISCH (last (hyp th3))) th3;; -let decr_gen_thms_array = Array.init (max_dim + 1) +let decr_gen_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_decreasing_lemma n j));; -let decr_thms_array = Array.init (max_dim + 1) +let decr_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_mono_lemma0 decr_gen_thms_array.(n).(j)));; @@ -1045,7 +1045,7 @@ let gen_convex_max_lemma n j = (UNDISCH_ALL o ONCE_REWRITE_RULE[GSYM ZERO_EQ_ZERO_CONST] o DISCH (last (hyp th3))) th3;; -let convex_thms_array = Array.init (max_dim + 1) +let convex_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_convex_max_lemma n j));; @@ -1067,8 +1067,8 @@ let m_glue_cells n j pass_th1 pass_th2 = z_vars = map (fun i -> z_vars_array.(i)) (1--n) and f_var = mk_var ("f", type_of f_tm) and t_tm = List.nth x2s (j - 1) in - - let th0 = (INST[t_tm, t_var_real; f_tm, f_var] o + + let th0 = (INST[t_tm, t_var_real; f_tm, f_var] o INST (zip z2s z_vars) o INST (zip x1s x_vars)) (fst glue_thms_array.(n).(j)) in (MY_PROVE_HYP pass_th1 o MY_PROVE_HYP pass_th2) th0;; @@ -1088,8 +1088,8 @@ let m_glue_cells_list n j pass_th1 pass_th2 = fs1_var = mk_var ("fs1", type_of fs1_tm) and fs2_var = mk_var ("fs2", type_of fs2_tm) and t_tm = List.nth x2s (j - 1) in - - let th0 = (INST[t_tm, t_var_real; fs1_tm, fs1_var; fs2_tm, fs2_var] o + + let th0 = (INST[t_tm, t_var_real; fs1_tm, fs1_var; fs2_tm, fs2_var] o INST (zip z2s z_vars) o INST (zip x1s x_vars)) (snd glue_thms_array.(n).(j)) in (MY_PROVE_HYP pass_th1 o MY_PROVE_HYP pass_th2) th0;; @@ -1112,13 +1112,13 @@ let m_mono_pass_gen n j decr_flag diff2_th partial_mono_th sub_th pass_th = bound_var = mk_var ((if decr_flag then "hi" else "lo"), real_ty) in let le_th0 = (if decr_flag then float_le0 else float_ge0) bound_tm in - let le_th = try EQT_ELIM le_th0 with Failure _ -> + let le_th = try EQT_ELIM le_th0 with Failure _ -> failwith (sprintf "m_mono_pass_gen: j = %d, th = %s" j (string_of_thm le_th0)) in let th0 = (INST[f_tm, f_var; bound_tm, bound_var; domain, domain_var] o - INST (zip xs x_vars) o INST (zip zs z_vars)) + INST (zip xs x_vars) o INST (zip zs z_vars)) (if decr_flag then decr_gen_thms_array.(n).(j) else incr_gen_thms_array.(n).(j)) in - (MY_PROVE_HYP le_th o MY_PROVE_HYP pass_th o MY_PROVE_HYP diff2_th o + (MY_PROVE_HYP le_th o MY_PROVE_HYP pass_th o MY_PROVE_HYP diff2_th o MY_PROVE_HYP sub_th o MY_PROVE_HYP partial_mono_th) th0;; @@ -1140,9 +1140,9 @@ let m_incr_pass n pp j m_taylor_th pass_th0 = let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) and f_var = mk_var ("f", type_of f_tm) in - let th0 = (INST[f_tm, f_var; lo_tm, lo_var_real] o + let th0 = (INST[f_tm, f_var; lo_tm, lo_var_real] o INST (zip zs z_vars) o INST (zip xs x_vars)) incr_thms_array.(n).(j) in - (MY_PROVE_HYP lo_ge0_th o MY_PROVE_HYP pass_th0 o + (MY_PROVE_HYP lo_ge0_th o MY_PROVE_HYP pass_th0 o MY_PROVE_HYP diff2_th o MY_PROVE_HYP partial_bound) th0;; @@ -1163,9 +1163,9 @@ let m_decr_pass n pp j m_taylor_th pass_th0 = let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) and f_var = mk_var ("f", type_of f_tm) in - let th0 = (INST[f_tm, f_var; hi_tm, hi_var_real] o + let th0 = (INST[f_tm, f_var; hi_tm, hi_var_real] o INST (zip zs z_vars) o INST (zip xs x_vars)) decr_thms_array.(n).(j) in - (MY_PROVE_HYP hi_le0_th o MY_PROVE_HYP pass_th0 o + (MY_PROVE_HYP hi_le0_th o MY_PROVE_HYP pass_th0 o MY_PROVE_HYP diff2_th o MY_PROVE_HYP partial_bound) th0;; (*************************) @@ -1186,7 +1186,7 @@ let m_convex_pass n j diff2_th partial2_bound_th pass1_th pass2_th = f_var = mk_var ("f", type_of f_tm) in let le_th0 = float_ge0 bound_tm in - let le_th = + let le_th = try EQT_ELIM le_th0 with Failure _ -> failwith ("m_convex_pass: "^string_of_thm le_th0) in let th0 = (INST[f_tm, f_var; bound_tm, lo_var_real] o @@ -1201,7 +1201,7 @@ let m_convex_pass n j diff2_th partial2_bound_th pass1_th pass2_th = (* split_domain *) -let split_domain n pp j domain_th = +let split_domain n pp j domain_th = let domain_tm, y_tm, _ = dest_m_cell_domain (concl domain_th) in let x_tm, z_tm = dest_pair domain_tm in let xs = dest_vector x_tm and @@ -1231,7 +1231,7 @@ let restrict_domain n j left_flag domain_th = (if left_flag then left_restrict_thms_array.(n).(j) else right_restrict_thms_array.(n).(j)) in let ths = CONJUNCTS (MY_PROVE_HYP domain_th th0) in hd ths, hd (tl ths);; - + @@ -1248,7 +1248,7 @@ let m_verify_raw (report_start, total_size) n pp fs certificate domain_th0 th_li let rec apply_trans sub_ths th0 acc = match sub_ths with | [] -> rev acc - | th :: ths -> + | th :: ths -> let th' = eval_subset_trans th th0 in apply_trans ths th' (th' :: acc) in @@ -1265,7 +1265,7 @@ let m_verify_raw (report_start, total_size) n pp fs certificate domain_th0 th_li let xx, zz = dest_pair domain in let df0_flags = itlist (fun m b -> m.df0_flag && b) mono true in let _ = !info_print_level < 2 || (report (sprintf "df0_flags = %b" df0_flags); true) in - let taylor_th, diff2_th = + let taylor_th, diff2_th = if df0_flags then TRUTH, fs.diff2_f xx zz else @@ -1306,13 +1306,13 @@ let m_verify_raw (report_start, total_size) n pp fs certificate domain_th0 th_li match certificate with | Result_mono (mono, r1) -> let _ = !info_print_level < 2 || - (let mono_strs = - map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") + (let mono_strs = + map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") m.variable m.df0_flag) mono in report (sprintf "Mono: [%s]" (String.concat ";" mono_strs)); true) in verify_mono mono domain_th r1 - | Result_pass (_, f0_flag) -> + | Result_pass (_, f0_flag) -> let _ = k := !k + 1 in let _ = !info_print_level < 2 || (report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag); true) in @@ -1325,8 +1325,8 @@ let m_verify_raw (report_start, total_size) n pp fs certificate domain_th0 th_li m_taylor_cell_pass0 n (fs.f pp xx zz) else let taylor_th = fs.taylor pp pp domain_th in - m_taylor_cell_pass n pp taylor_th - + m_taylor_cell_pass n pp taylor_th + | Result_glue (i, convex_flag, r1, r2) -> let domain1_th, domain2_th = if convex_flag then @@ -1350,15 +1350,15 @@ let m_verify_raw (report_start, total_size) n pp fs certificate domain_th0 th_li | Result_pass_ref i -> let _ = !info_print_level < 2 || (report (sprintf "Ref: %d" i); true) in - if i > 0 then + if i > 0 then List.nth th_list (i - 1) else let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let pass_th = List.nth th_list (-i - 1) in m_cell_pass_subdomain domain pass_th - + | _ -> failwith "False result" in - + rec_verify domain_th0 certificate;; @@ -1368,11 +1368,11 @@ let m_verify_raw (report_start, total_size) n pp fs certificate domain_th0 th_li let m_verify_raw0 n pp fs certificate xx zz = m_verify_raw (0, 0) n pp fs certificate (mk_m_center_domain n pp xx zz) [];; - + let m_verify_list n pp fs certificate_list xx zz = let domain_hash = Hashtbl.create (length certificate_list * 10) in - let mem, find, add = Hashtbl.mem domain_hash, + let mem, find, add = Hashtbl.mem domain_hash, Hashtbl.find domain_hash, Hashtbl.add domain_hash in let get_m_cell_domain n pp domain0 path = @@ -1381,7 +1381,7 @@ let m_verify_list n pp fs certificate_list xx zz = | [] -> domain_th | (s, j) :: ps -> let hash' = hash^s^(string_of_int j) in - if mem hash' then + if mem hash' then get_rec (find hash') ps hash' else if s = "l" || s = "r" then @@ -1433,7 +1433,7 @@ let m_p_verify_raw (report_start, total_size) n p_split fs certificate domain_th let rec apply_trans sub_ths th0 acc = match sub_ths with | [] -> rev acc - | th :: ths -> + | th :: ths -> let th' = eval_subset_trans th th0 in apply_trans ths th' (th' :: acc) in @@ -1450,7 +1450,7 @@ let m_p_verify_raw (report_start, total_size) n p_split fs certificate domain_th let xx, zz = dest_pair domain in let df0_flags = itlist (fun m b -> m.df0_flag && b) mono true in let _ = !info_print_level < 2 || (report (sprintf "df0_flags = %b" df0_flags); true) in - let taylor_th, diff2_th = + let taylor_th, diff2_th = if df0_flags then TRUTH, fs.diff2_f xx zz else @@ -1486,15 +1486,15 @@ let m_p_verify_raw (report_start, total_size) n p_split fs certificate domain_th match certificate with | P_result_mono (p_stat, mono, r1) -> let _ = !info_print_level < 2 || - (let mono_strs = - map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") + (let mono_strs = + map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") m.variable m.df0_flag) mono in report (sprintf "Mono: [%s]" (String.concat ";" mono_strs)); true) in verify_mono p_stat mono domain_th r1 | P_result_pass (p_stat, _, f0_flag) -> let _ = k := !k + 1; kk := !kk + 1 in - let _ = !info_print_level < 2 || + let _ = !info_print_level < 2 || (report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag); true) in let _ = !info_print_level <> 1 || (let r = int_of_float (float_of_int !kk /. r_size2 *. 100.0) in @@ -1505,8 +1505,8 @@ let m_p_verify_raw (report_start, total_size) n p_split fs certificate domain_th m_taylor_cell_pass0 n (fs.f p_stat.pp xx zz) else let taylor_th = fs.taylor p_stat.pp p_stat.pp domain_th in - m_taylor_cell_pass n p_stat.pp taylor_th - + m_taylor_cell_pass n p_stat.pp taylor_th + | P_result_glue (p_stat, i, convex_flag, r1, r2) -> let domain1_th, domain2_th = if convex_flag then @@ -1530,13 +1530,13 @@ let m_p_verify_raw (report_start, total_size) n p_split fs certificate domain_th | P_result_ref i -> let _ = !info_print_level < 2 || (report (sprintf "Ref: %d" i); true) in - if i > 0 then + if i > 0 then List.nth th_list (i - 1) else let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let pass_th = List.nth th_list (-i - 1) in m_cell_pass_subdomain domain pass_th in - + rec_verify domain_th0 certificate;; (*****************) @@ -1544,11 +1544,11 @@ let m_p_verify_raw (report_start, total_size) n p_split fs certificate domain_th let m_p_verify_raw0 n p_split fs certificate xx zz = m_p_verify_raw (0, 0) n p_split fs certificate (mk_m_center_domain n p_split xx zz) [];; - + let m_p_verify_list n p_split fs certificate_list xx zz = let domain_hash = Hashtbl.create (length certificate_list * 10) in - let mem, find, add = Hashtbl.mem domain_hash, + let mem, find, add = Hashtbl.mem domain_hash, Hashtbl.find domain_hash, Hashtbl.add domain_hash in let get_m_cell_domain n pp domain0 path = @@ -1557,7 +1557,7 @@ let m_p_verify_list n p_split fs certificate_list xx zz = | [] -> domain_th | (s, j) :: ps -> let hash' = hash^s^(string_of_int j) in - if mem hash' then + if mem hash' then get_rec (find hash') ps hash' else if s = "l" || s = "r" then @@ -1581,7 +1581,7 @@ let m_p_verify_list n p_split fs certificate_list xx zz = let k = ref 0 in let kk = ref 0 in let total_size = end_itlist (+) (map (p_result_size o snd) certificate_list) in - + let rec rec_verify certificate_list th_list = match certificate_list with | [] -> last th_list @@ -1610,7 +1610,7 @@ let m_verify_disj_raw (report_start, total_size) n pp fs_list certificate domain let rec apply_trans sub_ths th0 acc = match sub_ths with | [] -> rev acc - | th :: ths -> + | th :: ths -> let th' = eval_subset_trans th th0 in apply_trans ths th' (th' :: acc) in @@ -1627,7 +1627,7 @@ let m_verify_disj_raw (report_start, total_size) n pp fs_list certificate domain let xx, zz = dest_pair domain in let df0_flags = itlist (fun m b -> m.df0_flag && b) mono true in let _ = !info_print_level < 2 || (report (sprintf "df0_flags = %b" df0_flags); true) in - let taylor_th, diff2_th = + let taylor_th, diff2_th = if df0_flags then TRUTH, fs.diff2_f xx zz else @@ -1670,14 +1670,14 @@ let m_verify_disj_raw (report_start, total_size) n pp fs_list certificate domain failwith "Mono: not implemented" (* let _ = !info_print_level < 2 || - (let mono_strs = - map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") + (let mono_strs = + map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") m.variable m.df0_flag) mono in report (sprintf "Mono: [%s]" (String.concat ";" mono_strs)); true) in verify_mono mono domain_th r1 *) - | Result_pass (j, f0_flag) -> + | Result_pass (j, f0_flag) -> let _ = k := !k + 1 in let _ = !info_print_level < 2 || (report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag); true) in @@ -1692,8 +1692,8 @@ let m_verify_disj_raw (report_start, total_size) n pp fs_list certificate domain m_taylor_cell_list_pass0 n (fs.f pp xx zz) else let taylor_th = fs.taylor pp pp domain_th in - m_taylor_cell_list_pass n pp taylor_th - + m_taylor_cell_list_pass n pp taylor_th + | Result_glue (i, convex_flag, r1, r2) -> let domain1_th, domain2_th = if convex_flag then @@ -1721,15 +1721,15 @@ let m_verify_disj_raw (report_start, total_size) n pp fs_list certificate domain | Result_pass_ref i -> let _ = !info_print_level < 2 || (report (sprintf "Ref: %d" i); true) in - if i > 0 then + if i > 0 then List.nth th_list (i - 1) else let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let pass_th = List.nth th_list (-i - 1) in m_cell_list_pass_subdomain domain pass_th - + | _ -> failwith "False result" in - + rec_verify domain_th0 certificate;; @@ -1755,9 +1755,9 @@ let m_p_verify_disj_raw (report_start, total_size) n p_split fs_list certificate | P_result_mono (p_stat, mono, r1) -> failwith "Mono: not implemented" - | P_result_pass (p_stat, j, f0_flag) -> + | P_result_pass (p_stat, j, f0_flag) -> let _ = k := !k + 1; kk := !kk + 1 in - let _ = !info_print_level < 2 || + let _ = !info_print_level < 2 || (report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag); true) in let _ = !info_print_level <> 1 || (let r = int_of_float (float_of_int !kk /. r_size2 *. 100.0) in @@ -1769,8 +1769,8 @@ let m_p_verify_disj_raw (report_start, total_size) n p_split fs_list certificate m_taylor_cell_list_pass0 n (fs.f p_stat.pp xx zz) else let taylor_th = fs.taylor p_stat.pp p_stat.pp domain_th in - m_taylor_cell_list_pass n p_stat.pp taylor_th - + m_taylor_cell_list_pass n p_stat.pp taylor_th + | P_result_glue (p_stat, i, convex_flag, r1, r2) -> let domain1_th, domain2_th = if convex_flag then @@ -1789,14 +1789,14 @@ let m_p_verify_disj_raw (report_start, total_size) n p_split fs_list certificate | P_result_ref i -> let _ = !info_print_level < 2 || (report (sprintf "Ref: %d" i); true) in - if i > 0 then + if i > 0 then List.nth th_list (i - 1) else let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let pass_th = List.nth th_list (-i - 1) in m_cell_list_pass_subdomain domain pass_th - - | _ -> failwith "False result" + + | _ -> failwith "False result" in rec_verify domain_th0 certificate;; diff --git a/Formal_ineqs/verifier/m_verifier_build.hl b/Formal_ineqs/verifier/m_verifier_build.hl index 5e3730b9..8f73c2d5 100644 --- a/Formal_ineqs/verifier/m_verifier_build.hl +++ b/Formal_ineqs/verifier/m_verifier_build.hl @@ -40,7 +40,7 @@ type verification_funs = };; -(**********************************) +(**********************************) (* mk_verification_functions *) let mk_verification_functions_poly pp0 poly_tm = @@ -49,16 +49,16 @@ let mk_verification_functions_poly pp0 poly_tm = let n = get_dim x_tm in let _ = !info_print_level <= 1 || (report0 (sprintf "Computing partial derivatives (%d)..." n); true) in - let partials = map (fun i -> + let partials = map (fun i -> let _ = !info_print_level <= 1 || (report0 (sprintf " %d" i); true) in gen_partial_poly i new_f) (1--n) in - let get_partial i eq_th = + let get_partial i eq_th = let partial_i = gen_partial_poly i (rand (concl eq_th)) in let pi = (rator o lhand o concl) partial_i in REWRITE_RULE[GSYM partial2] (TRANS (AP_TERM pi eq_th) partial_i) in - let partials2 = map (fun j -> + let partials2 = map (fun j -> let th = List.nth partials (j - 1) in - map (fun i -> + map (fun i -> let _ = !info_print_level <= 1 || (report0 (sprintf " %d,%d" j i); true) in get_partial i th) (1--j)) (1--n) in @@ -70,12 +70,12 @@ let mk_verification_functions_poly pp0 poly_tm = let second_th = gen_second_bounded_poly_thm new_f partials2 in let replace_numeral i th = - let num_eq = (REWRITE_RULE[Arith_num.NUM_THM] o Arith_nat.NUMERAL_TO_NUM_CONV) + let num_eq = (REWRITE_RULE[Arith_num.NUM_THM] o Arith_nat.NUMERAL_TO_NUM_CONV) (mk_small_numeral i) in GEN_REWRITE_RULE (LAND_CONV o RATOR_CONV o DEPTH_CONV) [num_eq] th in let eval0 = mk_eval_function pp0 new_f in - let eval1 = map (fun i -> + let eval1 = map (fun i -> let d_th = List.nth partials (i - 1) in let eq_th = replace_numeral i d_th in mk_eval_function_eq pp0 eq_th) (1--n) in @@ -98,5 +98,5 @@ let mk_verification_functions_poly pp0 poly_tm = - + end;; diff --git a/Formal_ineqs/verifier/m_verifier_main.hl b/Formal_ineqs/verifier/m_verifier_main.hl index 7310d7a3..e560e3e6 100644 --- a/Formal_ineqs/verifier/m_verifier_main.hl +++ b/Formal_ineqs/verifier/m_verifier_main.hl @@ -115,7 +115,7 @@ let test_expression bin_ops unary_ops = let lhs, rhs = dest_comb tm in let c, _ = dest_const lhs in if mem c unary_ops then test rhs else false - with Failure _ -> false + with Failure _ -> false in fun tm -> frees tm = [] || @@ -139,7 +139,7 @@ let is_poly = let rec mk_funs = (* add *) let mk_add n (f1, ti1) (f2, ti2) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x and b = f2 p1 p2 x in eval_m_taylor_add2 n p1 p2 a b), @@ -149,7 +149,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_add p1 p2 a b) in (* sub *) let mk_sub n (f1, ti1) (f2, ti2) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x and b = f2 p1 p2 x in eval_m_taylor_sub2 n p1 p2 a b), @@ -159,7 +159,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_sub p1 p2 a b) in (* mul *) let mk_mul n (f1, ti1) (f2, ti2) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x and b = f2 p1 p2 x in eval_m_taylor_mul2 n p1 p2 a b), @@ -179,7 +179,7 @@ let rec mk_funs = ieval_pow p1 p2 a) in (* neg *) let mk_neg n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_neg2 n a), (fun p1 p2 x -> @@ -187,7 +187,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_neg a) in (* abs *) let mk_real_abs n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_abs2 n p2 a), (fun p1 p2 x -> @@ -195,7 +195,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_abs p2 a) in (* sqrt *) let mk_sqrt n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_sqrt2 n p1 p2 a), (fun p1 p2 x -> @@ -203,7 +203,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_sqrt p1 p2 a) in (* inv *) let mk_inv n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_inv2 n p1 p2 a), (fun p1 p2 x -> @@ -211,7 +211,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_inv p1 p2 a) in (* exp *) let mk_exp n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_exp2 n p1 p2 a), (fun p1 p2 x -> @@ -219,7 +219,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_exp p1 p2 a) in (* log *) let mk_log n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_log2 n p1 p2 a), (fun p1 p2 x -> @@ -227,7 +227,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_log p1 p2 a) in (* atn *) let mk_atn n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_atn2 n p1 p2 a), (fun p1 p2 x -> @@ -235,7 +235,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_atn p1 p2 a) in (* cos *) let mk_cos n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_cos2 n p1 p2 a), (fun p1 p2 x -> @@ -243,7 +243,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_cos p1 p2 a) in (* sin *) let mk_sin n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_sin2 n p1 p2 a), (fun p1 p2 x -> @@ -251,7 +251,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_sin p1 p2 a) in (* acs *) let mk_acs n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_acs2 n p1 p2 a), (fun p1 p2 x -> @@ -259,7 +259,7 @@ let rec mk_funs = Informal_taylor.eval_m_taylor_acs p1 p2 a) in (* asn *) let mk_asn n (f1, ti1) = - (fun p1 p2 x -> + (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_asn2 n p1 p2 a), (fun p1 p2 x -> @@ -274,8 +274,8 @@ let rec mk_funs = let a = ti1 p1 p2 x in Informal_taylor.eval_m_taylor_matan p1 p2 a) in - (* binary operations *) - let bin_ops = + (* binary operations *) + let bin_ops = ["real_add", mk_add; "real_sub", mk_sub; "real_mul", mk_mul] in @@ -323,7 +323,7 @@ let rec mk_funs = try mk_bin n pp x_var body_tm with Failure _ -> mk_unary n pp x_var body_tm;; - + (* Prepares verification functions *) (* fun_tm must be in the form `\x. f x` *) let mk_verification_functions = @@ -341,15 +341,15 @@ let mk_verification_functions = let eval0 = mk_eval_function pp fun_tm in let eval0_informal = Informal_taylor.mk_eval_function pp fun_tm in let _ = params := { - !params with - raw_intervals1 = false; + !params with + raw_intervals1 = false; convex_flag = false - } in + } in { - taylor = eval_taylor; - f = eval0; - df = dummy_df; - ddf = dummy_ddf; + taylor = eval_taylor; + f = eval0; + df = dummy_df; + ddf = dummy_ddf; diff2_f = dummy_diff2 }, { @@ -359,7 +359,7 @@ let mk_verification_functions = Informal_verifier.ddf = dummy_ddf };; - + (********************************) let convert_to_float_list pp lo_flag list_tm = @@ -375,7 +375,7 @@ let convert_to_float_list pp lo_flag list_tm = let mk_float_domain pp (xx_tm, zz_tm) = let xx_list = dest_list xx_tm and zz_list = dest_list zz_tm in - let n = length xx_list in + let n = length xx_list in let get_intervals tms = let i_funs = map build_interval_fun tms in map (fun f -> eval_interval_fun pp f [] []) i_funs in @@ -390,9 +390,9 @@ let mk_float_domain pp (xx_tm, zz_tm) = c_vars = mk_real_vars n "c" and d_vars = mk_real_vars n "d" in let th0 = (INST (zip xx_list c_vars) o INST (zip zz_list d_vars) o - INST (zip a_vals a_vars) o INST (zip b_vals b_vars)) + INST (zip a_vals a_vars) o INST (zip b_vals b_vars)) subset_interval_thms_array.(n) in - itlist MY_PROVE_HYP (xx_ineqs @ zz_ineqs) th0, + itlist MY_PROVE_HYP (xx_ineqs @ zz_ineqs) th0, (mk_list (a_vals, real_ty), mk_list (b_vals, real_ty));; @@ -405,18 +405,18 @@ let mk_standard_ineq = lemma_le = REAL_ARITH `a <= b <=> a - b <= &0` and lemma_imp = TAUT `(P <=> Q) ==> (Q ==> P)` in fun thms tm -> - let th0 = (REWRITE_CONV([real_gt; real_ge; real_div] @ thms) + let th0 = (REWRITE_CONV([real_gt; real_ge; real_div] @ thms) THENC DEPTH_CONV let_CONV) tm in let rhs = rand (concl th0) in - let th1 = (ONCE_REWRITE_CONV[lemma_le] THENC - ONCE_REWRITE_CONV[lemma_lt] THENC + let th1 = (ONCE_REWRITE_CONV[lemma_le] THENC + ONCE_REWRITE_CONV[lemma_lt] THENC PURE_REWRITE_CONV[REAL_NEG_0; REAL_SUB_RZERO; REAL_SUB_LZERO]) rhs in let th2 = TRANS th0 th1 in let ineqs = striplist dest_disj (rand (concl th2)) in let le_flags = map (can (dest_binop le_op_real)) ineqs in - if exists I le_flags then - let q_le_tms, q_lt_tms = unzip - (map2 (fun i b -> + if exists I le_flags then + let q_le_tms, q_lt_tms = unzip + (map2 (fun i b -> let var = mk_var ("Q" ^ string_of_int i, real_ty) in mk_binop (if b then le_op_real else lt_op_real) var `&0`, mk_binop lt_op_real var `&0`) @@ -425,7 +425,7 @@ let mk_standard_ineq = qs_lt = end_itlist (curry mk_disj) q_lt_tms and p_tm = `P:bool` in (* |- (P <=> Q1 <= &0 \/ ...) ==> (Q1 < &0 \/ ... ==> P) *) - let q_th = MESON[REAL_LT_IMP_LE] + let q_th = MESON[REAL_LT_IMP_LE] (mk_imp (mk_eq (p_tm, qs_le), mk_imp (qs_lt, p_tm))) in (* |- Q1 < &0 \/ ... ==> P *) MATCH_MP q_th th2 @@ -441,10 +441,10 @@ let expr_to_vector_fun = let x_var = mk_var ("x", n_vector_type_array.(if n = 0 then 1 else n)) in let x_tm = mk_icomb (comp_op, x_var) in let vars2 = map (fun i -> mk_comb (x_tm, mk_small_numeral i)) (1--n) in - mk_abs (x_var, subst (zip vars2 vars) expr_tm), + mk_abs (x_var, subst (zip vars2 vars) expr_tm), (if n = 0 then mk_vector_list [x_var] else mk_vector_list vars);; -(* Converts a list of terms in the form [`x + y`; `z`] +(* Converts a list of terms in the form [`x + y`; `z`] into a list of terms [`\x:real^3. x$1 + x$2`; `\x:real^3. x$3` *) let exprs_to_vector_fun = let comp_op = `$` in @@ -484,19 +484,19 @@ let dest_ineq ineq_tm = let lhs, rhs = dest_binop le_op_real tm in let lo_flag = (frees lhs = []) in let name = (fst o dest_var) (if lo_flag then rhs else lhs) in - let val_ref = + let val_ref = try assoc name !ineqs - with Failure _ -> - let val_ref = ref (x_var_real, x_var_real) in + with Failure _ -> + let val_ref = ref (x_var_real, x_var_real) in ineqs := ((name, val_ref) :: !ineqs); val_ref in val_ref := if lo_flag then (lhs, snd !val_ref) else (fst !val_ref, rhs) in - let _ = map (fun tm -> + let _ = map (fun tm -> (try decode_ineq tm with Failure _ -> failwith ("Bad variable bound inequality: "^string_of_term tm))) conds in let names, bounds0 = unzip !ineqs in let lo, hi = unzip (map (fun r -> !r) bounds0) in let test_bounds bounds bound_name = - let _ = map2 (fun tm name -> if frees tm <> [] then + let _ = map2 (fun tm name -> if frees tm <> [] then failwith (bound_name^" bound is not defined for "^name) else ()) bounds names in () in let _ = test_bounds hi "Upper"; test_bounds lo "Lower" in @@ -514,7 +514,7 @@ let normalize_result norm_flag v1 imp_th1 domain_sub_th pass_thm = let th3 = MP imp_th1 th2 in let dom_th = (UNDISCH_ALL o SPEC v1 o REWRITE_RULE[SUBSET]) domain_sub_th in let th4 = (DISCH_ALL o MY_PROVE_HYP dom_th) th3 in - let th5 = REWRITE_RULE[IN_INTERVAL; dimindex_array.(n); + let th5 = REWRITE_RULE[IN_INTERVAL; dimindex_array.(n); gen_in_interval n; comp_thms] th4 in if norm_flag then GEN_ALL th5 else th4;; @@ -569,7 +569,7 @@ let verify_ineq0 params0 norm_flag pp ineq_tm var_names (lo_tm, hi_tm) rewrite_t let _ = !info_print_level < 1 || (Certificate.report_stats stats; true) in let c1 = Certificate.transform_result xx_float zz_float certificate in - let start, finish, result = + let start, finish, result = if !params.adaptive_precision then let _ = !info_print_level < 1 || (report0 "Informal verification... "; true) in let c1p = Informal_verifier.m_verify_list pp 1 pp [ti] c1 xx2 zz2 in @@ -593,7 +593,7 @@ let verify_ineq0 params0 norm_flag pp ineq_tm var_names (lo_tm, hi_tm) rewrite_t (* -(* A simple verification function which accepts +(* A simple verification function which accepts a list of rewrite theorems which are applied to the inequality before verification *) let verify_ineq_and_rewrite rewrite_thms params pp ineq_tm = @@ -656,7 +656,7 @@ let verify_disj_ineq0 params0 norm_flag pp ineq_tm var_names (lo_tm, hi_tm) rewr let _ = params0.convex_flag = false || (report "WARNING: covex_flag should be false"; true) in let _ = params0.allow_derivatives = false || (report "WARNING: allow_derivatives should be false"; true) in - let params = ref {params0 with + let params = ref {params0 with mono_pass_flag = false; convex_flag = false; allow_derivatives = false} in @@ -703,7 +703,7 @@ let verify_disj_ineq0 params0 norm_flag pp ineq_tm var_names (lo_tm, hi_tm) rewr -(* A simple verification function which accepts +(* A simple verification function which accepts a list of rewrite theorems which are applied to the inequality before verification *) let verify_ineq_and_rewrite rewrite_thms params pp ineq_tm = @@ -720,7 +720,7 @@ end;; let h0 = new_definition `h0 = #1.26` and lmfun = new_definition`lmfun h = if (h<=h0) then (h0 - h)/(h0 - &1) else &0` and hplus = new_definition `hplus = #1.3254` and - marchal_quartic = new_definition `marchal_quartic h = + marchal_quartic = new_definition `marchal_quartic h = (sqrt(&2)-h)*(h- hplus )*(&9*(h pow 2) - &17*h + &3)/ ((sqrt(&2) - &1)* &5 *(hplus - &1))`;; @@ -734,7 +734,7 @@ let lmfun_cond_ge = (UNDISCH_ALL o prove)(`h0 <= x ==> lmfun x = &0`, REAL_ARITH_TAC);; let eq_tm = `marchal_quartic x - lmfun x`;; -let eq_th1, eq_th2 = +let eq_th1, eq_th2 = let ths = [marchal_quartic; h0; hplus] in REWRITE_CONV (lmfun_cond_le :: ths) eq_tm, REWRITE_CONV (REAL_SUB_RZERO :: lmfun_cond_ge :: ths) eq_tm;; diff --git a/Functionspaces/README b/Functionspaces/README index 6b49ac78..88cc99ef 100644 --- a/Functionspaces/README +++ b/Functionspaces/README @@ -1,9 +1,9 @@ - Library of complex function vector spaces - - (c) Copyright, Mohamed Yousri Mahmoud, Vincent Aravantinos, 2012-2013 - Hardware Verification Group, - Concordia University - - Contact: , + Library of complex function vector spaces + + (c) Copyright, Mohamed Yousri Mahmoud, Vincent Aravantinos, 2012-2013 + Hardware Verification Group, + Concordia University + + Contact: , Distributed with HOL Light under same license terms diff --git a/Help/.singlefun.doc b/Help/.singlefun.doc index 9701b542..28e3aa80 100644 --- a/Help/.singlefun.doc +++ b/Help/.singlefun.doc @@ -16,16 +16,16 @@ and is undefined for all arguments other than {x}. { # let f = (1 |=> 2);; val f : (int, int) func = - + # apply f 1;; val it : int = 2 - + # apply f 2;; Exception: Failure "apply". } \SEEALSO -|->, apply, applyd, choose, combine, defined, dom, foldl, foldr, +|->, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC diff --git a/Help/.valmod.doc b/Help/.valmod.doc index 4f048b6f..90f13521 100644 --- a/Help/.valmod.doc +++ b/Help/.valmod.doc @@ -6,7 +6,7 @@ Modify a finite partial function at one point. \DESCRIBE -This is one of a suite of operations on finite partial functions, type +This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} is a finite partial function then {(x |-> y) f} gives a modified @@ -29,7 +29,7 @@ Never fails. } \SEEALSO -|=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, +|=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC diff --git a/Help/ABS_CONV.doc b/Help/ABS_CONV.doc index a170b9d1..183d13b6 100644 --- a/Help/ABS_CONV.doc +++ b/Help/ABS_CONV.doc @@ -20,7 +20,7 @@ abstraction {`\x. t`}. \FAILURE {ABS_CONV c tm} fails if {tm} is not an abstraction or if {tm} has the form -{`\x. t`} but the conversion {c} fails when applied to the term {t}, or if the +{`\x. t`} but the conversion {c} fails when applied to the term {t}, or if the theorem returned has assumptions in which the abstracted variable {x} is free. The function returned by {ABS_CONV c} may also fail if the ML function {c:term->thm} is not, in fact, a conversion (i.e. a function that maps a term diff --git a/Help/ACCEPT_TAC.doc b/Help/ACCEPT_TAC.doc index 141d7cff..b17996cf 100644 --- a/Help/ACCEPT_TAC.doc +++ b/Help/ACCEPT_TAC.doc @@ -17,7 +17,7 @@ conclusion is alpha-convertible to the conclusion of {th}. conclusion of the supplied theorem {th}. \EXAMPLE -The theorem {BOOL_CASES_AX = |- !t. (t <=> T) \/ (t <=> F)} can be used to +The theorem {BOOL_CASES_AX = |- !t. (t <=> T) \/ (t <=> F)} can be used to solve the goal: { # g `!x. (x <=> T) \/ (x <=> F)`;; @@ -30,7 +30,7 @@ solve the goal: \USES Used for completing proofs by supplying an existing theorem, such as an axiom, -or a lemma already proved. Often this can simply be done by rewriting, but +or a lemma already proved. Often this can simply be done by rewriting, but there are times when greater delicacy is wanted. \SEEALSO diff --git a/Help/ALL_TAC.doc b/Help/ALL_TAC.doc index 59928bac..34959c27 100644 --- a/Help/ALL_TAC.doc +++ b/Help/ALL_TAC.doc @@ -21,15 +21,15 @@ Suppose we want to solve the goal: # g `~(n MOD 2 = 0) <=> n MOD 2 = 1`;; ... } -We could just solve it with {e ARITH_TAC}, but suppose we want to introduce a +We could just solve it with {e ARITH_TAC}, but suppose we want to introduce a little lemma that {n MOD 2 < 2}, proving that by {ARITH_TAC}. We could do { # e(SUBGOAL_THEN `n MOD 2 < 2` ASSUME_TAC THENL [ARITH_TAC; ...rest of proof...]);; } -However if we split off many lemmas, we get a deeply nested proof structure -that's a bit confusing. In cases where the proofs of the lemmas are trivial +However if we split off many lemmas, we get a deeply nested proof structure +that's a bit confusing. In cases where the proofs of the lemmas are trivial one-liners like this we might just want to keep the proof basically linear with { # e(SUBGOL_THEN `n MOD 2 < 2` ASSUME_TAC THENL [ARITH_TAC; ALL_TAC] THEN @@ -37,7 +37,7 @@ one-liners like this we might just want to keep the proof basically linear with } \USES -Keeping proof structures linear, as in the above example, or convenient +Keeping proof structures linear, as in the above example, or convenient algebraic combinations in complicated tactic structures. \SEEALSO diff --git a/Help/ASM_ARITH_TAC.doc b/Help/ASM_ARITH_TAC.doc index 25b640f6..97e0dc15 100644 --- a/Help/ASM_ARITH_TAC.doc +++ b/Help/ASM_ARITH_TAC.doc @@ -10,31 +10,31 @@ inequality reasoning only, using assumptions {ASM_ARITH_TAC} will automatically prove goals that require basic algebraic normalization and inequality reasoning over the natural numbers. For nonlinear equational reasoning use {NUM_RING} and derivatives. Unlike plain {ARITH_TAC}, -{ASM_ARITH_TAC} uses any assumptions that are not universally quantified as +{ASM_ARITH_TAC} uses any assumptions that are not universally quantified as additional hypotheses. \FAILURE Fails if the automated methods do not suffice. \EXAMPLE -This example illustrates how {ASM_ARITH_TAC} uses assumptions while {ARITH_TAC} -does not. Of course, this is for illustration only: plain {ARITH_TAC} would +This example illustrates how {ASM_ARITH_TAC} uses assumptions while {ARITH_TAC} +does not. Of course, this is for illustration only: plain {ARITH_TAC} would solve the entire goal before application of {STRIP_TAC}. { - # g `1 <= 6 * x /\ 2 * x <= 3 ==> x = 1`;; + # g `1 <= 6 * x /\ 2 * x <= 3 ==> x = 1`;; Warning: Free variables in goal: x val it : goalstack = 1 subgoal (1 total) - + `1 <= 6 * x /\ 2 * x <= 3 ==> x = 1` - + # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) - + 0 [`1 <= 6 * x`] 1 [`2 * x <= 3`] - + `x = 1` - + # e ARITH_TAC;; Exception: Failure "linear_ineqs: no contradiction". # e ASM_ARITH_TAC;; diff --git a/Help/ASM_FOL_TAC.doc b/Help/ASM_FOL_TAC.doc index 1c002d1a..90a1aa9b 100644 --- a/Help/ASM_FOL_TAC.doc +++ b/Help/ASM_FOL_TAC.doc @@ -6,12 +6,12 @@ Fix up function arities for first-order proof search. \DESCRIBE -This function attempts to make the assumptions of a goal more `first-order'. -Functions that are not consistently used with the same arity, e.g. a function -{f} that is sometimes applied {f(a)} and sometimes used as an argument to other -functions, {g(f)}, will be identified. Applications of the function will then +This function attempts to make the assumptions of a goal more `first-order'. +Functions that are not consistently used with the same arity, e.g. a function +{f} that is sometimes applied {f(a)} and sometimes used as an argument to other +functions, {g(f)}, will be identified. Applications of the function will then be modified by the introduction of the identity function {I} (which can be -thought of later as binary `function application') so that {f(a)} becomes +thought of later as binary `function application') so that {f(a)} becomes {I f a}. This gives a more natural formulation as a prelude to traditional first-order proof search. diff --git a/Help/ASM_SIMP_TAC.doc b/Help/ASM_SIMP_TAC.doc index b1223008..b7cd4a37 100644 --- a/Help/ASM_SIMP_TAC.doc +++ b/Help/ASM_SIMP_TAC.doc @@ -9,7 +9,7 @@ assumptions and built-in simplifications. \DESCRIBE A call to {ASM_SIMP_TAC[theorems]} will apply conditional contextual rewriting with {theorems} and the current assumptions of the goal to the goal's -conclusion, as well as the default simplifications (see {basic_rewrites} and +conclusion, as well as the default simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of rewriting, see {SIMP_CONV}. If the extra generality of contextual conditional rewriting is not needed, {REWRITE_TAC} is usually more efficient. diff --git a/Help/ASSOC_CONV.doc b/Help/ASSOC_CONV.doc index 7eb6c406..147b4a44 100644 --- a/Help/ASSOC_CONV.doc +++ b/Help/ASSOC_CONV.doc @@ -6,15 +6,15 @@ Right-associates a term with respect to an associative binary operator. \DESCRIBE -The conversion {ASSOC_CONV} expects a theorem asserting that a certain binary -operator is associative, in the standard form (with optional universal +The conversion {ASSOC_CONV} expects a theorem asserting that a certain binary +operator is associative, in the standard form (with optional universal quantifiers): { x op (y op z) = (x op y) op z } -It is then applied to a term, and will right-associate any toplevel -combinations built up from the operator {op}. Note that if {op} is polymorphic, -the type instance of the theorem needs to be the same as in the term to which +It is then applied to a term, and will right-associate any toplevel +combinations built up from the operator {op}. Note that if {op} is polymorphic, +the type instance of the theorem needs to be the same as in the term to which it is applied. \FAILURE diff --git a/Help/AUGMENT_SIMPSET.doc b/Help/AUGMENT_SIMPSET.doc index cc4a88ce..13184b98 100644 --- a/Help/AUGMENT_SIMPSET.doc +++ b/Help/AUGMENT_SIMPSET.doc @@ -6,9 +6,9 @@ Augment context of a simpset with a list of theorems. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset'. Given a list of theorems {thl} -and a simpset {ss}, the call {AUGMENT_SIMPSET thl ss} augments the state of the +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset'. Given a list of theorems {thl} +and a simpset {ss}, the call {AUGMENT_SIMPSET thl ss} augments the state of the simpset, adding the theorems as new rewrite rules and also making any provers in the simpset process the new context appropriately. diff --git a/Help/BETA.doc b/Help/BETA.doc index 3ea4c0f1..62029982 100644 --- a/Help/BETA.doc +++ b/Help/BETA.doc @@ -6,10 +6,10 @@ Special primitive case of beta-reduction. \DESCRIBE -Given a term of the form {(\x. t[x]) x}, i.e. a lambda-term applied to exactly +Given a term of the form {(\x. t[x]) x}, i.e. a lambda-term applied to exactly the same variable that occurs in the abstraction, {BETA} returns the theorem {|- (\x. t[x]) x = t[x]}. - + \FAILURE Fails if the term is not of the required form. @@ -18,7 +18,7 @@ Fails if the term is not of the required form. # BETA `(\n. n + 1) n`;; val it : thm = |- (\n. n + 1) n = n + 1 } -\noindent Note that more general beta-reduction is not handled by {BETA}, but +\noindent Note that more general beta-reduction is not handled by {BETA}, but will be by {BETA_CONV}: { # BETA `(\n. n + 1) m`;; @@ -28,7 +28,7 @@ will be by {BETA_CONV}: } \USES -This is more efficient than {BETA_CONV} in the special case in which it works, +This is more efficient than {BETA_CONV} in the special case in which it works, because no traversal and replacement of the body of the abstraction is needed. \COMMENTS diff --git a/Help/BETA_TAC.doc b/Help/BETA_TAC.doc index 12afcd7e..582b994b 100644 --- a/Help/BETA_TAC.doc +++ b/Help/BETA_TAC.doc @@ -22,8 +22,8 @@ Variables are renamed where necessary to avoid free variable capture. Never fails, but will have no effect if there are no beta-redexes. \COMMENTS -Beta-reduction, and indeed, generalized beta reduction ({GEN_BETA_CONV}) are -already among the basic rewrites, so happen anyway simply on {REWRITE_TAC[]}. +Beta-reduction, and indeed, generalized beta reduction ({GEN_BETA_CONV}) are +already among the basic rewrites, so happen anyway simply on {REWRITE_TAC[]}. But occasionally it is convenient to be able to invoke them separately. \SEEALSO diff --git a/Help/BINDER_CONV.doc b/Help/BINDER_CONV.doc index f3312ab4..98f5f6b8 100644 --- a/Help/BINDER_CONV.doc +++ b/Help/BINDER_CONV.doc @@ -6,13 +6,13 @@ Applies conversion to the body of a binder. \DESCRIBE -If {c} is a conversion such that {c `t`} returns {|- t = t'}, then -{BINDER_CONV c `b (\x. t)`} returns {|- b (\x. t) = b (\x. t')}, i.e. applies -the core conversion to the body of a `binder'. In fact, {b} here can be any +If {c} is a conversion such that {c `t`} returns {|- t = t'}, then +{BINDER_CONV c `b (\x. t)`} returns {|- b (\x. t) = b (\x. t')}, i.e. applies +the core conversion to the body of a `binder'. In fact, {b} here can be any term, but it is typically a binder constant such as a quantifier. \FAILURE -Fails if the core conversion does, or if the theorem returned by it is not of +Fails if the core conversion does, or if the theorem returned by it is not of the right form. \EXAMPLE diff --git a/Help/BINOP_TAC.doc b/Help/BINOP_TAC.doc index e53f2af6..48f7f0b2 100644 --- a/Help/BINOP_TAC.doc +++ b/Help/BINOP_TAC.doc @@ -3,7 +3,7 @@ \TYPE {BINOP_TAC : tactic} \SYNOPSIS -Breaks apart equation between binary operator applications into equality +Breaks apart equation between binary operator applications into equality between their arguments. \DESCRIBE @@ -17,11 +17,11 @@ subgoals expressing equality of the corresponding arguments: } \FAILURE -Fails if the conclusion of the goal is not an equation between applications of +Fails if the conclusion of the goal is not an equation between applications of the same curried binary operator. \EXAMPLE -We can set up the following goal which is an equation between applications of +We can set up the following goal which is an equation between applications of the binary operator {+}: { @@ -31,12 +31,12 @@ the binary operator {+}: { # e BINOP_TAC;; val it : goalstack = 2 subgoals (2 total) - + `w * z = z * w` - + `f (2 * x + 1) = f (SUC (x + 1) * 2 - 1)` } -\noindent the first of which can be solved by {ARITH_TAC}, and the second by +\noindent the first of which can be solved by {ARITH_TAC}, and the second by {AP_TERM_TAC THEN ARITH_TAC}. \SEEALSO diff --git a/Help/BITS_ELIM_CONV.doc b/Help/BITS_ELIM_CONV.doc index c59b852b..646a4c3f 100644 --- a/Help/BITS_ELIM_CONV.doc +++ b/Help/BITS_ELIM_CONV.doc @@ -7,7 +7,7 @@ Removes stray instances of special constants used in numeral representation \DESCRIBE The HOL Light representation of numeral constants like {`6`} uses a -number of special constants {`NUMERAL`}, {`BIT0`}, {`BIT1`} and {`_0`}, +number of special constants {`NUMERAL`}, {`BIT0`}, {`BIT1`} and {`_0`}, essentially to represent those numbers in binary. The conversion {BITS_ELIM_CONV} eliminates any uses of these constants within the given term not used as part of a standard numeral. @@ -18,15 +18,15 @@ Never fails \EXAMPLE { # BITS_ELIM_CONV `BIT0(BIT1(BIT1 _0)) = 6`;; - val it : thm = + val it : thm = |- BIT0 (BIT1 (BIT1 _0)) = 6 <=> 2 * (2 * (2 * 0 + 1) + 1) = 6 - + # (BITS_ELIM_CONV THENC NUM_REDUCE_CONV) `BIT0(BIT1(BIT1 _0)) = 6`;; val it : thm = |- BIT0 (BIT1 (BIT1 _0)) = 6 <=> T } \USES -Mainly intended for internal use in functions doing sophisticated things with +Mainly intended for internal use in functions doing sophisticated things with numerals. \SEEALSO diff --git a/Help/BOOL_CASES_TAC.doc b/Help/BOOL_CASES_TAC.doc index 2bc970c3..f89235a4 100644 --- a/Help/BOOL_CASES_TAC.doc +++ b/Help/BOOL_CASES_TAC.doc @@ -19,8 +19,8 @@ by {F} and {T} respectively. A ?- t[F/x] A ?- t[T/x] } \noindent The term given does not have to be free in the goal, but if it isn't, -{BOOL_CASES_TAC} will merely duplicate the original goal twice. Note that in -the new goals, we don't have {x} and {~x} as assumptions; for that use +{BOOL_CASES_TAC} will merely duplicate the original goal twice. Note that in +the new goals, we don't have {x} and {~x} as assumptions; for that use {ASM_CASES_TAC}. \FAILURE diff --git a/Help/CACHE_CONV.doc b/Help/CACHE_CONV.doc index f09fdca8..984417de 100644 --- a/Help/CACHE_CONV.doc +++ b/Help/CACHE_CONV.doc @@ -6,15 +6,15 @@ Accelerates a conversion by cacheing previous results. \DESCRIBE -If {cnv} is any conversion, then {CACHE_CONV cnv} gives a new conversion that -is functionally identical but keeps a cache of previous arguments and results, +If {cnv} is any conversion, then {CACHE_CONV cnv} gives a new conversion that +is functionally identical but keeps a cache of previous arguments and results, and simply returns the cached result if the same input is encountered again. \FAILURE Never fails, though the subsequent application to a term may. \EXAMPLE -The following call takes a while, making several applications to the same +The following call takes a while, making several applications to the same expression: { # time (DEPTH_CONV NUM_RED_CONV) `31 EXP 31 + 31 EXP 31 + 31 EXP 31`;; @@ -23,10 +23,10 @@ expression: |- 31 EXP 31 + 31 EXP 31 + 31 EXP 31 = 51207522392169707875831929087177944268134203293 } -\noindent whereas the cached variant is faster since the result for {31 EXP 31} +\noindent whereas the cached variant is faster since the result for {31 EXP 31} is stored away and re-used after the first call: { - # time (DEPTH_CONV(CACHE_CONV NUM_RED_CONV)) + # time (DEPTH_CONV(CACHE_CONV NUM_RED_CONV)) `31 EXP 31 + 31 EXP 31 + 31 EXP 31`;; CPU time (user): 0.461 val it : thm = diff --git a/Help/CHANGED_CONV.doc b/Help/CHANGED_CONV.doc index b63f9f91..18e7b045 100644 --- a/Help/CHANGED_CONV.doc +++ b/Help/CHANGED_CONV.doc @@ -9,26 +9,26 @@ Makes a conversion fail if applying it leaves a term unchanged. conversional. \DESCRIBE -For a conversion {cnv}, the construct {CHANGED_CONV c} gives a new conversion +For a conversion {cnv}, the construct {CHANGED_CONV c} gives a new conversion that has the same action as {cnv}, except that it will fail on terms {t} such -that {cnv t} returns a reflexive theorem {|- t = t}, or more precisely +that {cnv t} returns a reflexive theorem {|- t = t}, or more precisely {|- t = t'} where {t} and {t'} are alpha-equivalent. \FAILURE -Never fails when applied to the conversion, but fails on further application to +Never fails when applied to the conversion, but fails on further application to a term if the original conversion does or it returns a reflexive theorem. \EXAMPLE { # ONCE_DEPTH_CONV num_CONV `x + 0`;; val it : thm = |- x + 0 = x + 0 - + # CHANGED_CONV(ONCE_DEPTH_CONV num_CONV) `x + 0`;; Exception: Failure "CHANGED_CONV". - + # CHANGED_CONV(ONCE_DEPTH_CONV num_CONV) `6`;; val it : thm = |- 6 = SUC 5 - + # REPEATC(CHANGED_CONV(ONCE_DEPTH_CONV num_CONV)) `6`;; val it : thm = |- 6 = SUC (SUC (SUC (SUC (SUC (SUC 0))))) } diff --git a/Help/CHAR_EQ_CONV.doc b/Help/CHAR_EQ_CONV.doc index d0f7b02e..52c1d1a5 100644 --- a/Help/CHAR_EQ_CONV.doc +++ b/Help/CHAR_EQ_CONV.doc @@ -16,14 +16,14 @@ If {s} and {t} are two character literal terms in the HOL logic, respectively. \FAILURE -{CHAR_EQ_CONV tm} fails f {tm} is not of the specified form, an equation +{CHAR_EQ_CONV tm} fails f {tm} is not of the specified form, an equation between character literals. \EXAMPLE { # let t = mk_eq(mk_char 'A',mk_char 'A');; val t : term = `ASCII F T F F F F F T = ASCII F T F F F F F T` - + # CHAR_EQ_CONV t;; val it : thm = |- ASCII F T F F F F F T = ASCII F T F F F F F T <=> T } @@ -32,8 +32,8 @@ between character literals. Performing basic equality reasoning while producing a proof about characters. \COMMENTS -There is no particularly convenient parser/printer support for the HOL {char} -type, but when combined into lists they are considered as strings and provided +There is no particularly convenient parser/printer support for the HOL {char} +type, but when combined into lists they are considered as strings and provided with more intuitive parser/printer support. There is a corresponding proof rule {STRING_EQ_CONV} for strings. diff --git a/Help/CHEAT_TAC.doc b/Help/CHEAT_TAC.doc index a6f707a7..3aa33eea 100644 --- a/Help/CHEAT_TAC.doc +++ b/Help/CHEAT_TAC.doc @@ -6,18 +6,18 @@ Proves goal by asserting it as an axiom. \DESCRIBE -Given any goal {A ?- p}, the tactic {CHEAT_TAC} solves it by using {mk_thm}, +Given any goal {A ?- p}, the tactic {CHEAT_TAC} solves it by using {mk_thm}, which in turn involves essentially asserting the goal as a new axiom. \FAILURE Never fails. \USES -Temporarily plugging boring parts of a proof to deal with the interesting +Temporarily plugging boring parts of a proof to deal with the interesting parts. \COMMENTS -Needless to say, this should be used with caution since once new axioms are +Needless to say, this should be used with caution since once new axioms are asserted there is no guarantee that logical consistency is preserved. \SEEALSO diff --git a/Help/CHOOSE_THEN.doc b/Help/CHOOSE_THEN.doc index d2ec1c77..8249b522 100644 --- a/Help/CHOOSE_THEN.doc +++ b/Help/CHOOSE_THEN.doc @@ -50,8 +50,8 @@ quantified theorems. For example one might use the inbuilt theorem `0 < (x + SUC d) * (x + SUC d)` } -\noindent which can then be finished off quite easily, by, for example just -{ARITH_TAC}, or +\noindent which can then be finished off quite easily, by, for example just +{ARITH_TAC}, or { # e(REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; LT_0]);; } diff --git a/Help/CHOOSE_UPPERCASE.doc b/Help/CHOOSE_UPPERCASE.doc index 399a9600..f9804dbe 100644 --- a/Help/CHOOSE_UPPERCASE.doc +++ b/Help/CHOOSE_UPPERCASE.doc @@ -23,7 +23,7 @@ produces the theorem {A1 u (A2 - {{s[v/x]}}) |- t}. \FAILURE Fails unless the terms and theorems correspond as indicated above; in particular, {v} must be a variable and have the same type as the variable -existentially quantified over, and it must not be free in {A2 - {{s[v/x]}}}, +existentially quantified over, and it must not be free in {A2 - {{s[v/x]}}}, {s} or {t}. \COMMENTS diff --git a/Help/CNF_CONV.doc b/Help/CNF_CONV.doc index 76a0709f..ba4c46c2 100644 --- a/Help/CNF_CONV.doc +++ b/Help/CNF_CONV.doc @@ -6,14 +6,14 @@ Converts a term already in negation normal form into conjunctive normal form. \DESCRIBE -When applied to a term already in negation normal form (see {NNF_CONV}), -meaning that all other propositional connectives have been eliminated in favour -of conjunction, disjunction and negation, and negation is only applied to -atomic formulas, {CNF_CONV} puts the term into an equivalent conjunctive normal -form, which is a right-associated conjunction of disjunctions without -repetitions. No reduction by subsumption is performed, however, e.g. from +When applied to a term already in negation normal form (see {NNF_CONV}), +meaning that all other propositional connectives have been eliminated in favour +of conjunction, disjunction and negation, and negation is only applied to +atomic formulas, {CNF_CONV} puts the term into an equivalent conjunctive normal +form, which is a right-associated conjunction of disjunctions without +repetitions. No reduction by subsumption is performed, however, e.g. from {a /\ (a \/ b)} to just {a}). - + \FAILURE Never fails; non-Boolean terms will just yield a reflexive theorem. diff --git a/Help/COMB2_CONV.doc b/Help/COMB2_CONV.doc index 8e5adccd..6e61405c 100644 --- a/Help/COMB2_CONV.doc +++ b/Help/COMB2_CONV.doc @@ -17,7 +17,7 @@ it fails if either {c1} or {c2} does, or if either returns a theorem that is of the wrong form. \COMMENTS -The special case when the two conversions are the same is more briefly achieved +The special case when the two conversions are the same is more briefly achieved using {COMB_CONV}. \SEEALSO diff --git a/Help/CONDS_CELIM_CONV.doc b/Help/CONDS_CELIM_CONV.doc index 5b909318..4a2d1611 100644 --- a/Help/CONDS_CELIM_CONV.doc +++ b/Help/CONDS_CELIM_CONV.doc @@ -20,7 +20,7 @@ Boolean. \EXAMPLE { - # CONDS_CELIM_CONV `y <= z ==> !x. (if x <= y then y else x) <= z`;; + # CONDS_CELIM_CONV `y <= z ==> !x. (if x <= y then y else x) <= z`;; val it : thm = |- y <= z ==> (!x. (if x <= y then y else x) <= z) <=> y <= z ==> (!x. (~(x <= y) \/ y <= z) /\ (x <= y \/ x <= z)) @@ -35,7 +35,7 @@ The function {CONDS_ELIM_CONV} is functionally similar, but will do the final propositional splitting in a ``disjunctive'' rather than ``conjunctive'' way. The disjunctive way is usually better when the term will subsequently be passed to a refutation procedure, whereas the conjunctive form is better for -non-refutation procedures. In each case, the policy is changed in an +non-refutation procedures. In each case, the policy is changed in an appropriate way after passing through quantifiers. \SEEALSO diff --git a/Help/CONJUNCTS_UPPERCASE.doc b/Help/CONJUNCTS_UPPERCASE.doc index cf41acb1..322bb144 100644 --- a/Help/CONJUNCTS_UPPERCASE.doc +++ b/Help/CONJUNCTS_UPPERCASE.doc @@ -23,7 +23,7 @@ Never fails. { # CONJUNCTS(ASSUME `(x /\ y) /\ z /\ w`);; val it : thm list = - [(x /\ y) /\ z /\ w |- x; (x /\ y) /\ z /\ w |- y; (x /\ y) /\ z /\ w + [(x /\ y) /\ z /\ w |- x; (x /\ y) /\ z /\ w |- y; (x /\ y) /\ z /\ w |- z; (x /\ y) /\ z /\ w |- w] } diff --git a/Help/CONJ_ACI_RULE.doc b/Help/CONJ_ACI_RULE.doc index d4f5d7f2..63cf3e2c 100644 --- a/Help/CONJ_ACI_RULE.doc +++ b/Help/CONJ_ACI_RULE.doc @@ -12,7 +12,7 @@ sides of the equation are conjunctions of exactly the same set of conjuncts, corresponding theorem {|- t1 /\ ... /\ tn <=> u1 /\ ... /\ um}. \FAILURE -Fails if applied to a term that is not a Boolean equation or the two sets of +Fails if applied to a term that is not a Boolean equation or the two sets of conjuncts are different. \EXAMPLE @@ -22,8 +22,8 @@ conjuncts are different. } \COMMENTS -The same effect can be had with the more general {AC} construct. However, for -the special case of conjunction, {CONJ_ACI_RULE} is substantially more +The same effect can be had with the more general {AC} construct. However, for +the special case of conjunction, {CONJ_ACI_RULE} is substantially more efficient when there are many conjuncts involved. \SEEALSO diff --git a/Help/CONV_TAC.doc b/Help/CONV_TAC.doc index 75b76445..e457787c 100644 --- a/Help/CONV_TAC.doc +++ b/Help/CONV_TAC.doc @@ -18,9 +18,9 @@ tactic {CONV_TAC c} reduces a goal {g} to the subgoal {g'}. More precisely, if =============== CONV_TAC c A ?- g' } -\noindent In the special case where {`g`} is {`T`}, the call immediately solves -the goal rather than generating a subgoal {A ?- T}. And in a slightly liberal -interpretation of ``conversion'', the conversion may also just prove the goal +\noindent In the special case where {`g`} is {`T`}, the call immediately solves +the goal rather than generating a subgoal {A ?- T}. And in a slightly liberal +interpretation of ``conversion'', the conversion may also just prove the goal and return {A' |- g}, in which case again the goal will be completely solved. Note that in all cases the conversion {c} should return a theorem whose @@ -46,10 +46,10 @@ equations (rewrite rules). For example, a goal: { # e(CONV_TAC REAL_RAT_REDUCE_CONV);; val it : goalstack = 1 subgoal (1 total) - + `abs (pi - &22 / &7) <= &1 / &791` } -It is also handy for invoking decision procedures that only have a ``rule'' +It is also handy for invoking decision procedures that only have a ``rule'' form, and no special ``tactic'' form. (Indeed, the tactic form can be defined in terms of the rule form by using {CONV_TAC}.) For example, the goal: { diff --git a/Help/DISJ_CASES_THEN2.doc b/Help/DISJ_CASES_THEN2.doc index b4e20eb6..783f44d0 100644 --- a/Help/DISJ_CASES_THEN2.doc +++ b/Help/DISJ_CASES_THEN2.doc @@ -62,7 +62,7 @@ also substituting: `PRE 0 = 0 <=> 0 = 0` } -\noindent Either subgoal can be finished with {ARITH_TAC}, but the way, but so +\noindent Either subgoal can be finished with {ARITH_TAC}, but the way, but so could the initial goal. \USES diff --git a/Help/EQT_ELIM.doc b/Help/EQT_ELIM.doc index e67f1d35..e2bee0ae 100644 --- a/Help/EQT_ELIM.doc +++ b/Help/EQT_ELIM.doc @@ -21,7 +21,7 @@ Fails if the argument theorem is not of the form {A |- tm <=> T}. { # REFL `T`;; val it : thm = |- T <=> T - + # EQT_ELIM it;; val it : thm = |- T } diff --git a/Help/ETA_CONV.doc b/Help/ETA_CONV.doc index 7a3e550c..e0f350b4 100644 --- a/Help/ETA_CONV.doc +++ b/Help/ETA_CONV.doc @@ -19,10 +19,10 @@ Fails if the input term is not an eta-redex. { # ETA_CONV `\n. SUC n`;; val it : thm = |- (\n. SUC n) = SUC - + # ETA_CONV `\n. 1 + n`;; val it : thm = |- (\n. 1 + n) = (+) 1 - + # ETA_CONV `\n. n + 1`;; Exception: Failure "ETA_CONV". } diff --git a/Help/EXISTS_EQUATION.doc b/Help/EXISTS_EQUATION.doc index f5cc643c..066ffade 100644 --- a/Help/EXISTS_EQUATION.doc +++ b/Help/EXISTS_EQUATION.doc @@ -6,19 +6,19 @@ Derives existence from explicit equational constraint. \DESCRIBE -Given a term {`x = t`} where {x} does not occur free in {t}, and a +Given a term {`x = t`} where {x} does not occur free in {t}, and a theorem {A |- p[x]}, the rule {EXISTS_EQUATION} returns -{A - {{x = t}} |- ?x. p[x]}. Normally, the equation {x = t} is one of the -hypotheses of the theorem, so this rule allows one to derive an existence +{A - {{x = t}} |- ?x. p[x]}. Normally, the equation {x = t} is one of the +hypotheses of the theorem, so this rule allows one to derive an existence assertion ignoring the actual ``definition''. \FAILURE -Fails if the term is not an equation, if the LHS is not a variable, or if the +Fails if the term is not an equation, if the LHS is not a variable, or if the variable occurs free in the RHS. \EXAMPLE { - # let th = (UNDISCH o EQT_ELIM o SIMP_CONV[ARITH]) + # let th = (UNDISCH o EQT_ELIM o SIMP_CONV[ARITH]) `x = 3 ==> ODD(x) /\ x > 2`;; val th : thm = x = 3 |- ODD x /\ x > 2 diff --git a/Help/EXPAND_TAC.doc b/Help/EXPAND_TAC.doc index 6c7ed682..5918a7d8 100644 --- a/Help/EXPAND_TAC.doc +++ b/Help/EXPAND_TAC.doc @@ -6,10 +6,10 @@ Expand an abbreviation in the hypotheses. \DESCRIBE -The tactic {EXPAND_TAC "x"}, applied to a goal, looks for a hypothesis of the -form {`t = x`} where {x} is a variable with the given name. It then replaces +The tactic {EXPAND_TAC "x"}, applied to a goal, looks for a hypothesis of the +form {`t = x`} where {x} is a variable with the given name. It then replaces {x} by {t} throughout the conclusion of the goal. - + \FAILURE Fails if there is no suitable assumption in the goal. @@ -26,9 +26,9 @@ Consider the final goal in the example given for {ABBREV_TAC}: { # e(EXPAND_TAC "n");; val it : goalstack = 1 subgoal (1 total) - + 0 [`12345 + 12345 = n`] - + `(12345 + 12345) + f (12345 + 12345) = f (12345 + 12345)` } diff --git a/Help/FIND_ASSUM.doc b/Help/FIND_ASSUM.doc index a57edf69..9aa94689 100644 --- a/Help/FIND_ASSUM.doc +++ b/Help/FIND_ASSUM.doc @@ -6,11 +6,11 @@ Apply a theorem-tactic to the the first assumption equal to given term. \DESCRIBE -The tactic {FIND_ASSUM ttac `t`} finds the first assumption whose conclusion is +The tactic {FIND_ASSUM ttac `t`} finds the first assumption whose conclusion is {t}, and applies {ttac} to it. If there is no such assumption, the call fails. \FAILURE -Fails if there is no assumption the same as the given term, or if the +Fails if there is no assumption the same as the given term, or if the theorem-tactic itself fails on the assumption. \EXAMPLE @@ -22,22 +22,22 @@ Suppose we set up this goal: { # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) - + 0 [`0 = x`] 1 [`y = 0`] - + `f (x + f y) = f (f (f x * x * y))` } -We can't just use {ASM_REWRITE_TAC[]} to solve the goal, but we can more +We can't just use {ASM_REWRITE_TAC[]} to solve the goal, but we can more directly use the assumptions: { - # e(FIND_ASSUM SUBST1_TAC `y = 0` THEN + # e(FIND_ASSUM SUBST1_TAC `y = 0` THEN FIND_ASSUM (SUBST1_TAC o SYM) `0 = x`);; val it : goalstack = 1 subgoal (1 total) - + 0 [`0 = x`] 1 [`y = 0`] - + `f (0 + f 0) = f (f (f 0 * 0 * 0))` } \noindent after which simple rewriting solves the goal: @@ -50,13 +50,13 @@ directly use the assumptions: Identifying an assumption to use by explicitly quoting it. \COMMENTS -A similar effect can be achieved by {ttac(ASSUME `t`)}. The use of {FIND_ASSUM} -may be considered preferable because it immediately fails if there is no -assumption {t}, whereas the {ASSUME} construct only generates a validity +A similar effect can be achieved by {ttac(ASSUME `t`)}. The use of {FIND_ASSUM} +may be considered preferable because it immediately fails if there is no +assumption {t}, whereas the {ASSUME} construct only generates a validity failure. Still, the the above example, it would have been a little briefer to write: { - # e(REWRITE_TAC[ASSUME `y = 0`; SYM(ASSUME `0 = x`); + # e(REWRITE_TAC[ASSUME `y = 0`; SYM(ASSUME `0 = x`); ADD_CLAUSES; MULT_CLAUSES]);; } diff --git a/Help/FIRST_ASSUM.doc b/Help/FIRST_ASSUM.doc index 4683f49c..02d848f0 100644 --- a/Help/FIRST_ASSUM.doc +++ b/Help/FIRST_ASSUM.doc @@ -16,7 +16,7 @@ The tactic \noindent has the effect of applying the first tactic which can be produced by {ttac} from the assumptions {(.. |- A1)}, ..., {(.. |- An)} and which succeeds when applied to the goal. Failures of {ttac} to produce a tactic are -ignored. The similar function {FIRST_X_ASSUM} is the same except that the +ignored. The similar function {FIRST_X_ASSUM} is the same except that the assumption used is then removed from the goal. \FAILURE diff --git a/Help/FORALL_UNWIND_CONV.doc b/Help/FORALL_UNWIND_CONV.doc index 586e25c3..d41b3e04 100644 --- a/Help/FORALL_UNWIND_CONV.doc +++ b/Help/FORALL_UNWIND_CONV.doc @@ -9,8 +9,8 @@ Eliminates universally quantified variables that are equated to something. conversion. \DESCRIBE -The conversion {FORALL_UNWIND_CONV}, applied to a formula with one or more -universal quantifiers around an implication, eliminates any quantifiers where +The conversion {FORALL_UNWIND_CONV}, applied to a formula with one or more +universal quantifiers around an implication, eliminates any quantifiers where the antecedent of the implication contains a conjunct equating its variable to some other term (with that variable not free in it). diff --git a/Help/F_F.doc b/Help/F_F.doc index f2d1b552..c5e15155 100644 --- a/Help/F_F.doc +++ b/Help/F_F.doc @@ -4,7 +4,7 @@ \SYNOPSIS -Infix operator. Applies two functions to a pair: +Infix operator. Applies two functions to a pair: {(f F_F g) (x,y)} = {(f x, g y)}. \KEYWORDS diff --git a/Help/GABS_CONV.doc b/Help/GABS_CONV.doc index 3ad51e30..30861d09 100644 --- a/Help/GABS_CONV.doc +++ b/Help/GABS_CONV.doc @@ -13,7 +13,7 @@ the conversion {ABS_CONV c} maps generalized abstractions of the form |- (\vs. t) = (\vs. t') } \noindent That is, {ABS_CONV c `\vs. t`} applies {c} to the body of the -generalized abstraction {`\vs. t`}. It is permissible to use it on a basic +generalized abstraction {`\vs. t`}. It is permissible to use it on a basic abstraction, in which case the effect is the same as {ABS_CONV}. \FAILURE diff --git a/Help/GEN.doc b/Help/GEN.doc index 94098c40..6528ab2f 100644 --- a/Help/GEN.doc +++ b/Help/GEN.doc @@ -29,7 +29,7 @@ This is a basic example: } \noindent while the following example shows how the above side-condition prevents the derivation of the theorem {x <=> T |- !x. x <=> T}, which is -invalid. +invalid. { # let t = ASSUME `x <=> T`;; val t : thm = x <=> T |- x <=> T diff --git a/Help/GENERAL_REWRITE_CONV.doc b/Help/GENERAL_REWRITE_CONV.doc index e2b71547..cc46cb4a 100644 --- a/Help/GENERAL_REWRITE_CONV.doc +++ b/Help/GENERAL_REWRITE_CONV.doc @@ -6,14 +6,14 @@ Rewrite with theorems as well as an existing net. \DESCRIBE -The call {GENERAL_REWRITE_CONV b cnvl net thl} will regard {thl} as rewrite -rules, and if {b = true}, also potentially as conditional rewrite rules. These -extra rules will be incorporated into the existing {net}, and rewriting applied +The call {GENERAL_REWRITE_CONV b cnvl net thl} will regard {thl} as rewrite +rules, and if {b = true}, also potentially as conditional rewrite rules. These +extra rules will be incorporated into the existing {net}, and rewriting applied with a search strategy {cnvl} (e.g. {DEPTH_CONV}). \COMMENTS -This is mostly for internal use, but it can sometimes be more efficient when -rewriting with large sets of theorems repeatedly if they are first composed +This is mostly for internal use, but it can sometimes be more efficient when +rewriting with large sets of theorems repeatedly if they are first composed into a net and then augmented like this. \SEEALSO diff --git a/Help/GEN_NNF_CONV.doc b/Help/GEN_NNF_CONV.doc index cf1b1af2..0bc0cac8 100644 --- a/Help/GEN_NNF_CONV.doc +++ b/Help/GEN_NNF_CONV.doc @@ -16,7 +16,7 @@ double negations eliminated. This function is very general. The first, boolean, argument determines how logical equivalences `{p <=> q}' are split. If the flag is {true}, toplevel equivalences are split ``conjunctively'' into `{(p \/ ~q) /\ (~p \/ q)}', while -if it is false they are split ``disjunctively'' into +if it is false they are split ``disjunctively'' into `{(p /\ q) \/ (~p /\ ~q)}'. At subformulas, the effect is modified appropriately in order to make the resulting formula simpler in conjunctive normal form (if the flag is true) or disjunctive normal form (if the flag is diff --git a/Help/GEN_REAL_ARITH.doc b/Help/GEN_REAL_ARITH.doc index e2d8f06f..c7dace40 100644 --- a/Help/GEN_REAL_ARITH.doc +++ b/Help/GEN_REAL_ARITH.doc @@ -7,9 +7,9 @@ Initial normalization and proof reconstruction wrapper for real decision procedure. \DESCRIBE -The function {GEN_REAL_ARITH} takes two arguments, the first of which is an -underlying `prover', and the second a term to prove. This function is mainly -intended for internal use: the function {REAL_ARITH} is essentially implemented +The function {GEN_REAL_ARITH} takes two arguments, the first of which is an +underlying `prover', and the second a term to prove. This function is mainly +intended for internal use: the function {REAL_ARITH} is essentially implemented as { GEN_REAL_ARITH REAL_LINEAR_PROVER @@ -31,14 +31,14 @@ proceeding with the proof, e.g. {REAL_LINEAR_PROVER} adds theorems {|- &0 <= &n} for relevant numeral terms {&n}. This is why the interface passes in a reconstruction function rather than simply expecting a Positivstellensatz refutation back. - + \FAILURE -Never fails at this stage, though it may fail when subsequently applied to a +Never fails at this stage, though it may fail when subsequently applied to a term. \EXAMPLE -As noted, the built-in decision procedure {REAL_ARITH} is a simple application. -See also the file {Examples/sos.ml}, where a more sophisticated nonlinear +As noted, the built-in decision procedure {REAL_ARITH} is a simple application. +See also the file {Examples/sos.ml}, where a more sophisticated nonlinear prover is plugged into {GEN_REAL_ARITH} in place of {REAL_LINEAR_PROVER}. \COMMENTS diff --git a/Help/HAS_SIZE_CONV.doc b/Help/HAS_SIZE_CONV.doc index 2fa50071..b67fa803 100644 --- a/Help/HAS_SIZE_CONV.doc +++ b/Help/HAS_SIZE_CONV.doc @@ -6,8 +6,8 @@ Converts statement about set's size into existential enumeration. \DESCRIBE -Given a term of the form {`s HAS_SIZE n`} for a numeral {n}, the conversion -{HAS_SIZE_CONV} returns an equivalent form postulating the existence of {n} +Given a term of the form {`s HAS_SIZE n`} for a numeral {n}, the conversion +{HAS_SIZE_CONV} returns an equivalent form postulating the existence of {n} pairwise distinct elements that make up the set. \FAILURE diff --git a/Help/HAS_SIZE_DIMINDEX_RULE.doc b/Help/HAS_SIZE_DIMINDEX_RULE.doc index cd030643..66ce18a2 100644 --- a/Help/HAS_SIZE_DIMINDEX_RULE.doc +++ b/Help/HAS_SIZE_DIMINDEX_RULE.doc @@ -8,7 +8,7 @@ Computes the {dimindex} for a standard finite type. \DESCRIBE Finite types parsed and printed as numerals are provided, and this conversion when applied to such a type of the form {`:n`} returns the theorem -{|- (:n) HAS_SIZE n} where the {(:n)} is the customary HOL Light printing of +{|- (:n) HAS_SIZE n} where the {(:n)} is the customary HOL Light printing of the universe set {UNIV:n->bool}, the second {n} is a numeral term and {HAS_SIZE} is the usual cardinality relation. diff --git a/Help/HIGHER_REWRITE_CONV.doc b/Help/HIGHER_REWRITE_CONV.doc index 5f0ccd04..9e0d238a 100644 --- a/Help/HIGHER_REWRITE_CONV.doc +++ b/Help/HIGHER_REWRITE_CONV.doc @@ -6,9 +6,9 @@ Rewrite once using more general higher order matching. \DESCRIBE -The call {HIGHER_REWRITE_CONV [th1;...;thn] flag t} will find a higher-order -match for the whole term {t} against one of the left-hand sides of the -equational theorems in the list {[th1;...;thn]}. Each such theorem should be of +The call {HIGHER_REWRITE_CONV [th1;...;thn] flag t} will find a higher-order +match for the whole term {t} against one of the left-hand sides of the +equational theorems in the list {[th1;...;thn]}. Each such theorem should be of the form {|- P pat <=> t} where {f} is a variable. A free subterm {pat'} of {t} will be found that matches (in the usual restricted higher-order sense) the pattern {pat}. If the {flag} argument is true, this will be some topmost diff --git a/Help/IMP_REWR_CONV.doc b/Help/IMP_REWR_CONV.doc index 95746ac9..44ddaa20 100644 --- a/Help/IMP_REWR_CONV.doc +++ b/Help/IMP_REWR_CONV.doc @@ -6,15 +6,15 @@ Basic conditional rewriting conversion. \DESCRIBE -Given an equational theorem {A |- !x1...xn. p ==> s = t} that expresses a +Given an equational theorem {A |- !x1...xn. p ==> s = t} that expresses a conditional rewrite rule, the conversion {IMP_REWR_CONV} gives a conversion that applied to any term {s'} will attempt to match the left-hand side of the -equation {s = t} to {s'}, and return the corresponding theorem +equation {s = t} to {s'}, and return the corresponding theorem {A |- p' ==> s' = t'}. \FAILURE -Fails if the theorem is not of the right form or the two terms cannot be -matched, for example because the variables that need to be instantiated are +Fails if the theorem is not of the right form or the two terms cannot be +matched, for example because the variables that need to be instantiated are free in the hypotheses {A}. \EXAMPLE @@ -30,7 +30,7 @@ We use the following theorem: } \USES -One of the building-blocks for conditional rewriting as implemented by +One of the building-blocks for conditional rewriting as implemented by {SIMP_CONV}, {SIMP_RULE}, {SIMP_TAC} etc. \SEEALSO diff --git a/Help/INSTANTIATE_ALL.doc b/Help/INSTANTIATE_ALL.doc index 7be0caae..026a1335 100644 --- a/Help/INSTANTIATE_ALL.doc +++ b/Help/INSTANTIATE_ALL.doc @@ -10,14 +10,14 @@ The call {INSTANTIATE_ALL i t}, where {i} is an instantiation as returned by {term_match}, will perform the instantiation indicated by {i} in the conclusion of the theorem {th}: types and terms will be instantiated and the beta-reductions that are part of higher-order matching will be applied. - + \FAILURE Never fails on a valid instantiation. \COMMENTS -This is not intended for general use. {PART_MATCH} is generally a more -convenient packaging. The function {INSTANTIATE} is almost the same but does -not instantiate hypotheses and may fail if type variables or term variables +This is not intended for general use. {PART_MATCH} is generally a more +convenient packaging. The function {INSTANTIATE} is almost the same but does +not instantiate hypotheses and may fail if type variables or term variables free in the hypotheses make the instantiation impossible. \SEEALSO diff --git a/Help/INSTANTIATE_UPPERCASE.doc b/Help/INSTANTIATE_UPPERCASE.doc index 5988c9d8..d0791f99 100644 --- a/Help/INSTANTIATE_UPPERCASE.doc +++ b/Help/INSTANTIATE_UPPERCASE.doc @@ -10,9 +10,9 @@ The call {INSTANTIATE i t}, where {i} is an instantiation as returned by {term_match}, will perform the instantiation indicated by {i} in the conclusion of the theorem {th}: types and terms will be instantiated and the beta-reductions that are part of higher-order matching will be applied. - + \FAILURE -Fails if the instantiation is impossible because of free term or type variables +Fails if the instantiation is impossible because of free term or type variables in the hypotheses. \EXAMPLE @@ -28,7 +28,7 @@ in the hypotheses. } \COMMENTS -This is not intended for general use. {PART_MATCH} is generally a more +This is not intended for general use. {PART_MATCH} is generally a more convenient packaging. \SEEALSO diff --git a/Help/INST_TYPE.doc b/Help/INST_TYPE.doc index 091ae034..d66322c6 100644 --- a/Help/INST_TYPE.doc +++ b/Help/INST_TYPE.doc @@ -9,8 +9,8 @@ Instantiates types in a theorem. rule, type, instantiate. \DESCRIBE -{INST_TYPE [ty1,tv1;...;tyn,tvn]} will systematically replaces all instances of -each type variable {tvi} by the corresponding type {tyi} in both assumptions +{INST_TYPE [ty1,tv1;...;tyn,tvn]} will systematically replaces all instances of +each type variable {tvi} by the corresponding type {tyi} in both assumptions and conclusions of a theorem: { A |- t diff --git a/Help/INTEGER_RULE.doc b/Help/INTEGER_RULE.doc index cacb148f..a6d5c6b6 100644 --- a/Help/INTEGER_RULE.doc +++ b/Help/INTEGER_RULE.doc @@ -7,29 +7,29 @@ Automatically prove elementary divisibility property over the integers. \DESCRIBE {INTEGER_RULE} is a partly heuristic rule that can often -automatically prove elementary ``divisibility'' properties of the integers. The -precise subset that is dealt with is difficult to describe rigorously, but many -universally quantified combinations of {divides}, {coprime}, {gcd} and -congruences {(x == y) (mod n)} can be proved automatically, as well as some -existentially quantified goals. The examples below may give a feel for what can +automatically prove elementary ``divisibility'' properties of the integers. The +precise subset that is dealt with is difficult to describe rigorously, but many +universally quantified combinations of {divides}, {coprime}, {gcd} and +congruences {(x == y) (mod n)} can be proved automatically, as well as some +existentially quantified goals. The examples below may give a feel for what can be done. \FAILURE Fails if the goal is not accessible to the methods used. \EXAMPLE -All sorts of elementary Boolean combinations of divisibility and congruence +All sorts of elementary Boolean combinations of divisibility and congruence properties can be solved, e.g. { - # INTEGER_RULE + # INTEGER_RULE `!x y n:int. (x == y) (mod n) ==> (n divides x <=> n divides y)`;; ... val it : thm = |- !x y n. (x == y) (mod n) ==> (n divides x <=> n divides y) - # INTEGER_RULE + # INTEGER_RULE `!a b d:int. d divides gcd(a,b) <=> d divides a /\ d divides b`;; ... - val it : thm = + val it : thm = |- !a b d. d divides gcd (a,b) <=> d divides a /\ d divides b } \noindent including some less obvious ones: @@ -40,7 +40,7 @@ properties can be solved, e.g. val it : thm = |- !x y. coprime (x * y,x pow 2 + y pow 2) <=> coprime (x,y) } \noindent A limited class of existential goals is solvable too, e.g. a classic -sufficient condition for a linear congruence to have a solution: +sufficient condition for a linear congruence to have a solution: { # INTEGER_RULE `!a b n:int. coprime(a,n) ==> ?x. (a * x == b) (mod n)`;; ... diff --git a/Help/INTRO_TAC.doc b/Help/INTRO_TAC.doc index 96f7755d..b2e033d0 100644 --- a/Help/INTRO_TAC.doc +++ b/Help/INTRO_TAC.doc @@ -64,20 +64,20 @@ variables x1, x2 into n, n'. All is done in a single tactic invocation. # g `!a. ~(a = 0) ==> ONE_ONE (\n. a * n)`;; # e (REWRITE_TAC[ONE_ONE; EQ_MULT_LCANCEL]);; val it : goalstack = 1 subgoal (1 total) - + `!a. ~(a = 0) ==> (!x1 x2. a = 0 \/ x1 = x2 ==> x1 = x2)` - + # e (INTRO_TAC "!a; anz; ![n] [n']; az | eq");; val it : goalstack = 2 subgoals (2 total) - + 0 [`~(a = 0)`] (anz) 1 [`n = n'`] (eq) - + `n = n'` - + 0 [`~(a = 0)`] (anz) 1 [`a = 0`] (az) - + `n = n'` } diff --git a/Help/INT_POLY_CONV.doc b/Help/INT_POLY_CONV.doc index 5e3dd71e..3586dfbb 100644 --- a/Help/INT_POLY_CONV.doc +++ b/Help/INT_POLY_CONV.doc @@ -30,17 +30,17 @@ This illustrates how terms are `multiplied out': \noindent while the following verifies a remarkable `sum of cubes' identity due to Yasutoshi Kohmoto: { - # INT_POLY_CONV - `(&1679616 * a pow 16 - &66096 * a pow 10 * b pow 6 + - &153 * a pow 4 * b pow 12) pow 3 + - (-- &1679616 * a pow 16 - &559872 * a pow 13 * b pow 3 - - &27216 * a pow 10 * b pow 6 + &3888 * a pow 7 * b pow 9 + - &63 * a pow 4 * b pow 12 - &3 * a * b pow 15) pow 3 + - (&1679616 * a pow 15 * b + &279936 * a pow 12 * b pow 4 - - &11664 * a pow 9 * b pow 7 - + # INT_POLY_CONV + `(&1679616 * a pow 16 - &66096 * a pow 10 * b pow 6 + + &153 * a pow 4 * b pow 12) pow 3 + + (-- &1679616 * a pow 16 - &559872 * a pow 13 * b pow 3 - + &27216 * a pow 10 * b pow 6 + &3888 * a pow 7 * b pow 9 + + &63 * a pow 4 * b pow 12 - &3 * a * b pow 15) pow 3 + + (&1679616 * a pow 15 * b + &279936 * a pow 12 * b pow 4 - + &11664 * a pow 9 * b pow 7 - &648 * a pow 6 * b pow 10 + &9 * a pow 3 * b pow 13 + b pow 16) pow 3`;; val it : thm = - |- ... = + |- ... = b pow 48 } diff --git a/Help/INT_REM_DOWN_CONV.doc b/Help/INT_REM_DOWN_CONV.doc index bdcb356c..668ca846 100644 --- a/Help/INT_REM_DOWN_CONV.doc +++ b/Help/INT_REM_DOWN_CONV.doc @@ -8,7 +8,7 @@ Combines nested {rem} terms into a single toplevel one. \DESCRIBE When applied to a term containing integer arithmetic operations of negation, addition, subtraction, multiplication and exponentiation, -interspersed with applying {rem} with a fixed modulus {n}, and a toplevel +interspersed with applying {rem} with a fixed modulus {n}, and a toplevel {... rem n} too, the conversion {INT_REM_DOWN_CONV} proves that this is equal to a simplified term with only the toplevel {rem}. diff --git a/Help/INT_RING.doc b/Help/INT_RING.doc index a9f59db8..e4fc15d3 100644 --- a/Help/INT_RING.doc +++ b/Help/INT_RING.doc @@ -23,10 +23,10 @@ valid on all integral domains (see below). \EXAMPLE Here is a nice identity taken from one of Ramanujan's notebooks: { - # INT_RING + # INT_RING `!a b c:int. a + b + c = &0 - ==> &2 * (a * b + a * c + b * c) pow 2 = + ==> &2 * (a * b + a * c + b * c) pow 2 = a pow 4 + b pow 4 + c pow 4 /\ &2 * (a * b + a * c + b * c) pow 4 = (a * (b - c)) pow 4 + (b * (a - c)) pow 4 + (c * (a - b)) pow 4`;; @@ -38,7 +38,7 @@ Here is a nice identity taken from one of Ramanujan's notebooks: &2 * (a * b + a * c + b * c) pow 4 = (a * (b - c)) pow 4 + (b * (a - c)) pow 4 + (c * (a - b)) pow 4 } -The reasoning {INT_RING} is capable of includes, of course, the degenerate case +The reasoning {INT_RING} is capable of includes, of course, the degenerate case of simple algebraic identity, e.g. Brahmagupta's identity: { # INT_RING `(a pow 2 + b pow 2) * (c pow 2 + d pow 2) = diff --git a/Help/ISPEC.doc b/Help/ISPEC.doc index ecfbe65e..725f31df 100644 --- a/Help/ISPEC.doc +++ b/Help/ISPEC.doc @@ -10,7 +10,7 @@ rule, type. \DESCRIBE This rule specializes a quantified variable as does {SPEC}; it differs -from it in also instantiating the type if needed, both in the conclusion and +from it in also instantiating the type if needed, both in the conclusion and hypotheses: { A |- !x:ty.tm diff --git a/Help/ISPECL.doc b/Help/ISPECL.doc index 85732b1b..0b33e65c 100644 --- a/Help/ISPECL.doc +++ b/Help/ISPECL.doc @@ -15,7 +15,7 @@ rule, type. ----------------------------- ISPECL [`t1`,...,`tn`] A' |- t[t1,...tn/x1,...,xn] } -\noindent (where {ti} is free for {xi} in {tm}) in which {A'} results from +\noindent (where {ti} is free for {xi} in {tm}) in which {A'} results from applying all the corresponding type instantiations to the assumption list {A}. \FAILURE diff --git a/Help/LAND_CONV.doc b/Help/LAND_CONV.doc index d2e4e39a..2a38eac2 100644 --- a/Help/LAND_CONV.doc +++ b/Help/LAND_CONV.doc @@ -6,11 +6,11 @@ Apply a conversion to left-hand argument of binary operator. \DESCRIBE -If {c} is a conversion where {c `l`} gives {|- l = l'}, then +If {c} is a conversion where {c `l`} gives {|- l = l'}, then {LAND_CONV c `op l r`} gives {|- op l r = op l' r}. - + \FAILURE -Fails if the underlying conversion does or returns an inappropriate theorem +Fails if the underlying conversion does or returns an inappropriate theorem (i.e. is not really a conversion). \EXAMPLE diff --git a/Help/LIST_CONV.doc b/Help/LIST_CONV.doc index 62171464..d0a825dd 100644 --- a/Help/LIST_CONV.doc +++ b/Help/LIST_CONV.doc @@ -6,7 +6,7 @@ Apply a conversion to each element of a list. \DESCRIBE -If {cnv `ti`} returns {|- ti = ti'} for {i} ranging from {1} to {n}, then +If {cnv `ti`} returns {|- ti = ti'} for {i} ranging from {1} to {n}, then {LIST_CONV cnv `[t1; ...; tn]`} returns {|- [t1; ...; tn] = [t1'; ...; tn']}. \FAILURE diff --git a/Help/MATCH_ACCEPT_TAC.doc b/Help/MATCH_ACCEPT_TAC.doc index 010be0b9..db80e5bc 100644 --- a/Help/MATCH_ACCEPT_TAC.doc +++ b/Help/MATCH_ACCEPT_TAC.doc @@ -25,12 +25,12 @@ Fails unless the theorem has a conclusion which is instantiable to match that of the goal. \EXAMPLE -The following example shows variable and type instantiation at work. Suppose we +The following example shows variable and type instantiation at work. Suppose we have the following simple goal: { # g `HD [1;2] = 1`;; } -\noindent we can do it via the polymorphic theorem +\noindent we can do it via the polymorphic theorem {HD = |- !h t. HD(CONS h t) = h}: { # e(MATCH_ACCEPT_TAC HD);; diff --git a/Help/MATCH_CONV.doc b/Help/MATCH_CONV.doc index e7054dcb..3284b10a 100644 --- a/Help/MATCH_CONV.doc +++ b/Help/MATCH_CONV.doc @@ -36,8 +36,8 @@ reduction is performed: (function CONS h t -> h + 1) [1; 2; 3; 4] } \noindent so the conversion may need to be repeated: -{ - # TOP_DEPTH_CONV MATCH_CONV +{ + # TOP_DEPTH_CONV MATCH_CONV `(function [] -> 0 | CONS h t -> h + 1) [1;2;3;4]`;; val it : thm = |- (function [] -> 0 | CONS h t -> h + 1) [1; 2; 3; 4] = 1 + 1 } diff --git a/Help/META_EXISTS_TAC.doc b/Help/META_EXISTS_TAC.doc index f1ba105d..dabb0414 100644 --- a/Help/META_EXISTS_TAC.doc +++ b/Help/META_EXISTS_TAC.doc @@ -18,11 +18,11 @@ Never fails. See {UNIFY_ACCEPT_TAC} for an example of using metavariables. \USES -Delaying instantiations until the correct term becomes clearer. +Delaying instantiations until the correct term becomes clearer. \COMMENTS -Users should probably steer clear of using metavariables if possible. Note that -the metavariable instantiations apply across the whole fringe of goals, not +Users should probably steer clear of using metavariables if possible. Note that +the metavariable instantiations apply across the whole fringe of goals, not just the current goal, and can lead to confusion. \SEEALSO diff --git a/Help/META_SPEC_TAC.doc b/Help/META_SPEC_TAC.doc index 685a8e95..af2bb958 100644 --- a/Help/META_SPEC_TAC.doc +++ b/Help/META_SPEC_TAC.doc @@ -23,7 +23,7 @@ Delaying instantiations until the right choice becomes clearer. \COMMENTS Users should probably steer clear of using metavariables if possible. Note that -the metavariable instantiations apply across the whole fringe of goals, not +the metavariable instantiations apply across the whole fringe of goals, not just the current goal, and can lead to confusion. \SEEALSO diff --git a/Help/MK_COMB_TAC.doc b/Help/MK_COMB_TAC.doc index 49888964..6b9e9bee 100644 --- a/Help/MK_COMB_TAC.doc +++ b/Help/MK_COMB_TAC.doc @@ -3,12 +3,12 @@ \TYPE {MK_COMB_TAC : tactic} \SYNOPSIS -Breaks down a goal between function applications into equality of functions and +Breaks down a goal between function applications into equality of functions and arguments. \DESCRIBE -Given a goal whose conclusion is an equation between function applications -{A ?- f x = g y}, the tactic {MK_COMB_TAC} breaks it down to two subgoals +Given a goal whose conclusion is an equation between function applications +{A ?- f x = g y}, the tactic {MK_COMB_TAC} breaks it down to two subgoals expressing equality of the corresponding rators and rands: { A ?- f x = g y diff --git a/Help/MK_EXISTS_UPPERCASE.doc b/Help/MK_EXISTS_UPPERCASE.doc index bd09a27e..8c95f050 100644 --- a/Help/MK_EXISTS_UPPERCASE.doc +++ b/Help/MK_EXISTS_UPPERCASE.doc @@ -6,9 +6,9 @@ Existentially quantifies both sides of equational theorem. \DESCRIBE -Given a theorem {th} whose conclusion is a Boolean equation (iff), the rule +Given a theorem {th} whose conclusion is a Boolean equation (iff), the rule {MK_EXISTS `v` th} existentially quantifies both sides of {th} over the -variable {v}, provided it is not free in the hypotheses +variable {v}, provided it is not free in the hypotheses { A |- p <=> q ---------------------------- MK_EXISTS `v` [where v not free in A] @@ -16,7 +16,7 @@ variable {v}, provided it is not free in the hypotheses } \FAILURE -Fails if the term is not a variable or is free in the hypotheses of the +Fails if the term is not a variable or is free in the hypotheses of the theorem, or if the theorem does not have a Boolean equation for its conclusion. \EXAMPLE diff --git a/Help/MK_FORALL_UPPERCASE.doc b/Help/MK_FORALL_UPPERCASE.doc index a87b3c86..75a8d98a 100644 --- a/Help/MK_FORALL_UPPERCASE.doc +++ b/Help/MK_FORALL_UPPERCASE.doc @@ -6,8 +6,8 @@ Universally quantifies both sides of equational theorem. \DESCRIBE -Given a theorem {th} whose conclusion is a Boolean equation (iff), the rule -{MK_FORALL `v` th} universally quantifies both sides of {th} over the variable +Given a theorem {th} whose conclusion is a Boolean equation (iff), the rule +{MK_FORALL `v` th} universally quantifies both sides of {th} over the variable {v}, provided it is not free in the hypotheses { A |- p <=> q @@ -16,14 +16,14 @@ Given a theorem {th} whose conclusion is a Boolean equation (iff), the rule } \FAILURE -Fails if the term is not a variable or is free in the hypotheses of the +Fails if the term is not a variable or is free in the hypotheses of the theorem, or if the theorem does not have a Boolean equation for its conclusion. \EXAMPLE { # let th = ARITH_RULE `f(x:A) >= 1 <=> ~(f(x) = 0)`;; val th : thm = |- f x >= 1 <=> ~(f x = 0) - + # MK_FORALL `x:A` th;; val it : thm = |- (!x. f x >= 1) <=> (!x. ~(f x = 0)) } diff --git a/Help/MOD_DOWN_CONV.doc b/Help/MOD_DOWN_CONV.doc index 9bb809f7..e52e2fa0 100644 --- a/Help/MOD_DOWN_CONV.doc +++ b/Help/MOD_DOWN_CONV.doc @@ -19,7 +19,7 @@ Never fails but may have no effect { # let tm = `((x MOD n) + (y MOD n * 3) EXP 2) MOD n`;; val tm : term = `(x MOD n + (y MOD n * 3) EXP 2) MOD n` - + # MOD_DOWN_CONV tm;; val it : thm = |- (x MOD n + (y MOD n * 3) EXP 2) MOD n = (x + (y * 3) EXP 2) MOD n diff --git a/Help/MONO_TAC.doc b/Help/MONO_TAC.doc index 43e5c42a..6cd933de 100644 --- a/Help/MONO_TAC.doc +++ b/Help/MONO_TAC.doc @@ -16,14 +16,14 @@ We set up the following goal: # g `(!x. P x ==> Q x) ==> (?y. P y /\ ~Q y) ==> (?y. Q y /\ ~P y)`;; ... } -\noindent and after breaking it down, we reach the standard form expected for +\noindent and after breaking it down, we reach the standard form expected for monotonicity goals: { # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) - + 0 [`!x. P x ==> Q x`] - + `(?y. P y /\ ~Q y) ==> (?y. Q y /\ ~P y)` } \noindent Indeed, it is solved automatically: @@ -33,11 +33,11 @@ monotonicity goals: } \COMMENTS -Normally, this kind of reasoning is automated by the inductive definitions +Normally, this kind of reasoning is automated by the inductive definitions package, so explicit use of this tactic is rare. \SEEALSO -monotonicity_theorems, new_inductive_definition, +monotonicity_theorems, new_inductive_definition, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC diff --git a/Help/MP_CONV.doc b/Help/MP_CONV.doc index 36c2ee5d..9668b869 100644 --- a/Help/MP_CONV.doc +++ b/Help/MP_CONV.doc @@ -6,19 +6,19 @@ Removes antecedent of implication theorem by solving it with a conversion. \DESCRIBE -The call {MP_CONV conv th}, where the theorem {th} has the form {A |- p ==> q}, -attempts to solve the antecedent {p} by applying the conversion {conv} to it. -If this conversion returns either {|- p} or {|- p <=> T}, then {MP_CONV} +The call {MP_CONV conv th}, where the theorem {th} has the form {A |- p ==> q}, +attempts to solve the antecedent {p} by applying the conversion {conv} to it. +If this conversion returns either {|- p} or {|- p <=> T}, then {MP_CONV} returns {A |- q}. Otherwise it fails. \FAILURE -Fails if the conclusion of the theorem is not implicational or if the +Fails if the conclusion of the theorem is not implicational or if the conversion fails to prove its antecedent. \EXAMPLE Suppose we generate this `epsilon-delta' theorem: { - # let th = MESON[LE_REFL] + # let th = MESON[LE_REFL] `(!e. &0 < e / &2 <=> &0 < e) /\ (!a x y e. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 ==> abs(x - y) < e) ==> (!e. &0 < e ==> ?n. !m. n <= m ==> abs(x m - a) < e) diff --git a/Help/NNF_CONV.doc b/Help/NNF_CONV.doc index 6ca0c66f..cb1ca89a 100644 --- a/Help/NNF_CONV.doc +++ b/Help/NNF_CONV.doc @@ -26,15 +26,15 @@ Never fails; on non-Boolean terms it just returns a reflexive theorem. } \USES -Mostly useful as a prelude to automated proof procedures, but users may +Mostly useful as a prelude to automated proof procedures, but users may sometimes find it useful. \COMMENTS -A toplevel equivalence {p <=> q} is converted to {(p /\ q) \/ (~p /\ ~q)}. In -general this ``splitting'' of equivalences is done with the expectation that -the final formula may be put into disjunctive normal form (DNF), as a prelude -to a refutation procedure. An otherwise similar conversion {NNFC_CONV} prefers -a `conjunctive' splitting and is better suited for a term that will later be +A toplevel equivalence {p <=> q} is converted to {(p /\ q) \/ (~p /\ ~q)}. In +general this ``splitting'' of equivalences is done with the expectation that +the final formula may be put into disjunctive normal form (DNF), as a prelude +to a refutation procedure. An otherwise similar conversion {NNFC_CONV} prefers +a `conjunctive' splitting and is better suited for a term that will later be translated to CNF. \SEEALSO diff --git a/Help/NO_TAC.doc b/Help/NO_TAC.doc index 09feffc7..b1f85193 100644 --- a/Help/NO_TAC.doc +++ b/Help/NO_TAC.doc @@ -19,13 +19,13 @@ However trivial the goal, {NO_TAC} always fails: { # g `T`;; val it : goalstack = 1 subgoal (1 total) - + `T` - + # e NO_TAC;; Exception: Failure "NO_TAC". } -\noindent however, {tac THEN NO_TAC} will never reach {NO_TAC} if {tac} leaves +\noindent however, {tac THEN NO_TAC} will never reach {NO_TAC} if {tac} leaves no subgoals: { # e(REWRITE_TAC[] THEN NO_TAC);; @@ -33,14 +33,14 @@ no subgoals: } \USES -Can be useful in forcing certain ``speculative'' tactics to fail unless they -solve the goal completely. For example, you might wish to break down a huge -conjunction of goals and attempt to solve as many conjuncts as possible by +Can be useful in forcing certain ``speculative'' tactics to fail unless they +solve the goal completely. For example, you might wish to break down a huge +conjunction of goals and attempt to solve as many conjuncts as possible by just rewriting with a list of theorems {[thl]}. You could do: { REPEAT CONJ_TAC THEN REWRITE_TAC[thl] } -\noindent However, if you don't want to apply the rewrites unless they result +\noindent However, if you don't want to apply the rewrites unless they result in an immediate solution, you can do instead: { REPEAT CONJ_TAC THEN TRY(REWRITE_TAC[thl] THEN NO_TAC) diff --git a/Help/NUMBER_RULE.doc b/Help/NUMBER_RULE.doc index bdcd8845..32c18acb 100644 --- a/Help/NUMBER_RULE.doc +++ b/Help/NUMBER_RULE.doc @@ -11,7 +11,7 @@ elementary ``divisibility'' properties of the natural numbers. The precise subset that is dealt with is difficult to describe rigorously, but many universally quantified combinations of {divides}, {coprime}, {gcd} and congruences {(x == y) (mod n)} can be proved automatically, as well as some -existentially quantified goals. See a similar rule {INTEGER_RULE} for the +existentially quantified goals. See a similar rule {INTEGER_RULE} for the integers for a representative set of examples. \FAILURE @@ -21,9 +21,9 @@ Fails if the goal is not accessible to the methods used. Here is a typical example, which would be rather tedious to prove manually: { # NUMBER_RULE - `!a b a' b'. ~(gcd(a,b) = 0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b) + `!a b a' b'. ~(gcd(a,b) = 0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b) ==> coprime(a',b')`;; - ... + ... val it : thm = |- !a b a' b'. ~(gcd (a,b) = 0) /\ a = a' * gcd (a,b) /\ b = b' * gcd (a,b) diff --git a/Help/NUMBER_TAC.doc b/Help/NUMBER_TAC.doc index b17f5791..8bc2859b 100644 --- a/Help/NUMBER_TAC.doc +++ b/Help/NUMBER_TAC.doc @@ -19,11 +19,11 @@ documentation for {INTEGER_RULE} for a larger set of representative examples. Fails if the goal is not accessible to the methods used. \EXAMPLE -A typical elementary divisibility property is that if two numbers are congruent -with respect to two coprime (without non-trivial common factors) moduli, then +A typical elementary divisibility property is that if two numbers are congruent +with respect to two coprime (without non-trivial common factors) moduli, then they are congruent with respect to their product: { - # g `!m n x y:num. (x == y) (mod m) /\ (x == y) (mod n) /\ coprime(m,n) + # g `!m n x y:num. (x == y) (mod m) /\ (x == y) (mod n) /\ coprime(m,n) ==> (x == y) (mod (m * n))`;; ... } @@ -33,7 +33,7 @@ they are congruent with respect to their product: ... val it : goalstack = No subgoals } -The analogous goal without the coprimality assumption will fail, and indeed the +The analogous goal without the coprimality assumption will fail, and indeed the goal would be false without it. \SEEALSO diff --git a/Help/NUM_EVEN_CONV.doc b/Help/NUM_EVEN_CONV.doc index 3ae47be8..569d66c0 100644 --- a/Help/NUM_EVEN_CONV.doc +++ b/Help/NUM_EVEN_CONV.doc @@ -16,12 +16,12 @@ returns one of the theorems: } \noindent or { - |- EVEN(n) <=> F + |- EVEN(n) <=> F } \noindent according to whether the number denoted by {n} is even. \FAILURE -Fails if applied to a term that is not of the form {`EVEN n`} with {n} a +Fails if applied to a term that is not of the form {`EVEN n`} with {n} a numeral. \EXAMPLE @@ -34,7 +34,7 @@ numeral. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EXP_CONV, NUM_FACT_CONV, -NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, +NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. diff --git a/Help/NUM_EXP_CONV.doc b/Help/NUM_EXP_CONV.doc index 8905ccd1..ee6ce99b 100644 --- a/Help/NUM_EXP_CONV.doc +++ b/Help/NUM_EXP_CONV.doc @@ -14,7 +14,7 @@ If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then { |- n EXP m = s } -\noindent where {s} is the numeral that denotes the natural number denoted by +\noindent where {s} is the numeral that denotes the natural number denoted by {n} raised to the power of the one denoted by {m}. \FAILURE @@ -38,7 +38,7 @@ If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_FACT_CONV, -NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, +NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. diff --git a/Help/NUM_FACT_CONV.doc b/Help/NUM_FACT_CONV.doc index 9cf79c32..ba1c7184 100644 --- a/Help/NUM_FACT_CONV.doc +++ b/Help/NUM_FACT_CONV.doc @@ -14,7 +14,7 @@ If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then { |- FACT n = s } -\noindent where {s} is the numeral that denotes the factorial of the natural +\noindent where {s} is the numeral that denotes the factorial of the natural number denoted by {n}. \FAILURE @@ -35,7 +35,7 @@ numeral. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, -NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, +NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. diff --git a/Help/NUM_GE_CONV.doc b/Help/NUM_GE_CONV.doc index 73748a72..e9bf815e 100644 --- a/Help/NUM_GE_CONV.doc +++ b/Help/NUM_GE_CONV.doc @@ -10,12 +10,12 @@ conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then -{NUM_GE_CONV `n >= m`} returns: +{NUM_GE_CONV `n >= m`} returns: { |- n >= m <=> T or |- n >= m <=> F } -\noindent depending on whether the natural number represented by {n} is greater +\noindent depending on whether the natural number represented by {n} is greater than or equal to the one represented by {m}. \FAILURE @@ -26,17 +26,17 @@ are numerals. { # NUM_GE_CONV `1 >= 0`;; val it : thm = |- 1 >= 0 <=> T - + # NUM_GE_CONV `181 >= 211`;; val it : thm = |- 181 >= 211 <=> F } - + \USES -Performing basic arithmetic reasoning while producing a proof. +Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, -NUM_FACT_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, +NUM_FACT_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. diff --git a/Help/NUM_GT_CONV.doc b/Help/NUM_GT_CONV.doc index 0813457d..f178afdd 100644 --- a/Help/NUM_GT_CONV.doc +++ b/Help/NUM_GT_CONV.doc @@ -10,12 +10,12 @@ conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then -{NUM_GT_CONV `n > m`} returns: +{NUM_GT_CONV `n > m`} returns: { |- n > m <=> T or |- n > m <=> F } -\noindent depending on whether the natural number represented by {n} is greater +\noindent depending on whether the natural number represented by {n} is greater than the one represented by {m}. \FAILURE @@ -26,17 +26,17 @@ are numerals. { # NUM_GT_CONV `3 > 2`;; val it : thm = |- 3 > 2 <=> T - + # NUM_GT_CONV `77 > 77`;; val it : thm = |- 77 > 77 <=> F } - + \USES -Performing basic arithmetic reasoning while producing a proof. +Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, -NUM_FACT_CONV, NUM_GE_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, +NUM_FACT_CONV, NUM_GE_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. diff --git a/Help/NUM_LE_CONV.doc b/Help/NUM_LE_CONV.doc index f2b1a96a..f6603d9d 100644 --- a/Help/NUM_LE_CONV.doc +++ b/Help/NUM_LE_CONV.doc @@ -10,12 +10,12 @@ conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then -{NUM_LE_CONV `n <= m`} returns: +{NUM_LE_CONV `n <= m`} returns: { |- n <= m <=> T or |- n <= m <=> F } -\noindent depending on whether the natural number represented by {n} is less +\noindent depending on whether the natural number represented by {n} is less than or equal to the one represented by {m}. \FAILURE @@ -26,17 +26,17 @@ are numerals. { # NUM_LE_CONV `12 <= 19`;; val it : thm = |- 12 <= 19 <=> T - + # NUM_LE_CONV `12345 <= 12344`;; val it : thm = |- 12345 <= 12344 <=> F } - + \USES -Performing basic arithmetic reasoning while producing a proof. +Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, -NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LT_CONV, NUM_MAX_CONV, +NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. diff --git a/Help/NUM_LT_CONV.doc b/Help/NUM_LT_CONV.doc index 44c4f3af..29073cb3 100644 --- a/Help/NUM_LT_CONV.doc +++ b/Help/NUM_LT_CONV.doc @@ -3,36 +3,36 @@ \TYPE {NUM_LT_CONV : conv} \SYNOPSIS -Proves whether one numeral is less than another. - +Proves whether one numeral is less than another. + \KEYWORDS conversion, number, arithmetic. - + \DESCRIBE -If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then -{NUM_LT_CONV `n < m`} returns: +If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then +{NUM_LT_CONV `n < m`} returns: -{ - |- n < m <=> T or |- n < m <=> F -} -\noindent depending on whether the natural number represented by {n} is less +{ + |- n < m <=> T or |- n < m <=> F +} +\noindent depending on whether the natural number represented by {n} is less than the one represented by {m}. - -\FAILURE + +\FAILURE {NUM_LT_CONV tm} fails if {tm} is not of the form {`n < m`}, where {n} and {m} are numerals. - -\EXAMPLE + +\EXAMPLE { # NUM_LT_CONV `42 < 42`;; val it : thm = |- 42 < 42 <=> F - + # NUM_LT_CONV `11 < 19`;; val it : thm = |- 11 < 19 <=> T -} - -\USES -Performing basic arithmetic reasoning while producing a proof. +} + +\USES +Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, diff --git a/Help/NUM_NORMALIZE_CONV.doc b/Help/NUM_NORMALIZE_CONV.doc index 67484580..c23782c7 100644 --- a/Help/NUM_NORMALIZE_CONV.doc +++ b/Help/NUM_NORMALIZE_CONV.doc @@ -10,8 +10,8 @@ in canonical polynomial form. Given a term {t} of natural number type built up from other ``atomic'' components (not necessarily simple variables) and numeral constants by addition, multiplication and exponentiation by constant exponents, -{NUM_NORMALIZE_CONV t} will return {|- t = t'} where {t'} is the result of -putting the term into a normalized form, essentially a multiplied-out +{NUM_NORMALIZE_CONV t} will return {|- t = t'} where {t'} is the result of +putting the term into a normalized form, essentially a multiplied-out polynomial with a specific ordering of and within monomials. \FAILURE @@ -19,16 +19,16 @@ Should never fail. \EXAMPLE { - # NUM_NORMALIZE_CONV `1 + (1 + x + x EXP 2) * (x + (x * x) EXP 2)`;; + # NUM_NORMALIZE_CONV `1 + (1 + x + x EXP 2) * (x + (x * x) EXP 2)`;; val it : thm = |- 1 + (1 + x + x EXP 2) * (x + (x * x) EXP 2) = x EXP 6 + x EXP 5 + x EXP 4 + x EXP 3 + x EXP 2 + x + 1 } \COMMENTS -This can be used to prove simple algebraic equations, but {NUM_RING} or -{ARITH_RULE} are generally more powerful and convenient for that. In -particular, this function does not handle cutoff subtraction or other such +This can be used to prove simple algebraic equations, but {NUM_RING} or +{ARITH_RULE} are generally more powerful and convenient for that. In +particular, this function does not handle cutoff subtraction or other such operations. \SEEALSO diff --git a/Help/NUM_ODD_CONV.doc b/Help/NUM_ODD_CONV.doc index de4c58f7..f2161ac0 100644 --- a/Help/NUM_ODD_CONV.doc +++ b/Help/NUM_ODD_CONV.doc @@ -16,19 +16,19 @@ returns one of the theorems: } \noindent or { - |- ODD(n) <=> F + |- ODD(n) <=> F } \noindent according to whether the number denoted by {n} is odd. \FAILURE -Fails if applied to a term that is not of the form {`ODD n`} with {n} a +Fails if applied to a term that is not of the form {`ODD n`} with {n} a numeral. \EXAMPLE { # NUM_ODD_CONV `ODD 123`;; val it : thm = |- ODD 123 <=> T - + # NUM_ODD_CONV `ODD 1234`;; val it : thm = |- ODD 1234 <=> F } diff --git a/Help/NUM_PRE_CONV.doc b/Help/NUM_PRE_CONV.doc index 2b2732ab..3b895b49 100644 --- a/Help/NUM_PRE_CONV.doc +++ b/Help/NUM_PRE_CONV.doc @@ -15,18 +15,18 @@ If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then |- PRE n = s } \noindent where {s} is the numeral that denotes the cutoff predecessor of the -natural number denoted by {n} (that is, the result of subtracting 1 from it, or +natural number denoted by {n} (that is, the result of subtracting 1 from it, or zero if it is already zero). \FAILURE -{NUM_PRE_CONV tm} fails if {tm} is not of the form {`PRE n`}, where {n} is a +{NUM_PRE_CONV tm} fails if {tm} is not of the form {`PRE n`}, where {n} is a numeral. \EXAMPLE { # NUM_PRE_CONV `PRE 0`;; val it : thm = |- PRE 0 = 0 - + # NUM_PRE_CONV `PRE 12345`;; val it : thm = |- PRE 12345 = 12344 } diff --git a/Help/NUM_REDUCE_TAC.doc b/Help/NUM_REDUCE_TAC.doc index 9bf94317..997e1434 100644 --- a/Help/NUM_REDUCE_TAC.doc +++ b/Help/NUM_REDUCE_TAC.doc @@ -9,12 +9,12 @@ Evaluate subexpressions of goal built up from natural number numerals. conversion, number, arithmetic. \DESCRIBE -When applied to a goal, {NUM_REDUCE_TAC} performs a recursive bottom-up +When applied to a goal, {NUM_REDUCE_TAC} performs a recursive bottom-up evaluation by proof of subterms of the conclusion built from numerals using the unary operators `{SUC}', `{PRE}' and `{FACT}' and the binary arithmetic (`{+}', `{-}', `{*}', `{EXP}', `{DIV}', `{MOD}') and relational (`{<}', `{<=}', `{>}', `{>=}', `{=}') operators, as well as propagating constants through logical -operations, e.g. {T /\ x <=> x}, returning a new subgoal where all these +operations, e.g. {T /\ x <=> x}, returning a new subgoal where all these subexpressions are reduced. \FAILURE @@ -24,9 +24,9 @@ Never fails, but may have no effect. { # g `1 EXP 3 + 12 EXP 3 = 1729 /\ 9 EXP 3 + 10 EXP 3 = 1729`;; val it : goalstack = 1 subgoal (1 total) - + `1 EXP 3 + 12 EXP 3 = 1729 /\ 9 EXP 3 + 10 EXP 3 = 1729` - + # e NUM_REDUCE_TAC;; val it : goalstack = No subgoals } diff --git a/Help/NUM_RED_CONV.doc b/Help/NUM_RED_CONV.doc index e0a05da3..416ad800 100644 --- a/Help/NUM_RED_CONV.doc +++ b/Help/NUM_RED_CONV.doc @@ -43,7 +43,7 @@ combinations of numerals, use {NUM_REDUCE_CONV}: } \USES -Access to this `one-step' reduction is not usually especially useful, but if +Access to this `one-step' reduction is not usually especially useful, but if you want to add a conversion {conv} for some other operator on numbers, you can conveniently incorporate it into {NUM_REDUCE_CONV} with { diff --git a/Help/NUM_RING.doc b/Help/NUM_RING.doc index e1322f21..fe2b6d45 100644 --- a/Help/NUM_RING.doc +++ b/Help/NUM_RING.doc @@ -6,24 +6,24 @@ Ring decision procedure instantiated to natural numbers. \DESCRIBE -The rule {NUM_RING} should be applied to a formula that, after suitable -normalization, can be considered a universally quantified Boolean combination -of equations and inequations between terms of type {:num}. If that formula +The rule {NUM_RING} should be applied to a formula that, after suitable +normalization, can be considered a universally quantified Boolean combination +of equations and inequations between terms of type {:num}. If that formula holds in all integral domains, {NUM_RING} will prove it. Any ``alien'' atomic -formulas that are not natural number equations will not contribute to the proof -but will not in themselves cause an error. The function is a particular -instantiation of {RING}, which is a more generic procedure for ring and +formulas that are not natural number equations will not contribute to the proof +but will not in themselves cause an error. The function is a particular +instantiation of {RING}, which is a more generic procedure for ring and semiring structures. \FAILURE -Fails if the formula is unprovable by the methods employed. This does not +Fails if the formula is unprovable by the methods employed. This does not necessarily mean that it is not valid for {:num}, but rather that it is not valid on all integral domains (see below). \EXAMPLE The following formula is proved because it holds in all integral domains: { - # NUM_RING `(x + y) EXP 2 = x EXP 2 ==> y = 0 \/ y + 2 * x = 0`;; + # NUM_RING `(x + y) EXP 2 = x EXP 2 ==> y = 0 \/ y + 2 * x = 0`;; 1 basis elements and 0 critical pairs Translating certificate to HOL inferences val it : thm = |- (x + y) EXP 2 = x EXP 2 ==> y = 0 \/ y + 2 * x = 0 diff --git a/Help/NUM_SUB_CONV.doc b/Help/NUM_SUB_CONV.doc index 9ac57edd..fbf8d08b 100644 --- a/Help/NUM_SUB_CONV.doc +++ b/Help/NUM_SUB_CONV.doc @@ -14,9 +14,9 @@ If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then { |- n - m = s } -\noindent where {s} is the numeral that denotes the result of subtracting the -natural number denoted by {m} from the one denoted by {n}, returning zero for -all cases where {m} is greater than {n} (cutoff subtraction over the natural +\noindent where {s} is the numeral that denotes the result of subtracting the +natural number denoted by {m} from the one denoted by {n}, returning zero for +all cases where {m} is greater than {n} (cutoff subtraction over the natural numbers). \FAILURE @@ -33,7 +33,7 @@ numbers). } \COMMENTS -Note that subtraction over type {:num} is defined as this cutoff subtraction. +Note that subtraction over type {:num} is defined as this cutoff subtraction. If you want a number system with negative numbers, use {:int} or {:real}. \SEEALSO diff --git a/Help/NUM_SUC_CONV.doc b/Help/NUM_SUC_CONV.doc index b503e56e..6d73d4ba 100644 --- a/Help/NUM_SUC_CONV.doc +++ b/Help/NUM_SUC_CONV.doc @@ -14,11 +14,11 @@ If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then { |- SUC n = s } -\noindent where {s} is the numeral that denotes the successor of the natural +\noindent where {s} is the numeral that denotes the successor of the natural number denoted by {n} (that is, the result of adding 1 to it). \FAILURE -{NUM_SUC_CONV tm} fails if {tm} is not of the form {`SUC n`}, where {n} is a +{NUM_SUC_CONV tm} fails if {tm} is not of the form {`SUC n`}, where {n} is a numeral. \EXAMPLE diff --git a/Help/NUM_TO_INT_CONV.doc b/Help/NUM_TO_INT_CONV.doc index 63ed2287..d3fe5dbf 100644 --- a/Help/NUM_TO_INT_CONV.doc +++ b/Help/NUM_TO_INT_CONV.doc @@ -25,7 +25,7 @@ Never fails. } \USES -Mostly intended as a preprocessing step to allow rules for the integers to +Mostly intended as a preprocessing step to allow rules for the integers to deduce facts about natural numbers too. \SEEALSO diff --git a/Help/ONCE_ASM_REWRITE_TAC.doc b/Help/ONCE_ASM_REWRITE_TAC.doc index c7968ff7..7407ab8d 100644 --- a/Help/ONCE_ASM_REWRITE_TAC.doc +++ b/Help/ONCE_ASM_REWRITE_TAC.doc @@ -60,7 +60,7 @@ save inference steps. \SEEALSO basic_rewrites, ASM_REWRITE_TAC, GEN_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, -PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, +PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC diff --git a/Help/ONCE_DEPTH_SQCONV.doc b/Help/ONCE_DEPTH_SQCONV.doc index 738a699a..6daa12f0 100644 --- a/Help/ONCE_DEPTH_SQCONV.doc +++ b/Help/ONCE_DEPTH_SQCONV.doc @@ -7,9 +7,9 @@ Applies simplification to the first suitable sub-term(s) encountered in top-down order. \DESCRIBE -HOL Light's simplification functions (e.g. {SIMP_TAC}) have their traversal -algorithm controlled by a ``strategy''. {ONCE_DEPTH_SQCONV} is a strategy -corresponding to {ONCE_DEPTH_CONV} for ordinary conversions: simplification is +HOL Light's simplification functions (e.g. {SIMP_TAC}) have their traversal +algorithm controlled by a ``strategy''. {ONCE_DEPTH_SQCONV} is a strategy +corresponding to {ONCE_DEPTH_CONV} for ordinary conversions: simplification is applied to the first suitable subterm(s) encountered in top-down order. \FAILURE diff --git a/Help/ONCE_REWRITE_TAC.doc b/Help/ONCE_REWRITE_TAC.doc index abc7de3e..a78b658d 100644 --- a/Help/ONCE_REWRITE_TAC.doc +++ b/Help/ONCE_REWRITE_TAC.doc @@ -34,22 +34,22 @@ Given a theorem list: { # g `0 < 3`;; val it : goalstack = 1 subgoal (1 total) - + `0 < 3` } \noindent the tactic {ONCE_REWRITE_TAC thl} performs a single rewrite { # e(ONCE_REWRITE_TAC thl);; val it : goalstack = 1 subgoal (1 total) - + `0 < SUC 2` } -\noindent in contrast to {REWRITE_TAC thl} which would rewrite the goal +\noindent in contrast to {REWRITE_TAC thl} which would rewrite the goal repeatedly into this form: { # e(REWRITE_TAC thl);; val it : goalstack = 1 subgoal (1 total) - + `0 < SUC (SUC (SUC 0))` } @@ -59,7 +59,7 @@ rewriting would diverge. It can also be used to save inference steps. \SEEALSO ASM_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, PURE_ASM_REWRITE_TAC, -PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, +PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC diff --git a/Help/ONCE_SIMPLIFY_CONV.doc b/Help/ONCE_SIMPLIFY_CONV.doc index 8cc0e071..9f725810 100644 --- a/Help/ONCE_SIMPLIFY_CONV.doc +++ b/Help/ONCE_SIMPLIFY_CONV.doc @@ -18,7 +18,7 @@ simplification. Never fails. \USES -Usually some other interface to the simplifier is more convenient, but you may +Usually some other interface to the simplifier is more convenient, but you may want to use this to employ a customized simpset. \SEEALSO diff --git a/Help/ONCE_SIMP_CONV.doc b/Help/ONCE_SIMP_CONV.doc index 1efbe592..6c2859fd 100644 --- a/Help/ONCE_SIMP_CONV.doc +++ b/Help/ONCE_SIMP_CONV.doc @@ -6,16 +6,16 @@ Simplify a term once by conditional contextual rewriting. \DESCRIBE -A call {ONCE_SIMP_CONV thl tm} will return {|- tm = tm'} where {tm'} results +A call {ONCE_SIMP_CONV thl tm} will return {|- tm = tm'} where {tm'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as -built-in simplifications (see {basic_rewrites} and {basic_convs}). For more -details on this kind of conditional rewriting, see {SIMP_TAC}. The {ONCE} -prefix indicates that the first applicable terms in a toplevel term will be -simplified once only, though conditional subgoals generated will be simplified +built-in simplifications (see {basic_rewrites} and {basic_convs}). For more +details on this kind of conditional rewriting, see {SIMP_TAC}. The {ONCE} +prefix indicates that the first applicable terms in a toplevel term will be +simplified once only, though conditional subgoals generated will be simplified repeatedly. \FAILURE -Never fails, but may return a reflexive theorem {|- tm = tm} if no +Never fails, but may return a reflexive theorem {|- tm = tm} if no simplifications can be made. \SEEALSO diff --git a/Help/ONCE_SIMP_TAC.doc b/Help/ONCE_SIMP_TAC.doc index 5036cec9..ed3f4ffc 100644 --- a/Help/ONCE_SIMP_TAC.doc +++ b/Help/ONCE_SIMP_TAC.doc @@ -11,9 +11,9 @@ goal {A ?- g'} where {g'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of conditional rewriting, see {SIMP_CONV}. The {ONCE} prefix indicates that -the first applicable terms in a toplevel term will be simplified once only. -Moreover, in contrast to the other simplification tactics, any unsolved -subgoals arising from conditions on rewrites will be split off as new goals, +the first applicable terms in a toplevel term will be simplified once only. +Moreover, in contrast to the other simplification tactics, any unsolved +subgoals arising from conditions on rewrites will be split off as new goals, allowing simplification to proceed more interactively. \FAILURE diff --git a/Help/ORDERED_IMP_REWR_CONV.doc b/Help/ORDERED_IMP_REWR_CONV.doc index df6c2091..c9a6c9a0 100644 --- a/Help/ORDERED_IMP_REWR_CONV.doc +++ b/Help/ORDERED_IMP_REWR_CONV.doc @@ -16,15 +16,15 @@ side, after instantiation. If the ordering condition is violated, it will fail, even if the match is fine. \FAILURE -Fails if the theorem is not of the right form or the two terms cannot be -matched, for example because the variables that need to be instantiated are +Fails if the theorem is not of the right form or the two terms cannot be +matched, for example because the variables that need to be instantiated are free in the hypotheses {A}, or if the ordering requirement fails. \EXAMPLE \USES -Applying conditional rewrite rules that are permutative and would loop without -some ordering restriction. Applied automatically to some permutative rewrite +Applying conditional rewrite rules that are permutative and would loop without +some ordering restriction. Applied automatically to some permutative rewrite rules in the simplifier, e.g. in {SIMP_CONV}. \SEEALSO diff --git a/Help/ORDERED_REWR_CONV.doc b/Help/ORDERED_REWR_CONV.doc index dc4601cf..4d970fe1 100644 --- a/Help/ORDERED_REWR_CONV.doc +++ b/Help/ORDERED_REWR_CONV.doc @@ -15,8 +15,8 @@ side of the equation {s = t} to {s'}, and return the corresponding theorem {A the ordering condition is violated, it will fail, even if the match is fine. \FAILURE -Fails if the theorem is not of the right form or the two terms cannot be -matched, for example because the variables that need to be instantiated are +Fails if the theorem is not of the right form or the two terms cannot be +matched, for example because the variables that need to be instantiated are free in the hypotheses {A}, or if the ordering requirement fails. \EXAMPLE @@ -25,7 +25,7 @@ We apply the permutative rewrite: # ADD_SYM;; val it : thm = |- !m n. m + n = n + m } -\noindent with the default term ordering {term_order} designed for this kind of +\noindent with the default term ordering {term_order} designed for this kind of application. Note that it applies in one direction: { # ORDERED_REWR_CONV term_order ADD_SYM `1 + 2`;; @@ -38,10 +38,10 @@ application. Note that it applies in one direction: } \USES -Applying conditional rewrite rules that are permutative and would loop without -some restriction. Thanks to the fact that higher-level rewriting operations -like {REWRITE_CONV} and {REWRITE_TAC} have ordering built in for permutative -rewrite rules, rewriting with theorem like {ADD_AC} will effectively normalize +Applying conditional rewrite rules that are permutative and would loop without +some restriction. Thanks to the fact that higher-level rewriting operations +like {REWRITE_CONV} and {REWRITE_TAC} have ordering built in for permutative +rewrite rules, rewriting with theorem like {ADD_AC} will effectively normalize terms. \SEEALSO diff --git a/Help/ORELSE.doc b/Help/ORELSE.doc index cf69b300..dabf3a38 100644 --- a/Help/ORELSE.doc +++ b/Help/ORELSE.doc @@ -18,10 +18,10 @@ The resulting tactic fails if both {t1} and {t2} fail when applied to the relevant goal. \EXAMPLE -The tactic {STRIP_TAC} breaks down the logical structure of a goal in various -ways, e.g. stripping off universal quantifiers and putting the antecedent of -implicational conclusions into the assumptions. However it does not break down -equivalences into two implications, as {EQ_TAC} does. So you might start +The tactic {STRIP_TAC} breaks down the logical structure of a goal in various +ways, e.g. stripping off universal quantifiers and putting the antecedent of +implicational conclusions into the assumptions. However it does not break down +equivalences into two implications, as {EQ_TAC} does. So you might start breaking down a goal corresponding to the inbuilt theorem {MOD_EQ_0} { # g `!m n. ~(n = 0) ==> ((m MOD n = 0) <=> (?q. m = q * n))`;; @@ -31,15 +31,15 @@ breaking down a goal corresponding to the inbuilt theorem {MOD_EQ_0} { # e(REPEAT(STRIP_TAC ORELSE EQ_TAC));; val it : goalstack = 2 subgoals (2 total) - + 0 [`~(n = 0)`] 1 [`m = q * n`] - + `m MOD n = 0` - + 0 [`~(n = 0)`] 1 [`m MOD n = 0`] - + `?q. m = q * n` } diff --git a/Help/PINST.doc b/Help/PINST.doc index 768774e1..041d285c 100644 --- a/Help/PINST.doc +++ b/Help/PINST.doc @@ -6,20 +6,20 @@ Instantiate types and terms in a theorem. \DESCRIBE -The call {PINST [ty1,tv1; ...; tyn,tvn] [tm1,v1; ...; tmk,vk] th} instantiates -both types and terms in the theorem {th} using the two instantiation -lists. The {tyi} should be types, the {tvi} type variables, the {tmi} terms and -the {vi} term variables. Note carefully that the {vi} refer to variables in the -theorem {{\em before}} type instantiation, but the {tmi} should be replacements +The call {PINST [ty1,tv1; ...; tyn,tvn] [tm1,v1; ...; tmk,vk] th} instantiates +both types and terms in the theorem {th} using the two instantiation +lists. The {tyi} should be types, the {tvi} type variables, the {tmi} terms and +the {vi} term variables. Note carefully that the {vi} refer to variables in the +theorem {{\em before}} type instantiation, but the {tmi} should be replacements for the type-instantiated ones. More explicitly, the behaviour is as follows. First, the type variables in {th} are instantiated according to the list {[ty1,tv1; ...; tyn,tvn]}, exactly as for {INST_TYPE}. Moreover the same type instantiation is applied to the variables in the second list, to give -{[tm1,v1'; ...; tmk,vk']}. This is then used to instantiate the already +{[tm1,v1'; ...; tmk,vk']}. This is then used to instantiate the already type-instantiated theorem. \FAILURE -Fails if the instantiation lists are ill-formed, as with {INST} and +Fails if the instantiation lists are ill-formed, as with {INST} and {INST_TYPE}, for example if some {tvi} is not a type variable. \EXAMPLE diff --git a/Help/POP_ASSUM.doc b/Help/POP_ASSUM.doc index 68d31afe..c5580bf1 100644 --- a/Help/POP_ASSUM.doc +++ b/Help/POP_ASSUM.doc @@ -30,7 +30,7 @@ applied to assumptions other than the first. There are admittedly times when {POP_ASSUM} is convenient, but it is unwise to use it if there is more than one assumption in the assumption list, since this -introduces a dependency on the ordering and makes proofs somewhat brittle with +introduces a dependency on the ordering and makes proofs somewhat brittle with respect to changes. Another point to consider is that if the relevant assumption has been obtained @@ -51,11 +51,11 @@ Starting with the goal: } \noindent and breaking it down: { - # e(REPEAT STRIP_TAC);; + # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) - + 0 [`0 = x`] - + `f (x * f x) = f x` } \noindent we might use the equation to substitute backwards: @@ -66,11 +66,11 @@ Starting with the goal: { # e(REWRITE_TAC[MULT_CLAUSES; SYM(ASSUME `0 = x`)]);; } -\noindent and we could even have avoided putting the equation in the +\noindent and we could even have avoided putting the equation in the assumptions at all by from the beginning doing: { - # e(REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN - REWRITE_TAC[MULT_CLAUSES]);; + # e(REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[MULT_CLAUSES]);; } \USES diff --git a/Help/POP_ASSUM_LIST.doc b/Help/POP_ASSUM_LIST.doc index 9fcf4a4e..8cce0d6f 100644 --- a/Help/POP_ASSUM_LIST.doc +++ b/Help/POP_ASSUM_LIST.doc @@ -30,7 +30,7 @@ number from the {ASSUME}d-assumption list, since this introduces a dependency on ordering. \EXAMPLE -We can collect all the assumptions of a goal into a conjunction and make them a +We can collect all the assumptions of a goal into a conjunction and make them a new antecedent by: { POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) diff --git a/Help/PROP_ATOM_CONV.doc b/Help/PROP_ATOM_CONV.doc index 4df4608d..97d13d0b 100644 --- a/Help/PROP_ATOM_CONV.doc +++ b/Help/PROP_ATOM_CONV.doc @@ -11,8 +11,8 @@ through any number of the core propositional connectives `{~}', `{/\}', `{\/}', `{==>}' and `{<=>}', as well as the quantifiers `{!x. p[x]}', `{?x. p[x]}' and `{?!x. p[x]}'. When it reaches a subterm that can no longer be decomposed into any of those items (e.g. the starting term if it is not of Boolean type), the -conversion {conv} is tried, with a reflexive theorem returned in case of -failure. That is, the conversion is applied to the ``atomic subformulas'' in +conversion {conv} is tried, with a reflexive theorem returned in case of +failure. That is, the conversion is applied to the ``atomic subformulas'' in the usual sense of first-order logic. \FAILURE @@ -20,7 +20,7 @@ Never fails. \EXAMPLE Here we swap all equations in a formula, but not any logical equivalences that -are part of its logical structure: +are part of its logical structure: { # PROP_ATOM_CONV(ONCE_DEPTH_CONV SYM_CONV) `(!x. x = y ==> x = z) <=> (y = z <=> 1 + z = z + 1)`;; @@ -30,7 +30,7 @@ are part of its logical structure: z = y <=> z + 1 = 1 + z } -\noindent By contrast, just {ONCE_DEPTH_CONV SYM_CONV} would just swap the +\noindent By contrast, just {ONCE_DEPTH_CONV SYM_CONV} would just swap the top-level logical equivalence. \USES diff --git a/Help/PURE_SIMP_CONV.doc b/Help/PURE_SIMP_CONV.doc index fa64ab83..cb9243d6 100644 --- a/Help/PURE_SIMP_CONV.doc +++ b/Help/PURE_SIMP_CONV.doc @@ -3,7 +3,7 @@ \TYPE {PURE_SIMP_CONV : thm list -> conv} \SYNOPSIS -Simplify a term repeatedly by conditional contextual rewriting, not using +Simplify a term repeatedly by conditional contextual rewriting, not using default simplifications. \DESCRIBE diff --git a/Help/PURE_SIMP_TAC.doc b/Help/PURE_SIMP_TAC.doc index fb77b815..ff018808 100644 --- a/Help/PURE_SIMP_TAC.doc +++ b/Help/PURE_SIMP_TAC.doc @@ -3,7 +3,7 @@ \TYPE {PURE_SIMP_TAC : thm list -> tactic} \SYNOPSIS -Simplify a goal repeatedly by conditional contextual rewriting without default +Simplify a goal repeatedly by conditional contextual rewriting without default simplifications. \DESCRIBE @@ -14,7 +14,7 @@ built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details, see {SIMP_CONV}. \FAILURE -Never fails, though may not change the goal if no simplifications are +Never fails, though may not change the goal if no simplifications are applicable. \COMMENTS diff --git a/Help/REAL_FIELD.doc b/Help/REAL_FIELD.doc index 6153d348..c943f453 100644 --- a/Help/REAL_FIELD.doc +++ b/Help/REAL_FIELD.doc @@ -6,9 +6,9 @@ Prove basic `field' facts over the reals. \DESCRIBE -Most of the built-in HOL arithmetic decision procedures have limited ability to -deal with inversion or division. {REAL_FIELD} is an enhancement of {REAL_RING} -that has the same underlying method but first performs various case-splits, +Most of the built-in HOL arithmetic decision procedures have limited ability to +deal with inversion or division. {REAL_FIELD} is an enhancement of {REAL_RING} +that has the same underlying method but first performs various case-splits, reducing a goal involving the inverse {inv(t)} of a term {t} to the cases where {t = 0} where {t * inv(t) = &1}, repeatedly for all such {t}. After subsequently splitting the goal into normal form, {REAL_RING} (for algebraic @@ -19,7 +19,7 @@ this allows some {t = 0} cases to be excluded by simple linear reasoning. Fails if the term is not provable using the methods described. \EXAMPLE -Here we do some simple algebraic simplification, ruling out the degenerate +Here we do some simple algebraic simplification, ruling out the degenerate {x = &0} case using the inequality in the antecedent. { # REAL_FIELD `!x. &0 < x ==> &1 / x - &1 / (x + &1) = &1 / (x * (x + &1))`;; @@ -28,7 +28,7 @@ Here we do some simple algebraic simplification, ruling out the degenerate } \COMMENTS -Except for the discharge of conditions using linear reasoning, this rule is +Except for the discharge of conditions using linear reasoning, this rule is essentially equational. For nonlinear inequality reasoning, there are no powerful rules built into HOL Light, but the additional derived rules defined in {Examples/sos.ml} and {Rqe/make.ml} may be useful. diff --git a/Help/REAL_IDEAL_CONV.doc b/Help/REAL_IDEAL_CONV.doc index d85f550f..03526b15 100644 --- a/Help/REAL_IDEAL_CONV.doc +++ b/Help/REAL_IDEAL_CONV.doc @@ -8,18 +8,18 @@ Produces identity proving ideal membership over the reals. \DESCRIBE The call {REAL_IDEAL_CONV [`p1`; ...; `pn`] `p`}, where all the terms have type {:real} and can be considered as polynomials, will test whether {p} is in -the ideal generated by the {p1,...,pn}. If so, it will return a corresponding -theorem {|- p = q1 * p1 + ... + qn * pn} showing how to express {p} in terms of +the ideal generated by the {p1,...,pn}. If so, it will return a corresponding +theorem {|- p = q1 * p1 + ... + qn * pn} showing how to express {p} in terms of the other polynomials via some `cofactors' {qi}. - -\FAILURE + +\FAILURE Fails if the terms are ill-typed, or if ideal membership fails. - -\EXAMPLE -In the case of a singleton list, this just corresponds to dividing one + +\EXAMPLE +In the case of a singleton list, this just corresponds to dividing one multivariate polynomial by another, e.g. { - # REAL_IDEAL_CONV [`x - &1`] `x pow 4 - &1`;; + # REAL_IDEAL_CONV [`x - &1`] `x pow 4 - &1`;; 1 basis elements and 0 critical pairs val it : thm = |- x pow 4 - &1 = (&1 * x pow 3 + &1 * x pow 2 + &1 * x + &1) * (x - &1) diff --git a/Help/REAL_INT_RAT_CONV.doc b/Help/REAL_INT_RAT_CONV.doc index 0bed8aee..d9c50036 100644 --- a/Help/REAL_INT_RAT_CONV.doc +++ b/Help/REAL_INT_RAT_CONV.doc @@ -7,7 +7,7 @@ Convert basic rational constant of real type to canonical form. \DESCRIBE When applied to a term that is a rational constant of type {:real}, -{REAL_INT_RAT_CONV} converts it to an explicit ratio {&p / &q} or {-- &p / &q}; +{REAL_INT_RAT_CONV} converts it to an explicit ratio {&p / &q} or {-- &p / &q}; {q} is always there, even if it is {1}. \FAILURE @@ -26,7 +26,7 @@ Never fails; simply has no effect if it is not applied to a suitable constant. } \USES -Mainly for internal use as a preprocessing step in rational-number +Mainly for internal use as a preprocessing step in rational-number calculations. \SEEALSO diff --git a/Help/REAL_INT_REDUCE_CONV.doc b/Help/REAL_INT_REDUCE_CONV.doc index 0b3e602c..c6c9e044 100644 --- a/Help/REAL_INT_REDUCE_CONV.doc +++ b/Help/REAL_INT_REDUCE_CONV.doc @@ -13,7 +13,7 @@ using the unary operators `{--}', `{inv}' and `{abs}', and the binary arithmetic (`{+}', `{-}', `{*}', `{/}', `{pow}') and relational (`{<}', `{<=}', `{>}', `{>=}', `{=}') operators, as well as propagating literals through logical operations, e.g. {T /\ x <=> x}, returning a theorem that the original -and reduced terms are equal. The permissible integer literals are of the form +and reduced terms are equal. The permissible integer literals are of the form {&n} or {-- &n} for numeral {n}, nonzero in the negative case. \FAILURE diff --git a/Help/REAL_INT_RED_CONV.doc b/Help/REAL_INT_RED_CONV.doc index bc7308e8..645896de 100644 --- a/Help/REAL_INT_RED_CONV.doc +++ b/Help/REAL_INT_RED_CONV.doc @@ -3,7 +3,7 @@ \TYPE {REAL_INT_RED_CONV : term -> thm} \SYNOPSIS -Performs one arithmetic or relational operation on integer literals of type +Performs one arithmetic or relational operation on integer literals of type {:real}. \DESCRIBE @@ -15,19 +15,19 @@ asserting the equivalence of the term to a canonical integer (for the arithmetic operators) or a truth-value (for the relational operators). The integer literals are terms of the form {&n} or {-- &n} (with nonzero {n} in the latter case). - + \FAILURE Fails if applied to an inappropriate term. \USES More convenient for most purposes is {REAL_INT_REDUCE_CONV}, which applies -these evaluation conversions recursively at depth, or still more generally +these evaluation conversions recursively at depth, or still more generally {REAL_RAT_REDUCE_CONV} which applies to any rational numbers, not just integers. Still, access to this `one-step' reduction can be handy if you want to add a conversion {conv} for some other operator on real number literals, which -you can conveniently incorporate it into {REAL_INT_REDUCE_CONV} with +you can conveniently incorporate it into {REAL_INT_REDUCE_CONV} with { - # let REAL_INT_REDUCE_CONV' = + # let REAL_INT_REDUCE_CONV' = DEPTH_CONV(REAL_INT_RED_CONV ORELSEC conv);; } diff --git a/Help/REAL_LINEAR_PROVER.doc b/Help/REAL_LINEAR_PROVER.doc index 7112fe7a..94a0ac78 100644 --- a/Help/REAL_LINEAR_PROVER.doc +++ b/Help/REAL_LINEAR_PROVER.doc @@ -11,7 +11,7 @@ The {REAL_LINEAR_PROVER} function should be given two arguments. The first is a proof translator that constructs a contradiction from a tuple of three theorem lists using a Positivstellensatz refutation, which is essentially a representation of how to add and multiply equalities or inequalities chosen -from the list to reach a trivially false equation or inequality such as +from the list to reach a trivially false equation or inequality such as {&0 > &0}. The second argument is a triple of theorem lists, respectively a list of equations of the form {A_i |- p_i = &0}, a list of non-strict inequalities of the form {B_j |- q_i >= &0}, and a list of strict inequalities diff --git a/Help/REAL_POLY_MUL_CONV.doc b/Help/REAL_POLY_MUL_CONV.doc index 1f69ec3a..ef200685 100644 --- a/Help/REAL_POLY_MUL_CONV.doc +++ b/Help/REAL_POLY_MUL_CONV.doc @@ -11,7 +11,7 @@ more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function {REAL_POLY_MUL_CONV} is a more delicate conversion that, given a term {p1 * p2} -where {p1} and {p2} are real polynomials in normal form, returns a theorem +where {p1} and {p2} are real polynomials in normal form, returns a theorem {|- p1 * p2 = p} where {p} is in normal form. \FAILURE @@ -26,7 +26,7 @@ guaranteed. } \USES -More delicate polynomial operations that simply the direct normalization with +More delicate polynomial operations that simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO diff --git a/Help/REAL_POLY_NEG_CONV.doc b/Help/REAL_POLY_NEG_CONV.doc index bfd0472e..3361adae 100644 --- a/Help/REAL_POLY_NEG_CONV.doc +++ b/Help/REAL_POLY_NEG_CONV.doc @@ -15,8 +15,8 @@ where {p} is a real polynomial in normal form, returns a theorem {|- --p = p'} where {p'} is in normal form. \FAILURE -Fails if applied to a term that is not the negation of a real term. If negation -is applied to a polynomial in non-normal form, the overall normalization is not +Fails if applied to a term that is not the negation of a real term. If negation +is applied to a polynomial in non-normal form, the overall normalization is not guaranteed. \EXAMPLE @@ -26,7 +26,7 @@ guaranteed. } \USES -More delicate polynomial operations than simply the direct normalization with +More delicate polynomial operations than simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO diff --git a/Help/REAL_POLY_POW_CONV.doc b/Help/REAL_POLY_POW_CONV.doc index 7981b0f7..9bf48012 100644 --- a/Help/REAL_POLY_POW_CONV.doc +++ b/Help/REAL_POLY_POW_CONV.doc @@ -10,7 +10,7 @@ For many purposes it is useful to retain polynomials in a canonical form. For more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function -{REAL_POLY_POW_CONV} is a more delicate conversion that, given a term +{REAL_POLY_POW_CONV} is a more delicate conversion that, given a term {p1 pow n} where {p} is a real polynomial in normal form and {n} a numeral, returns a theorem {|- p pow n = p'} where {p'} is in normal form. @@ -27,7 +27,7 @@ not guaranteed. } \USES -More delicate polynomial operations that simply the direct normalization with +More delicate polynomial operations that simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO diff --git a/Help/REAL_POLY_SUB_CONV.doc b/Help/REAL_POLY_SUB_CONV.doc index b813767f..971b11ac 100644 --- a/Help/REAL_POLY_SUB_CONV.doc +++ b/Help/REAL_POLY_SUB_CONV.doc @@ -11,7 +11,7 @@ more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function {REAL_POLY_SUB_CONV} is a more delicate conversion that, given a term {p1 - p2} -where {p1} and {p2} are real polynomials in normal form, returns a theorem +where {p1} and {p2} are real polynomials in normal form, returns a theorem {|- p1 - p2 = p} where {p} is in normal form. \FAILURE @@ -26,7 +26,7 @@ not guaranteed. } \USES -More delicate polynomial operations that simply the direct normalization with +More delicate polynomial operations that simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO diff --git a/Help/RECALL_ACCEPT_TAC.doc b/Help/RECALL_ACCEPT_TAC.doc index dc989da1..ecb08ed4 100644 --- a/Help/RECALL_ACCEPT_TAC.doc +++ b/Help/RECALL_ACCEPT_TAC.doc @@ -6,8 +6,8 @@ Delay evaluation of theorem-producing function till needed. \DESCRIBE -Given a theorem-producing inference rule {f} and its argument {a}, the tactic -{RECALL_ACCEPT_TAC f a} will evaluate {th = f a} and do {ACCEPT_TAC th}, but +Given a theorem-producing inference rule {f} and its argument {a}, the tactic +{RECALL_ACCEPT_TAC f a} will evaluate {th = f a} and do {ACCEPT_TAC th}, but only when the tactic is applied to a goal. \FAILURE @@ -19,14 +19,14 @@ You might for example do { RECALL_ACCEPT_TAC (EQT_ELIM o NUM_REDUCE_CONV) `16 EXP 53 < 15 EXP 55`;; } -\noindent and the call +\noindent and the call { (EQT_ELIM o NUM_REDUCE_CONV) `16 EXP 53 < 15 EXP 55` } \noindent will be delayed until the tactic is applied. \USES -Delaying a time-consuming compound inference rule in a tactic script until it +Delaying a time-consuming compound inference rule in a tactic script until it is actually used. \ENDDOC diff --git a/Help/REFL.doc b/Help/REFL.doc index d6a3376c..c5880afe 100644 --- a/Help/REFL.doc +++ b/Help/REFL.doc @@ -18,7 +18,7 @@ Never fails. { # REFL `2`;; val it : thm = |- 2 = 2 - + # REFL `p:bool`;; val it : thm = |- p <=> p } diff --git a/Help/REFUTE_THEN.doc b/Help/REFUTE_THEN.doc index cda9d3e9..00dd8a46 100644 --- a/Help/REFUTE_THEN.doc +++ b/Help/REFUTE_THEN.doc @@ -7,8 +7,8 @@ Assume the negation of the goal and apply theorem-tactic to it. \DESCRIBE The tactic {REFUTE_THEN ttac} applied to a goal {g}, assumes the negation of -the goal and applies {ttac} to it and a similar goal with a conclusion of {F}. -More precisely, if the original goal {A ?- u} is unnegated and {ttac}'s action +the goal and applies {ttac} to it and a similar goal with a conclusion of {F}. +More precisely, if the original goal {A ?- u} is unnegated and {ttac}'s action is { A ?- F @@ -21,16 +21,16 @@ is ============== REFUTE_THEN ttac B ?- v } -For example, if {ttac} is just {ASSUME_TAC}, this corresponds to a classic +For example, if {ttac} is just {ASSUME_TAC}, this corresponds to a classic `proof by contradiction': -{ - A ?- u +{ + A ?- u ================= REFUTE_THEN ASSUME_TAC - A u {{~u}} ?- F -} + A u {{~u}} ?- F +} Whatever {ttac} may be, if the conclusion {u} of the goal is negated, the effect is the same except that the assumed theorem will not be double-negated, -so the effect is the same as {DISCH_THEN}. +so the effect is the same as {DISCH_THEN}. \FAILURE Never fails unless the underlying theorem-tactic {ttac} does. @@ -39,8 +39,8 @@ Never fails unless the underlying theorem-tactic {ttac} does. Classical `proof by contradiction'. \COMMENTS -When applied to an unnegated goal, this tactic embodies implicitly the -classical principle of `proof by contradiction', but for negated goals the +When applied to an unnegated goal, this tactic embodies implicitly the +classical principle of `proof by contradiction', but for negated goals the tactic is also intuitionistically valid. \SEEALSO diff --git a/Help/REPEATC.doc b/Help/REPEATC.doc index d0f1b087..dd4c5cc9 100644 --- a/Help/REPEATC.doc +++ b/Help/REPEATC.doc @@ -24,7 +24,7 @@ Never fails, but can diverge if the supplied conversion never fails. { # BETA_CONV `(\x. (\y. x + y) (x + 1)) 1`;; val it : thm = |- (\x. (\y. x + y) (x + 1)) 1 = (\y. 1 + y) (1 + 1) - + # REPEATC BETA_CONV `(\x. (\y. x + y) (x + 1)) 1`;; val it : thm = |- (\x. (\y. x + y) (x + 1)) 1 = 1 + 1 + 1 } diff --git a/Help/REPEAT_UPPERCASE.doc b/Help/REPEAT_UPPERCASE.doc index f9fc3546..9dbedc4c 100644 --- a/Help/REPEAT_UPPERCASE.doc +++ b/Help/REPEAT_UPPERCASE.doc @@ -14,7 +14,7 @@ succeeds, continues applying it to all subgoals generated. \FAILURE The application of {REPEAT} to a tactic never fails, and neither does the -composite tactic, even if the basic tactic fails immediately, unless it raises +composite tactic, even if the basic tactic fails immediately, unless it raises an exception other that {Failure ...}. \EXAMPLE @@ -26,7 +26,7 @@ If we start with a goal having many universal quantifiers: { # e GEN_TAC;; val it : goalstack = 1 subgoal (1 total) - + `!x y z. w < z /\ x < y ==> w * x + 1 <= y * z` } \noindent and {REPEAT GEN_TAC} will strip them off as far as possible: @@ -36,7 +36,7 @@ If we start with a goal having many universal quantifiers: `w < z /\ x < y ==> w * x + 1 <= y * z` } -Similarly, {REPEAT COND_CASES_TAC} will eliminate all free conditionals in the +Similarly, {REPEAT COND_CASES_TAC} will eliminate all free conditionals in the goal instead of just one. \SEEALSO diff --git a/Help/REPLICATE_TAC.doc b/Help/REPLICATE_TAC.doc index 5ea832cd..ca65b049 100644 --- a/Help/REPLICATE_TAC.doc +++ b/Help/REPLICATE_TAC.doc @@ -6,16 +6,16 @@ Apply a tactic a specific number of times. \DESCRIBE -The call {REPLICATE n tac} gives a new tactic that it equivalent to an {n}-fold +The call {REPLICATE n tac} gives a new tactic that it equivalent to an {n}-fold repetition of {tac}, i.e. {tac THEN tac THEN ... THEN tac}. - + \FAILURE -The call {REPLICATE n tac} never fails, but when applied to a goal it will fail +The call {REPLICATE n tac} never fails, but when applied to a goal it will fail if the tactic does. \EXAMPLE -We might conceivably want to strip off exactly three universal quantifiers from -a goal that contains more than three. We can use {REPLICATE_TAC 3 GEN_TAC} to +We might conceivably want to strip off exactly three universal quantifiers from +a goal that contains more than three. We can use {REPLICATE_TAC 3 GEN_TAC} to do that. \SEEALSO diff --git a/Help/REWRITES_CONV.doc b/Help/REWRITES_CONV.doc index 5616cee8..b12fe453 100644 --- a/Help/REWRITES_CONV.doc +++ b/Help/REWRITES_CONV.doc @@ -10,13 +10,13 @@ The underlying machinery in rewriting and simplification assembles (conditional) rewrite rules and other conversions into a net, including a priority number so that, for example, pure rewrites get applied before conditional rewrites. If {net} is such a net (for example, constructed using -{mk_rewrites} and {net_of_thm}), then {REWRITES_CONV net} is a conversion that -uses all those conversions at the toplevel to attempt to rewrite the term. If a +{mk_rewrites} and {net_of_thm}), then {REWRITES_CONV net} is a conversion that +uses all those conversions at the toplevel to attempt to rewrite the term. If a conditional rewrite is applied, the resulting theorem will have an assumption. This is the primitive operation that performs HOL Light rewrite steps. \FAILURE -Fails when applied to the term if none of the conversions in the net are +Fails when applied to the term if none of the conversions in the net are applicable. \SEEALSO diff --git a/Help/RIGHT_BETAS.doc b/Help/RIGHT_BETAS.doc index ff17e805..7a6cedd9 100644 --- a/Help/RIGHT_BETAS.doc +++ b/Help/RIGHT_BETAS.doc @@ -8,7 +8,7 @@ Apply and beta-reduce equational theorem with abstraction on RHS. \DESCRIBE Given a list of arguments {[`a1`; ...; `an`]} and a theorem of the form {A |- f = \x1 ... xn. t[x1,...xn]}, the rule {RIGHT_BETAS} returns -{A |- f a1 ... an = t[a1,...,an]}. That is, it applies the theorem to the list +{A |- f a1 ... an = t[a1,...,an]}. That is, it applies the theorem to the list of arguments and beta-reduces the right-hand side. \FAILURE diff --git a/Help/RING_AND_IDEAL_CONV.doc b/Help/RING_AND_IDEAL_CONV.doc index 9cfc2d80..ccf45335 100644 --- a/Help/RING_AND_IDEAL_CONV.doc +++ b/Help/RING_AND_IDEAL_CONV.doc @@ -6,8 +6,8 @@ Returns a pair giving a ring proof procedure and an ideal membership routine. \DESCRIBE -This function combines the functionality of {RING} and {ideal_cofactors}. Each -of these requires the same rather lengthy input. When you want to apply both to +This function combines the functionality of {RING} and {ideal_cofactors}. Each +of these requires the same rather lengthy input. When you want to apply both to the same set of parameters, you can do so using {RING_AND_IDEAL_CONV}. That is: { RING_AND_IDEAL_CONV parms diff --git a/Help/SELECT_ELIM_TAC.doc b/Help/SELECT_ELIM_TAC.doc index a0b1523b..0d448417 100644 --- a/Help/SELECT_ELIM_TAC.doc +++ b/Help/SELECT_ELIM_TAC.doc @@ -6,12 +6,12 @@ Eliminate select terms from a goal. \DESCRIBE -The tactic {SELECT_ELIM_TAC} attempts to remove from a goal any select terms, -i.e. instances of the Hilbert choice operator {@x. P[x]}. First, any instances -that occur inside their own predicate, i.e. {P[@x. P[x]]}, are replaced simply -by {?x. P[x]}, as with {SELECT_CONV}. Other select-terms are eliminated by -replacing each on with a new variable {v} and adding a corresponding instance -of the axiom {SELECT_AX}, of the form {!x. P[x] ==> P[v]}. Note that the latter +The tactic {SELECT_ELIM_TAC} attempts to remove from a goal any select terms, +i.e. instances of the Hilbert choice operator {@x. P[x]}. First, any instances +that occur inside their own predicate, i.e. {P[@x. P[x]]}, are replaced simply +by {?x. P[x]}, as with {SELECT_CONV}. Other select-terms are eliminated by +replacing each on with a new variable {v} and adding a corresponding instance +of the axiom {SELECT_AX}, of the form {!x. P[x] ==> P[v]}. Note that the latter does not strictly preserve logical equivalence, only implication. So it is possible to replace a provable goal by an unprovable one. But since not much is provable about a select term except via the axiom {SELECT_AX}, this is not diff --git a/Help/SET_TAC.doc b/Help/SET_TAC.doc index 3c1f2c3b..a08133f7 100644 --- a/Help/SET_TAC.doc +++ b/Help/SET_TAC.doc @@ -8,8 +8,8 @@ Attempt to prove goal using basic set-theoretic reasoning. \DESCRIBE When applied to a goal and a list of lemmas to use, the tactic {SET_TAC} puts the lemmas into the goal as antecedents, expands various set-theoretic -definitions explicitly and then attempts to solve the result using {MESON}. It -does not by default use the assumption list of the goal, but this can be done +definitions explicitly and then attempts to solve the result using {MESON}. It +does not by default use the assumption list of the goal, but this can be done using {ASM SET_TAC} in place of plain {SET_TAC}. \FAILURE diff --git a/Help/SIMPLE_CHOOSE.doc b/Help/SIMPLE_CHOOSE.doc index ac629ce8..08aee715 100644 --- a/Help/SIMPLE_CHOOSE.doc +++ b/Help/SIMPLE_CHOOSE.doc @@ -12,7 +12,7 @@ hypothesis so that the choice of assumption is unambiguous. In general, it picks the one that happens to be first in the list. \FAILURE -Fails if {v} is not a variable or if it is free in the conclusion of the +Fails if {v} is not a variable or if it is free in the conclusion of the theorem {th}. \EXAMPLE diff --git a/Help/SIMPLE_EXISTS.doc b/Help/SIMPLE_EXISTS.doc index ba32b1b0..d9ef9b5e 100644 --- a/Help/SIMPLE_EXISTS.doc +++ b/Help/SIMPLE_EXISTS.doc @@ -6,8 +6,8 @@ Introduces an existential quantifier over a variable in a theorem. \DESCRIBE -When applied to a pair consisting of a variable {v} and a theorem {|- p}, -{SIMPLE_EXISTS} returns the theorem {|- ?v. p}. It is not compulsory for {v} to +When applied to a pair consisting of a variable {v} and a theorem {|- p}, +{SIMPLE_EXISTS} returns the theorem {|- ?v. p}. It is not compulsory for {v} to appear free in {p}, but otherwise the quantification is vacuous. \FAILURE @@ -20,8 +20,8 @@ Fails only if {v} is not a variable. } \COMMENTS -The {EXISTS} function is more general: it can introduce an existentially -quantified variable to replace chosen instances of any term in the theorem. +The {EXISTS} function is more general: it can introduce an existentially +quantified variable to replace chosen instances of any term in the theorem. However, {SIMPLE_EXISTS} is easier to use when the simple case is needed. \SEEALSO diff --git a/Help/SIMPLIFY_CONV.doc b/Help/SIMPLIFY_CONV.doc index 77124471..69008cbf 100644 --- a/Help/SIMPLIFY_CONV.doc +++ b/Help/SIMPLIFY_CONV.doc @@ -6,22 +6,22 @@ General simplification at depth with arbitrary simpset. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset'. Given a simpset {ss} and an +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset'. Given a simpset {ss} and an additional list of theorems {thl} to be used as (conditional or unconditional) -rewrite rules, {SIMPLIFY_CONV ss thl} gives a simplification conversion with a -repeated top-down traversal strategy ({TOP_DEPTH_SQCONV}) and a nesting limit +rewrite rules, {SIMPLIFY_CONV ss thl} gives a simplification conversion with a +repeated top-down traversal strategy ({TOP_DEPTH_SQCONV}) and a nesting limit of 3 for the recursive solution of subconditions by further simplification. \FAILURE Never fails. \USES -Usually some other interface to the simplifier is more convenient, but you may +Usually some other interface to the simplifier is more convenient, but you may want to use this to employ a customized simpset. \SEEALSO -GEN_SIMPLIFY_CONV, ONCE_SIMPLIFY_CONV, SIMP_CONV, SIMP_RULE, SIMP_TAC, +GEN_SIMPLIFY_CONV, ONCE_SIMPLIFY_CONV, SIMP_CONV, SIMP_RULE, SIMP_TAC, TOP_DEPTH_SQCONV. \ENDDOC diff --git a/Help/SIMP_CONV.doc b/Help/SIMP_CONV.doc index 21887f3b..21fda3f4 100644 --- a/Help/SIMP_CONV.doc +++ b/Help/SIMP_CONV.doc @@ -43,7 +43,7 @@ Here we use the conditional and contextual facilities: val it : thm = |- (a + c + e) + (b + a + d) + e = a + a + b + c + d + e + e } -\COMMENTS +\COMMENTS For simply rewriting with unconditional equations, {REWRITE_CONV} and relatives are simpler and more efficient. diff --git a/Help/STRING_EQ_CONV.doc b/Help/STRING_EQ_CONV.doc index 2768b921..c60061c8 100644 --- a/Help/STRING_EQ_CONV.doc +++ b/Help/STRING_EQ_CONV.doc @@ -12,18 +12,18 @@ If {"s"} and {"t"} are two string literals in the HOL logic, { |- "s" = "t" <=> T or |- "s" = "t" <=> F } -\noindent depending on whether the string literals are equal or not equal, +\noindent depending on whether the string literals are equal or not equal, respectively. \FAILURE -{STRING_EQ_CONV tm} fails if {tm} is not of the specified form, an equation +{STRING_EQ_CONV tm} fails if {tm} is not of the specified form, an equation between string literals. \EXAMPLE { # STRING_EQ_CONV `"same" = "same"`;; val it : thm = |- "same" = "same" <=> T - + # STRING_EQ_CONV `"knowledge" = "power"`;; val it : thm = |- "knowledge" = "power" <=> F } diff --git a/Help/STRIP_GOAL_THEN.doc b/Help/STRIP_GOAL_THEN.doc index 123a21ac..97c7953d 100644 --- a/Help/STRIP_GOAL_THEN.doc +++ b/Help/STRIP_GOAL_THEN.doc @@ -59,7 +59,7 @@ When solving the goal { # e(STRIP_GOAL_THEN SUBST1_TAC);; val it : goalstack = 1 subgoal (1 total) - + `1 * 1 = 1` } \noindent which is immediate by {ARITH_TAC}, for example. diff --git a/Help/STRUCT_CASES_TAC.doc b/Help/STRUCT_CASES_TAC.doc index 9b2a9c09..b92323a2 100644 --- a/Help/STRUCT_CASES_TAC.doc +++ b/Help/STRUCT_CASES_TAC.doc @@ -58,7 +58,7 @@ following tactic: Generating a case split from the axioms specifying a structure. \SEEALSO -ASM_CASES_TAC, BOOL_CASES_TAC, COND_CASES_TAC, DISJ_CASES_TAC, +ASM_CASES_TAC, BOOL_CASES_TAC, COND_CASES_TAC, DISJ_CASES_TAC, STRUCT_CASES_THEN. \ENDDOC diff --git a/Help/SUBST_VAR_TAC.doc b/Help/SUBST_VAR_TAC.doc index 45458a2b..cf3ca73e 100644 --- a/Help/SUBST_VAR_TAC.doc +++ b/Help/SUBST_VAR_TAC.doc @@ -6,22 +6,22 @@ Use an equation to substitute ``safely'' in goal. \DESCRIBE -When applied to a theorem with an equational hypothesis {A |- s = t}, {SUBST_ -VAR_TAC} has no effect if {s} and {t} are alpha-equivalent. Otherwise, if -either side of the equation is a variable not free in the other side, or a -constant, and the conclusion contains no free variables not free in some -assumption of the goal, then the theorem is used to replace that constant or -variable throughout the goal, assumptions and conclusions. If none of these +When applied to a theorem with an equational hypothesis {A |- s = t}, {SUBST_ +VAR_TAC} has no effect if {s} and {t} are alpha-equivalent. Otherwise, if +either side of the equation is a variable not free in the other side, or a +constant, and the conclusion contains no free variables not free in some +assumption of the goal, then the theorem is used to replace that constant or +variable throughout the goal, assumptions and conclusions. If none of these cases apply, or the conclusion is not even an equation, the application fails. \FAILURE Fails if applied to a non-equation for which none of the cases above hold. \USES -By some sequence like {REPEAT(FIRST_X_ASSUM SUBST_VAR_TAC)} one can use all -possible assumptions to substitute ``safely'', in the sense that it will not -change the provability status of the goal. This is sometimes a useful prelude -to other automatic techniques. +By some sequence like {REPEAT(FIRST_X_ASSUM SUBST_VAR_TAC)} one can use all +possible assumptions to substitute ``safely'', in the sense that it will not +change the provability status of the goal. This is sometimes a useful prelude +to other automatic techniques. \COMMENTS diff --git a/Help/SYM.doc b/Help/SYM.doc index 58f423d5..a539a9a3 100644 --- a/Help/SYM.doc +++ b/Help/SYM.doc @@ -30,8 +30,8 @@ Fails unless the theorem is equational. } \COMMENTS -The {SYM} rule requires the input theorem to be a simple equation, without -additional structure such as outer universal quantifiers. To reverse equality +The {SYM} rule requires the input theorem to be a simple equation, without +additional structure such as outer universal quantifiers. To reverse equality signs deeper inside theorems, you may use {GSYM} instead. \SEEALSO diff --git a/Help/SYM_CONV.doc b/Help/SYM_CONV.doc index b7e74dc5..c3c4f146 100644 --- a/Help/SYM_CONV.doc +++ b/Help/SYM_CONV.doc @@ -20,7 +20,7 @@ Fails if applied to a term that is not an equation. \EXAMPLE { - # SYM_CONV `2 = x`;; + # SYM_CONV `2 = x`;; val it : thm = |- 2 = x <=> x = 2 } diff --git a/Help/TAUT.doc b/Help/TAUT.doc index fa23a294..a60de4a6 100644 --- a/Help/TAUT.doc +++ b/Help/TAUT.doc @@ -6,10 +6,10 @@ Proves a propositional tautology. \DESCRIBE -The call {TAUT `t`} where {t} is a propositional tautology, will prove it -automatically and return {|- t}. A propositional tautology is -a formula built up using the logical connectives `{~}', `{/\}', `{\/}', `{==>}' -and `{<=>}' from terms that can be considered ``atomic'' that is logically +The call {TAUT `t`} where {t} is a propositional tautology, will prove it +automatically and return {|- t}. A propositional tautology is +a formula built up using the logical connectives `{~}', `{/\}', `{\/}', `{==>}' +and `{<=>}' from terms that can be considered ``atomic'' that is logically valid whatever truth-values are assigned to the atomic formulas. \FAILURE @@ -33,12 +33,12 @@ Here is a simple and potentially useful tautology: } \USES -Solving a tautologous goal completely by {CONV_TAC TAUT}, or generating a +Solving a tautologous goal completely by {CONV_TAC TAUT}, or generating a tautology to massage the goal into a more convenient equivalent form by {REWRITE_TAC[TAUT `...`]} or {ONCE_REWRITE_TAC[TAUT `...`]}. \COMMENTS -The algorithm used is quite naive, and not efficient on large formulas. For +The algorithm used is quite naive, and not efficient on large formulas. For more general first-order reasoning, with quantifier instantiation, use MESON-based methods. diff --git a/Help/THEN.doc b/Help/THEN.doc index ccb161be..120b7ab8 100644 --- a/Help/THEN.doc +++ b/Help/THEN.doc @@ -24,13 +24,13 @@ Suppose we want to prove the inbuilt theorem {DELETE_INSERT} ourselves: # g `!x y. (x INSERT s) DELETE y = if x = y then s DELETE y else x INSERT (s DELETE y)`;; } -We may wish to perform a case-split using {COND_CASES_TAC}, but since variables +We may wish to perform a case-split using {COND_CASES_TAC}, but since variables in the if-then-else construct are bound, this is inapplicable. Thus we want to -first strip off the universally quantified variables: +first strip off the universally quantified variables: { # e(REPEAT GEN_TAC);; val it : goalstack = 1 subgoal (1 total) - + `(x INSERT s) DELETE y = (if x = y then s DELETE y else x INSERT (s DELETE y))` } @@ -40,7 +40,7 @@ first strip off the universally quantified variables: ... } A quicker way (starting again from the initial goal) would be to combine the -tactics using {THEN}: +tactics using {THEN}: { # e(REPEAT GEN_TAC THEN COND_CASES_TAC);; ... @@ -57,7 +57,7 @@ to multiple subgoals; sequences like the following: { EQ_TAC THEN ASM_REWRITE_TAC[] } -If using this several times in succession, remember that {THEN} is +If using this several times in succession, remember that {THEN} is left-associative. \SEEALSO diff --git a/Help/TOP_SWEEP_CONV.doc b/Help/TOP_SWEEP_CONV.doc index 07571e0f..8455f4d4 100644 --- a/Help/TOP_SWEEP_CONV.doc +++ b/Help/TOP_SWEEP_CONV.doc @@ -7,9 +7,9 @@ Repeatedly applies a conversion top-down at all levels, but after descending to subterms, does not return to higher ones. \DESCRIBE -The call {TOP_SWEEP_CONV conv} applies {conv} repeatedly at the top level of a -term, and then descends into subterms of the result, recursively doing the same -thing. However, once the subterms are dealt with, it does not, unlike +The call {TOP_SWEEP_CONV conv} applies {conv} repeatedly at the top level of a +term, and then descends into subterms of the result, recursively doing the same +thing. However, once the subterms are dealt with, it does not, unlike {TOP_DEPTH_CONV conv}, return to re-examine them. \FAILURE @@ -24,12 +24,12 @@ If we create an equation between large tuples: mk_eq(mkpairs "x",mkpairs "y");; ... } -\noindent we can observe that -{ +\noindent we can observe that +{ # time (TOP_DEPTH_CONV(REWR_CONV PAIR_EQ)); ();; } \noindent is a little bit slower than -{ +{ # time (TOP_SWEEP_CONV(REWR_CONV PAIR_EQ)); ();; } diff --git a/Help/TRANS.doc b/Help/TRANS.doc index fcafa181..77bdf2fe 100644 --- a/Help/TRANS.doc +++ b/Help/TRANS.doc @@ -11,7 +11,7 @@ rule, transitivity, equality. \DESCRIBE When applied to a theorem {A1 |- t1 = t2} and a theorem {A2 |- t2' = t3}, where {t2} and {t2'} are alpha-equivalent (in particular, where they are identical), -the inference rule {TRANS} returns the theorem {A1 u A2 |- t1 = t3}. +the inference rule {TRANS} returns the theorem {A1 u A2 |- t1 = t3}. { A1 |- t1 = t2 A2 |- t2' = t3 -------------------------------- TRANS diff --git a/Help/TRANS_TAC.doc b/Help/TRANS_TAC.doc index 42b79ac0..67b98023 100644 --- a/Help/TRANS_TAC.doc +++ b/Help/TRANS_TAC.doc @@ -44,7 +44,7 @@ relations {R1}, {R2} and {R3} may be, and often are, the same) and the conclusion matches the goal, in the usual sense of higher-order matching. \COMMENTS -The effect of {TRANS_TAC th t} can often be replicated by the more primitive +The effect of {TRANS_TAC th t} can often be replicated by the more primitive tactic sequence {MATCH_MP_TAC th THEN EXISTS_TAC t}. The use of {TRANS_TAC} is not only less verbose, but it is also more general in that it ensures correct type-instantiation of the theorem, whereas in highly polymorphic theorems the diff --git a/Help/TRY.doc b/Help/TRY.doc index f774ae84..4d4902d9 100644 --- a/Help/TRY.doc +++ b/Help/TRY.doc @@ -18,8 +18,8 @@ The application of {TRY} to a tactic never fails. The resulting tactic never fails. \EXAMPLE -We might want to try a certain tactic ``speculatively'', even if we're not sure -that it will work, for example, to handle the ``easy'' subgoals from breaking +We might want to try a certain tactic ``speculatively'', even if we're not sure +that it will work, for example, to handle the ``easy'' subgoals from breaking apart a large conjunction. On a small scale, we might want to prove: { # g `(x + 1) EXP 2 = x EXP 2 + 2 * x + 1 /\ @@ -27,13 +27,13 @@ apart a large conjunction. On a small scale, we might want to prove: (x < y ==> 2 * x + 1 < 2 * y)`;; ... } -\noindent and just see which conjuncts we can get rid of automatically by -{ARITH_TAC}. It turns out that it only leaves one subgoal with some nonlinear +\noindent and just see which conjuncts we can get rid of automatically by +{ARITH_TAC}. It turns out that it only leaves one subgoal with some nonlinear reasoning: { # e(REPEAT CONJ_TAC THEN TRY ARITH_TAC);; val it : goalstack = 1 subgoal (1 total) - + `x EXP 2 = y EXP 2 ==> x = y` } diff --git a/Help/TRY_CONV.doc b/Help/TRY_CONV.doc index a56d662f..043b56e3 100644 --- a/Help/TRY_CONV.doc +++ b/Help/TRY_CONV.doc @@ -10,7 +10,7 @@ conversion, failure. \DESCRIBE {TRY_CONV c `t`} attempts to apply the conversion {c} to the term {`t`}; if -this fails, then the identity conversion is applied instead giving the +this fails, then the identity conversion is applied instead giving the reflexive theorem {|- t = t}. \FAILURE diff --git a/Help/UNDISCH_TAC.doc b/Help/UNDISCH_TAC.doc index 1b4a4b49..fe4da461 100644 --- a/Help/UNDISCH_TAC.doc +++ b/Help/UNDISCH_TAC.doc @@ -19,7 +19,7 @@ tactic, discharge. {UNDISCH_TAC} will fail if {`v`} is not an assumption. \COMMENTS -{UNDISCH}arging {`v`} will remove all assumptions that are alpha-equivalent to +{UNDISCH}arging {`v`} will remove all assumptions that are alpha-equivalent to {`v`}. \SEEALSO diff --git a/Help/UNDISCH_THEN.doc b/Help/UNDISCH_THEN.doc index ca610c52..4d6c0be9 100644 --- a/Help/UNDISCH_THEN.doc +++ b/Help/UNDISCH_THEN.doc @@ -11,7 +11,7 @@ the assumptions to give a goal {A - {{a}} |- t}, and applies the theorem-tactic {ttac} to the assumption {.. |- a} and that new goal. \FAILURE -Fails if {a} is not an assumption; when applied to the goal it fails exactly if +Fails if {a} is not an assumption; when applied to the goal it fails exactly if the theorem-tactic fails on the modified goal. \COMMENTS diff --git a/Help/UNIFY_ACCEPT_TAC.doc b/Help/UNIFY_ACCEPT_TAC.doc index 1889a742..8cbc338f 100644 --- a/Help/UNIFY_ACCEPT_TAC.doc +++ b/Help/UNIFY_ACCEPT_TAC.doc @@ -13,7 +13,7 @@ and {t'} by instantiating free variables in {t} and metavariables in the list solution of the goal. \FAILURE -Fails if no unification will work. In fact, type instantiation is not at +Fails if no unification will work. In fact, type instantiation is not at present included in the unification. \EXAMPLE @@ -21,50 +21,50 @@ An inherently uninteresting but instructive example is the goal: { # g `(?x:num. p(x) /\ q(x) /\ r(x)) ==> ?y. p(y) /\ (q(y) <=> r(y))`;; } -\noindent which could of course be solved directly by {MESON_TAC[]} or -{ITAUT_TAC}. In fact, the process we will outline is close to what {ITAUT_TAC} +\noindent which could of course be solved directly by {MESON_TAC[]} or +{ITAUT_TAC}. In fact, the process we will outline is close to what {ITAUT_TAC} does automatically. Let's start with: { # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) - + 0 [`p x`] 1 [`q x`] 2 [`r x`] - + `?y. p y /\ (q y <=> r y)` } -\noindent and defer the actual choice of existential witness by introducing a +\noindent and defer the actual choice of existential witness by introducing a metavariable: { # e (X_META_EXISTS_TAC `n:num` THEN CONJ_TAC);; val it : goalstack = 2 subgoals (2 total) - + 0 [`p x`] 1 [`q x`] 2 [`r x`] - + `q n <=> r n` - + 0 [`p x`] 1 [`q x`] 2 [`r x`] - + `p n` } \noindent Now we finally fix the metavariable to match our assumption: { # e(FIRST_X_ASSUM(UNIFY_ACCEPT_TAC [`n:num`]));; val it : goalstack = 1 subgoal (1 total) - + 0 [`p x`] 1 [`q x`] 2 [`r x`] - - + + `q x <=> r x` } -\noindent Note that the metavariable has also been correspondingly instantiated +\noindent Note that the metavariable has also been correspondingly instantiated in the remaining goal, which we can solve easily: { # e(ASM_REWRITE_TAC[]);; diff --git a/Help/VALID.doc b/Help/VALID.doc index c22ee2c9..e7161069 100644 --- a/Help/VALID.doc +++ b/Help/VALID.doc @@ -9,9 +9,9 @@ Tries to ensure that a tactic is valid. tactical. \DESCRIBE -For any tactic {t}, the application {VALID t} gives a new tactic that does -exactly the same as {t} except that it also checks validity of the tactic -and will fail if it is violated. Validity means that the subgoals produced by +For any tactic {t}, the application {VALID t} gives a new tactic that does +exactly the same as {t} except that it also checks validity of the tactic +and will fail if it is violated. Validity means that the subgoals produced by {t} can, if proved, be used by the justification function given by {t} to construct a theorem corresponding to the original goal. diff --git a/Help/WEAK_CNF_CONV.doc b/Help/WEAK_CNF_CONV.doc index b452b88c..c3d0fa85 100644 --- a/Help/WEAK_CNF_CONV.doc +++ b/Help/WEAK_CNF_CONV.doc @@ -6,9 +6,9 @@ Converts a term already in negation normal form into conjunctive normal form. \DESCRIBE -When applied to a term already in negation normal form (see {NNF_CONV}), -meaning that all other propositional connectives have been eliminated in favour -of conjunction, disjunction and negation, and negation is only applied to +When applied to a term already in negation normal form (see {NNF_CONV}), +meaning that all other propositional connectives have been eliminated in favour +of conjunction, disjunction and negation, and negation is only applied to atomic formulas, {WEAK_CNF_CONV} puts the term into an equivalent conjunctive normal form, which is a conjunction of disjunctions. diff --git a/Help/X_CHOOSE_THEN.doc b/Help/X_CHOOSE_THEN.doc index fd75f5b2..38b3d2d0 100644 --- a/Help/X_CHOOSE_THEN.doc +++ b/Help/X_CHOOSE_THEN.doc @@ -46,10 +46,10 @@ Suppose we have the following goal: { # e(REPEAT GEN_TAC THEN REWRITE_TAC[LT_EXISTS]);; val it : goalstack = 1 subgoal (1 total) - + `(?d. n = m + SUC d) ==> m EXP 2 + 2 * m <= n EXP 2` } -\noindent we may then use {X_CHOOSE_THEN} to introduce the name {e} for the +\noindent we may then use {X_CHOOSE_THEN} to introduce the name {e} for the existential variable and immediately substitute it in the goal: { # e(DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST1_TAC));; diff --git a/Help/X_META_EXISTS_TAC.doc b/Help/X_META_EXISTS_TAC.doc index cb04c28c..0cc55a48 100644 --- a/Help/X_META_EXISTS_TAC.doc +++ b/Help/X_META_EXISTS_TAC.doc @@ -22,8 +22,8 @@ See {UNIFY_ACCEPT_TAC} for an example of using metavariables. Delaying instantiations until the correct term becomes clearer. \COMMENTS -Users should probably steer clear of using metavariables if possible. Note that -the metavariable instantiations apply across the whole fringe of goals, not +Users should probably steer clear of using metavariables if possible. Note that +the metavariable instantiations apply across the whole fringe of goals, not just the current goal, and can lead to confusion. \SEEALSO diff --git a/Help/alpha.doc b/Help/alpha.doc index 537c3a78..74fab04f 100644 --- a/Help/alpha.doc +++ b/Help/alpha.doc @@ -11,7 +11,7 @@ variable changed to {v'}, and other variables renamed if necessary. \FAILURE Fails if the first term is not a variable, or if the second is not an -abstraction, if the corresponding types are not the same, or if the desired new +abstraction, if the corresponding types are not the same, or if the desired new variable is already free in the abstraction. \EXAMPLE diff --git a/Help/apply.doc b/Help/apply.doc index 891058c0..0345325b 100644 --- a/Help/apply.doc +++ b/Help/apply.doc @@ -6,7 +6,7 @@ Applies a finite partial function, failing on undefined points. \DESCRIBE -This is one of a suite of operations on finite partial functions, type +This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} is a finite partial function and {x} an argument, {apply f x} tries @@ -21,7 +21,7 @@ to apply {f} to {x} and fails if it is undefined. } \SEEALSO -|->, |=>, applyd, choose, combine, defined, dom, foldl, foldr, +|->, |=>, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC diff --git a/Help/assocd.doc b/Help/assocd.doc index 082bb1c0..3dc24757 100644 --- a/Help/assocd.doc +++ b/Help/assocd.doc @@ -6,9 +6,9 @@ Looks up item in association list taking default in case of failure. \DESCRIBE -The call {assocd x [x1,y1; ...; xn,yn] y} returns the first {yi} in the list -where the corresponding {xi} is the same as {x}. If there is no such item, it -returns the value {y}. This is similar to {assoc} except that the latter will +The call {assocd x [x1,y1; ...; xn,yn] y} returns the first {yi} in the list +where the corresponding {xi} is the same as {x}. If there is no such item, it +returns the value {y}. This is similar to {assoc} except that the latter will fail rather than take a default. \FAILURE diff --git a/Help/aty.doc b/Help/aty.doc index 09030f5c..b01848a7 100644 --- a/Help/aty.doc +++ b/Help/aty.doc @@ -8,11 +8,11 @@ The type variable {`:A`}. \DESCRIBE This name is bound to the HOL type {:A}. -\FAILURE +\FAILURE Not applicable. \USES -Exploiting the very common type variable {:A} inside derived rules (e.g. an +Exploiting the very common type variable {:A} inside derived rules (e.g. an instantiation list for {inst} or {type_subst}) without the inefficiency or inconvenience of calling a quotation parser or explicit constructor. diff --git a/Help/b.doc b/Help/b.doc index 8c1af79d..53eb0d50 100644 --- a/Help/b.doc +++ b/Help/b.doc @@ -18,19 +18,19 @@ The function {b} will fail if the backup list is empty. { # g `(HD[1;2;3] = 1) /\ (TL[1;2;3] = [2;3])`;; val it : goalstack = 1 subgoal (1 total) - + `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` - + # e CONJ_TAC;; val it : goalstack = 2 subgoals (2 total) - + `TL [1; 2; 3] = [2; 3]` - + `HD [1; 2; 3] = 1` - + # b();; val it : goalstack = 1 subgoal (1 total) - + `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` } diff --git a/Help/basic_convs.doc b/Help/basic_convs.doc index aae4dec2..382440ff 100644 --- a/Help/basic_convs.doc +++ b/Help/basic_convs.doc @@ -16,9 +16,9 @@ Never fails. \EXAMPLE In the default HOL Light state the only conversions are for generalized beta -reduction and the reduction of pattern-matching constructs such as +reduction and the reduction of pattern-matching constructs such as {match...with}. All the other default simplifications are done by rewrite -rules. +rules. { # basic_convs();; val it : (string * (term * conv)) list = diff --git a/Help/basic_net.doc b/Help/basic_net.doc index 69d0a47f..8538574a 100644 --- a/Help/basic_net.doc +++ b/Help/basic_net.doc @@ -3,21 +3,21 @@ \TYPE {basic_net : unit -> gconv net} \SYNOPSIS -Returns the term net used to optimize access to default rewrites and +Returns the term net used to optimize access to default rewrites and conversions. \DESCRIBE -The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) -have default sets of (conditional) equations and other conversions that are -applied by default, except in the {PURE_} variants. Internally, these are -maintained in a term net (see {enter} and {lookup} for more information), and a +The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) +have default sets of (conditional) equations and other conversions that are +applied by default, except in the {PURE_} variants. Internally, these are +maintained in a term net (see {enter} and {lookup} for more information), and a call to {basic_net()} returns that net. \FAILURE Never fails. \USES -Only useful for those who are delving deep into the implementation of +Only useful for those who are delving deep into the implementation of rewriting. \SEEALSO diff --git a/Help/basic_prover.doc b/Help/basic_prover.doc index cdcb240b..93a565f2 100644 --- a/Help/basic_prover.doc +++ b/Help/basic_prover.doc @@ -8,10 +8,10 @@ The basic prover use function used in the simplifier. \DESCRIBE The HOL Light simplifier (e.g. as invoked by {SIMP_TAC}) allows provers of type {prover} to be installed into simpsets, to automatically dispose of -side-conditions. There is another component of the simpset that controls how -these are applied to unproven subgoals arising in simplification. The -{basic_prover} function, which is used in all the standard simpsets, simply -tries to simplify the goals with the rewrites as far as possible, then tries +side-conditions. There is another component of the simpset that controls how +these are applied to unproven subgoals arising in simplification. The +{basic_prover} function, which is used in all the standard simpsets, simply +tries to simplify the goals with the rewrites as far as possible, then tries the provers one at a time on the resulting subgoals till one succeeds. \FAILURE diff --git a/Help/basic_rewrites.doc b/Help/basic_rewrites.doc index 44036a8a..e65bbc07 100644 --- a/Help/basic_rewrites.doc +++ b/Help/basic_rewrites.doc @@ -6,16 +6,16 @@ Returns the set of built-in theorems used, by default, in rewriting. \DESCRIBE -The list of theorems returned by {basic_rewrites()} is applied by default in -rewriting conversions, rules and tactics such as {ONCE_REWRITE_CONV}, +The list of theorems returned by {basic_rewrites()} is applied by default in +rewriting conversions, rules and tactics such as {ONCE_REWRITE_CONV}, {REWRITE_RULE} and {SIMP_TAC}, though not in the `pure' variants like {PURE_REWRITE_TAC}. This default set can be modified using {extend_basic_rewrites}, {set_basic_rewrites}. Other conversions, not -necessarily expressible as rewriting with a theorem, can be added using +necessarily expressible as rewriting with a theorem, can be added using {set_basic_convs} and {extend_basic_convs} and examined by {basic_convs}. \EXAMPLE -The following shows the list of default rewrites in the standard HOL Light +The following shows the list of default rewrites in the standard HOL Light state. Most of them are basic logical tautologies. { # basic_rewrites();; @@ -38,8 +38,8 @@ The {basic_rewrites} are included in the set of equations used by some of the rewriting tools. \SEEALSO -extend_basic_rewrites, set_basic_rewrites, set_basic_convs, extend_basic_convs, -basic_convs, REWRITE_CONV, REWRITE_RULE, REWRITE_TAC, SIMP_CONV, SIMP_RULE, +extend_basic_rewrites, set_basic_rewrites, set_basic_convs, extend_basic_convs, +basic_convs, REWRITE_CONV, REWRITE_RULE, REWRITE_TAC, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC diff --git a/Help/binops.doc b/Help/binops.doc index 538ed3cf..a120ef3f 100644 --- a/Help/binops.doc +++ b/Help/binops.doc @@ -6,10 +6,10 @@ Repeatedly breaks apart an iterated binary operator into components. \DESCRIBE -The call {binops op t} repeatedly breaks down applications of the binary -operator {op} within {t}. If {t} is of the form {(op l) r} (thinking of {op} as -infix, {l op r}), then it recursively breaks down {l} and {r} in the same way -and appends the results. Otherwise, a singleton list of the original term is +The call {binops op t} repeatedly breaks down applications of the binary +operator {op} within {t}. If {t} is of the form {(op l) r} (thinking of {op} as +infix, {l op r}), then it recursively breaks down {l} and {r} in the same way +and appends the results. Otherwise, a singleton list of the original term is returned. \FAILURE diff --git a/Help/bool_ty.doc b/Help/bool_ty.doc index 69fadd70..5b06b15c 100644 --- a/Help/bool_ty.doc +++ b/Help/bool_ty.doc @@ -12,7 +12,7 @@ This name is bound to the HOL type {:bool}. Not applicable. \USES -Exploiting the very common type {:bool} inside derived rules without the +Exploiting the very common type {:bool} inside derived rules without the inefficiency or inconvenience of calling a quotation parser or explicit constructor. diff --git a/Help/bty.doc b/Help/bty.doc index 2b0a1b0d..6f2617fc 100644 --- a/Help/bty.doc +++ b/Help/bty.doc @@ -8,11 +8,11 @@ The type variable {`:B`}. \DESCRIBE This name is bound to the HOL type {:B}. -\FAILURE +\FAILURE Not applicable. \USES -Exploiting the very common type variable {:B} inside derived rules (e.g. an +Exploiting the very common type variable {:B} inside derived rules (e.g. an instantiation list for {inst} or {type_subst}) without the inefficiency or inconvenience of calling a quotation parser or explicit constructor. diff --git a/Help/by.doc b/Help/by.doc index d3f1dc37..ee0ef681 100644 --- a/Help/by.doc +++ b/Help/by.doc @@ -6,8 +6,8 @@ Converts a tactic to a refinement. \DESCRIBE -The call {by tac} for a tactic {tac} gives a refinement of the current list of -subgoals that applies {tac} to the first subgoal. +The call {by tac} for a tactic {tac} gives a refinement of the current list of +subgoals that applies {tac} to the first subgoal. \COMMENTS Only of interest to users who want to handle `refinements' explicitly. diff --git a/Help/cases.doc b/Help/cases.doc index 4a1c320b..b7a2315f 100644 --- a/Help/cases.doc +++ b/Help/cases.doc @@ -6,9 +6,9 @@ Produce cases theorem for an inductive type. \DESCRIBE -A call {cases "ty"} where {"ty"} is the name of a recursive type defined with -{define_type}, returns a ``cases'' theorem asserting that each element of the -type is an instance of one of the type constructors. The effect is exactly +A call {cases "ty"} where {"ty"} is the name of a recursive type defined with +{define_type}, returns a ``cases'' theorem asserting that each element of the +type is an instance of one of the type constructors. The effect is exactly the same is if {prove_cases_thm} were applied to the induction theorem produced by {define_type}, and the documentation for {prove_cases_thm} gives a lengthier discussion. diff --git a/Help/check.doc b/Help/check.doc index e14bc0b8..53b4044f 100644 --- a/Help/check.doc +++ b/Help/check.doc @@ -22,7 +22,7 @@ Checks that a value satisfies a predicate. } \USES -Can be used to filter out candidates from a set of terms, e.g. to apply +Can be used to filter out candidates from a set of terms, e.g. to apply theorem-tactics to assumptions with a certain pattern. \SEEALSO diff --git a/Help/choose.doc b/Help/choose.doc index 1f427d30..9b647d88 100644 --- a/Help/choose.doc +++ b/Help/choose.doc @@ -26,7 +26,7 @@ Fails if and only if the finite partial function is completely undefined. } \SEEALSO -|->, |=>, apply, applyd, combine, defined, dom, foldl, foldr, +|->, |=>, apply, applyd, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC diff --git a/Help/comment_token.doc b/Help/comment_token.doc index dd5bd3bd..3fe369ca 100644 --- a/Help/comment_token.doc +++ b/Help/comment_token.doc @@ -18,7 +18,7 @@ break. Not applicable. \EXAMPLE -Here we change the comment token to be `{--}' (as used in Ada, Eiffel, Haskell, +Here we change the comment token to be `{--}' (as used in Ada, Eiffel, Haskell, Occam and several other programming languages): { # comment_token := Ident "--";; diff --git a/Help/compose_insts.doc b/Help/compose_insts.doc index c9a86ed4..efa2dfb0 100644 --- a/Help/compose_insts.doc +++ b/Help/compose_insts.doc @@ -8,7 +8,7 @@ Compose two instantiations. \DESCRIBE Given two instantiations {i1} and {i2} (with type {instantiation}, as returned by {term_match} for example), the call {compose_insts i1 i2} will give a new -instantiation that results from composing them, with {i1} applied first and +instantiation that results from composing them, with {i1} applied first and then {i2}. For example, {instantiate (compose_insts i1 i2) t} should be the same as {instantiate i2 (instantiate i1 t)}. @@ -16,7 +16,7 @@ same as {instantiate i2 (instantiate i1 t)}. Never fails. \COMMENTS -Mostly of specialized interest; used in sequencing tactics like {THEN} to +Mostly of specialized interest; used in sequencing tactics like {THEN} to compose metavariable instantiations. \SEEALSO diff --git a/Help/concl.doc b/Help/concl.doc index 647b38be..ac64a1db 100644 --- a/Help/concl.doc +++ b/Help/concl.doc @@ -13,7 +13,7 @@ Never fails. \EXAMPLE { - # ADD_SYM;; + # ADD_SYM;; val it : thm = |- !m n. m + n = n + m # concl ADD_SYM;; val it : term = `!m n. m + n = n + m` diff --git a/Help/conjuncts.doc b/Help/conjuncts.doc index 23c34409..282d5446 100644 --- a/Help/conjuncts.doc +++ b/Help/conjuncts.doc @@ -9,7 +9,7 @@ Iteratively breaks apart a conjunction. If a term {t} is a conjunction {p /\ q}, then {conjuncts t} will recursively break down {p} and {q} into conjuncts and append the resulting lists. Otherwise it will return the singleton list {[t]}. So if {t} is of the form -{t1 /\ ... /\ tn} with any reassociation, no {ti} itself being a conjunction, +{t1 /\ ... /\ tn} with any reassociation, no {ti} itself being a conjunction, the list returned will be {[t1; ...; tn]}. But { conjuncts(list_mk_conj([t1;...;tn])) @@ -31,7 +31,7 @@ Never fails, even if the term is not boolean. \COMMENTS Because {conjuncts} splits both the left and right sides of a conjunction, -this operation is not the inverse of {list_mk_conj}. You can also use +this operation is not the inverse of {list_mk_conj}. You can also use {splitlist dest_conj} to split in a right-associated way only. \SEEALSO diff --git a/Help/current_goalstack.doc b/Help/current_goalstack.doc index 34b166e9..d7e24acc 100644 --- a/Help/current_goalstack.doc +++ b/Help/current_goalstack.doc @@ -6,14 +6,14 @@ Reference variable holding current goalstack. \DESCRIBE -The reference variable {current_goalstack} contains the current goalstack. A +The reference variable {current_goalstack} contains the current goalstack. A goalstack is a type containing a list of goalstates. \FAILURE Not applicable. \COMMENTS -Users will probably not often want to examine this variable explicitly, since +Users will probably not often want to examine this variable explicitly, since various proof commands modify it in various ways. \SEEALSO diff --git a/Help/decreasing.doc b/Help/decreasing.doc index ed259b18..4ac0aefb 100644 --- a/Help/decreasing.doc +++ b/Help/decreasing.doc @@ -3,7 +3,7 @@ \TYPE {decreasing : ('a -> 'b) -> 'a -> 'a -> bool} \SYNOPSIS -When applied to a ``measure'' function {f}, the call {increasing f} returns a +When applied to a ``measure'' function {f}, the call {increasing f} returns a binary function ordering elements in a call {increasing f x y} by {f(y) , |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, +|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefined. \ENDDOC diff --git a/Help/definitions.doc b/Help/definitions.doc index e1a087a7..9299a0ea 100644 --- a/Help/definitions.doc +++ b/Help/definitions.doc @@ -6,7 +6,7 @@ Returns the current set of primitive definitions. \DESCRIBE -A call {definitions()} returns the current list of basic definitions made in +A call {definitions()} returns the current list of basic definitions made in the HOL Light kernel. \FAILURE @@ -14,13 +14,13 @@ Never fails. \COMMENTS This is a more logically primitive list than the one maintained in the list -{!the_definitions}, and is intended mainly for auditing a proof development +{!the_definitions}, and is intended mainly for auditing a proof development that uses axioms to ensure that no axioms and definitions clash. Under normal circumstances axioms are not used and so this information is not needed. Definitions returned by {definitions()} are in their primitive equational form, and include everything defined in the kernel. By contrast, those in the list {!the_definitions} are often quantified and eta-expanded, and the list may be -incomplete since it is only maintained outside the logical kernel as a +incomplete since it is only maintained outside the logical kernel as a convenience. \SEEALSO diff --git a/Help/denominator.doc b/Help/denominator.doc index c0697903..55ae5905 100644 --- a/Help/denominator.doc +++ b/Help/denominator.doc @@ -17,9 +17,9 @@ Never fails. { # denominator(Int 22 // Int 7);; val it : num = 7 - # denominator(Int 0);; + # denominator(Int 0);; val it : num = 1 - # denominator(Int 100);; + # denominator(Int 100);; val it : num = 1 # denominator(Int 4 // Int(-2));; val it : num = 1 diff --git a/Help/derive_nonschematic_inductive_relations.doc b/Help/derive_nonschematic_inductive_relations.doc index d29674bf..077d104c 100644 --- a/Help/derive_nonschematic_inductive_relations.doc +++ b/Help/derive_nonschematic_inductive_relations.doc @@ -8,12 +8,12 @@ Deduce inductive definitions properties from an explicit assignment. \DESCRIBE Given a set of clauses as given to {new_inductive_definitions}, the call {derive_nonschematic_inductive_relations} will introduce explicit equational -constraints (``definitions'', though only assumptions of the theorem, not -actually constant definitions) that allow it to deduce those clauses. It will -in general have additional `monotonicity' hypotheses, but these may be -removable by {prove_monotonicity_hyps}. None of the arguments are treated as +constraints (``definitions'', though only assumptions of the theorem, not +actually constant definitions) that allow it to deduce those clauses. It will +in general have additional `monotonicity' hypotheses, but these may be +removable by {prove_monotonicity_hyps}. None of the arguments are treated as schematic. - + \FAILURE Fails if the format of the clauses is wrong. @@ -22,7 +22,7 @@ Here we try one of the classic examples of a mutually inductive definition, defining odd-ness and even-ness of natural numbers: { # (prove_monotonicity_hyps o derive_nonschematic_inductive_relations) - `even(0) /\ odd(1) /\ + `even(0) /\ odd(1) /\ (!n. even(n) ==> odd(n + 1)) /\ (!n. odd(n) ==> even(n + 1))`;; val it : thm = odd = @@ -48,16 +48,16 @@ defining odd-ness and even-ness of natural numbers: (!a0. odd a0 <=> a0 = 1 \/ (?n. a0 = n + 1 /\ even n)) /\ (!a1. even a1 <=> a1 = 0 \/ (?n. a1 = n + 1 /\ odd n)) } -\noindent Note that the final theorem has two assumptions that one can think of -as the appropriate explicit definitions of these relations, and the conclusion +\noindent Note that the final theorem has two assumptions that one can think of +as the appropriate explicit definitions of these relations, and the conclusion gives the rule, induction and cases theorems. \COMMENTS -Normally, use {prove_inductive_relations_exist} or {new_inductive_definition}. +Normally, use {prove_inductive_relations_exist} or {new_inductive_definition}. This function is only needed for a very fine level of control. \SEEALSO -new_inductive_definition, prove_inductive_relations_exist, +new_inductive_definition, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC diff --git a/Help/derive_strong_induction.doc b/Help/derive_strong_induction.doc index 170f6f72..1f3362cf 100644 --- a/Help/derive_strong_induction.doc +++ b/Help/derive_strong_induction.doc @@ -6,15 +6,15 @@ Derive stronger induction theorem from inductive definition. \DESCRIBE -The function {derive_strong_induction} is applied to a pair of theorems as -returned by {new_inductive_definition}. The first theorem is the `rule' -theorem, the second the `induction' theorem; the `case' theorem returned by -{new_inductive_definition} is not needed. It returns a stronger induction -theorem where instances of each inductive predicate occurring in hypotheses +The function {derive_strong_induction} is applied to a pair of theorems as +returned by {new_inductive_definition}. The first theorem is the `rule' +theorem, the second the `induction' theorem; the `case' theorem returned by +{new_inductive_definition} is not needed. It returns a stronger induction +theorem where instances of each inductive predicate occurring in hypotheses is conjoined with the corresponding inductive relation too. \FAILURE -Fails if the two input theorems are not of the correct form for rule and +Fails if the two input theorems are not of the correct form for rule and induction theorems returned by {new_inductive_definition}. \EXAMPLE @@ -40,7 +40,7 @@ A simple example of a mutually inductive definition is: |- (!a0. odd a0 <=> a0 = 1 \/ (?n. a0 = n + 1 /\ even n)) /\ (!a1. even a1 <=> a1 = 0 \/ (?n. a1 = n + 1 /\ odd n)) } -The stronger induction theorem can be derived as follows. Note that it is +The stronger induction theorem can be derived as follows. Note that it is similar in form to {eo_INDUCT} but has stronger hypotheses for two of the conjuncts in the antecedent. { @@ -55,16 +55,16 @@ conjuncts in the antecedent. } \COMMENTS -This function needs to discharge monotonicity theorems as part of its internal -working, just as {new_inductive_definition} does when the inductive definition -is made. Usually this is automatic and the user doesn't see it, but in -difficult cases, the theorem returned may have additional monotonicity +This function needs to discharge monotonicity theorems as part of its internal +working, just as {new_inductive_definition} does when the inductive definition +is made. Usually this is automatic and the user doesn't see it, but in +difficult cases, the theorem returned may have additional monotonicity hypotheses that are unproven. In such cases, you can either try to prove them -manually or extend {monotonicity_theorems} to make the built-in monotonicity +manually or extend {monotonicity_theorems} to make the built-in monotonicity prover more powerful. \SEEALSO -new_inductive_definition, prove_inductive_relations_exist, +new_inductive_definition, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC diff --git a/Help/dest_binder.doc b/Help/dest_binder.doc index 368a0d86..f4f39516 100644 --- a/Help/dest_binder.doc +++ b/Help/dest_binder.doc @@ -7,16 +7,16 @@ Breaks apart a ``binder''. \DESCRIBE Applied to a term {tm} of the form {`c (\x. t)`} where {c} is a constant whose -name is {"s"}, the call {dest_binder "c" tm} returns {(`x`,`t`)}. Note that -this is actually independent of whether the name parses as a binder, but the +name is {"s"}, the call {dest_binder "c" tm} returns {(`x`,`t`)}. Note that +this is actually independent of whether the name parses as a binder, but the usual application is where it does. \FAILURE -Fails if the term is not of the appropriate form with a constant of the same +Fails if the term is not of the appropriate form with a constant of the same name. \EXAMPLE -The call {dest_binder "!"} is the same as {dest_forall}, and is in fact how +The call {dest_binder "!"} is the same as {dest_forall}, and is in fact how that function is implemented. \SEEALSO diff --git a/Help/dest_binop.doc b/Help/dest_binop.doc index 30064a87..e63a3ba2 100644 --- a/Help/dest_binop.doc +++ b/Help/dest_binop.doc @@ -6,8 +6,8 @@ Breaks apart an application of a given binary operator to two arguments. \DESCRIBE -The call {dest_binop op t}, where {t} is of the form {(op l) r}, will return -the pair {l,r}. If {t} is not of that form, it fails. Note that {op} can be any +The call {dest_binop op t}, where {t} is of the form {(op l) r}, will return +the pair {l,r}. If {t} is not of that form, it fails. Note that {op} can be any term; it need not be a constant nor parsed infix. \FAILURE diff --git a/Help/dest_char.doc b/Help/dest_char.doc index 857cf34b..d6883c47 100644 --- a/Help/dest_char.doc +++ b/Help/dest_char.doc @@ -6,7 +6,7 @@ Produces OCaml character corresponding to object-level character. \DESCRIBE -{dest_char t} where {t} is a term of HOL type {char}, produces the +{dest_char t} where {t} is a term of HOL type {char}, produces the corresponding OCaml character. \FAILURE @@ -22,9 +22,9 @@ Fails if the term is not of type {char} } \COMMENTS -There is no particularly convenient parser/printer support for the HOL {char} -type, but when combined into lists they are considered as strings and provided -with more intuitive parser/printer support. +There is no particularly convenient parser/printer support for the HOL {char} +type, but when combined into lists they are considered as strings and provided +with more intuitive parser/printer support. \SEEALSO dest_string, mk_char, mk_string. diff --git a/Help/dest_comb.doc b/Help/dest_comb.doc index b1e02258..048beb4f 100644 --- a/Help/dest_comb.doc +++ b/Help/dest_comb.doc @@ -20,7 +20,7 @@ Fails with {dest_comb} if term is not a combination. # dest_comb `SUC 0`;; val it : term * term = (`SUC`, `0`) } -We can use {dest_comb} to reveal more about the internal representation of +We can use {dest_comb} to reveal more about the internal representation of numerals: { # dest_comb `12`;; diff --git a/Help/dest_finty.doc b/Help/dest_finty.doc index db78049d..cb0a62c1 100644 --- a/Help/dest_finty.doc +++ b/Help/dest_finty.doc @@ -6,7 +6,7 @@ Converts a standard finite type to corresponding integer. \DESCRIBE -Finite types parsed and printed as numerals are provided, and this operation +Finite types parsed and printed as numerals are provided, and this operation when applied to such a type gives the corresponding number. \FAILURE diff --git a/Help/dest_fun_ty.doc b/Help/dest_fun_ty.doc index 60b99588..9ed719fb 100644 --- a/Help/dest_fun_ty.doc +++ b/Help/dest_fun_ty.doc @@ -6,16 +6,16 @@ Break apart a function type into domain and range. \DESCRIBE -The call {dest_fun_ty `:s->t`} breaks apart the function type {s->t} and +The call {dest_fun_ty `:s->t`} breaks apart the function type {s->t} and returns the pair {`:s`,`:t`}. \FAILURE -Fails if the type given as argument is not a function type (constructor +Fails if the type given as argument is not a function type (constructor {"fun"}). \EXAMPLE { - # dest_fun_ty `:A->B`;; + # dest_fun_ty `:A->B`;; val it : hol_type * hol_type = (`:A`, `:B`) # dest_fun_ty `:num->num->bool`;; diff --git a/Help/dest_iff.doc b/Help/dest_iff.doc index 8bb5725a..cf68e4e3 100644 --- a/Help/dest_iff.doc +++ b/Help/dest_iff.doc @@ -9,18 +9,18 @@ Term destructor for logical equivalence. {dest_iff(`t1 <=> t2`)} returns {(`t1`,`t2`)}. \FAILURE -Fails with if term is not a logical equivalence, i.e. an equation between terms +Fails with if term is not a logical equivalence, i.e. an equation between terms of Boolean type. \EXAMPLE { - # dest_iff `x = y <=> y = 1`;; + # dest_iff `x = y <=> y = 1`;; val it : term * term = (`x = y`, `y = 1`) } \COMMENTS -The function {dest_eq} has the same effect, but the present function checks -that the types of the two sides are indeed Boolean, whereas {dest_eq} will +The function {dest_eq} has the same effect, but the present function checks +that the types of the two sides are indeed Boolean, whereas {dest_eq} will break apart any equation. \SEEALSO diff --git a/Help/dest_numeral.doc b/Help/dest_numeral.doc index 879467cf..b39d36ad 100644 --- a/Help/dest_numeral.doc +++ b/Help/dest_numeral.doc @@ -25,7 +25,7 @@ Fails if the term is not a numeral. \COMMENTS The similar function {dest_small_numeral} maps to a machine integer, which means it may overflow. So the use of {dest_numeral} is better unless you are -very sure of the range. +very sure of the range. { # dest_small_numeral `18446744073709551616`;; Exception: Failure "int_of_big_int". diff --git a/Help/dest_realintconst.doc b/Help/dest_realintconst.doc index 3c0a31c6..7fc5628e 100644 --- a/Help/dest_realintconst.doc +++ b/Help/dest_realintconst.doc @@ -12,7 +12,7 @@ forms of integer literals are `{&n}' for a numeral {n} or `{-- &n}' for a nonzero numeral {n}. \FAILURE -Fails if applied to a term that is not a canonical integer literal of type +Fails if applied to a term that is not a canonical integer literal of type {:real}. \EXAMPLE diff --git a/Help/dest_setenum.doc b/Help/dest_setenum.doc index 9a8e3b3e..47a943e6 100644 --- a/Help/dest_setenum.doc +++ b/Help/dest_setenum.doc @@ -7,9 +7,9 @@ Breaks apart a set enumeration. \DESCRIBE {dest_setenum} is a term destructor for set enumerations: -{dest_setenum `{{t1,...,tn}}`} returns {[`t1`;...;`tn`]}. Note that the list -follows the syntactic pattern of the set enumeration, even if it contains -duplicates. (The underlying set is still a set logically, of course, but can be +{dest_setenum `{{t1,...,tn}}`} returns {[`t1`;...;`tn`]}. Note that the list +follows the syntactic pattern of the set enumeration, even if it contains +duplicates. (The underlying set is still a set logically, of course, but can be represented redundantly.) \FAILURE diff --git a/Help/dest_uexists.doc b/Help/dest_uexists.doc index 4130331a..cc65bebe 100644 --- a/Help/dest_uexists.doc +++ b/Help/dest_uexists.doc @@ -6,7 +6,7 @@ Breaks apart a unique existence term. \DESCRIBE -If {t} has the form {?!x. p[x]} (there exists a unique [x} such that {p[x]} +If {t} has the form {?!x. p[x]} (there exists a unique [x} such that {p[x]} then {dest_uexists t} returns the pair {x,p[x]}; otherwise it fails. \FAILURE diff --git a/Help/disjuncts.doc b/Help/disjuncts.doc index 43496398..09c1e110 100644 --- a/Help/disjuncts.doc +++ b/Help/disjuncts.doc @@ -9,7 +9,7 @@ Iteratively breaks apart a disjunction. If a term {t} is a disjunction {p \/ q}, then {disjuncts t} will recursively break down {p} and {q} into disjuncts and append the resulting lists. Otherwise it will return the singleton list {[t]}. So if {t} is of the form -{t1 \/ ... \/ tn} with any reassociation, no {ti} itself being a disjunction, +{t1 \/ ... \/ tn} with any reassociation, no {ti} itself being a disjunction, the list returned will be {[t1; ...; tn]}. But { disjuncts(list_mk_disj([t1;...;tn])) @@ -25,16 +25,16 @@ Never fails, even if the term is not boolean. # list_mk_disj [`a \/ b`;`c \/ d`;`e \/ f`];; val it : term = `(a \/ b) \/ (c \/ d) \/ e \/ f` - # disjuncts it;; - val it : term list = [`a`; `b`; `c`; `d`; `e`; `f`] + # disjuncts it;; + val it : term list = [`a`; `b`; `c`; `d`; `e`; `f`] - # disjuncts `1`;; - val it : term list = [`1`] + # disjuncts `1`;; + val it : term list = [`1`] } \COMMENTS Because {disjuncts} splits both the left and right sides of a disjunction, -this operation is not the inverse of {list_mk_disj}. You can also use +this operation is not the inverse of {list_mk_disj}. You can also use {splitlist dest_disj} to split in a right-associated way only. \SEEALSO diff --git a/Help/distinctness_store.doc b/Help/distinctness_store.doc index d8ad82e8..45df1e15 100644 --- a/Help/distinctness_store.doc +++ b/Help/distinctness_store.doc @@ -6,8 +6,8 @@ Internal theorem list of distinctness theorems. \DESCRIBE -This list contains all the distinctness theorems (see {distinct}) for the -recursive types defined so far. It is automatically extended by {define_type} +This list contains all the distinctness theorems (see {distinct}) for the +recursive types defined so far. It is automatically extended by {define_type} and used as a cache by {distinct}. \FAILURE @@ -15,5 +15,5 @@ Not applicable. \SEEALSO define_type, distinctness, extend_rectype_net, injectivity_store. - + \ENDDOC diff --git a/Help/do_list.doc b/Help/do_list.doc index 79c7ef06..dafb291b 100644 --- a/Help/do_list.doc +++ b/Help/do_list.doc @@ -6,9 +6,9 @@ Apply imperative function to each element of a list. \DESCRIBE -The call {do_list f [x1; ... ; xn]} evaluates in sequence the expressions -{f x1}, ..., {f xn} in that order, discarding the results. Presumably the -applications will have some side-effect, such as printing something to the +The call {do_list f [x1; ... ; xn]} evaluates in sequence the expressions +{f x1}, ..., {f xn} in that order, discarding the results. Presumably the +applications will have some side-effect, such as printing something to the terminal. \EXAMPLE diff --git a/Help/dpty.doc b/Help/dpty.doc index cb59ae2e..fd0cac7e 100644 --- a/Help/dpty.doc +++ b/Help/dpty.doc @@ -6,7 +6,7 @@ Dummy pretype. \DESCRIBE -This is a dummy pretype, intended as a placeholder until the correct one is +This is a dummy pretype, intended as a placeholder until the correct one is discovered. \FAILURE diff --git a/Help/empty_ss.doc b/Help/empty_ss.doc index 89f2aeb0..63785c93 100644 --- a/Help/empty_ss.doc +++ b/Help/empty_ss.doc @@ -6,9 +6,9 @@ Simpset consisting of only the default rewrites and conversions. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset'. The simpset {empty_ss} has just -the basic rewrites and conversions (see {basic_rewrites} and {basic_convs}), +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset'. The simpset {empty_ss} has just +the basic rewrites and conversions (see {basic_rewrites} and {basic_convs}), and no other provers. \FAILURE diff --git a/Help/equals_goal.doc b/Help/equals_goal.doc index 891d00dc..ccae6162 100644 --- a/Help/equals_goal.doc +++ b/Help/equals_goal.doc @@ -6,9 +6,9 @@ Equality test on goals. \DESCRIBE -The relation {equals_goal} tests if two goals have exactly the same structure, -with the same assumptions, conclusions and even labels, with the assumptions in -the same order. The only respect in which this differs from a pure equality +The relation {equals_goal} tests if two goals have exactly the same structure, +with the same assumptions, conclusions and even labels, with the assumptions in +the same order. The only respect in which this differs from a pure equality tests is that the various term components are tested modulo alpha-conversion. \FAILURE diff --git a/Help/equals_thm.doc b/Help/equals_thm.doc index 185f5c4a..faf867f2 100644 --- a/Help/equals_thm.doc +++ b/Help/equals_thm.doc @@ -6,10 +6,10 @@ Equality test on theorems. \DESCRIBE -The call {equals_thm th1 th2} returns {true} if and only if both the -conclusions and assumptions of the two theorems {th1} and {th2} are exactly the -same. The same can be achieved by a simple equality test, but it is better -practice to use this function because it will also work in the proof recording +The call {equals_thm th1 th2} returns {true} if and only if both the +conclusions and assumptions of the two theorems {th1} and {th2} are exactly the +same. The same can be achieved by a simple equality test, but it is better +practice to use this function because it will also work in the proof recording version of HOL Light (see the {Proofrecording} subdirectory). \FAILURE diff --git a/Help/exists.doc b/Help/exists.doc index 7b47b027..e8c17cb2 100644 --- a/Help/exists.doc +++ b/Help/exists.doc @@ -10,7 +10,7 @@ list. \DESCRIBE {exists p [x1;...;xn]} returns {true} if {(p xi)} is true for some {xi} in the -list. Otherwise, for example if the list is empty, it returns {false}. +list. Otherwise, for example if the list is empty, it returns {false}. \FAILURE Never fails. diff --git a/Help/extend_basic_congs.doc b/Help/extend_basic_congs.doc index 003ee186..c0243b44 100644 --- a/Help/extend_basic_congs.doc +++ b/Help/extend_basic_congs.doc @@ -6,21 +6,21 @@ Extends the set of congruence rules used by the simplifier. \DESCRIBE -The HOL Light simplifier (as invoked by {SIMP_TAC} etc.) uses congruence rules -to determine how it uses context when descending through a term. These are -essentially theorems showing how to decompose one equality to a series of other -inequalities in context. A call to {extend_basic_congs thl} adds the congruence +The HOL Light simplifier (as invoked by {SIMP_TAC} etc.) uses congruence rules +to determine how it uses context when descending through a term. These are +essentially theorems showing how to decompose one equality to a series of other +inequalities in context. A call to {extend_basic_congs thl} adds the congruence rules in {thl} to the defaults. \FAILURE Never fails. \EXAMPLE -By default, the simplifier uses context {p} when simplifying {q} within an +By default, the simplifier uses context {p} when simplifying {q} within an implication {p ==> q}. Some users would like the simplifier to do likewise for a conjunction {p /\ q}, which is not done by default: { - # SIMP_CONV[] `x = 1 /\ x < 2`;; + # SIMP_CONV[] `x = 1 /\ x < 2`;; val it : thm = |- x = 1 /\ x < 2 <=> x = 1 /\ x < 2 } \noindent You can make it do so with @@ -31,10 +31,10 @@ a conjunction {p /\ q}, which is not done by default: } \noindent as you can see: { - # SIMP_CONV[] `x = 1 /\ x < 2`;; + # SIMP_CONV[] `x = 1 /\ x < 2`;; val it : thm = |- x = 1 /\ x < 2 <=> x = 1 /\ 1 < 2 - # SIMP_CONV[ARITH] `x = 1 /\ x < 2`;; + # SIMP_CONV[ARITH] `x = 1 /\ x < 2`;; val it : thm = |- x = 1 /\ x < 2 <=> x = 1 } diff --git a/Help/extend_basic_convs.doc b/Help/extend_basic_convs.doc index f5eb3611..d9fe293d 100644 --- a/Help/extend_basic_convs.doc +++ b/Help/extend_basic_convs.doc @@ -6,11 +6,11 @@ Extend the set of default conversions used by rewriting and simplification. \DESCRIBE -The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) -have default sets of (conditional) equations and other conversions that are +The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) +have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. The latter are normally term transformations that cannot be expressed as single (conditional or -unconditional) rewrite rules. A call to +unconditional) rewrite rules. A call to { extend_basic_convs("name",(`pat`,conv)) } @@ -21,15 +21,15 @@ refer to it and restricting it to subterms encountered that match {pat}. Never fails. \EXAMPLE -By default, no arithmetic is done in rewriting, though rewriting with the -theorem {ARITH} gives that effect. +By default, no arithmetic is done in rewriting, though rewriting with the +theorem {ARITH} gives that effect. { # REWRITE_CONV[] `x = 1 + 2 + 3 + 4`;; val it : thm = |- x = 1 + 2 + 3 + 4 <=> x = 1 + 2 + 3 + 4 } You can add {NUM_ADD_CONV} to the set of default conversions by { - # extend_basic_convs("addition on nat",(`m + n:num`,NUM_ADD_CONV));; + # extend_basic_convs("addition on nat",(`m + n:num`,NUM_ADD_CONV));; val it : unit = () } \noindent and now it happens by default: diff --git a/Help/fail.doc b/Help/fail.doc index 9fc078d0..8d2c9679 100644 --- a/Help/fail.doc +++ b/Help/fail.doc @@ -6,18 +6,18 @@ Fail with empty string. \DESCRIBE -In HOL Light, the class of exceptions {Failure "string"} is used consistently. -This makes it easy to catch all HOL-related exceptions by a {Failure _} pattern -without accidentally catching others. In general, the failure can be generated -by {failwith "string"}, but the special case of an empty string is bound to the -function {fail}. +In HOL Light, the class of exceptions {Failure "string"} is used consistently. +This makes it easy to catch all HOL-related exceptions by a {Failure _} pattern +without accidentally catching others. In general, the failure can be generated +by {failwith "string"}, but the special case of an empty string is bound to the +function {fail}. \FAILURE Always fails. \USES Useful when there is no intention to propagate helpful information about the -cause of the exception, for example because you know it will be caught and +cause of the exception, for example because you know it will be caught and handled without discrimination. \SEEALSO diff --git a/Help/find_path.doc b/Help/find_path.doc index 6a84f5ef..d3f541d5 100644 --- a/Help/find_path.doc +++ b/Help/find_path.doc @@ -6,7 +6,7 @@ Returns a path to some subterm satisfying a predicate. \DESCRIBE -The call {find_path p t} traverses the term {t} top-down until it finds a +The call {find_path p t} traverses the term {t} top-down until it finds a subterm satisfying the predicate {p}. It then returns a path indicating how to reach it; this is just a string with each character interpreted as: @@ -14,7 +14,7 @@ reach it; this is just a string with each character interpreted as: \item {"b"}: take the body of an abstraction -\item {"l"}: take the left (rator) path in an application +\item {"l"}: take the left (rator) path in an application \item {"r"}: take the right (rand) path in an application diff --git a/Help/find_terms.doc b/Help/find_terms.doc index f5b21387..d2baf1f3 100644 --- a/Help/find_terms.doc +++ b/Help/find_terms.doc @@ -18,7 +18,7 @@ This is a simple example: val it : term list = [`z`; `y`; `x`] } \noindent while the following shows that the terms returned may overlap or -contain each other: +contain each other: { # find_terms is_comb `x + y + z`;; val it : term list = [`(+) y`; `y + z`; `(+) x`; `x + y + z`] diff --git a/Help/flush_goalstack.doc b/Help/flush_goalstack.doc index 5e664d3f..7ae718ba 100644 --- a/Help/flush_goalstack.doc +++ b/Help/flush_goalstack.doc @@ -6,9 +6,9 @@ Eliminate all but the current goalstate from the current goalstack. \DESCRIBE -Normally, the current goalstack has the current goalstate at the head and all -previous intermediate states further back in the list. This function -{flush_goalstack()} keeps just the current goalstate and eliminates all +Normally, the current goalstack has the current goalstate at the head and all +previous intermediate states further back in the list. This function +{flush_goalstack()} keeps just the current goalstate and eliminates all previous states. \FAILURE diff --git a/Help/foldr.doc b/Help/foldr.doc index 4924e9f4..de8b4891 100644 --- a/Help/foldr.doc +++ b/Help/foldr.doc @@ -14,8 +14,8 @@ application {foldl f p a} returns { f x1 y1 (f x2 y2 (f x3 y3 (f ... (f xn yn a) ... ))) } -Note that the order in which the pairs are operated on depends on the internal -structure of the finite partial function, and is often not the most obvious. +Note that the order in which the pairs are operated on depends on the internal +structure of the finite partial function, and is often not the most obvious. \FAILURE Fails if one of the embedded function applications does. @@ -31,9 +31,9 @@ Fails if one of the embedded function applications does. # foldr (fun x y a -> (x,y)::a) f [];; val it : (int * int) list = [(2, 3); (1, 2)] } -Note how the pairs are actually processed in the opposite order to the order in -which they are presented by {graph}. The order will in general not be obvious, -and generally this is applied to operations with appropriate commutativity +Note how the pairs are actually processed in the opposite order to the order in +which they are presented by {graph}. The order will in general not be obvious, +and generally this is applied to operations with appropriate commutativity properties. \SEEALSO diff --git a/Help/follow_path.doc b/Help/follow_path.doc index 342a6267..55e05f1f 100644 --- a/Help/follow_path.doc +++ b/Help/follow_path.doc @@ -6,22 +6,22 @@ Find the subterm of a given term indicated by a path. \DESCRIBE -A call {follow_path p t} follows path {p} inside {t} and returns the subterm -encountered. The path is a string with the successive characters interpreted as +A call {follow_path p t} follows path {p} inside {t} and returns the subterm +encountered. The path is a string with the successive characters interpreted as follows: \begin{{itemize}} \item {"b"}: take the body of an abstraction -\item {"l"}: take the left (rator) path in an application +\item {"l"}: take the left (rator) path in an application \item {"r"}: take the right (rand) path in an application \end{{itemize}} \FAILURE -Fails if the path is not meaningful for the term, e.g. if a {"b"} is +Fails if the path is not meaningful for the term, e.g. if a {"b"} is encountered for a subterm that is not an abstraction. \EXAMPLE diff --git a/Help/forall.doc b/Help/forall.doc index bca5350e..b4b9b580 100644 --- a/Help/forall.doc +++ b/Help/forall.doc @@ -20,7 +20,7 @@ Never fails. { # forall (fun x -> x <= 2) [0;1;2];; val it : bool = true - # forall (fun x -> x <= 2) [1;2;3];; + # forall (fun x -> x <= 2) [1;2;3];; val it : bool = false } diff --git a/Help/forall2.doc b/Help/forall2.doc index 1ed56695..32b78d7e 100644 --- a/Help/forall2.doc +++ b/Help/forall2.doc @@ -7,14 +7,14 @@ Tests if corresponding elements of two lists all satisfy a relation. \DESCRIBE {forall p [x1;...;xn] [y1;...;yn]} returns {true} if {(p xi yi)} is true for -all corresponding {xi} and {yi} in the list. Otherwise, or if the lengths of +all corresponding {xi} and {yi} in the list. Otherwise, or if the lengths of the lists are different, it returns {false}. \FAILURE Never fails. \EXAMPLE -Here we check whether all elements of the first list are less than the +Here we check whether all elements of the first list are less than the corresponding element of the second: { # forall2 (<) [1;2;3] [2;3;4];; @@ -23,7 +23,7 @@ corresponding element of the second: # forall2 (<) [1;2;3;4] [5;4;3;2];; val it : bool = false - # forall2 (<) [1] [2;3];; + # forall2 (<) [1] [2;3];; val it : bool = false } diff --git a/Help/free_in.doc b/Help/free_in.doc index 7865698c..ad7e1c3a 100644 --- a/Help/free_in.doc +++ b/Help/free_in.doc @@ -28,7 +28,7 @@ of {x} in the second term is free, even though there is also a bound instance: } \COMMENTS -If the term {t1} is a variable, the rule {vfree_in} is more basic and probably +If the term {t1} is a variable, the rule {vfree_in} is more basic and probably more efficient. \SEEALSO diff --git a/Help/freesin.doc b/Help/freesin.doc index a38f8919..afd03681 100644 --- a/Help/freesin.doc +++ b/Help/freesin.doc @@ -6,8 +6,8 @@ Tests if all free variables of a term appear in a list. \DESCRIBE -The call {freesin l t} tests whether all free variables of {t} occur in the -list {l}. The special case where {l = []} will therefore test whether {t} is +The call {freesin l t} tests whether all free variables of {t} occur in the +list {l}. The special case where {l = []} will therefore test whether {t} is closed (i.e. contains no free variables). \FAILURE @@ -24,7 +24,7 @@ Never fails. } \USES -Can be attractive to fold together some free-variable tests without explicitly +Can be attractive to fold together some free-variable tests without explicitly constructing the set of free variables in a term. \SEEALSO diff --git a/Help/g.doc b/Help/g.doc index 3735c169..194fd9c2 100644 --- a/Help/g.doc +++ b/Help/g.doc @@ -24,7 +24,7 @@ Fails unless the argument term has type {bool}. { # g `HD[1;2;3] = 1 /\ TL[1;2;3] = [2;3]`;; val it : goalstack = 1 subgoal (1 total) - + `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` } diff --git a/Help/gcd_num.doc b/Help/gcd_num.doc index 3d31bf51..94c09c53 100644 --- a/Help/gcd_num.doc +++ b/Help/gcd_num.doc @@ -7,21 +7,21 @@ Computes greatest common divisor of two unlimited-precision integers. \DESCRIBE The call {gcd_num m n} for two unlimited-precision (type {num}) integers {m} -and {n} returns the (positive) greatest common divisor of {m} and {n}. If +and {n} returns the (positive) greatest common divisor of {m} and {n}. If both {m} and {n} are zero, it returns zero. \FAILURE -Fails if either number is not an integer (the type {num} supports arbitrary +Fails if either number is not an integer (the type {num} supports arbitrary rationals). \EXAMPLE { # gcd_num (Int 35) (Int(-77));; val it : num = 7 - + # gcd_num (Int 11) (Int 0);; val it : num = 11 - + # gcd_num (Int 22 // Int 7) (Int 2);; Exception: Failure "big_int_of_ratio". } diff --git a/Help/get_type_arity.doc b/Help/get_type_arity.doc index a415cb55..c058c505 100644 --- a/Help/get_type_arity.doc +++ b/Help/get_type_arity.doc @@ -6,10 +6,10 @@ Returns the arity of a type constructor. \DESCRIBE -When applied to the name of a type constructor, {arity} returns its arity, i.e. -how many types it is supposed to be applied to. Base types like {:bool} are +When applied to the name of a type constructor, {arity} returns its arity, i.e. +how many types it is supposed to be applied to. Base types like {:bool} are regarded as constructors with zero arity. - + \FAILURE Fails if there is no type constructor of that name. diff --git a/Help/graph.doc b/Help/graph.doc index cfe89200..67476140 100644 --- a/Help/graph.doc +++ b/Help/graph.doc @@ -14,7 +14,7 @@ etc. The {graph} function takes a finite partial function that maps {x1} to {[x1,y1; ...; xn,yn]}. \FAILURE -Attempts to sort the resulting list, so may fail if the type of the pairs does +Attempts to sort the resulting list, so may fail if the type of the pairs does not permit comparison. \EXAMPLE diff --git a/Help/help.doc b/Help/help.doc index 8a80b556..a46b9a0f 100644 --- a/Help/help.doc +++ b/Help/help.doc @@ -11,7 +11,7 @@ particular identifier {s} in the system. If there is no entry for identifier {s}, the call responds instead with some possibly helpful suggestions as to what you might have meant, based on a simple `edit distance' criterion. -The built-in help files are stored in the {Help} subdirectory of HOL Light. +The built-in help files are stored in the {Help} subdirectory of HOL Light. Users can add additional locations by modifying {help_path}. Normally the help file for an identifier {name} would be called {name.doc}, but there are a few exceptions, because some identifiers have characters that cannot be put in diff --git a/Help/hol_dir.doc b/Help/hol_dir.doc index b6f7a2f2..db0917e8 100644 --- a/Help/hol_dir.doc +++ b/Help/hol_dir.doc @@ -8,7 +8,7 @@ Base directory in which HOL Light is installed. \DESCRIBE This reference variable holds the directory (folder) for the base of the HOL Light distribution. This information is used, for example, when loading files -with {loads}. Normally set to the current directory when HOL Light is loaded or +with {loads}. Normally set to the current directory when HOL Light is loaded or built, but picked up from the system variable {HOLLIGHT_DIR} if it is defined. \FAILURE diff --git a/Help/hol_expand_directory.doc b/Help/hol_expand_directory.doc index dc42f833..d6e07871 100644 --- a/Help/hol_expand_directory.doc +++ b/Help/hol_expand_directory.doc @@ -6,9 +6,9 @@ Modifies directory name starting with {$} to include HOL directory \DESCRIBE -The function {hol_expand_directory} takes a string indicating a directory. If -it does not begin with a dollar sign {$}, the string is returned unchanged. -Otherwise, the initial dollar sign is replaced with the current HOL Light +The function {hol_expand_directory} takes a string indicating a directory. If +it does not begin with a dollar sign {$}, the string is returned unchanged. +Otherwise, the initial dollar sign is replaced with the current HOL Light directory {hol_dir}. To get an actual {$} at the start of the returned directory, actually use two dollar signs {$$}. diff --git a/Help/ignore_constant_varstruct.doc b/Help/ignore_constant_varstruct.doc index ae01337f..f8cc320a 100644 --- a/Help/ignore_constant_varstruct.doc +++ b/Help/ignore_constant_varstruct.doc @@ -3,17 +3,17 @@ \TYPE {ignore_constant_varstruct : bool ref} \SYNOPSIS -Interpret a simple varstruct as a variable, even if there is a constant of that +Interpret a simple varstruct as a variable, even if there is a constant of that name. \DESCRIBE -As well as conventional abstractions {`\x. t`} where {x} is a variable, HOL -Light permits generalized abstractions where the varstruct is a more complex -term, e.g. {`\(x,y). x + y`}. This includes the degenerate case of just a -constant. However, one may want a regular abstraction whose bound variable -happens to be in use as a constant. When parsing a quotation {"\c. t"} where -{c} is the name of a constant, HOL Light interprets it as a simple abstraction -with a variable {c} when the flag {ignore_constant_varstruct} is {true}, as it +As well as conventional abstractions {`\x. t`} where {x} is a variable, HOL +Light permits generalized abstractions where the varstruct is a more complex +term, e.g. {`\(x,y). x + y`}. This includes the degenerate case of just a +constant. However, one may want a regular abstraction whose bound variable +happens to be in use as a constant. When parsing a quotation {"\c. t"} where +{c} is the name of a constant, HOL Light interprets it as a simple abstraction +with a variable {c} when the flag {ignore_constant_varstruct} is {true}, as it is by default. It will interpret it as a degenerate generalized abstraction, only useful when applied to the constant {c}, if the flag is {false}. diff --git a/Help/increasing.doc b/Help/increasing.doc index 6f07068f..908e260a 100644 --- a/Help/increasing.doc +++ b/Help/increasing.doc @@ -6,7 +6,7 @@ Returns a total ordering based on a measure function \DESCRIBE -When applied to a ``measure'' function {f}, the call {increasing f} returns a +When applied to a ``measure'' function {f}, the call {increasing f} returns a binary function ordering elements in a call {increasing f x y} by {f(x) abs(x) = abs(y)) (-1) [1;2;3];; val it : int list = [1; 2; 3] - + # insert' (fun x y -> abs(x) = abs(y)) (-1) [2;3;4];; val it : int list = [-1; 2; 3; 4] } diff --git a/Help/inst.doc b/Help/inst.doc index 68af15f3..2c641792 100644 --- a/Help/inst.doc +++ b/Help/inst.doc @@ -6,12 +6,12 @@ Instantiate type variables in a term. \DESCRIBE -The call {inst [ty1,tv1; ...; tyn,tvn] t} will systematically replace each type -variable {tvi} by the corresponding type {tyi} inside the term {t}. Bound +The call {inst [ty1,tv1; ...; tyn,tvn] t} will systematically replace each type +variable {tvi} by the corresponding type {tyi} inside the term {t}. Bound variables will be renamed if necessary to avoid capture. \FAILURE -Never fails. Repeated type variables in the instantiation list are not +Never fails. Repeated type variables in the instantiation list are not detected, and the first such element will be used. \EXAMPLE @@ -23,21 +23,21 @@ Here is a simple example: # type_of(rand it);; val it : hol_type = `:num` } -To construct an example where variable renaming is necessary we need to -construct terms with identically-named variables of different types, which +To construct an example where variable renaming is necessary we need to +construct terms with identically-named variables of different types, which cannot be done directly in the term parser: { - # let tm = mk_abs(`x:A`,`x + 1`);; + # let tm = mk_abs(`x:A`,`x + 1`);; val tm : term = `\x. x + 1` } -\noindent Note that the two variables {x} are different; this is a constant -boolean function returning {x + 1}. Now if we instantiate type variable {:A} to +\noindent Note that the two variables {x} are different; this is a constant +boolean function returning {x + 1}. Now if we instantiate type variable {:A} to {:num}, we still get a constant function, thanks to variable renaming: { - # inst [`:num`,`:A`] tm;; + # inst [`:num`,`:A`] tm;; val it : term = `\x'. x + 1` } -\noindent It would have been incorrect to just keep the same name, for that +\noindent It would have been incorrect to just keep the same name, for that would have been the successor function, something different. \SEEALSO diff --git a/Help/inst_goal.doc b/Help/inst_goal.doc index 2f986103..c08b0809 100644 --- a/Help/inst_goal.doc +++ b/Help/inst_goal.doc @@ -17,7 +17,7 @@ Should never fail on a valid instantiation. Probably only of specialist interest to those writing tactics from scratch. \SEEALSO -compose_insts, instantiate, INSTANTIATE, INSTANTIATE_ALL, +compose_insts, instantiate, INSTANTIATE, INSTANTIATE_ALL, PART_MATCH, term_match. \ENDDOC diff --git a/Help/install_user_printer.doc b/Help/install_user_printer.doc index c78d5f03..a71fe9c3 100644 --- a/Help/install_user_printer.doc +++ b/Help/install_user_printer.doc @@ -12,9 +12,9 @@ only if it fails with {Failure ...} will the normal HOL Light printing be invoked. The additional string argument {s} is just to provide a convenient handle for later removal through {delete_user_printer}. However, any previous user printer with the same string tag will be removed when -{install_user_printer} is called. The printing function takes two arguments, -the second being the term to print and the first being the formatter to be -used; this ensures that the printer will automatically have its output sent to +{install_user_printer} is called. The printing function takes two arguments, +the second being the term to print and the first being the formatter to be +used; this ensures that the printer will automatically have its output sent to the current formatter by the overall printer. \FAILURE diff --git a/Help/installed_parsers.doc b/Help/installed_parsers.doc index 8c996ebd..162cabdc 100644 --- a/Help/installed_parsers.doc +++ b/Help/installed_parsers.doc @@ -6,8 +6,8 @@ List the user parsers currently installed. \DESCRIBE -HOL Light allows user parsing functions to be installed, and will try them on -all terms during parsing before the usual parsers. The call +HOL Light allows user parsing functions to be installed, and will try them on +all terms during parsing before the usual parsers. The call {installed_parsers()} lists the parsing functions that have been so installed. \FAILURE diff --git a/Help/intersect.doc b/Help/intersect.doc index 7db1dc49..37492c37 100644 --- a/Help/intersect.doc +++ b/Help/intersect.doc @@ -10,7 +10,7 @@ list, set. \DESCRIBE {intersect l1 l2} returns a list consisting of those elements of {l1} that -also appear in {l2}. If both sets are free of repetitions, this can be +also appear in {l2}. If both sets are free of repetitions, this can be considered a set-theoretic intersection operation. \FAILURE diff --git a/Help/is_binder.doc b/Help/is_binder.doc index c7303fd1..7cf30762 100644 --- a/Help/is_binder.doc +++ b/Help/is_binder.doc @@ -6,8 +6,8 @@ Tests if a term is a binder construct with named constant. \DESCRIBE -The call {is_binder "c" t} tests whether the term {t} has the form of an -application of a constant {c} to an abstraction. Note that this has nothing to +The call {is_binder "c" t} tests whether the term {t} has the form of an +application of a constant {c} to an abstraction. Note that this has nothing to do with the parsing status of the name {c} as a binder, but only the form of the term. diff --git a/Help/is_const.doc b/Help/is_const.doc index 0843f75a..0191fdca 100644 --- a/Help/is_const.doc +++ b/Help/is_const.doc @@ -19,7 +19,7 @@ Never fails. # is_const `x:bool`;; val it : bool = false } -Note that numerals are not constants; they are composite constructs hidden by +Note that numerals are not constants; they are composite constructs hidden by prettyprinting: { # is_const `0`;; diff --git a/Help/is_imp.doc b/Help/is_imp.doc index 1611b8ff..582e16ed 100644 --- a/Help/is_imp.doc +++ b/Help/is_imp.doc @@ -6,7 +6,7 @@ Tests if a term is an application of implication. \DESCRIBE -The call {is_imp t} returns {true} if {t} is of the form {p ==> q} for some {p} +The call {is_imp t} returns {true} if {t} is of the form {p ==> q} for some {p} and {q}, and returns {false} otherwise. \FAILURE diff --git a/Help/is_numeral.doc b/Help/is_numeral.doc index 9e8bb5c5..99b6ff26 100644 --- a/Help/is_numeral.doc +++ b/Help/is_numeral.doc @@ -6,7 +6,7 @@ Tests if a term is a natural number numeral. \DESCRIBE -When applied to a term, {is_numeral} returns {true} if and only if the term is +When applied to a term, {is_numeral} returns {true} if and only if the term is a canonical natural number numeral ({0}, {1}, {2} etc.) \FAILURE diff --git a/Help/is_prefix.doc b/Help/is_prefix.doc index 66385c50..18c159c4 100644 --- a/Help/is_prefix.doc +++ b/Help/is_prefix.doc @@ -6,8 +6,8 @@ Tests if an identifier has prefix status. \DESCRIBE -Certain identifiers {c} have prefix status, meaning that combinations of the -form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The +Certain identifiers {c} have prefix status, meaning that combinations of the +form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The call {is_prefix "c"} tests if {c} is one of those identifiers. \FAILURE diff --git a/Help/is_ratconst.doc b/Help/is_ratconst.doc index e3cbd77d..cc51702c 100644 --- a/Help/is_ratconst.doc +++ b/Help/is_ratconst.doc @@ -8,8 +8,8 @@ Tests if a term is a canonical rational literal of type {:real}. \DESCRIBE The call {is_ratconst t} tests whether the term {t} is a canonical rational literal of type {:real}. This means an integer literal {&n} for numeral {n}, -{-- &n} for a nonzero numeral {n}, or a ratio {&p / &q} or {-- &p / &q} where -{p} is nonzero, {q > 1} and {p} and {q} share no common factor. If so, +{-- &n} for a nonzero numeral {n}, or a ratio {&p / &q} or {-- &p / &q} where +{p} is nonzero, {q > 1} and {p} and {q} share no common factor. If so, {is_ratconst} returns {true}, and otherwise {false}. \FAILURE diff --git a/Help/is_realintconst.doc b/Help/is_realintconst.doc index 92b1de35..64d480b5 100644 --- a/Help/is_realintconst.doc +++ b/Help/is_realintconst.doc @@ -7,7 +7,7 @@ Tests if a term is an integer literal of type {:real}. \DESCRIBE The call {is_realintconst t} tests whether the term {t} is a canonical integer -literal of type {:real}, i.e. either `{&n}' for a numeral {n} or `{-- &n}' for +literal of type {:real}, i.e. either `{&n}' for a numeral {n} or `{-- &n}' for a nonzero numeral {n}. If so it returns {true}, otherwise {false}. \FAILURE diff --git a/Help/is_reserved_word.doc b/Help/is_reserved_word.doc index ee4f4082..c0260aaf 100644 --- a/Help/is_reserved_word.doc +++ b/Help/is_reserved_word.doc @@ -6,9 +6,9 @@ Tests if a string is one of the reserved words. \DESCRIBE -Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', -meaning that they are special to the parser and cannot be used as ordinary -identifiers. The call {is_reserved_word s} tests if the string {s} is one of +Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', +meaning that they are special to the parser and cannot be used as ordinary +identifiers. The call {is_reserved_word s} tests if the string {s} is one of them. \FAILURE diff --git a/Help/is_type.doc b/Help/is_type.doc index 833426ae..4a9a348b 100644 --- a/Help/is_type.doc +++ b/Help/is_type.doc @@ -6,7 +6,7 @@ Tests whether a type is an instance of a type constructor. \DESCRIBE -{is_type ty} returns {true} if {ty} is a base type or constructed by an outer +{is_type ty} returns {true} if {ty} is a base type or constructed by an outer type constructor, and {false} if it is a type variable. \FAILURE diff --git a/Help/is_uexists.doc b/Help/is_uexists.doc index f5aba45a..14486a3f 100644 --- a/Help/is_uexists.doc +++ b/Help/is_uexists.doc @@ -6,7 +6,7 @@ Tests if a term is of the form `there exists a unique ...' \DESCRIBE -If {t} has the form {?!x. p[x]} (there exists a unique {x} such that {p[x]} +If {t} has the form {?!x. p[x]} (there exists a unique {x} such that {p[x]} then {is_uexists t} returns {true}, otherwise {false}. \FAILURE diff --git a/Help/is_vartype.doc b/Help/is_vartype.doc index 47f2b291..1d123c18 100644 --- a/Help/is_vartype.doc +++ b/Help/is_vartype.doc @@ -22,7 +22,7 @@ Never fails. # is_vartype (mk_vartype "bool");; val it : bool = true - + } \SEEALSO diff --git a/Help/isalnum.doc b/Help/isalnum.doc index bac7e0fa..85e0f6d4 100644 --- a/Help/isalnum.doc +++ b/Help/isalnum.doc @@ -6,12 +6,12 @@ Tests if a one-character string is alphanumeric. \DESCRIBE -The call {isalnum s} tests whether the first character of string {s} (normally -it is the only character) is alphanumeric, i.e. an uppercase or lowercase +The call {isalnum s} tests whether the first character of string {s} (normally +it is the only character) is alphanumeric, i.e. an uppercase or lowercase letter, a digit, an underscore or a prime character. \FAILURE -Fails if the string is empty. +Fails if the string is empty. \SEEALSO isalpha, isbra, isnum, issep, isspace, issymb. diff --git a/Help/isalpha.doc b/Help/isalpha.doc index adec9f43..92732a0f 100644 --- a/Help/isalpha.doc +++ b/Help/isalpha.doc @@ -6,12 +6,12 @@ Tests if a one-character string is alphabetic. \DESCRIBE -The call {isalpha s} tests whether the first character of string {s} (normally -it is the only character) is alphabetic, i.e. an uppercase or lowercase +The call {isalpha s} tests whether the first character of string {s} (normally +it is the only character) is alphabetic, i.e. an uppercase or lowercase letter, an underscore or a prime character. \FAILURE -Fails if the string is empty. +Fails if the string is empty. \SEEALSO isalnum, isbra, isnum, issep, isspace, issymb. diff --git a/Help/isbra.doc b/Help/isbra.doc index 4e9fd1d7..76eb501d 100644 --- a/Help/isbra.doc +++ b/Help/isbra.doc @@ -6,12 +6,12 @@ Tests if a one-character string is some kind of bracket. \DESCRIBE -The call {isbra s} tests whether the first character of string {s} (normally -it is the only character) is a bracket, meaning an opening or closing +The call {isbra s} tests whether the first character of string {s} (normally +it is the only character) is a bracket, meaning an opening or closing parenthesis, square bracket or curly brace. \FAILURE -Fails if the string is empty. +Fails if the string is empty. \SEEALSO isalnum, isalpha, isnum, issep, isspace, issymb. diff --git a/Help/isnum.doc b/Help/isnum.doc index 98539ae0..38290888 100644 --- a/Help/isnum.doc +++ b/Help/isnum.doc @@ -6,11 +6,11 @@ Tests if a one-character string is a decimal digit. \DESCRIBE -The call {isnum s} tests whether the first character of string {s} (normally +The call {isnum s} tests whether the first character of string {s} (normally it is the only character) is a decimal digit. \FAILURE -Fails if the string is empty. +Fails if the string is empty. \SEEALSO isalnum, isalpha, isbra, issep, isspace, issymb. diff --git a/Help/issep.doc b/Help/issep.doc index 551e7013..30dae985 100644 --- a/Help/issep.doc +++ b/Help/issep.doc @@ -6,11 +6,11 @@ Tests if a one-character string is a separator. \DESCRIBE -The call {issep s} tests whether the first character of string {s} (normally +The call {issep s} tests whether the first character of string {s} (normally it is the only character) is one of the separators `{,}' or `{;}'. \FAILURE -Fails if the string is empty. +Fails if the string is empty. \SEEALSO isalnum, isalpha, isbra, isnum, isspace, issymb. diff --git a/Help/isspace.doc b/Help/isspace.doc index 30aecc9b..fd43f5cf 100644 --- a/Help/isspace.doc +++ b/Help/isspace.doc @@ -6,7 +6,7 @@ Tests if a one-character string is some kind of space. \DESCRIBE -The call {isspace s} tests whether the first character of string {s} (normally +The call {isspace s} tests whether the first character of string {s} (normally it is the only character) is a `space' of some kind, including tab and newline. \FAILURE diff --git a/Help/issymb.doc b/Help/issymb.doc index 41faa47f..7580f99c 100644 --- a/Help/issymb.doc +++ b/Help/issymb.doc @@ -6,18 +6,18 @@ Tests if a one-character string is a symbol other than bracket or separator. \DESCRIBE -The call {issymb s} tests whether the first character of string {s} (normally -it is the only character) is ``symbolic''. This means that it is one of the +The call {issymb s} tests whether the first character of string {s} (normally +it is the only character) is ``symbolic''. This means that it is one of the usual ASCII characters but is not alphanumeric, not an underscore or prime character, and is also not one of the two separators `{,}' or `{;}' nor any -bracket, parenthesis or curly brace. More explicitly, the set of symbolic +bracket, parenthesis or curly brace. More explicitly, the set of symbolic characters is: { \ ! @ # $ % ^ & * - + | \ \ < = > / ? ~ . : } \FAILURE -Fails if the string is empty. +Fails if the string is empty. \SEEALSO isalnum, isalpha, isbra, isnum, issep, isspace. diff --git a/Help/itlist.doc b/Help/itlist.doc index 38320b0e..71c6d714 100644 --- a/Help/itlist.doc +++ b/Help/itlist.doc @@ -21,7 +21,7 @@ Never fails. \EXAMPLE { - # itlist (+) [1;2;3;4;5] 0;; + # itlist (+) [1;2;3;4;5] 0;; val it : int = 15 # itlist (+) [1;2;3;4;5] 6;; val it : int = 21 diff --git a/Help/lcm_num.doc b/Help/lcm_num.doc index 6fd1dccf..0466086f 100644 --- a/Help/lcm_num.doc +++ b/Help/lcm_num.doc @@ -11,7 +11,7 @@ The call {lcm_num m n} for two unlimited-precision (type {num}) integers {m} and or {n} (or both) are both zero, it returns zero. \FAILURE -Fails if either number is not an integer (the type {num} supports arbitrary +Fails if either number is not an integer (the type {num} supports arbitrary rationals). \EXAMPLE diff --git a/Help/let_CONV.doc b/Help/let_CONV.doc index 79e629bf..0b6a1c24 100644 --- a/Help/let_CONV.doc +++ b/Help/let_CONV.doc @@ -23,11 +23,11 @@ the theorem: {ti} for {v1} in parallel in {t}, with automatic renaming of bound variables to prevent free variable capture. -{let_CONV} also works on {let}-terms that bind terms built up from applications +{let_CONV} also works on {let}-terms that bind terms built up from applications of inductive type constructors. For example, if {} is an arbitrarily-nested tuple of distinct variables {v1}, ..., {vn} and {} is a structurally similar tuple of values, that is {} equals -{[t1,...,tn/v1,...,vn]} for some terms {t1}, ..., {tn}, then: +{[t1,...,tn/v1,...,vn]} for some terms {t1}, ..., {tn}, then: { let_CONV `let = in t` } diff --git a/Help/lhand.doc b/Help/lhand.doc index 9c78be7c..5b1b107a 100644 --- a/Help/lhand.doc +++ b/Help/lhand.doc @@ -6,9 +6,9 @@ Take left-hand argument of a binary operator. \DESCRIBE -When applied to a term {t} that is an application of a binary operator to two -arguments, i.e. is of the form {(op l) r}, the call {lhand t} will return the -left-hand argument {l}. The terms {op} and {r} are arbitrary, though in many +When applied to a term {t} that is an application of a binary operator to two +arguments, i.e. is of the form {(op l) r}, the call {lhand t} will return the +left-hand argument {l}. The terms {op} and {r} are arbitrary, though in many applications {op} is a constant such as addition or equality. \FAILURE @@ -18,14 +18,14 @@ Fails if the term is not of the indicated form. { # lhand `1 + 2`;; val it : term = `1` - + # lhand `2 + 2 = 4`;; val it : term = `2 + 2` - + # lhand `f x y z`;; Warning: inventing type variables val it : term = `y` - + # lhand `if p then q else r`;; Warning: inventing type variables val it : term = `q` diff --git a/Help/lift_theorem.doc b/Help/lift_theorem.doc index 90df8f52..0f1c02fb 100644 --- a/Help/lift_theorem.doc +++ b/Help/lift_theorem.doc @@ -7,8 +7,8 @@ Lifts a theorem to quotient type from representing type. \DESCRIBE The function {lift_theorem} should be applied (i) a pair of type bijection -theorems as returned by {define_quotient_type} for equivalence classes over a -binary relation {R}, (ii) a triple of theorems asserting that the relation {R} +theorems as returned by {define_quotient_type} for equivalence classes over a +binary relation {R}, (ii) a triple of theorems asserting that the relation {R} is reflexive, symmetric and transitive in exactly the following form: { |- !x. R x x @@ -16,38 +16,38 @@ is reflexive, symmetric and transitive in exactly the following form: |- !x y z. R x y /\ R y z ==> R x z } \noindent and (iii) the list of theorems returned as the second component of -the pairs from {lift_function} for all functions that should be mapped. -Finally, it is then applied to a theorem about the representing type. It -automatically maps it over to the quotient type, appropriately modifying -quantification over the representing type into quantification over the new -quotient type, and replacing functions over the representing type with their -corresponding lifted counterparts. Note that all variables should be bound by -quantifiers; these may be existential or universal but if any types involve the -representing type {rty} it must be just {rty} and not a composite or +the pairs from {lift_function} for all functions that should be mapped. +Finally, it is then applied to a theorem about the representing type. It +automatically maps it over to the quotient type, appropriately modifying +quantification over the representing type into quantification over the new +quotient type, and replacing functions over the representing type with their +corresponding lifted counterparts. Note that all variables should be bound by +quantifiers; these may be existential or universal but if any types involve the +representing type {rty} it must be just {rty} and not a composite or higher-order type such as {rty->rty} or {rty#num}. \FAILURE -Fails if any of the input theorems are malformed (e.g. symmetry stated with +Fails if any of the input theorems are malformed (e.g. symmetry stated with implication instead of equivalence) or fail to correspond (e.g. different -polymorphic type variables in the type bijections and the equivalence theorem). -Otherwise it will not fail, but if used improperly may not map the theorem -across cleanly. +polymorphic type variables in the type bijections and the equivalence theorem). +Otherwise it will not fail, but if used improperly may not map the theorem +across cleanly. \EXAMPLE -This is a continuation of the example in the documentation entries for -{define_quotient_type} and {lift_function}, where a type of finite multisets is -defined as the quotient of the type of lists by a suitable equivalence relation -{multisame}. We can take the theorems asserting that this is indeed reflexive, +This is a continuation of the example in the documentation entries for +{define_quotient_type} and {lift_function}, where a type of finite multisets is +defined as the quotient of the type of lists by a suitable equivalence relation +{multisame}. We can take the theorems asserting that this is indeed reflexive, symmetric and transitive: { # let [MULTISAME_REFL;MULTISAME_SYM;MULTISAME_TRANS] = (CONJUNCTS o prove) (`(!l:(A)list. multisame l l) /\ (!l l':(A)list. multisame l l' <=> multisame l' l) /\ - (!l1 l2 l3:(A)list. + (!l1 l2 l3:(A)list. multisame l1 l2 /\ multisame l2 l3 ==> multisame l1 l3)`, REWRITE_TAC[multisame] THEN MESON_TAC[]);; } -\noindent and can now lift theorems. For example, we know that {APPEND} is +\noindent and can now lift theorems. For example, we know that {APPEND} is itself associative, and so in particular: { # let MULTISAME_APPEND_ASSOC = prove @@ -60,11 +60,11 @@ itself associative, and so in particular: (`!a l m. listmult a (APPEND l m) = listmult a l + listmult a m`, REWRITE_TAC[listmult; LENGTH_APPEND; FILTER_APPEND]);; } -These theorems and any others like them can now be lifted to equivalence +These theorems and any others like them can now be lifted to equivalence classes: { # let [MULTIPLICITY_MUNION;MUNION_ASSOC] = - map (lift_theorem (multiset_abs,multiset_rep) + map (lift_theorem (multiset_abs,multiset_rep) (MULTISAME_REFL,MULTISAME_SYM,MULTISAME_TRANS) [multiplicity_th; munion_th]) [LISTMULT_APPEND; MULTISAME_APPEND_ASSOC];; diff --git a/Help/list_mk_binop.doc b/Help/list_mk_binop.doc index ea5e8d38..ee846441 100644 --- a/Help/list_mk_binop.doc +++ b/Help/list_mk_binop.doc @@ -7,13 +7,13 @@ Makes an iterative application of a binary operator. \DESCRIBE The call {list_mk_binop op [t1; ...; tn]} constructs the term -{op t1 (op t2 (op ... (op tn-1 tn) ...)))}. If we think of {op} as an infix -operator we can write it {t1 op t2 op t3 ... op tn}, but the call will work for +{op t1 (op t2 (op ... (op tn-1 tn) ...)))}. If we think of {op} as an infix +operator we can write it {t1 op t2 op t3 ... op tn}, but the call will work for any term {op} compatible with all the types. \FAILURE -Fails if the list of terms is empty or if the types would not work for the -composite term. In particular, if the list contains at least three items, all +Fails if the list of terms is empty or if the types would not work for the +composite term. In particular, if the list contains at least three items, all the types must be the same. \EXAMPLE @@ -22,7 +22,7 @@ This example is typical: # list_mk_binop `(+):num->num->num` (map mk_small_numeral (1--10));; val it : term = `1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10` } -\noindent while these show that for smaller lists, one can just regard it as +\noindent while these show that for smaller lists, one can just regard it as {mk_comb} or {mk_binop}: { # list_mk_binop `SUC` [`0`];; diff --git a/Help/list_mk_gabs.doc b/Help/list_mk_gabs.doc index 9c45b274..8ea04e41 100644 --- a/Help/list_mk_gabs.doc +++ b/Help/list_mk_gabs.doc @@ -7,7 +7,7 @@ Iteratively makes a generalized abstraction. \DESCRIBE The call {list_mk_gabs([vs1; ...; vsn],t)} constructs an interated generalized -abstraction {\vs1. \vs2. ... \vsn. t}. See {mk_gabs} for more details on +abstraction {\vs1. \vs2. ... \vsn. t}. See {mk_gabs} for more details on constructing generalized abstractions. \FAILURE @@ -15,7 +15,7 @@ Never fails. \EXAMPLE { - # list_mk_gabs([`(x:num,y:num)`; `(w:num,z:num)`],`x + w + 1`);; + # list_mk_gabs([`(x:num,y:num)`; `(w:num,z:num)`],`x + w + 1`);; val it : term = `\(x,y). \(w,z). x + w + 1` } diff --git a/Help/list_mk_icomb.doc b/Help/list_mk_icomb.doc index f64f3d4c..3490b278 100644 --- a/Help/list_mk_icomb.doc +++ b/Help/list_mk_icomb.doc @@ -22,10 +22,10 @@ This would fail with the basic {list_mk_comb} function } \COMMENTS -Note that in general the generic type of the constant is only instantiated -sufficiently to make its type match the arguments, which does not necessarily -determine it completely. Unless you are sure this will be sufficient, it is -safer and probably more efficient to instantiate the type manually using {inst} +Note that in general the generic type of the constant is only instantiated +sufficiently to make its type match the arguments, which does not necessarily +determine it completely. Unless you are sure this will be sufficient, it is +safer and probably more efficient to instantiate the type manually using {inst} first. \SEEALSO diff --git a/Help/loaded_files.doc b/Help/loaded_files.doc index 5b94d7f1..5bc0991c 100644 --- a/Help/loaded_files.doc +++ b/Help/loaded_files.doc @@ -6,11 +6,11 @@ List of files loaded so far. \DESCRIBE -This reference variable stores a list of previously loaded files together with -MD5 digests. It is updated by all the main loading functions {load_on_path}, -{loads}, {loadt} and {needs}, and is used by {needs} to avoid reloading the +This reference variable stores a list of previously loaded files together with +MD5 digests. It is updated by all the main loading functions {load_on_path}, +{loads}, {loadt} and {needs}, and is used by {needs} to avoid reloading the same file multiple times. - + \FAILURE Not applicable. diff --git a/Help/lookup.doc b/Help/lookup.doc index e0a57e97..dece94b8 100644 --- a/Help/lookup.doc +++ b/Help/lookup.doc @@ -20,13 +20,13 @@ will match any term of the form {a + b}, even if {a} and {b} are the same.) It is intended that nets are a first-level filter for efficiency; finer discrimination may be embodied in the subsequent action with the list of returned objects. - + \FAILURE Never fails. \EXAMPLE -If we want to create ourselves the kind of automated rewriting with the basic -rewrites that is done by {REWRITE_CONV}, we could simply try in succession all +If we want to create ourselves the kind of automated rewriting with the basic +rewrites that is done by {REWRITE_CONV}, we could simply try in succession all the rewrites: { # let BASIC_REWRITE_CONV' = FIRST_CONV (map REWR_CONV (basic_rewrites()));; @@ -35,11 +35,11 @@ the rewrites: However, it would be more efficient to use the left-hand sides as patterns in a term net to organize the different rewriting conversions: { - # let rewr_net = + # let rewr_net = let enter_thm th = enter (freesl(hyp th)) (lhs(concl th),REWR_CONV th) in itlist enter_thm (basic_rewrites()) empty_net;; } -Now given a term, we get only the items with matchable patterns, usually much +Now given a term, we get only the items with matchable patterns, usually much less than the full list: { # lookup `(\x. x + 1) 2` rewr_net;; @@ -49,15 +49,15 @@ less than the full list: val it : (term -> thm) list = [; ; ] } The three items returned in the last call are rewrites based on the theorems -{|- T /\ t <=> t}, {|- t /\ T <=> t} and {|- t /\ t <=> t}, which are the only -ones matchable. We can use this net for a more efficient version of the same +{|- T /\ t <=> t}, {|- t /\ T <=> t} and {|- t /\ t <=> t}, which are the only +ones matchable. We can use this net for a more efficient version of the same conversion: { # let BASIC_REWRITE_CONV tm = FIRST_CONV (lookup tm rewr_net) tm;; val ( BASIC_REWRITE_CONV ) : term -> conv = } To see that it is indeed more efficient, consider: -{ +{ # let tm = funpow 8 (fun x -> mk_conj(x,x)) `T`;; ... time (DEPTH_CONV BASIC_REWRITE_CONV) tm;; diff --git a/Help/make_args.doc b/Help/make_args.doc index f40ad8c8..e6e4eb3e 100644 --- a/Help/make_args.doc +++ b/Help/make_args.doc @@ -3,13 +3,13 @@ \TYPE {make_args : string -> term list -> hol_type list -> term list} \SYNOPSIS -Make a list of terms with stylized variable names +Make a list of terms with stylized variable names \DESCRIBE -The call {make_args "s" avoids [ty0; ...; tyn]} constructs a list of variables +The call {make_args "s" avoids [ty0; ...; tyn]} constructs a list of variables of types {ty0}, ..., {tyn}, normally called {s0}, ..., {sn} but primed if necessary to avoid clashing with any in {avoids} - + \FAILURE Never fails. diff --git a/Help/map2.doc b/Help/map2.doc index b76052d6..a4248527 100644 --- a/Help/map2.doc +++ b/Help/map2.doc @@ -13,7 +13,7 @@ Fails with {map2} if the two lists are of different lengths. \EXAMPLE { - # map2 (+) [1;2;3] [30;20;10];; + # map2 (+) [1;2;3] [30;20;10];; val it : int list = [31; 22; 13] } diff --git a/Help/mapf.doc b/Help/mapf.doc index 9efe2133..d123c31d 100644 --- a/Help/mapf.doc +++ b/Help/mapf.doc @@ -6,11 +6,11 @@ Maps a function over the range of a finite partial function \DESCRIBE -This is one of a suite of operations on finite partial functions, type +This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain -etc. The function {mapf f p} applies the (ordinary OCaml) function {f} to all -the range elements of a finite partial function, so if it originally mapped +etc. The function {mapf f p} applies the (ordinary OCaml) function {f} to all +the range elements of a finite partial function, so if it originally mapped {xi} to {yi} for it now maps {xi} to {f(yi)}. \FAILURE @@ -26,7 +26,7 @@ Fails if the function fails on one of the {yi}. } \SEEALSO -|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, +|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, ran, tryapplyd, undefine, undefined. \ENDDOC diff --git a/Help/mem_prime.doc b/Help/mem_prime.doc index 4b91ba69..1f631597 100644 --- a/Help/mem_prime.doc +++ b/Help/mem_prime.doc @@ -6,9 +6,9 @@ Tests if an element is equivalent to a member of a list w.r.t. some relation. \DESCRIBE -If {r} is a binary relation, {x} an element and {l} a list, the call -{mem' r x l} tests if there is an element in the list {l} that is equivalent to -{x} according to {r}, that is, if {r x x'} holds for some {x'} in {l}. The +If {r} is a binary relation, {x} an element and {l} a list, the call +{mem' r x l} tests if there is an element in the list {l} that is equivalent to +{x} according to {r}, that is, if {r x x'} holds for some {x'} in {l}. The function {mem} is the special case where the relation is equality. \FAILURE diff --git a/Help/merge.doc b/Help/merge.doc index a478572f..12e33dd8 100644 --- a/Help/merge.doc +++ b/Help/merge.doc @@ -6,12 +6,12 @@ Merges together two sorted lists with respect to a given ordering. \DESCRIBE -If two lists {l1} and {l2} are sorted with respect to the given ordering {ord}, -then {merge ord l1 l2} will merge them into a sorted list of all the elements. +If two lists {l1} and {l2} are sorted with respect to the given ordering {ord}, +then {merge ord l1 l2} will merge them into a sorted list of all the elements. The merge keeps any duplicates; it is not a set operation. \FAILURE -Never fails, but if the lists are not appropriately sorted the results will not +Never fails, but if the lists are not appropriately sorted the results will not in general be correct. \EXAMPLE diff --git a/Help/merge_nets.doc b/Help/merge_nets.doc index 98038986..4a56e8e1 100644 --- a/Help/merge_nets.doc +++ b/Help/merge_nets.doc @@ -11,7 +11,7 @@ Term nets (type {'a net}) are a lookup structure associating objects of type one can then relatively quickly look up all objects whose pattern terms might possibly match to it. This is used, for example, in rewriting to quickly filter out obviously inapplicable rewrites rather than attempting each one in turn. -The call {merge_nets(net1,net2)} merges two nets together; the list of objects +The call {merge_nets(net1,net2)} merges two nets together; the list of objects is the union of those objects in the two nets {net1} and {net2}, with the term patterns adjusted appropriately. diff --git a/Help/mergesort.doc b/Help/mergesort.doc index c65a11a7..e0af2103 100644 --- a/Help/mergesort.doc +++ b/Help/mergesort.doc @@ -6,10 +6,10 @@ Sorts the list with respect to given ordering using mergesort algorithm. \DESCRIBE -If {ord} is a total order, a call {mergesort ord l} will sort the list {l} -according to the order {ord}. It works internally by a mergesort algorithm. -From a user's point of view, this just means: (i) its worst-case performance is -much better than {sort}, which uses quicksort, but (ii) it will not reliably +If {ord} is a total order, a call {mergesort ord l} will sort the list {l} +according to the order {ord}. It works internally by a mergesort algorithm. +From a user's point of view, this just means: (i) its worst-case performance is +much better than {sort}, which uses quicksort, but (ii) it will not reliably topologically sort for a non-total order, whereas {sort} will. \FAILURE diff --git a/Help/meson_dcutin.doc b/Help/meson_dcutin.doc index 03d75157..91011c3e 100644 --- a/Help/meson_dcutin.doc +++ b/Help/meson_dcutin.doc @@ -7,19 +7,19 @@ Determines cut-in point for divide-and-conquer refinement in {MESON}. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, -{MESON_TAC} and related rules and tactics. This number (by default 1) -determines the number of current subgoals at which point a special +{MESON_TAC} and related rules and tactics. This number (by default 1) +determines the number of current subgoals at which point a special divide-and-conquer refinement will be invoked. \FAILURE Not applicable. \USES -For users requiring fine control over the algorithms used in {MESON}'s +For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \COMMENTS -For more details of this optimization, see Harrison's paper ``Optimizing +For more details of this optimization, see Harrison's paper ``Optimizing Proof Search in Model Elimination'', CADE-13, 1996. \SEEALSO diff --git a/Help/meson_depth.doc b/Help/meson_depth.doc index 1ea08dff..cbf1f6e4 100644 --- a/Help/meson_depth.doc +++ b/Help/meson_depth.doc @@ -7,8 +7,8 @@ Make {MESON}'s search algorithm work by proof depth rather than size. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, -{MESON_TAC} and related rules and tactics. The basic search strategy is -iterated deepening, searching for proofs with higher and higher limits on the +{MESON_TAC} and related rules and tactics. The basic search strategy is +iterated deepening, searching for proofs with higher and higher limits on the search space. The flag {meson_depth}, when set to {true}, limits the search space based on proof depth, i.e. the longest branch. When set to {false}, as it is by default, the proof is limited based on total size. @@ -17,7 +17,7 @@ is by default, the proof is limited based on total size. Not applicable. \USES -For users requiring fine control over the algorithms used in {MESON}'s +For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \SEEALSO diff --git a/Help/meson_prefine.doc b/Help/meson_prefine.doc index 67d35a3c..b9612992 100644 --- a/Help/meson_prefine.doc +++ b/Help/meson_prefine.doc @@ -7,22 +7,22 @@ Makes {MESON} apply Plaisted's positive refinement. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, -{MESON_TAC} and related rules and tactics. When the flag {meson_prefine} is -{true}, as it is by default, Plaisted's ``positive refinement'' is used in -proof search; this limits the search space at the cost of sometimes requiring -longer proofs. When {meson_prefine} is false, this refinement is not applied. +{MESON_TAC} and related rules and tactics. When the flag {meson_prefine} is +{true}, as it is by default, Plaisted's ``positive refinement'' is used in +proof search; this limits the search space at the cost of sometimes requiring +longer proofs. When {meson_prefine} is false, this refinement is not applied. \FAILURE Not applicable. \USES -For users requiring fine control over the algorithms used in {MESON}'s +For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \COMMENTS -For more details, see Plaisted's article ``A Sequent-Style Model Elimination -Strategy and a Positive Refinement'', Journal of Automated Reasoning volume 6, -1990. +For more details, see Plaisted's article ``A Sequent-Style Model Elimination +Strategy and a Positive Refinement'', Journal of Automated Reasoning volume 6, +1990. \SEEALSO meson_brand, meson_chatty, meson_dcutin, meson_depth, meson_skew, diff --git a/Help/meson_skew.doc b/Help/meson_skew.doc index 8d6e7fe3..5fd22b59 100644 --- a/Help/meson_skew.doc +++ b/Help/meson_skew.doc @@ -7,18 +7,18 @@ Determines skew in {MESON} proof tree search limits. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, -{MESON_TAC} and related rules and tactics. During search, {MESON} successively -searches for proofs of larger and larger `size'. The ``skew'' value determines -what proportion of the entire proof size is permitted in the left-hand half of +{MESON_TAC} and related rules and tactics. During search, {MESON} successively +searches for proofs of larger and larger `size'. The ``skew'' value determines +what proportion of the entire proof size is permitted in the left-hand half of the list of subgoals. The symmetrical value is {2} (meaning one half), the -default setting of {3} (one third) seems generally better because it can cut +default setting of {3} (one third) seems generally better because it can cut down on redundancy in proofs. \FAILURE Not applicable. \USES -For users requiring fine control over the algorithms used in {MESON}'s +For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \COMMENTS diff --git a/Help/meson_split_limit.doc b/Help/meson_split_limit.doc index e455df91..f88f19f6 100644 --- a/Help/meson_split_limit.doc +++ b/Help/meson_split_limit.doc @@ -7,19 +7,19 @@ Limit initial case splits before {MESON} proper is applied. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, -{MESON_TAC} and related rules and tactics. Before these rules or tactics are -applied, the formula to be proved is often decomposed by splitting, for example -an equivalence {p <=> q} to two separate implications {p ==> q} and {q ==> p}. -This often makes the eventual proof much easier for {MESON}. On the other hand, +{MESON_TAC} and related rules and tactics. Before these rules or tactics are +applied, the formula to be proved is often decomposed by splitting, for example +an equivalence {p <=> q} to two separate implications {p ==> q} and {q ==> p}. +This often makes the eventual proof much easier for {MESON}. On the other hand, if splitting is applied too many times, it can become inefficient. The value -{meson_split_limit} (default {8}) is the maximum number of times that splitting +{meson_split_limit} (default {8}) is the maximum number of times that splitting can be applied before {MESON} proper. \FAILURE Not applicable. \USES -For users requiring fine control over the algorithms used in {MESON}'s +For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \SEEALSO diff --git a/Help/mk_abs.doc b/Help/mk_abs.doc index 50a32863..8685349a 100644 --- a/Help/mk_abs.doc +++ b/Help/mk_abs.doc @@ -6,12 +6,12 @@ Constructs an abstraction. \DESCRIBE -If {v} is a variable and {t} any term, then {mk_abs(v,t)} produces the -abstraction term {\v. t}. It is not necessary that {v} should occur free in -{t}. +If {v} is a variable and {t} any term, then {mk_abs(v,t)} produces the +abstraction term {\v. t}. It is not necessary that {v} should occur free in +{t}. \FAILURE -Fails if {v} is not a variable. See {mk_gabs} for constructing generalized +Fails if {v} is not a variable. See {mk_gabs} for constructing generalized abstraction terms. \EXAMPLE diff --git a/Help/mk_binder.doc b/Help/mk_binder.doc index 5c37442b..f8af246f 100644 --- a/Help/mk_binder.doc +++ b/Help/mk_binder.doc @@ -6,13 +6,13 @@ Constructs a term with a named constant applied to an abstraction. \DESCRIBE -The call {mk_binder "c" (x,t)} returns the term {c (\x. t)} where {c} is a -constant with the given name appropriately type-instantiated. Note that the -binder parsing status of {c} is irrelevant, though only if it is parsed as a +The call {mk_binder "c" (x,t)} returns the term {c (\x. t)} where {c} is a +constant with the given name appropriately type-instantiated. Note that the +binder parsing status of {c} is irrelevant, though only if it is parsed as a binder will the resulting term be printed and parseable as {c x. t}. - + \FAILURE -Failus if {x} is not a variable, if there is no constant {c} or if the type of +Failus if {x} is not a variable, if there is no constant {c} or if the type of that constant cannot be instantiated to match the abstraction. \EXAMPLE diff --git a/Help/mk_binop.doc b/Help/mk_binop.doc index d7454e94..ae628c90 100644 --- a/Help/mk_binop.doc +++ b/Help/mk_binop.doc @@ -10,9 +10,9 @@ The call {mk_binop op l r} returns the term {(op l) r}. \LIBRARY \DESCRIBE -The call {mk_binop op l r} returns the term {(op l) r} provided that is -well-typed. Otherwise it fails. The term {op} need not be a constant nor parsed -as infix, but that is the usual case. Note that type variables in {op} are not +The call {mk_binop op l r} returns the term {(op l) r} provided that is +well-typed. Otherwise it fails. The term {op} need not be a constant nor parsed +as infix, but that is the usual case. Note that type variables in {op} are not instantiated, so it needs to be the correct instance for the terms {l} and {r}. \FAILURE diff --git a/Help/mk_char.doc b/Help/mk_char.doc index a6cb409b..a1ef5979 100644 --- a/Help/mk_char.doc +++ b/Help/mk_char.doc @@ -6,7 +6,7 @@ Constructs object-level character from OCaml character. \DESCRIBE -{mk_char 'c'} produces the HOL term of type {char} corresponding to the OCaml +{mk_char 'c'} produces the HOL term of type {char} corresponding to the OCaml character {c}. \FAILURE @@ -19,8 +19,8 @@ Never fails } \COMMENTS -There is no particularly convenient parser/printer support for the HOL {char} -type, but when combined into lists they are considered as strings and provided +There is no particularly convenient parser/printer support for the HOL {char} +type, but when combined into lists they are considered as strings and provided with more intuitive parser/printer support. \SEEALSO diff --git a/Help/mk_const.doc b/Help/mk_const.doc index 5aefa382..23806514 100644 --- a/Help/mk_const.doc +++ b/Help/mk_const.doc @@ -6,10 +6,10 @@ Produce constant term by applying an instantiation to its generic type. \DESCRIBE -This is the basic way of constructing a constant term in HOL Light, applying a -specific instantiation (by {type_subst}) to its generic type. It may sometimes -be more convenient to use {mk_mconst}, which just takes the desired type for -the constant and finds the instantiation itself; that is also a natural inverse +This is the basic way of constructing a constant term in HOL Light, applying a +specific instantiation (by {type_subst}) to its generic type. It may sometimes +be more convenient to use {mk_mconst}, which just takes the desired type for +the constant and finds the instantiation itself; that is also a natural inverse for {dest_const}. However, {mk_const} is likely to be significantly faster. \FAILURE @@ -19,17 +19,17 @@ Fails if there is no constant of the given type. { # get_const_type "=";; val it : hol_type = `:A->A->bool` - + # mk_const("=",[`:num`,`:A`]);; val it : term = `(=)` # type_of it;; val it : hol_type = `:num->num->bool` - + # mk_const("=",[`:num`,`:A`]) = mk_mconst("=",`:num->num->bool`);; val it : bool = true } \SEEALSO dest_const, is_const, mk_mconst, type_subst. - + \ENDDOC diff --git a/Help/mk_flist.doc b/Help/mk_flist.doc index b6abf648..a564d0a6 100644 --- a/Help/mk_flist.doc +++ b/Help/mk_flist.doc @@ -6,8 +6,8 @@ Constructs object-level list from nonempty list of terms. \DESCRIBE -{mk_flist [`t1`;...;`tn`]} returns {`[t1;...;tn]`}. The list must be nonempty, -since the type could not be inferred for that case. For cases where you may +{mk_flist [`t1`;...;`tn`]} returns {`[t1;...;tn]`}. The list must be nonempty, +since the type could not be inferred for that case. For cases where you may need to construct an empty list, use {mk_list}. \FAILURE @@ -16,7 +16,7 @@ other. \EXAMPLE { - # mk_flist(map mk_small_numeral (1--10));; + # mk_flist(map mk_small_numeral (1--10));; val it : term = `[1; 2; 3; 4; 5; 6; 7; 8; 9; 10]` } diff --git a/Help/mk_fthm.doc b/Help/mk_fthm.doc index 715f2c0d..64d80e76 100644 --- a/Help/mk_fthm.doc +++ b/Help/mk_fthm.doc @@ -8,9 +8,9 @@ Create arbitrary theorem by adding additional `false' assumption. \DESCRIBE The call {mk_fthm(asl,c)} returns a theorem with conclusion {c} and assumption list {asl} together with the special assumption {_FALSITY_}, which is defined -to be logically equivalent to {F} (false). This is the closest approach to -{mk_thm} that does not involve adding a new axiom and so potentially -compromising soundness. +to be logically equivalent to {F} (false). This is the closest approach to +{mk_thm} that does not involve adding a new axiom and so potentially +compromising soundness. \FAILURE Fails if any of the given terms does not have Boolean type. @@ -22,7 +22,7 @@ Fails if any of the given terms does not have Boolean type. } \USES -Used for validity-checking of justification functions as a sanity check in +Used for validity-checking of justification functions as a sanity check in tactic applications: see {VALID}. \SEEALSO diff --git a/Help/mk_fun_ty.doc b/Help/mk_fun_ty.doc index 8ad2ea39..66734da8 100644 --- a/Help/mk_fun_ty.doc +++ b/Help/mk_fun_ty.doc @@ -6,7 +6,7 @@ Construct a function type. \DESCRIBE -The call {mk_fun_ty ty1 ty2} gives the function type {ty1->ty2}. This is an +The call {mk_fun_ty ty1 ty2} gives the function type {ty1->ty2}. This is an exact synonym of {mk_type("fun",[ty1; ty2])}, but a little more convenient. \FAILURE @@ -16,7 +16,7 @@ Never fails. { # mk_fun_ty `:num` `:num`;; val it : hol_type = `:num->num` - + # itlist mk_fun_ty [`:A`; `:B`; `:C`] `:bool`;; val it : hol_type = `:A->B->C->bool` } diff --git a/Help/mk_gabs.doc b/Help/mk_gabs.doc index 8367be8b..10962a41 100644 --- a/Help/mk_gabs.doc +++ b/Help/mk_gabs.doc @@ -6,12 +6,12 @@ Constructs a generalized abstraction. \DESCRIBE -Given a pair of terms {s} and {t}, the call {mk_gabs(s,t)} constructs a -canonical `generalized abstraction' that is thought of as `some function that -always maps {s} to {t}'. In the case where {s} is a variable, the result is an -ordinary abstraction as constructed by {mk_abs}. In other cases, the canonical -composite structure is created. Note that the logical construct is welldefined -even if there is no function mapping {s} to {t}, and this function will +Given a pair of terms {s} and {t}, the call {mk_gabs(s,t)} constructs a +canonical `generalized abstraction' that is thought of as `some function that +always maps {s} to {t}'. In the case where {s} is a variable, the result is an +ordinary abstraction as constructed by {mk_abs}. In other cases, the canonical +composite structure is created. Note that the logical construct is welldefined +even if there is no function mapping {s} to {t}, and this function will always succeed, even if the resulting structure is not really useful. \FAILURE @@ -31,8 +31,8 @@ Here is a simple abstraction: # mk_gabs(`CONS (h:num) t`,`if h = 0 then t else CONS h t`);; val it : term = `\CONS h t. if h = 0 then t else CONS h t` } -\noindent while here is a vacuous one about which nothing interesting will be -proved, because there is no welldefined function that always maps {x + y} to +\noindent while here is a vacuous one about which nothing interesting will be +proved, because there is no welldefined function that always maps {x + y} to {x}: { # mk_gabs(`x + y:num`,`x:num`);; diff --git a/Help/mk_goalstate.doc b/Help/mk_goalstate.doc index 974d6b9c..6bf7807f 100644 --- a/Help/mk_goalstate.doc +++ b/Help/mk_goalstate.doc @@ -7,7 +7,7 @@ Converts a goal into a 1-element goalstate. \DESCRIBE Given a goal {g}, the call {mk_goalstate g} converts it into a goalstate with -that goal as its only member. (A goalstate consists of a list of subgoals as +that goal as its only member. (A goalstate consists of a list of subgoals as well as justification and metavariable information.) \FAILURE diff --git a/Help/mk_iff.doc b/Help/mk_iff.doc index 9ed20a1f..1f188e70 100644 --- a/Help/mk_iff.doc +++ b/Help/mk_iff.doc @@ -6,7 +6,7 @@ Constructs a logical equivalence (Boolean equation). \DESCRIBE -{mk_iff(`t1`,`t2`)} returns {`t1 <=> t2`}. +{mk_iff(`t1`,`t2`)} returns {`t1 <=> t2`}. \FAILURE Fails with unless {t1} and {t2} both have Boolean type. @@ -18,7 +18,7 @@ Fails with unless {t1} and {t2} both have Boolean type. } \COMMENTS -Simply {mk_eq} has the same effect on successful calls. However {mk_iff} is +Simply {mk_eq} has the same effect on successful calls. However {mk_iff} is slightly more efficient, and will fail if the terms do not have Boolean type. \SEEALSO diff --git a/Help/mk_intconst.doc b/Help/mk_intconst.doc index 02ea764d..cbbe4b1d 100644 --- a/Help/mk_intconst.doc +++ b/Help/mk_intconst.doc @@ -8,7 +8,7 @@ Converts an OCaml number to a canonical integer literal of type {:int}. \DESCRIBE The call {mk_intconst n} where {n} is an OCaml number (type {num}) produces the canonical integer literal of type {:int} representing the integer {n}. This -will be of the form `{&m}' for a numeral {m} (when {n} is nonnegative) or +will be of the form `{&m}' for a numeral {m} (when {n} is nonnegative) or `{-- &m}' for a nonzero numeral {m} (when {n} is negative). \FAILURE diff --git a/Help/mk_list.doc b/Help/mk_list.doc index 32c42500..b961ed15 100644 --- a/Help/mk_list.doc +++ b/Help/mk_list.doc @@ -17,7 +17,7 @@ argument. \EXAMPLE { - # mk_list([`1`; `2`],`:num`);; + # mk_list([`1`; `2`],`:num`);; val it : term = `[1; 2]` # mk_list([],`:num`);; diff --git a/Help/mk_numeral.doc b/Help/mk_numeral.doc index 36dac4e1..9139efa6 100644 --- a/Help/mk_numeral.doc +++ b/Help/mk_numeral.doc @@ -6,12 +6,12 @@ Maps a nonnegative integer to corresponding numeral term. \DESCRIBE -The call {mk_numeral n} where {n} is a nonnegative integer of type {num} (this -is OCaml's type of unlimited-precision numbers) returns the HOL numeral +The call {mk_numeral n} where {n} is a nonnegative integer of type {num} (this +is OCaml's type of unlimited-precision numbers) returns the HOL numeral representation of {n}. \FAILURE -Fails if the argument is negative or not integral (type {num} can include +Fails if the argument is negative or not integral (type {num} can include rationals). \EXAMPLE @@ -24,10 +24,10 @@ rationals). } \COMMENTS -The similar function {mk_small_numeral} works from a regular machine integer, +The similar function {mk_small_numeral} works from a regular machine integer, Ocaml type {int}. If that suffices, it may be simpler. \SEEALSO -dest_numeral, dest_small_numeral, is_numeral, mk_small_numeral, term_of_rat. +dest_numeral, dest_small_numeral, is_numeral, mk_small_numeral, term_of_rat. \ENDDOC diff --git a/Help/mk_pair.doc b/Help/mk_pair.doc index 74838f25..267581a9 100644 --- a/Help/mk_pair.doc +++ b/Help/mk_pair.doc @@ -13,7 +13,7 @@ Never fails. \EXAMPLE { - # mk_pair(`x:real`,`T`);; + # mk_pair(`x:real`,`T`);; val it : term = `x,T` } diff --git a/Help/mk_primed_var.doc b/Help/mk_primed_var.doc index d2c2bc5c..7281e8cb 100644 --- a/Help/mk_primed_var.doc +++ b/Help/mk_primed_var.doc @@ -8,15 +8,15 @@ Rename variable to avoid specified names and constant names. \DESCRIBE The call {mk_primed_var avoid v} will return a renamed variant of {v}, by adding primes, so that its name is not the same as any of the variables in the -list {avoid}, nor the same as any constant name. It is a more conservative +list {avoid}, nor the same as any constant name. It is a more conservative version of the renaming function {variant}. \FAILURE -Fails if one of the items in the list {avoids} is not a variable, or if {v} +Fails if one of the items in the list {avoids} is not a variable, or if {v} itself is not. \EXAMPLE -This shows how the effect is more conservative than {variant} because it even +This shows how the effect is more conservative than {variant} because it even avoids variables of the same name and different type: { # variant [`x:bool`] `x:num`;; diff --git a/Help/mk_realintconst.doc b/Help/mk_realintconst.doc index 58c4bd80..98deccd0 100644 --- a/Help/mk_realintconst.doc +++ b/Help/mk_realintconst.doc @@ -12,7 +12,7 @@ be of the form `{&m}' for a numeral {m} (when {n} is nonnegative) or `{-- &m}' for a nonzero numeral {m} (when {n} is negative). \FAILURE -Fails if applied to a number that is not an integer (type {num} also includes +Fails if applied to a number that is not an integer (type {num} also includes rational numbers). \EXAMPLE diff --git a/Help/mk_rewrites.doc b/Help/mk_rewrites.doc index fd371d8d..2e3e0f48 100644 --- a/Help/mk_rewrites.doc +++ b/Help/mk_rewrites.doc @@ -6,10 +6,10 @@ Turn theorem into list of (conditional) rewrites. \DESCRIBE -Given a Boolean flag {b}, a theorem {th} and a list of theorems {thl}, the call -{mk_rewrites b th thl} breaks {th} down into a collection of rewrites (for -example, splitting conjunctions up into several sub-theorems) and appends them -to the front of {thl} (which are normally theorems already processed in this +Given a Boolean flag {b}, a theorem {th} and a list of theorems {thl}, the call +{mk_rewrites b th thl} breaks {th} down into a collection of rewrites (for +example, splitting conjunctions up into several sub-theorems) and appends them +to the front of {thl} (which are normally theorems already processed in this way). Non-equational theorems {|- p} are converted to {|- p <=> T}. If the flag {b} is true, then implicational theorems {|- p ==> s = t} are used as conditional rewrites; otherwise they are converted to {|- (p ==> s = t) <=> T}. @@ -27,7 +27,7 @@ Never fails. (!m. m + 0 = m) /\ (!m n. SUC m + n = SUC (m + n)) /\ (!m n. m + SUC n = SUC (m + n)) - + # mk_rewrites false ADD_CLAUSES [];; val it : thm list = [|- 0 + n = n; |- m + 0 = m; |- SUC m + n = SUC (m + n); @@ -35,7 +35,7 @@ Never fails. } \SEEALSO -extend_basic_rewrites, GEN_REWRITE_CONV, REWRITE_CONV, set_basic_rewrites, +extend_basic_rewrites, GEN_REWRITE_CONV, REWRITE_CONV, set_basic_rewrites, SIMP_CONV. \ENDDOC diff --git a/Help/mk_setenum.doc b/Help/mk_setenum.doc index bca51180..89c0f039 100644 --- a/Help/mk_setenum.doc +++ b/Help/mk_setenum.doc @@ -10,8 +10,8 @@ When applied to a list of terms {[`t1`; ...; `tn`]} and a type {ty}, where each term in the list has type {ty}, the function {mk_setenum} constructs an explicit set enumeration term {`{{t1, ..., tn}}`}. Note that duplicated elements are maintained in the resulting term, though this is logically the -same as the set without them. The type is needed so that the empty set can be -constructed; if you know that the list is nonempty, you can use {mk_fset} +same as the set without them. The type is needed so that the empty set can be +constructed; if you know that the list is nonempty, you can use {mk_fset} instead. \FAILURE diff --git a/Help/mk_small_numeral.doc b/Help/mk_small_numeral.doc index 4fb318e1..9578d783 100644 --- a/Help/mk_small_numeral.doc +++ b/Help/mk_small_numeral.doc @@ -24,6 +24,6 @@ OCaml type {num}. However, none of HOL's inference rules depend on the behaviour of machine integers, so logical soundness is not an issue. \SEEALSO -dest_numeral, dest_small_numeral, is_numeral, mk_numeral, term_of_rat. +dest_numeral, dest_small_numeral, is_numeral, mk_numeral, term_of_rat. \ENDDOC diff --git a/Help/mk_string.doc b/Help/mk_string.doc index 41c7230a..0b3d519d 100644 --- a/Help/mk_string.doc +++ b/Help/mk_string.doc @@ -6,7 +6,7 @@ Constructs object-level string from OCaml string. \DESCRIBE -{mk_string "..."} produces the HOL term of type {string} (which is an +{mk_string "..."} produces the HOL term of type {string} (which is an abbreviation for {char list}) corresponding to the OCaml string {"..."}. \FAILURE diff --git a/Help/net_of_cong.doc b/Help/net_of_cong.doc index 01b4a6ed..4828fc57 100644 --- a/Help/net_of_cong.doc +++ b/Help/net_of_cong.doc @@ -9,15 +9,15 @@ Add a congruence rule to a net. The underlying machinery in rewriting and simplification assembles (conditional) rewrite rules and other conversions into a net, including a priority number so that, for example, pure rewrites get applied before -conditional rewrites. The congruence rules used by the simplifier to establish -context (see {extend_basic_congs}) are also stored in this structure, with the -lowest priority 4. A call {net_of_cong th net} adds {th} as a new congruence +conditional rewrites. The congruence rules used by the simplifier to establish +context (see {extend_basic_congs}) are also stored in this structure, with the +lowest priority 4. A call {net_of_cong th net} adds {th} as a new congruence rule to {net} to yield an updated net. \FAILURE Fails unless the congruence is of the appropriate implicational form. \SEEALSO -extend_basic_congs, net_of_conv, net_of_thm. +extend_basic_congs, net_of_conv, net_of_thm. \ENDDOC diff --git a/Help/new_constant.doc b/Help/new_constant.doc index d20754ed..c90a0852 100644 --- a/Help/new_constant.doc +++ b/Help/new_constant.doc @@ -6,7 +6,7 @@ Declares a new constant. \DESCRIBE -A call {new_constant("c",`:ty`)} makes {c} a constant with most general type +A call {new_constant("c",`:ty`)} makes {c} a constant with most general type {ty}. \FAILURE @@ -20,8 +20,8 @@ Fails if there is already a constant of that name in the current theory. } \USES -Can be useful for declaring some arbitrary parameter, but more usually a -prelude to some new axioms about the constant introduced. Take care when using +Can be useful for declaring some arbitrary parameter, but more usually a +prelude to some new axioms about the constant introduced. Take care when using {new_axiom}! \SEEALSO diff --git a/Help/new_definition.doc b/Help/new_definition.doc index 95d5462d..26c1da15 100644 --- a/Help/new_definition.doc +++ b/Help/new_definition.doc @@ -11,14 +11,14 @@ It takes a term giving the desired definition. The value returned by {new_definition} is a theorem stating the definition requested by the user. Let {v_1},...,{v_n} be tuples of distinct variables, containing the variables -{x_1,...,x_m}. Evaluating {new_definition `c v_1 ... v_n = t`}, where {c} is a +{x_1,...,x_m}. Evaluating {new_definition `c v_1 ... v_n = t`}, where {c} is a variable whose name is not already used as a constant, declares {c} to be a new -constant and returns the theorem: +constant and returns the theorem: { |- !x_1 ... x_m. c v_1 ... v_n = t } Optionally, the definitional term argument may have any of its variables -universally quantified. +universally quantified. \FAILURE {new_definition} fails if {c} is already a constant or if the definition does @@ -36,9 +36,9 @@ A NAND relation on signals indexed by `time' can be defined as follows. \COMMENTS Note that the conclusion of the theorem returned is essentially the same as the -term input by the user, except that {c} was a variable in the original term but -is a constant in the returned theorem. The function {define} is significantly -more flexible in the kinds of definition it allows, but for some purposes this +term input by the user, except that {c} was a variable in the original term but +is a constant in the returned theorem. The function {define} is significantly +more flexible in the kinds of definition it allows, but for some purposes this more basic principle is fine. \SEEALSO diff --git a/Help/new_inductive_set.doc b/Help/new_inductive_set.doc index 17bc4f5a..6f37c88e 100644 --- a/Help/new_inductive_set.doc +++ b/Help/new_inductive_set.doc @@ -6,7 +6,7 @@ Define a set or family of sets inductively. \DESCRIBE -The function {new_inductive_set} is applied to a conjunction of ``rules'', each +The function {new_inductive_set} is applied to a conjunction of ``rules'', each of the form {!x1...xn. Pi ==> ti IN Sk}. This conjunction is interpreted as an inductive definition of a family of sets {Sk} (however many appear in the consequents of the rules). That is, the sets are defined to be the smallest diff --git a/Help/nsplit.doc b/Help/nsplit.doc index 148c53ce..8f38d35f 100644 --- a/Help/nsplit.doc +++ b/Help/nsplit.doc @@ -6,7 +6,7 @@ Applies a destructor in right-associative mode a specified number of times. \DESCRIBE -If {d} is an inverse to a binary constructor {f}, then +If {d} is an inverse to a binary constructor {f}, then { nsplit d l (f(x1,f(x2,...f(xn,y)))) } diff --git a/Help/null_inst.doc b/Help/null_inst.doc index 0d053c75..9ecc8d3d 100644 --- a/Help/null_inst.doc +++ b/Help/null_inst.doc @@ -14,7 +14,7 @@ term instantiations and higher-order matching information. This instantiation Not applicable. \EXAMPLE -Instantiating a term with it has no effect: +Instantiating a term with it has no effect: { # instantiate null_inst `x + 1 = 2`;; val it : term = `x + 1 = 2` diff --git a/Help/null_meta.doc b/Help/null_meta.doc index 7bd4b93d..b076be5e 100644 --- a/Help/null_meta.doc +++ b/Help/null_meta.doc @@ -14,7 +14,7 @@ nothing interesting with metavariables. Not applicable. \COMMENTS -This is not intended for general use, but readers writing custom tactics from +This is not intended for general use, but readers writing custom tactics from scratch may find it convenient. \SEEALSO diff --git a/Help/num_0.doc b/Help/num_0.doc index 940e9de9..4db76c30 100644 --- a/Help/num_0.doc +++ b/Help/num_0.doc @@ -6,7 +6,7 @@ Constant zero in unlimited-size integers. \DESCRIBE -The constant {num_0} is bound to the integer constant 0 in the +The constant {num_0} is bound to the integer constant 0 in the unlimited-precision numbers provided by the OCaml {Num} library. \FAILURE diff --git a/Help/numdom.doc b/Help/numdom.doc index 287f02c6..c5ab58f3 100644 --- a/Help/numdom.doc +++ b/Help/numdom.doc @@ -6,8 +6,8 @@ Returns numerator and denominator of normalized fraction. \DESCRIBE -Given a rational number as supported by the {Num} library, {numdom} returns a -numerator-denominator pair corresponding to that rational number cancelled down +Given a rational number as supported by the {Num} library, {numdom} returns a +numerator-denominator pair corresponding to that rational number cancelled down to its reduced form, $p/q$ where $q > 0$ and $p$ and $q$ have no common factor. \FAILURE diff --git a/Help/numerator.doc b/Help/numerator.doc index f52a2b30..62c9992d 100644 --- a/Help/numerator.doc +++ b/Help/numerator.doc @@ -17,9 +17,9 @@ Never fails. { # numerator(Int 22 // Int 7);; val it : num = 22 - # numerator(Int 0);; + # numerator(Int 0);; val it : num = 0 - # numerator(Int 100);; + # numerator(Int 100);; val it : num = 100 # numerator(Int 4 // Int(-2));; val it : num = -2 diff --git a/Help/occurs_in.doc b/Help/occurs_in.doc index d0b4b1a3..e1466d10 100644 --- a/Help/occurs_in.doc +++ b/Help/occurs_in.doc @@ -6,8 +6,8 @@ Tests if one type occurs in another. \DESCRIBE -The call {occurs_in ty1 ty2} returns {true} if {ty1} occurs as a subtype of -{ty2}, including the case where {ty1} and {ty2} are the same. If returns +The call {occurs_in ty1 ty2} returns {true} if {ty1} occurs as a subtype of +{ty2}, including the case where {ty1} and {ty2} are the same. If returns {false} otherwise. The type {ty1} does not have to be a type variable. \FAILURE diff --git a/Help/parse_as_infix.doc b/Help/parse_as_infix.doc index b4b5ce83..85160aa6 100644 --- a/Help/parse_as_infix.doc +++ b/Help/parse_as_infix.doc @@ -6,15 +6,15 @@ Adds identifier to list of infixes, with given precedence and associativity. \DESCRIBE -Certain identifiers are treated as infix operators with a given precedence and -associativity (left or right). The call {parse_as_infix("op",(p,a))} adds {op} -to the infix operators with precedence {p} and associativity {a} (it should be -one of the two strings {"left"} or {"right"}). Note that the infix status is -based purely on the name, which can be alphanumeric or symbolic, and does not +Certain identifiers are treated as infix operators with a given precedence and +associativity (left or right). The call {parse_as_infix("op",(p,a))} adds {op} +to the infix operators with precedence {p} and associativity {a} (it should be +one of the two strings {"left"} or {"right"}). Note that the infix status is +based purely on the name, which can be alphanumeric or symbolic, and does not depend on whether the name denotes a constant. \FAILURE -Never fails; if the given string was already an infix, its precedence and +Never fails; if the given string was already an infix, its precedence and associativity are changed to the new values. \EXAMPLE diff --git a/Help/parse_as_prefix.doc b/Help/parse_as_prefix.doc index 2e670de2..50e1ef22 100644 --- a/Help/parse_as_prefix.doc +++ b/Help/parse_as_prefix.doc @@ -6,8 +6,8 @@ Gives an identifier prefix status. \DESCRIBE -Certain identifiers {c} have prefix status, meaning that combinations of the -form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The +Certain identifiers {c} have prefix status, meaning that combinations of the +form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The call {parse_as_prefix "c"} adds {c} to the list of such identifiers. \FAILURE diff --git a/Help/parse_pretype.doc b/Help/parse_pretype.doc index 1c9b378c..c78c9649 100644 --- a/Help/parse_pretype.doc +++ b/Help/parse_pretype.doc @@ -6,8 +6,8 @@ Parses a pretype. \DESCRIBE -The call {parse_pretype t}, where {t} is a list of lexical tokens (as produced -by {lex}), parses the tokens and returns a pretype as well as the unparsed +The call {parse_pretype t}, where {t} is a list of lexical tokens (as produced +by {lex}), parses the tokens and returns a pretype as well as the unparsed tokens. \FAILURE diff --git a/Help/parse_term.doc b/Help/parse_term.doc index 0b297382..bd5281b9 100644 --- a/Help/parse_term.doc +++ b/Help/parse_term.doc @@ -20,9 +20,9 @@ Fails in the event of a syntax error or unparsed input. } \COMMENTS -Note that backslash characters should be doubled up when entering OCaml +Note that backslash characters should be doubled up when entering OCaml strings, as in the example above, since they are the string escape character. -This is handled automatically by the quotation parser, so one doesn't need to +This is handled automatically by the quotation parser, so one doesn't need to do it (indeed shouldn't do it) when entering quotations between backquotes. \SEEALSO diff --git a/Help/parse_type.doc b/Help/parse_type.doc index 7f820ea1..4b7b4fad 100644 --- a/Help/parse_type.doc +++ b/Help/parse_type.doc @@ -6,8 +6,8 @@ Parses a string into a HOL type. \DESCRIBE -The call {parse_type "s"} parses the string {s} into a HOL type. This is the -function that is invoked automatically when a type is written in quotations +The call {parse_type "s"} parses the string {s} into a HOL type. This is the +function that is invoked automatically when a type is written in quotations with an initial colon {`:s`}. \FAILURE diff --git a/Help/partition.doc b/Help/partition.doc index 4bb5c382..508ef63b 100644 --- a/Help/partition.doc +++ b/Help/partition.doc @@ -14,7 +14,7 @@ Never fails. \EXAMPLE { - # partition (fun x -> x mod 2 = 0) (1--10);; + # partition (fun x -> x mod 2 = 0) (1--10);; val it : int list * int list = ([2; 4; 6; 8; 10], [1; 3; 5; 7; 9]) } diff --git a/Help/pp_print_qterm.doc b/Help/pp_print_qterm.doc index 6e8a58eb..bb63743d 100644 --- a/Help/pp_print_qterm.doc +++ b/Help/pp_print_qterm.doc @@ -6,14 +6,14 @@ Prints a term with surrounding quotes to formatter. \DESCRIBE -The call {pp_print_term fmt tm} prints the usual textual representation of the +The call {pp_print_term fmt tm} prints the usual textual representation of the term {tm} to the formatter {fmt}, in the form {`tm`}. \FAILURE Should never fail unless the formatter does. \COMMENTS -The usual case where the formatter is the standard output is {print_qterm}. +The usual case where the formatter is the standard output is {print_qterm}. \SEEALSO pp_print_term, print_qterm, print_term. diff --git a/Help/pp_print_qtype.doc b/Help/pp_print_qtype.doc index 08d530f1..31248a44 100644 --- a/Help/pp_print_qtype.doc +++ b/Help/pp_print_qtype.doc @@ -6,14 +6,14 @@ Prints a type with initial colon and surrounding quotes to formatter. \DESCRIBE -The call {pp_print_type fmt ty} prints the usual textual representation of the +The call {pp_print_type fmt ty} prints the usual textual representation of the type {ty} to the formatter {fmt}, in the form {`:ty`}. \FAILURE Should never fail unless the formatter does. \COMMENTS -The usual case where the formatter is the standard output is {print_qtype}. +The usual case where the formatter is the standard output is {print_qtype}. \SEEALSO pp_print_type, print_qtype, print_type. diff --git a/Help/pp_print_term.doc b/Help/pp_print_term.doc index 86480094..5e4ce5bf 100644 --- a/Help/pp_print_term.doc +++ b/Help/pp_print_term.doc @@ -6,14 +6,14 @@ Prints a term (without quotes) to formatter. \DESCRIBE -The call {pp_print_term fmt tm} prints the usual textual representation of the +The call {pp_print_term fmt tm} prints the usual textual representation of the term {tm} to the formatter {fmt}. The string is just {tm} not {`tm`}. \FAILURE Should never fail unless the formatter does. \COMMENTS -The usual case where the formatter is the standard output is {print_term}. +The usual case where the formatter is the standard output is {print_term}. \SEEALSO pp_print_qterm, print_qterm, print_term. diff --git a/Help/pp_print_type.doc b/Help/pp_print_type.doc index 2a177b33..806031e0 100644 --- a/Help/pp_print_type.doc +++ b/Help/pp_print_type.doc @@ -6,14 +6,14 @@ Prints a type (without colon or quotes) to formatter. \DESCRIBE -The call {pp_print_type fmt ty} prints the usual textual representation of the +The call {pp_print_type fmt ty} prints the usual textual representation of the type {ty} to the formatter {fmt}. The string is just {ty} not {`:ty`}. \FAILURE Should never fail unless the formatter does. \COMMENTS -The usual case where the formatter is the standard output is {print_type}. +The usual case where the formatter is the standard output is {print_type}. \SEEALSO pp_print_qtype, print_qtype, print_type. diff --git a/Help/prebroken_binops.doc b/Help/prebroken_binops.doc index 7bc688c9..af06c743 100644 --- a/Help/prebroken_binops.doc +++ b/Help/prebroken_binops.doc @@ -8,16 +8,16 @@ Determines which binary operators are line-broken to the left \DESCRIBE The reference variable {prebroken_binops} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic -printing of terms and theorems at the toplevel. It holds a list of the names of -binary operators that, when a line break is needed, will be printed after the +printing of terms and theorems at the toplevel. It holds a list of the names of +binary operators that, when a line break is needed, will be printed after the line break rather than before it. By default it contains just implication. \FAILURE Not applicable. \COMMENTS -Putting more operators such as conjunction in this list gives an output format -closer to the one advocated in Lamport's ``How to write a large formula'' +Putting more operators such as conjunction in this list gives an output format +closer to the one advocated in Lamport's ``How to write a large formula'' paper. \SEEALSO diff --git a/Help/prefixes.doc b/Help/prefixes.doc index eb4078f2..92de09f8 100644 --- a/Help/prefixes.doc +++ b/Help/prefixes.doc @@ -3,8 +3,8 @@ \TYPE {prefixes : unit -> string list} \SYNOPSIS -Certain identifiers {c} have prefix status, meaning that combinations of the -form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The +Certain identifiers {c} have prefix status, meaning that combinations of the +form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The call {prefixes()} returns the list of all such identifiers. \FAILURE @@ -16,7 +16,7 @@ In the default HOL state: # prefixes();; val it : string list = ["~"; "--"; "mod"] } -This explains, for example, why `{~ ~ p}' parses as `{~(~p)}' rather than +This explains, for example, why `{~ ~ p}' parses as `{~(~p)}' rather than parsing as `{(~ ~) p}' and generating a typechecking error. \SEEALSO diff --git a/Help/preterm_of_term.doc b/Help/preterm_of_term.doc index ea2a0923..68b5aa6f 100644 --- a/Help/preterm_of_term.doc +++ b/Help/preterm_of_term.doc @@ -6,8 +6,8 @@ Converts a term into a preterm. \DESCRIBE -HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for -parsing and typechecking, which are later converted to types and terms. A call +HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for +parsing and typechecking, which are later converted to types and terms. A call {preterm_of_term `tm`} converts in the other direction, from a normal HOL term back to a preterm. @@ -15,8 +15,8 @@ back to a preterm. Never fails. \USES -User manipulation of preterms is not usually necessary, unless you seek to -radically change aspects of parsing and typechecking. +User manipulation of preterms is not usually necessary, unless you seek to +radically change aspects of parsing and typechecking. \SEEALSO pretype_of_type, term_of_preterm. diff --git a/Help/pretype_of_type.doc b/Help/pretype_of_type.doc index f8b2485e..691e0f22 100644 --- a/Help/pretype_of_type.doc +++ b/Help/pretype_of_type.doc @@ -6,8 +6,8 @@ Converts a type into a pretype. \DESCRIBE -HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for -parsing and typechecking, which are later converted to types and terms. A call +HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for +parsing and typechecking, which are later converted to types and terms. A call {preterm_of_term `tm`} converts in the other direction, from a normal HOL term back to a preterm. @@ -15,7 +15,7 @@ back to a preterm. Never fails. \USES -User manipulation of pretypes is not usually necessary, unless you seek to +User manipulation of pretypes is not usually necessary, unless you seek to radically change aspects of parsing and typechecking. \SEEALSO diff --git a/Help/print_goalstack.doc b/Help/print_goalstack.doc index 72a91345..3971f36c 100644 --- a/Help/print_goalstack.doc +++ b/Help/print_goalstack.doc @@ -6,14 +6,14 @@ Print a goalstack. \DESCRIBE -{print_goalstack gs} prints the goalstack {gs} to standard output, with no -following newline. +{print_goalstack gs} prints the goalstack {gs} to standard output, with no +following newline. \FAILURE Never fails. \COMMENTS -This is invoked automatically when something of type {goalstack} is produced at +This is invoked automatically when something of type {goalstack} is produced at the top level, so manual invocation is not normally needed. \SEEALSO diff --git a/Help/print_thm.doc b/Help/print_thm.doc index e7dfd052..e09ef329 100644 --- a/Help/print_thm.doc +++ b/Help/print_thm.doc @@ -6,7 +6,7 @@ Prints a HOL theorem to the standard output. \DESCRIBE -The call {print_thm th} prints the usual textual representation of the +The call {print_thm th} prints the usual textual representation of the theorem {th} to the standard output. \COMMENTS diff --git a/Help/print_to_string.doc b/Help/print_to_string.doc index 4cd5c7e4..d41d01e2 100644 --- a/Help/print_to_string.doc +++ b/Help/print_to_string.doc @@ -21,7 +21,7 @@ The standard function {string_of_term} is defined as: } \USES -Converting a general printing function to a `convert to string' function, as in +Converting a general printing function to a `convert to string' function, as in the example above. \SEEALSO diff --git a/Help/prove_monotonicity_hyps.doc b/Help/prove_monotonicity_hyps.doc index 5bedfd84..0db0946c 100644 --- a/Help/prove_monotonicity_hyps.doc +++ b/Help/prove_monotonicity_hyps.doc @@ -6,20 +6,20 @@ Attempt to prove monotonicity hypotheses of theorem automatically. \DESCRIBE -Given a theorem {A |- t}, the rule {prove_monotonicity_hyps} attempts to prove -and remove all hypotheses that are not equations, by breaking them down and -repeatedly using {MONO_TAC}. Any that are equations or are not automatically +Given a theorem {A |- t}, the rule {prove_monotonicity_hyps} attempts to prove +and remove all hypotheses that are not equations, by breaking them down and +repeatedly using {MONO_TAC}. Any that are equations or are not automatically provable will be left as they are. \FAILURE Never fails but may have no effect. \COMMENTS -Normally, this kind of reasoning is automated by the inductive definitions -package, so explicit use of this tactic is rare. +Normally, this kind of reasoning is automated by the inductive definitions +package, so explicit use of this tactic is rare. \SEEALSO -MONO_TAC, monotonicity_theorems, new_inductive_definition, +MONO_TAC, monotonicity_theorems, new_inductive_definition, prove_inductive_relations_exist. \ENDDOC diff --git a/Help/prove_recursive_functions_exist.doc b/Help/prove_recursive_functions_exist.doc index 0470e60b..60e1c238 100644 --- a/Help/prove_recursive_functions_exist.doc +++ b/Help/prove_recursive_functions_exist.doc @@ -6,8 +6,8 @@ Prove existence of recursive function over inductive type. \DESCRIBE -This function has essentially the same interface and functionality as -{new_recursive_definition}, but it merely proves the existence of the function +This function has essentially the same interface and functionality as +{new_recursive_definition}, but it merely proves the existence of the function rather than defining it. The first argument to {prove_recursive_functions_exist} is the primitive @@ -34,16 +34,16 @@ the form: \noindent where the variables {v1}, ..., {vm}, {vs} are distinct in each clause, and where in the {i}th clause {fn} appears (free) in {bodyi} only as part of an application of the form: -{ +{ `fn t1 ... v ... tm` -} +} \noindent in which the variable {v} of type {ty} also occurs among the variables {vsi}. - + If {} is a conjunction of clauses, as described above, then evaluating: -{ - prove_recursive_functions_exist th ``;; +{ + prove_recursive_functions_exist th ``;; } \noindent automatically proves the existence of a function {fn} that satisfies the defining equations supplied, and returns a theorem: @@ -52,10 +52,10 @@ the defining equations supplied, and returns a theorem: } {prove_recursive_functions_exist} also allows the supplied definition to omit clauses for any number of constructors. If a defining equation for the {i}th -constructor is omitted, then the value of {fn} at that constructor: +constructor is omitted, then the value of {fn} at that constructor: { - fn v1 ... (Ci vsi) ... vn -} + fn v1 ... (Ci vsi) ... vn +} \noindent is left unspecified ({fn}, however, is still a total function). \FAILURE @@ -65,23 +65,23 @@ find that {prove_general_recursive_function_exists} still works in such cases. \EXAMPLE Here we show that there exists a product function: { - prove_recursive_functions_exist num_RECURSION + prove_recursive_functions_exist num_RECURSION `(prod f 0 = 1) /\ (!n. prod f (SUC n) = f(SUC n) * prod f n)`;; val it : thm = |- ?prod. prod f 0 = 1 /\ (!n. prod f (SUC n) = f (SUC n) * prod f n) } \COMMENTS -Often {prove_general_recursive_function_exists} is an easier route to the same -goal. Its interface is simpler (no need to specify the recursion theorem) and -it is more powerful. However, for suitably constrained definitions +Often {prove_general_recursive_function_exists} is an easier route to the same +goal. Its interface is simpler (no need to specify the recursion theorem) and +it is more powerful. However, for suitably constrained definitions {prove_recursive_functions_exist} works well and is much more efficient. \USES -It is more usual to want to actually make definitions of recursive functions. -However, if a recursive function is needed in the middle of a proof, and seems -to ad-hoc for general use, you may just use {prove_recursive_functions_exist}, -perhaps adding the ``definition'' as an assumption of the goal with +It is more usual to want to actually make definitions of recursive functions. +However, if a recursive function is needed in the middle of a proof, and seems +to ad-hoc for general use, you may just use {prove_recursive_functions_exist}, +perhaps adding the ``definition'' as an assumption of the goal with {CHOOSE_TAC}. \SEEALSO diff --git a/Help/quotexpander.doc b/Help/quotexpander.doc index bb6cfe34..04492130 100644 --- a/Help/quotexpander.doc +++ b/Help/quotexpander.doc @@ -20,8 +20,8 @@ Never fails. } \COMMENTS -Not intended for general use, but automatically invoked when anything is typed -in backquotes {`like this`}. May be of some interest for users wishing to +Not intended for general use, but automatically invoked when anything is typed +in backquotes {`like this`}. May be of some interest for users wishing to change the behavior of the quotation parser. \ENDDOC diff --git a/Help/rat_of_term.doc b/Help/rat_of_term.doc index 75ee87e2..2a3f81d2 100644 --- a/Help/rat_of_term.doc +++ b/Help/rat_of_term.doc @@ -7,7 +7,7 @@ Converts a canonical rational literal of type {:real} to an OCaml number. \DESCRIBE The call {rat_of_term t} where term {t} is a canonical rational literal of type -{:real} returns the corresponding OCaml rational number (type {num}). The +{:real} returns the corresponding OCaml rational number (type {num}). The canonical literals are integer literals {&n} for numeral {n}, {-- &n} for a nonzero numeral {n}, or ratios {&p / &q} or {-- &p / &q} where {p} is nonzero, {q > 1} and {p} and {q} share no common factor. diff --git a/Help/rator.doc b/Help/rator.doc index 7021ed39..38fa3961 100644 --- a/Help/rator.doc +++ b/Help/rator.doc @@ -13,13 +13,13 @@ Fails with {rator} if term is not a combination. \EXAMPLE { - # rator `f(x)`;; + # rator `f(x)`;; Warning: inventing type variables val it : term = `f` - + # rator `~p`;; val it : term = `(~)` - + # rator `x + y`;; val it : term = `(+) x` } diff --git a/Help/reduce_interface.doc b/Help/reduce_interface.doc index a558921e..7c5b9990 100644 --- a/Help/reduce_interface.doc +++ b/Help/reduce_interface.doc @@ -6,9 +6,9 @@ Remove a specific overload/interface mapping for an identifier. \DESCRIBE -HOL Light allows an identifier to map to a specific constant (see -{override_interface}) or be overloaded to several depending on type (see -{overload_interface}). A call to {remove_interface "ident"} removes all such +HOL Light allows an identifier to map to a specific constant (see +{override_interface}) or be overloaded to several depending on type (see +{overload_interface}). A call to {remove_interface "ident"} removes all such mappings for the identifier {ident}. \FAILURE diff --git a/Help/refine.doc b/Help/refine.doc index b9a3c9fd..9d0955d9 100644 --- a/Help/refine.doc +++ b/Help/refine.doc @@ -15,7 +15,7 @@ information.) Fails if the refinement fails. \COMMENTS -Most users will not want to handle refinements explicitly. Usually one just +Most users will not want to handle refinements explicitly. Usually one just applies a tactic to the first goal in a goalstate. \ENDDOC diff --git a/Help/remove_type_abbrev.doc b/Help/remove_type_abbrev.doc index 825f4dd7..3d3a79af 100644 --- a/Help/remove_type_abbrev.doc +++ b/Help/remove_type_abbrev.doc @@ -6,9 +6,9 @@ Removes use of name as a type abbreviation. \DESCRIBE -A call {remove_type_abbrev "s"} removes any use of {s} as a type abbreviation, -whether there is one already. Note that since type abbreviations have no -logical status, being only a parsing abbreviation, this has no logical +A call {remove_type_abbrev "s"} removes any use of {s} as a type abbreviation, +whether there is one already. Note that since type abbreviations have no +logical status, being only a parsing abbreviation, this has no logical significance. \FAILURE diff --git a/Help/repeat.doc b/Help/repeat.doc index 112f872a..05a3e505 100644 --- a/Help/repeat.doc +++ b/Help/repeat.doc @@ -6,7 +6,7 @@ Repeatedly apply a function until it fails. \DESCRIBE -The call {repeat f x} successively applies {f} over and over again starting +The call {repeat f x} successively applies {f} over and over again starting with {x}, and stops at the first point when a {Failure _} exception occurs. \FAILURE @@ -19,7 +19,7 @@ Never fails. If {f} fails at once it returns {x}. } \COMMENTS -If you know exactly how many times you want to apply it, you may prefer +If you know exactly how many times you want to apply it, you may prefer {funpow}. \SEEALSO diff --git a/Help/report.doc b/Help/report.doc index aa019b0f..33819941 100644 --- a/Help/report.doc +++ b/Help/report.doc @@ -6,7 +6,7 @@ Prints a string and a following line break. \DESCRIBE -The call {report s} prints the string {s} to the terminal and then a following +The call {report s} prints the string {s} to the terminal and then a following newline. \FAILURE diff --git a/Help/report_timing.doc b/Help/report_timing.doc index c00f50f1..b0037f7d 100644 --- a/Help/report_timing.doc +++ b/Help/report_timing.doc @@ -6,10 +6,10 @@ Flag to determine whether {time} function outputs CPU time measure. \DESCRIBE -When {report_timing} is true, a call {time f x} will evaluate {f x} as usual -but also as a side-effect print out the CPU time taken. If {report_timing} is -false, nothing will be printed. Times are already printed in this way -automatically as informative output in some rules like {MESON}, so this can be +When {report_timing} is true, a call {time f x} will evaluate {f x} as usual +but also as a side-effect print out the CPU time taken. If {report_timing} is +false, nothing will be printed. Times are already printed in this way +automatically as informative output in some rules like {MESON}, so this can be used to silence them. \FAILURE diff --git a/Help/reserve_words.doc b/Help/reserve_words.doc index 5171d82e..dc5ce87e 100644 --- a/Help/reserve_words.doc +++ b/Help/reserve_words.doc @@ -6,8 +6,8 @@ Add given strings to the set of reserved words. \DESCRIBE -Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', -meaning that they are special to the parser and cannot be used as ordinary +Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', +meaning that they are special to the parser and cannot be used as ordinary identifiers. A call {reserve_words l} adds all strings in {l} to the list of reserved identifiers. diff --git a/Help/reserved_words.doc b/Help/reserved_words.doc index 144f8002..9c636cf0 100644 --- a/Help/reserved_words.doc +++ b/Help/reserved_words.doc @@ -6,8 +6,8 @@ Returns the list of reserved words. \DESCRIBE -Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', -meaning that they are special to the parser and cannot be used as ordinary +Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', +meaning that they are special to the parser and cannot be used as ordinary identifiers. The call {reserved_words()} returns a list of such identifiers. \FAILURE diff --git a/Help/retypecheck.doc b/Help/retypecheck.doc index 73fca932..7584680e 100644 --- a/Help/retypecheck.doc +++ b/Help/retypecheck.doc @@ -6,17 +6,17 @@ Typecheck a term, iterating over possible overload resolutions. \DESCRIBE -This is the main HOL Light typechecking function. Given an environment {env} of -pretype assignments for variables, it assigns a pretype to all variables and -constants, including performing resolution of overloaded constants based on -what type information there is. Normally, this happens implicitly when a term +This is the main HOL Light typechecking function. Given an environment {env} of +pretype assignments for variables, it assigns a pretype to all variables and +constants, including performing resolution of overloaded constants based on +what type information there is. Normally, this happens implicitly when a term is entered in the quotation parser. \FAILURE Fails if some terms cannot be consistently assigned a type. \COMMENTS -Only users seeking to change HOL's parser and typechecker quite radically need +Only users seeking to change HOL's parser and typechecker quite radically need to use this function. \SEEALSO diff --git a/Help/rev_assoc.doc b/Help/rev_assoc.doc index 1d7b4181..f91217cf 100644 --- a/Help/rev_assoc.doc +++ b/Help/rev_assoc.doc @@ -19,7 +19,7 @@ is empty. \EXAMPLE { - # rev_assoc 2 [(1,4);(3,2);(2,5);(2,6)];; + # rev_assoc 2 [(1,4);(3,2);(2,5);(2,6)];; val it : int = 3 } diff --git a/Help/reverse_interface_mapping.doc b/Help/reverse_interface_mapping.doc index b757bf8d..1c8925fb 100644 --- a/Help/reverse_interface_mapping.doc +++ b/Help/reverse_interface_mapping.doc @@ -24,10 +24,10 @@ Here is a simple library theorem about real numbers as it usually appears: # REAL_EQ_SUB_LADD;; val it : thm = |- !x y z. x = y - z <=> x + z = y } -\noindent but with another setting of {reverse_interface_mapping} we see that -the usual symbol `{+}' is an interface for {real_add}, while the `iff' sign is +\noindent but with another setting of {reverse_interface_mapping} we see that +the usual symbol `{+}' is an interface for {real_add}, while the `iff' sign is just an interface for Boolean equality: -{ +{ # reverse_interface_mapping := false;; val it : unit = () # REAL_EQ_SUB_LADD;; diff --git a/Help/rotate.doc b/Help/rotate.doc index 8222d98d..d99077f4 100644 --- a/Help/rotate.doc +++ b/Help/rotate.doc @@ -6,7 +6,7 @@ Rotate a goalstate. \DESCRIBE -The function {rotate n gl} rotates a list {gl} of subgoals by {n} places. The +The function {rotate n gl} rotates a list {gl} of subgoals by {n} places. The function {r} is the special case where this modification is applied to the imperative variable of unproven subgoals. diff --git a/Help/set_basic_congs.doc b/Help/set_basic_congs.doc index ced123bb..d8a785c3 100644 --- a/Help/set_basic_congs.doc +++ b/Help/set_basic_congs.doc @@ -6,17 +6,17 @@ Change the set of basic congruences used by the simplifier. \DESCRIBE -The HOL Light simplifier (as invoked by {SIMP_TAC} etc.) uses congruence rules -to determine how it uses context when descending through a term. These are -essentially theorems showing how to decompose one equality to a series of other -inequalities in context. A call to {set_basic_congs thl} sets the congruence -rules to the list of theorems {thl}. +The HOL Light simplifier (as invoked by {SIMP_TAC} etc.) uses congruence rules +to determine how it uses context when descending through a term. These are +essentially theorems showing how to decompose one equality to a series of other +inequalities in context. A call to {set_basic_congs thl} sets the congruence +rules to the list of theorems {thl}. \FAILURE Never fails. \COMMENTS -Normally, users only need to extend the congruences; for an example of how to +Normally, users only need to extend the congruences; for an example of how to do that see {extend_basic_congs}. \SEEALSO diff --git a/Help/set_basic_convs.doc b/Help/set_basic_convs.doc index cab97c5a..c0095508 100644 --- a/Help/set_basic_convs.doc +++ b/Help/set_basic_convs.doc @@ -6,8 +6,8 @@ Assign the set of default conversions. \DESCRIBE -The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) -have default sets of (conditional) equations and other conversions that are +The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) +have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. The latter are normally term transformations that cannot be expressed as single (conditional or unconditional) rewrite rules. A call to {set_basic_convs l} where {l} is a list @@ -19,8 +19,8 @@ encountered that match {pat}. Never fails. \COMMENTS -Normally, users will only want to extend the existing set of conversions using -{extend_basic_convs}. +Normally, users will only want to extend the existing set of conversions using +{extend_basic_convs}. \SEEALSO basic_convs, extend_basic_convs, set_basic_rewrites, REWRITE_TAC, SIMP_TAC. diff --git a/Help/set_basic_rewrites.doc b/Help/set_basic_rewrites.doc index c0b35506..27849a45 100644 --- a/Help/set_basic_rewrites.doc +++ b/Help/set_basic_rewrites.doc @@ -6,17 +6,17 @@ Assign the set of default rewrites used by rewriting and simplification. \DESCRIBE -The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) -have default sets of (conditional) equations and other conversions that are -applied by default, except in the {PURE_} variants. A call to -{extend_basic_rewrites thl} sets this to be the list of theorems {thl} (after +The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) +have default sets of (conditional) equations and other conversions that are +applied by default, except in the {PURE_} variants. A call to +{extend_basic_rewrites thl} sets this to be the list of theorems {thl} (after processing into rewrite rules by {mk_rewrites}). \FAILURE Never fails. \COMMENTS -Users will most likely want to extend the existing set by +Users will most likely want to extend the existing set by {extend_basic_rewrites} rather than completely change it like this. \SEEALSO diff --git a/Help/set_eq.doc b/Help/set_eq.doc index 3c4ec6ad..cfb326ce 100644 --- a/Help/set_eq.doc +++ b/Help/set_eq.doc @@ -7,8 +7,8 @@ Tests two `sets' for equality. \DESCRIBE {set_eq l1 l2} returns {true} if every element of {l1} appears in {l2} and -every element of {l2} appears in {l1}. Otherwise it returns {false}. In other -words, it tests if the lists are the same considered as sets, i.e. ignoring +every element of {l2} appears in {l1}. Otherwise it returns {false}. In other +words, it tests if the lists are the same considered as sets, i.e. ignoring duplicates. \FAILURE diff --git a/Help/setify.doc b/Help/setify.doc index 99b467a3..759bf7aa 100644 --- a/Help/setify.doc +++ b/Help/setify.doc @@ -7,7 +7,7 @@ Removes repeated elements from a list. Makes a list into a `set'. \DESCRIBE {setify l} removes repeated elements from {l}, leaving the last occurrence of -each duplicate in the list. +each duplicate in the list. \FAILURE Never fails. @@ -19,7 +19,7 @@ Never fails. } \COMMENTS -The current implementation will in fact return a sorted list according to the +The current implementation will in fact return a sorted list according to the basic OCaml polymorphic ordering. \SEEALSO diff --git a/Help/shareout.doc b/Help/shareout.doc index 81ea1436..a641c945 100644 --- a/Help/shareout.doc +++ b/Help/shareout.doc @@ -6,9 +6,9 @@ Shares out the elements of the second list according to pattern in first. \DESCRIBE -The call {shareout pat l} shares out the elements of {l} into the same groups -as the pattern list {pat}, while keeping them in the same order. If there are -more elements in {l} than needed, they will be discarded, but if there are +The call {shareout pat l} shares out the elements of {l} into the same groups +as the pattern list {pat}, while keeping them in the same order. If there are +more elements in {l} than needed, they will be discarded, but if there are fewer, failure will occur. \FAILURE diff --git a/Help/sort.doc b/Help/sort.doc index faf84032..a3e6b11e 100644 --- a/Help/sort.doc +++ b/Help/sort.doc @@ -38,12 +38,12 @@ order: This function uses the Quicksort algorithm internally, which has good typical-case performance and will sort topologically. However, its worst-case performance is quadratic. By contrast {mergesort} gives a good worst-case -performance but requires a total order. Note that any comparison-based -topological sorting function must have quadratic behaviour in the worst case. -For an $n$-element list, there are $n (n - 1) / 2$ pairs. For any topological -sorting algorithm, we can make sure the first $n (n - 1) / 2 - 1$ pairs +performance but requires a total order. Note that any comparison-based +topological sorting function must have quadratic behaviour in the worst case. +For an $n$-element list, there are $n (n - 1) / 2$ pairs. For any topological +sorting algorithm, we can make sure the first $n (n - 1) / 2 - 1$ pairs compared are unrelated in either direction, while still leaving the option of -choosing for the last pair $(a,b)$ either $a < b$ or $b < a$, eventually giving +choosing for the last pair $(a,b)$ either $a < b$ or $b < a$, eventually giving a partial order. So at least $n (n - 1) / 2$ comparisons are needed to distinguish these two partial orders correctly. diff --git a/Help/ss_of_congs.doc b/Help/ss_of_congs.doc index 71b58ddd..62ccc483 100644 --- a/Help/ss_of_congs.doc +++ b/Help/ss_of_congs.doc @@ -6,12 +6,12 @@ Add congruence rules to a simpset. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked +In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and unconditional rewrite rules, conversions and provers for conditions, as well as -a determination of how to use the prover on the conditions and how to process -theorems into rewrites. A call {ss_of_congs thl ss} adds {thl} as new -congruence rules to the simpset {ss} to yield a new simpset. For an +a determination of how to use the prover on the conditions and how to process +theorems into rewrites. A call {ss_of_congs thl ss} adds {thl} as new +congruence rules to the simpset {ss} to yield a new simpset. For an illustration of how congruence rules can be used, see {extend_basic_congs}. \FAILURE diff --git a/Help/ss_of_conv.doc b/Help/ss_of_conv.doc index 59a5b01f..0cd7555e 100644 --- a/Help/ss_of_conv.doc +++ b/Help/ss_of_conv.doc @@ -6,12 +6,12 @@ Add a new conversion to a simpset. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and -unconditional rewrite rules, conversions and provers for conditions, as well as -a determination of how to use the prover on the conditions and how to process -theorems into rewrites. A call {ss_of_conv pat cnv ss} adds the conversion -{cnv} to the simpset {ss} to yield a new simpset, restricting the initial +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and +unconditional rewrite rules, conversions and provers for conditions, as well as +a determination of how to use the prover on the conditions and how to process +theorems into rewrites. A call {ss_of_conv pat cnv ss} adds the conversion +{cnv} to the simpset {ss} to yield a new simpset, restricting the initial filtering of potential subterms to those matching {pat}. \FAILURE diff --git a/Help/ss_of_maker.doc b/Help/ss_of_maker.doc index d6264a09..b68d76f7 100644 --- a/Help/ss_of_maker.doc +++ b/Help/ss_of_maker.doc @@ -6,14 +6,14 @@ Change the rewrite maker in a simpset. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and -unconditional rewrite rules, conversions and provers for conditions, as well as -a determination of how to use the prover on the conditions and how to process -theorems into rewrites. A call {ss_of_maker maker ss} changes the ``rewrite -maker'' in {ss} to yield a new simpset; use of this simpset with additional -theorems will process those theorems using the new rewrite maker. The default -rewrite maker is {mk_rewrites} with an appropriate flag, and it is unusual to +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and +unconditional rewrite rules, conversions and provers for conditions, as well as +a determination of how to use the prover on the conditions and how to process +theorems into rewrites. A call {ss_of_maker maker ss} changes the ``rewrite +maker'' in {ss} to yield a new simpset; use of this simpset with additional +theorems will process those theorems using the new rewrite maker. The default +rewrite maker is {mk_rewrites} with an appropriate flag, and it is unusual to want to change it. \FAILURE diff --git a/Help/ss_of_prover.doc b/Help/ss_of_prover.doc index 1153abce..08044456 100644 --- a/Help/ss_of_prover.doc +++ b/Help/ss_of_prover.doc @@ -6,13 +6,13 @@ Change the method of prover application in a simpset. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and -unconditional rewrite rules, conversions and provers for conditions, as well as -a determination of how to use the prover on the conditions and how to process -theorems into rewrites. The default `prover use' method is to first recursively -apply all the simplification to conditions and then try the provers, if any, -one by one until one succeeds. It is unusual to want to change this, but if +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and +unconditional rewrite rules, conversions and provers for conditions, as well as +a determination of how to use the prover on the conditions and how to process +theorems into rewrites. The default `prover use' method is to first recursively +apply all the simplification to conditions and then try the provers, if any, +one by one until one succeeds. It is unusual to want to change this, but if desired you can do it with {ss_of_prover str ss}. \FAILURE diff --git a/Help/ss_of_provers.doc b/Help/ss_of_provers.doc index 3a7d661c..313d5011 100644 --- a/Help/ss_of_provers.doc +++ b/Help/ss_of_provers.doc @@ -6,19 +6,19 @@ Add new provers to a simpset. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and -unconditional rewrite rules, conversions and provers for conditions, as well as -a determination of how to use the prover on the conditions and how to process -theorems into rewrites. A call {ss_of_provers prs ss} adds the provers in {prs} -to the simpset {ss} to yield a new simpset. See {mk_prover} for more +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and +unconditional rewrite rules, conversions and provers for conditions, as well as +a determination of how to use the prover on the conditions and how to process +theorems into rewrites. A call {ss_of_provers prs ss} adds the provers in {prs} +to the simpset {ss} to yield a new simpset. See {mk_prover} for more explanation of how to create something of type {prover}. \FAILURE Never fails. \SEEALSO -mk_prover, mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_maker, +mk_prover, mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_maker, ss_of_prover, ss_of_thms. \ENDDOC diff --git a/Help/ss_of_thms.doc b/Help/ss_of_thms.doc index c63f8dac..75c3e0d4 100644 --- a/Help/ss_of_thms.doc +++ b/Help/ss_of_thms.doc @@ -6,10 +6,10 @@ Add theorems to a simpset. \DESCRIBE -In their maximal generality, simplification operations in HOL Light (as invoked -by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and -unconditional rewrite rules, conversions and provers for conditions, as well as -a determination of how to use the prover on the conditions and how to process +In their maximal generality, simplification operations in HOL Light (as invoked +by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and +unconditional rewrite rules, conversions and provers for conditions, as well as +a determination of how to use the prover on the conditions and how to process theorems into rewrites. A call {ss_of_thms thl ss} processes the theorems {thl} according to the rewrite maker in the simpset {ss} (normally {mk_rewrites}) and adds them to the theorems in {ss} to yield a new simpset. @@ -24,7 +24,7 @@ Never fails. } \SEEALSO -mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_maker, ss_of_prover, +mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_maker, ss_of_prover, ss_of_provers. - + \ENDDOC diff --git a/Help/string_of_file.doc b/Help/string_of_file.doc index 42e76e18..b8de0f2b 100644 --- a/Help/string_of_file.doc +++ b/Help/string_of_file.doc @@ -7,7 +7,7 @@ Read file and convert content into a string. \DESCRIBE When given a filename, the function {strings_of_file} attempts to open the file -for input, and if this is successful reads and closes it, returning the +for input, and if this is successful reads and closes it, returning the contents as a single string. \FAILURE diff --git a/Help/string_of_term.doc b/Help/string_of_term.doc index a9b4b464..8f420cb1 100644 --- a/Help/string_of_term.doc +++ b/Help/string_of_term.doc @@ -7,7 +7,7 @@ Converts a HOL term to a string representation. \DESCRIBE The call {string_of_term tm} produces a textual representation of the term {tm} -as a string, similar to what is printed automatically at the toplevel, though +as a string, similar to what is printed automatically at the toplevel, though without the surrounding quotes. \FAILURE @@ -20,7 +20,7 @@ Never fails. } \COMMENTS -The string may contain newlines for large terms, broken in a similar fashion to +The string may contain newlines for large terms, broken in a similar fashion to automatic printing. \SEEALSO diff --git a/Help/string_of_thm.doc b/Help/string_of_thm.doc index cab8c699..d509141a 100644 --- a/Help/string_of_thm.doc +++ b/Help/string_of_thm.doc @@ -16,7 +16,7 @@ Never fails. { # string_of_thm ADD_CLAUSES;; val it : string = - "|- (!n. 0 + n = n) /\\\n (!m. m + 0 = m) /\\\n (!m n. SUC m + n = SUC (m + "|- (!n. 0 + n = n) /\\\n (!m. m + 0 = m) /\\\n (!m n. SUC m + n = SUC (m + n)) /\\\n (!m n. m + SUC n = SUC (m + n))" # print_string it;; @@ -28,7 +28,7 @@ Never fails. } \COMMENTS -The string may contain newlines for large terms, broken in a similar fashion to +The string may contain newlines for large terms, broken in a similar fashion to automatic printing. \SEEALSO diff --git a/Help/string_of_type.doc b/Help/string_of_type.doc index cad4e8b8..29cea021 100644 --- a/Help/string_of_type.doc +++ b/Help/string_of_type.doc @@ -6,8 +6,8 @@ Converts a HOL type to a string representation. \DESCRIBE -The call {string_of_type ty} produces a textual representation of the type {ty} -as a string, similar to what is printed automatically at the toplevel, though +The call {string_of_type ty} produces a textual representation of the type {ty} +as a string, similar to what is printed automatically at the toplevel, though without the surrounding quotes and colon. \FAILURE diff --git a/Help/strings_of_file.doc b/Help/strings_of_file.doc index 9cb42803..46734763 100644 --- a/Help/strings_of_file.doc +++ b/Help/strings_of_file.doc @@ -6,12 +6,12 @@ Read file and convert content into a list of strings. \DESCRIBE -When given a filename, the function {strings_of_file} attempts to open the file +When given a filename, the function {strings_of_file} attempts to open the file for input, and if this is successful reads and closes it, returning a list of strings corresponding to the lines in the file. \FAILURE -Fails if the file cannot be opened (e.g. it does not exist, or the permissions +Fails if the file cannot be opened (e.g. it does not exist, or the permissions are wrong). \EXAMPLE diff --git a/Help/strip_gabs.doc b/Help/strip_gabs.doc index 18589ab4..c6773ddc 100644 --- a/Help/strip_gabs.doc +++ b/Help/strip_gabs.doc @@ -6,7 +6,7 @@ Breaks apart an iterated generalized or basic abstraction. \DESCRIBE -If the term {t} is iteratively constructed by basic or generalized +If the term {t} is iteratively constructed by basic or generalized abstractions, i.e. is of the form {\vs1. \vs2. ... \vsn. t}, then the call {strip_gabs t} returns a pair of the list of varstructs and the term {[vs1; vs2; ...; vsn],t}. diff --git a/Help/strip_ncomb.doc b/Help/strip_ncomb.doc index 58210664..587efbb0 100644 --- a/Help/strip_ncomb.doc +++ b/Help/strip_ncomb.doc @@ -6,9 +6,9 @@ Strip away a given number of arguments from a combination. \DESCRIBE -Given a number {n} and a combination term {`f a1 ... an`}, the function +Given a number {n} and a combination term {`f a1 ... an`}, the function {strip_ncomb} returns the result of stripping away exactly {n} arguments: -the pair {`f`,[`a1`;...;`an`]}. Note that exactly {n} arguments are stripped +the pair {`f`,[`a1`;...;`an`]}. Note that exactly {n} arguments are stripped even if {f} is a combination. \FAILURE diff --git a/Help/subset.doc b/Help/subset.doc index 736dc19e..5f75c250 100644 --- a/Help/subset.doc +++ b/Help/subset.doc @@ -6,8 +6,8 @@ Tests if one list is a subset of another. \DESCRIBE -The call {subset l1 l2} returns {true} if every element of {l1} also occurs in -{l2}, regardless of whether an element appears once or more than once in each +The call {subset l1 l2} returns {true} if every element of {l1} also occurs in +{l2}, regardless of whether an element appears once or more than once in each list. So when {l1} and {l2} are regarded as sets, this is a subset test. \FAILURE diff --git a/Help/temp_path.doc b/Help/temp_path.doc index ab64794d..8e9f5ca7 100644 --- a/Help/temp_path.doc +++ b/Help/temp_path.doc @@ -6,7 +6,7 @@ Directory in which to create temporary files. \DESCRIBE -Some HOL Light derived rules in the libraries (none in the core system) need to +Some HOL Light derived rules in the libraries (none in the core system) need to create temporary files. This is the directory in which they do so. \FAILURE diff --git a/Help/term_match.doc b/Help/term_match.doc index e320573a..42728071 100644 --- a/Help/term_match.doc +++ b/Help/term_match.doc @@ -26,10 +26,10 @@ Fails if terms cannot be matched. } \COMMENTS -This function can occasionally `succeed' yet produce a match that does not in -fact work. In typical uses, this will be implicitly checked by a subsequent -inference process. However, to get a self-contained matching effect, the user -should check that the instantiation returned does achieve a match, e.g. by +This function can occasionally `succeed' yet produce a match that does not in +fact work. In typical uses, this will be implicitly checked by a subsequent +inference process. However, to get a self-contained matching effect, the user +should check that the instantiation returned does achieve a match, e.g. by applying {instantiate}. \SEEALSO diff --git a/Help/term_of_preterm.doc b/Help/term_of_preterm.doc index 876b4f28..d5bf4e70 100644 --- a/Help/term_of_preterm.doc +++ b/Help/term_of_preterm.doc @@ -6,17 +6,17 @@ Converts a preterm into a term. \DESCRIBE -HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for -parsing and typechecking, which are later converted to types and terms. A call +HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for +parsing and typechecking, which are later converted to types and terms. A call {term_of_preterm ptm} attempts to convert preterm {ptm} into a HOL term. \FAILURE -Fails if some constants used in the preterm have not been defined, or if there -are other inconsistencies in the types so that a consistent typing cannot be +Fails if some constants used in the preterm have not been defined, or if there +are other inconsistencies in the types so that a consistent typing cannot be arrived at. \COMMENTS -Only users seeking to change HOL's parser and typechecker quite radically need +Only users seeking to change HOL's parser and typechecker quite radically need to use this function. \SEEALSO diff --git a/Help/term_order.doc b/Help/term_order.doc index 9e34e7ca..83bd58e2 100644 --- a/Help/term_order.doc +++ b/Help/term_order.doc @@ -6,16 +6,16 @@ Term order for use in AC-rewriting. \DESCRIBE -This binary predicate implements a crude but fairly efficient ordering on terms -that is appropriate for ensuring that ordered rewriting will perform -normalization. +This binary predicate implements a crude but fairly efficient ordering on terms +that is appropriate for ensuring that ordered rewriting will perform +normalization. \FAILURE Never fails. \EXAMPLE -This example shows how using ordered rewriting with this term ordering can give -normalization under associative and commutative laws given the appropriate +This example shows how using ordered rewriting with this term ordering can give +normalization under associative and commutative laws given the appropriate rewrites: { # ADD_AC;; @@ -31,8 +31,8 @@ rewrites: } \USES -It is used automatically when applying permutative rewrite rules inside -rewriting and simplification. Users will not normally want to use it +It is used automatically when applying permutative rewrite rules inside +rewriting and simplification. Users will not normally want to use it explicitly, though the example above shows roughly what goes on there. \SEEALSO diff --git a/Help/term_type_unify.doc b/Help/term_type_unify.doc index 9ce5902f..3bf188f9 100644 --- a/Help/term_type_unify.doc +++ b/Help/term_type_unify.doc @@ -6,7 +6,7 @@ Unify two terms including their type variables \DESCRIBE -Given two terms {tm1} and {tm2} and an existing instantiation {i} of type and +Given two terms {tm1} and {tm2} and an existing instantiation {i} of type and term variables, a call {term_type_unify tm1 tm2 i} attempts to find an augmentation of the instantiation {i} that makes the terms alpha-equivalent. The unification is purely first-order. @@ -16,7 +16,7 @@ Fails if the two terms are not first-order unifiable by instantiating the given variables and type variables. \COMMENTS -The more restrictive {term_unify} does a similar job when the type variables +The more restrictive {term_unify} does a similar job when the type variables are already compatible and only terms need to be instantiated. \SEEALSO diff --git a/Help/term_union.doc b/Help/term_union.doc index fbe5b39e..0b926b2c 100644 --- a/Help/term_union.doc +++ b/Help/term_union.doc @@ -6,10 +6,10 @@ Union of two sets of terms up to alpha-equivalence. \DESCRIBE -The call {term_union l1 l2} for two lists of terms {l1} and {l2} returns a list -including all of {l2} and all terms of {l1} for which no alpha-equivalent term -occurs in {l2} or earlier in {l1}. If both lists were sets modulo -alpha-conversion, i.e. contained no alpha-equivalent pairs, then so will be the +The call {term_union l1 l2} for two lists of terms {l1} and {l2} returns a list +including all of {l2} and all terms of {l1} for which no alpha-equivalent term +occurs in {l2} or earlier in {l1}. If both lists were sets modulo +alpha-conversion, i.e. contained no alpha-equivalent pairs, then so will be the result. \FAILURE @@ -25,8 +25,8 @@ Never fails. } \USES -For combining assumption lists of theorems without duplication of -alpha-equivalent ones. +For combining assumption lists of theorems without duplication of +alpha-equivalent ones. \SEEALSO aconv, union, union'. diff --git a/Help/the_inductive_definitions.doc b/Help/the_inductive_definitions.doc index 364682c9..d3b3ec5d 100644 --- a/Help/the_inductive_definitions.doc +++ b/Help/the_inductive_definitions.doc @@ -7,7 +7,7 @@ List of all definitions introduced so far. \DESCRIBE The reference variable {the_inductive_definitions} holds the list of -inductive definitions made so far using {new_inductive_definition}, which +inductive definitions made so far using {new_inductive_definition}, which automatically augments it. \FAILURE @@ -30,7 +30,7 @@ inductive definition is finiteness of a set: \USES This list is not logically necessary and is not part of HOL Light's logical core, but it is used outside the core so that multiple instances of the same -inductive definition are quietly ``ignored'' rather than rejected. +inductive definition are quietly ``ignored'' rather than rejected. Users may also sometimes find it convenient. \SEEALSO diff --git a/Help/the_inductive_types.doc b/Help/the_inductive_types.doc index 2e416262..c34c48ea 100644 --- a/Help/the_inductive_types.doc +++ b/Help/the_inductive_types.doc @@ -6,8 +6,8 @@ List of previously declared inductive types. \DESCRIBE -This reference variable contains a list of the inductive types, together with -their induction and recursion theorems as returned by {define_type}. The list +This reference variable contains a list of the inductive types, together with +their induction and recursion theorems as returned by {define_type}. The list is automatically extended by a call of {define_type}. \FAILURE diff --git a/Help/the_overload_skeletons.doc b/Help/the_overload_skeletons.doc index 68a6189c..df9c08c0 100644 --- a/Help/the_overload_skeletons.doc +++ b/Help/the_overload_skeletons.doc @@ -13,7 +13,7 @@ priority (see {prioritize_overload}). The reference variable can add more using {make_overloadable}) and their type skeletons. All constants to which an identifier is overloaded must have a type that is an instance of this skeleton, although you can make it a type variable in which case any type -would be allowed. The variable {the_implicit_types} offers somewhat analogous +would be allowed. The variable {the_implicit_types} offers somewhat analogous features for variables. \FAILURE diff --git a/Help/the_type_definitions.doc b/Help/the_type_definitions.doc index 3a4bd0b3..55b97ec1 100644 --- a/Help/the_type_definitions.doc +++ b/Help/the_type_definitions.doc @@ -6,8 +6,8 @@ List of type definitions made so far. \DESCRIBE -The reference variable {the_type_definitions} holds a list of entries, one for -each type definition made so far with {new_type_definition}. It is not normally +The reference variable {the_type_definitions} holds a list of entries, one for +each type definition made so far with {new_type_definition}. It is not normally explicitly manipulated by the user, but is automatically augmented by each call of {new_type_definition}. Each entry contains three strings (the type name, type constructor name and destructor name) and two theorems (the input @@ -19,16 +19,16 @@ nonemptiness theorem and the returned type bijections). That is, for a call: { (tyname,absname,repname),(nonempth,bijth) } -Note that the entries made using other interfaces to -{new_basic_type_definition}, such as {define_type}, are not included in this +Note that the entries made using other interfaces to +{new_basic_type_definition}, such as {define_type}, are not included in this list. \FAILURE Not applicable. \USES -This is mainly intended for internal use in {new_type_definition}, so that -repeated instances of the same definition are ignored rather than rejected. +This is mainly intended for internal use in {new_type_definition}, so that +repeated instances of the same definition are ignored rather than rejected. Some users may find the information useful too. \SEEALSO diff --git a/Help/top_realgoal.doc b/Help/top_realgoal.doc index 8b51b0f9..4b3c00d7 100644 --- a/Help/top_realgoal.doc +++ b/Help/top_realgoal.doc @@ -10,8 +10,8 @@ Returns the actual internal representation of the current goal, including the labels and the theorems that are the assumptions. \USES -For users interested in the precise internal structure of the goal, e.g. to -debug subtle free variable problems. Normally the simpler structure returned by +For users interested in the precise internal structure of the goal, e.g. to +debug subtle free variable problems. Normally the simpler structure returned by {top_goal} is entirely adequate. \SEEALSO diff --git a/Help/try_user_parser.doc b/Help/try_user_parser.doc index 645f0b54..4d3eb711 100644 --- a/Help/try_user_parser.doc +++ b/Help/try_user_parser.doc @@ -6,10 +6,10 @@ Try all user parsing functions. \DESCRIBE -HOL Light allows user parsing functions to be installed, and will try them on -all terms during parsing before the usual parsers. The call -{try_user_parser l} attempts to parse the list of tokens {l} using all the user -parsers, taking the results from whichever one succeeds first. +HOL Light allows user parsing functions to be installed, and will try them on +all terms during parsing before the usual parsers. The call +{try_user_parser l} attempts to parse the list of tokens {l} using all the user +parsers, taking the results from whichever one succeeds first. \FAILURE Fails if all user parsers fail. diff --git a/Help/try_user_printer.doc b/Help/try_user_printer.doc index b77ae2c5..846e5b42 100644 --- a/Help/try_user_printer.doc +++ b/Help/try_user_printer.doc @@ -9,7 +9,7 @@ Try user-defined printers on a term. HOL Light allows arbitrary user printers to be inserted into the toplevel printer so that they are invoked on all applicable subterms (see {install_user_printer}). The call {try_user_printer fmt tm} attempts all -installed user printers on the term {tm} in an implementation-defined order, +installed user printers on the term {tm} in an implementation-defined order, sending output to the formatter {fmt}. If one succeeds, the call returns {()}, and otherwise it fails. diff --git a/Help/tryapplyd.doc b/Help/tryapplyd.doc index f1760e83..c27dd192 100644 --- a/Help/tryapplyd.doc +++ b/Help/tryapplyd.doc @@ -6,12 +6,12 @@ Applies a finite partial function, with a default for undefined points. \DESCRIBE -This is one of a suite of operations on finite partial functions, type +This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain -etc. If {f} is a finite partial function, {x} an element of its domain type and -{y} of its range type, the call {tryapplyd f x y} tries to apply {f} to the -value {x}, as with {apply f x}, but if it is undefined, simply returns {y} +etc. If {f} is a finite partial function, {x} an element of its domain type and +{y} of its range type, the call {tryapplyd f x y} tries to apply {f} to the +value {x}, as with {apply f x}, but if it is undefined, simply returns {y} \FAILURE Never fails. @@ -20,13 +20,13 @@ Never fails. { # tryapplyd (1 |=> 2) 1 (-1);; val it : int = 2 - + # tryapplyd undefined 1 (-1);; val it : int = -1 } \SEEALSO -|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, +|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, undefine, undefined. \ENDDOC diff --git a/Help/type_abbrevs.doc b/Help/type_abbrevs.doc index 00c5b35a..2d696250 100644 --- a/Help/type_abbrevs.doc +++ b/Help/type_abbrevs.doc @@ -6,7 +6,7 @@ Lists all current type abbreviations. \DESCRIBE -The call {type_abbrevs()} returns a list of all current type abbreviations, +The call {type_abbrevs()} returns a list of all current type abbreviations, which are applied when parsing types but have no logical significance. \FAILURE diff --git a/Help/type_invention_warning.doc b/Help/type_invention_warning.doc index 9e51b3ac..16a37645 100644 --- a/Help/type_invention_warning.doc +++ b/Help/type_invention_warning.doc @@ -12,7 +12,7 @@ it will invent its own type variables to use in the most general type. The flag situations. The default is {true}, since this can often indicate a user error (e.g. the user forgot to define a constant before using it in a term or overlooked more general types than expected). To disable the warnings, set it -to {false}, while to make the checking even more rigorous and treat it as an +to {false}, while to make the checking even more rigorous and treat it as an error, set {type_invention_error} to {true}. \FAILURE diff --git a/Help/type_match.doc b/Help/type_match.doc index 68a7a828..5bdf5e9b 100644 --- a/Help/type_match.doc +++ b/Help/type_match.doc @@ -6,12 +6,12 @@ Computes a type instantiation to match one type to another. \DESCRIBE -The call {type_match vty cty []} will if possible find an instantiation of the -type variables in {vty} to make it the same as {cty}, and will fail if this is -not possible. The instantiation is returned in a list of term-variable pairs as -expected by type instantiation operations like {inst} and {INST_TYPE}. More -generally, {type_match vty cty env} will attempt to find such a match assuming -that the instantiations already in the list {env} are needed (this is helpful, +The call {type_match vty cty []} will if possible find an instantiation of the +type variables in {vty} to make it the same as {cty}, and will fail if this is +not possible. The instantiation is returned in a list of term-variable pairs as +expected by type instantiation operations like {inst} and {INST_TYPE}. More +generally, {type_match vty cty env} will attempt to find such a match assuming +that the instantiations already in the list {env} are needed (this is helpful, for example, in matching multiple pairs of types in parallel). \FAILURE @@ -23,7 +23,7 @@ Here is a basic example with an empty last argument: # type_match `:A->B->bool` `:num->num->bool` [];; val it : (hol_type * hol_type) list = [(`:num`, `:A`); (`:num`, `:B`)] } -\noindent and here is an illustration of how the extra argument can be used to +\noindent and here is an illustration of how the extra argument can be used to perform parallel matches. { # itlist2 type_match diff --git a/Help/type_of_pretype.doc b/Help/type_of_pretype.doc index 4c0738ad..82ef5def 100644 --- a/Help/type_of_pretype.doc +++ b/Help/type_of_pretype.doc @@ -6,16 +6,16 @@ Converts a pretype to a type. \DESCRIBE -HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for -parsing and typechecking, which are later converted to types and terms. A call +HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for +parsing and typechecking, which are later converted to types and terms. A call {type_of_pretype pty} attempts to convert pretype {pty} into a HOL type. \FAILURE -Fails if some type constants used in the pretype have not been defined, or if +Fails if some type constants used in the pretype have not been defined, or if the arities are wrong. \COMMENTS -Only users seeking to change HOL's parser and typechecker quite radically need +Only users seeking to change HOL's parser and typechecker quite radically need to use this function. \SEEALSO diff --git a/Help/type_unify.doc b/Help/type_unify.doc index 4832a27e..8694650a 100644 --- a/Help/type_unify.doc +++ b/Help/type_unify.doc @@ -6,8 +6,8 @@ Unify two types by instantiating their type variables \DESCRIBE -Given two types {ty1} and {ty2} and an existing instantiation {i} of type -variables, a call {type_unify vars ty1 ty2 i} attempts to find an augmented +Given two types {ty1} and {ty2} and an existing instantiation {i} of type +variables, a call {type_unify vars ty1 ty2 i} attempts to find an augmented instantiation of the type variables to make the two types equal. \FAILURE diff --git a/Help/type_vars_in_term.doc b/Help/type_vars_in_term.doc index e03d5fee..0d19de7d 100644 --- a/Help/type_vars_in_term.doc +++ b/Help/type_vars_in_term.doc @@ -6,14 +6,14 @@ Returns the set of type variables used in a term. \DESCRIBE -The call {type_vars_in_term t} returns the set of all type variables occurring +The call {type_vars_in_term t} returns the set of all type variables occurring anywhere inside any subterm of {t}. \FAILURE Never fails. \EXAMPLE -Note that the list of types occurring somewhere in the term may be larger than +Note that the list of types occurring somewhere in the term may be larger than the set of type variables in the term's toplevel type. For example: { # type_vars_in_term `!x:A. x = x`;; diff --git a/Help/typify_universal_set.doc b/Help/typify_universal_set.doc index 9ed2cfb0..e5b1fd22 100644 --- a/Help/typify_universal_set.doc +++ b/Help/typify_universal_set.doc @@ -8,10 +8,10 @@ Determines whether the universe set on a type is printed just as the type. \DESCRIBE The reference variable {typify_universal_set} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence -the automatic printing of terms and theorems at the toplevel. When it is +the automatic printing of terms and theorems at the toplevel. When it is {true}, as it is by default, any universal set {UNIV:A->bool} ({UNIV} is a predefined set constant valid over all types) is printed just as {(:A)}. When -{typify_universal_set} is {false}, it is printed as {UNIV}, just as for any +{typify_universal_set} is {false}, it is printed as {UNIV}, just as for any other constant. \FAILURE @@ -26,8 +26,8 @@ Note that having this setting is quite useful here: } \USES -HOL Light's Cartesian power type (constructor `{^}') uses a type to index the -power. When this flag is {true}, formulas often become easier to understand +HOL Light's Cartesian power type (constructor `{^}') uses a type to index the +power. When this flag is {true}, formulas often become easier to understand when printed, as in the above example. \SEEALSO diff --git a/Help/undefine.doc b/Help/undefine.doc index 75b75784..2540125f 100644 --- a/Help/undefine.doc +++ b/Help/undefine.doc @@ -6,11 +6,11 @@ Remove definition of a finite partial function on specific domain value. \DESCRIBE -This is one of a suite of operations on finite partial functions, type +This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain -etc. The call {undefine x f} removes a definition for the domain value {x} in -the finite partial function {f}; if there was none to begin with the function +etc. The call {undefine x f} removes a definition for the domain value {x} in +the finite partial function {f}; if there was none to begin with the function is unchanged. \FAILURE @@ -27,7 +27,7 @@ Never fails. } \SEEALSO -|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, +|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefined. \ENDDOC diff --git a/Help/undefined.doc b/Help/undefined.doc index 6f6de03c..22e7ba1b 100644 --- a/Help/undefined.doc +++ b/Help/undefined.doc @@ -6,7 +6,7 @@ Completely undefined finite partial function. \DESCRIBE -This is one of a suite of operations on finite partial functions, type +This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The value {undefined} is the `empty' finite partial function that is @@ -27,7 +27,7 @@ Not applicable. Starting a function to be augmented pointwise. \SEEALSO -|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, +|->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine. \ENDDOC diff --git a/Help/union.doc b/Help/union.doc index 44fd49d6..40f57885 100644 --- a/Help/union.doc +++ b/Help/union.doc @@ -9,8 +9,8 @@ Computes the union of two `sets'. list, set. \DESCRIBE -{union l1 l2} returns a list consisting of the elements of {l1} not already in -{l2} concatenated with {l2}. If {l1} and {l2} are initially free from +{union l1 l2} returns a list consisting of the elements of {l1} not already in +{l2} concatenated with {l2}. If {l1} and {l2} are initially free from duplicates, this gives a set-theoretic union operation. \FAILURE diff --git a/Help/union_prime.doc b/Help/union_prime.doc index f067d988..a3703c68 100644 --- a/Help/union_prime.doc +++ b/Help/union_prime.doc @@ -9,7 +9,7 @@ Union of sets modulo an equivalence. The call {union' r l1 l2} appends to the list {l2} all those elements {x} of {l1} for which there is not already an equivalent {x'} with {r x x'} in {l2} or earlier in {l1}. If {l1} and {l2} were free of equivalents under {r}, the -resulting list will be too, so this is a set operation modulo an equivalence. +resulting list will be too, so this is a set operation modulo an equivalence. The function {union} is the special case where the relation is just equality. \FAILURE diff --git a/Help/unions.doc b/Help/unions.doc index 4838437b..4af2a68a 100644 --- a/Help/unions.doc +++ b/Help/unions.doc @@ -6,7 +6,7 @@ Performs the union of a set of sets. \DESCRIBE -Applied to a list of lists, {union} returns a list of all the elements of them, +Applied to a list of lists, {union} returns a list of all the elements of them, in some unspecified order, with no repetitions. It can be considered as the union of the family of `sets'. diff --git a/Help/unions_prime.doc b/Help/unions_prime.doc index dfab41ec..7ba151f6 100644 --- a/Help/unions_prime.doc +++ b/Help/unions_prime.doc @@ -7,8 +7,8 @@ Compute union of a family of sets modulo an equivalence. \DESCRIBE If {r} is an equivalence relation an {l} a list of lists, the call -{unions' r l} returns a list with one representative of each {r}-equivalence -class occurring in any of the members. It thus gives a union of a family of +{unions' r l} returns a list with one representative of each {r}-equivalence +class occurring in any of the members. It thus gives a union of a family of sets with no duplicates under the equivalence {r}. \FAILURE diff --git a/Help/unparse_as_infix.doc b/Help/unparse_as_infix.doc index 5b965488..91f23b73 100644 --- a/Help/unparse_as_infix.doc +++ b/Help/unparse_as_infix.doc @@ -6,15 +6,15 @@ Removes string from the list of infix operators. \DESCRIBE -Certain identifiers are treated as infix operators with a given precedence and -associativity (left or right). The call {unparse_as_infix "op"} removes {op} +Certain identifiers are treated as infix operators with a given precedence and +associativity (left or right). The call {unparse_as_infix "op"} removes {op} from the list of infix identifiers, if it was indeed there. \FAILURE Never fails, even if the given string did not originally have infix status. \COMMENTS -Take care with applying this to some of the built-in operators, or parsing may +Take care with applying this to some of the built-in operators, or parsing may fail in existing libraries. \SEEALSO diff --git a/Help/unreserve_words.doc b/Help/unreserve_words.doc index 5ccb4b8a..b187eaa1 100644 --- a/Help/unreserve_words.doc +++ b/Help/unreserve_words.doc @@ -6,16 +6,16 @@ Remove given strings from the set of reserved words. \DESCRIBE -Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', -meaning that they are special to the parser and cannot be used as ordinary -identifiers. The call {unreserve_words l} removes all strings in {l} from the +Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', +meaning that they are special to the parser and cannot be used as ordinary +identifiers. The call {unreserve_words l} removes all strings in {l} from the list of reserved identifiers. \FAILURE Never fails, regardless of whether the given strings were in fact reserved. \COMMENTS -The initial set of reserved words in HOL Light should be unreserved only with +The initial set of reserved words in HOL Light should be unreserved only with great care, since then various elementary constructs may fail to parse. \SEEALSO diff --git a/Help/unspaced_binops.doc b/Help/unspaced_binops.doc index a5c3599f..df017803 100644 --- a/Help/unspaced_binops.doc +++ b/Help/unspaced_binops.doc @@ -10,7 +10,7 @@ The reference variable {unspaced_binops} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic printing of terms and theorems at the toplevel. It holds a list of the names of infix binary operators that are printed without surrounding spaces. By default, -it contains just the pairing operation `{,}', the numeric range `{..}' and the +it contains just the pairing operation `{,}', the numeric range `{..}' and the cartesian power indexing `{$}'. \FAILURE diff --git a/Help/use_file.doc b/Help/use_file.doc index 988ce7d3..38ea0fd4 100644 --- a/Help/use_file.doc +++ b/Help/use_file.doc @@ -6,7 +6,7 @@ Load a file, much like OCaml's {#use} directive. \DESCRIBE -Essentially the same as OCaml's {#use} directive, but a regular OCaml function +Essentially the same as OCaml's {#use} directive, but a regular OCaml function and therefore easier to exploit programmatically. \FAILURE diff --git a/Help/variant.doc b/Help/variant.doc index 90716154..f640e565 100644 --- a/Help/variant.doc +++ b/Help/variant.doc @@ -6,9 +6,9 @@ Modifies a variable name to avoid clashes. \DESCRIBE -The call {variant avoid v} returns a variant of {v}, with the name changed by -adding primes as much as necessary to avoid clashing with any free variables of -the terms in the list {avoid}. Usually {avoid} is just a list of variables, in +The call {variant avoid v} returns a variant of {v}, with the name changed by +adding primes as much as necessary to avoid clashing with any free variables of +the terms in the list {avoid}. Usually {avoid} is just a list of variables, in which case {v} is renamed so as to be different from all of them. The exact form of the variable name should not be relied on, except that the diff --git a/Help/variants.doc b/Help/variants.doc index b8a0b619..1ee7d35c 100644 --- a/Help/variants.doc +++ b/Help/variants.doc @@ -9,7 +9,7 @@ other. \DESCRIBE The call {variants av vs},s where {av} and {vs} are both lists of variables, will return a list {vs'} of variants of the variables in the list {vs}, renamed -as necessary by adding primes to avoid clashing with any free variables of the +as necessary by adding primes to avoid clashing with any free variables of the terms in the list {av} or with each other. \FAILURE diff --git a/Help/verbose.doc b/Help/verbose.doc index 1332d6a1..f7c54aa3 100644 --- a/Help/verbose.doc +++ b/Help/verbose.doc @@ -6,8 +6,8 @@ Flag to control verbosity of informative output. \DESCRIBE -When the value of {verbose} is set to {true}, the function {remark} will output -its string argument whenever called. This is used for most informative output +When the value of {verbose} is set to {true}, the function {remark} will output +its string argument whenever called. This is used for most informative output in automated rules. \FAILURE diff --git a/Help/warn.doc b/Help/warn.doc index bd9ae162..31c8ff30 100644 --- a/Help/warn.doc +++ b/Help/warn.doc @@ -7,7 +7,7 @@ Prints out a warning string \DESCRIBE When applied to a boolean value {b} and a string {s}, the call {warn b s} -prints out ``{Warning: s}'' and a following newline to the terminal if {b} is +prints out ``{Warning: s}'' and a following newline to the terminal if {b} is true and otherwise does nothing. \FAILURE diff --git a/IEEE/common.hl b/IEEE/common.hl index 2f5b4457..316e5c3f 100644 --- a/IEEE/common.hl +++ b/IEEE/common.hl @@ -9,7 +9,7 @@ let rec LABEL_CONJUNCTS_TAC labels thm = if is_conj(concl(thm)) then - CONJUNCTS_THEN2 + CONJUNCTS_THEN2 (fun c1 -> LABEL_TAC (hd labels) c1) (fun c2 -> LABEL_CONJUNCTS_TAC (tl labels) c2) thm @@ -22,7 +22,7 @@ let rec LABEL_CONJUNCTS_TAC labels thm = unparse_as_infix("ipow");; let ipow = define - `ipow (x:real) (e:int) = + `ipow (x:real) (e:int) = (if (&0 <= e) then (x pow (num_of_int e)) else (inv (x pow (num_of_int (--e)))))`;; @@ -33,7 +33,7 @@ let IPOW_LT_0 = REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ipow] THEN COND_CASES_TAC THENL [ (* 0 <= i *) - CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) + CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (i:int)`)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; @@ -70,10 +70,10 @@ let IPOW_INV_NEG = (* I'm sure this proof could be shortened ... yikes! *) let IPOW_ADD_EXP = - prove(`!(x:real) (u:int) (v:int). ~(x = &0) ==> - (x ipow u) * (x ipow v) = (x ipow (u + v))`, + prove(`!(x:real) (u:int) (v:int). ~(x = &0) ==> + (x ipow u) * (x ipow v) = (x ipow (u + v))`, (* lemma 1: prove when u, v non-negative *) - SUBGOAL_THEN `!(x:real) (u:int) (v:int). + SUBGOAL_THEN `!(x:real) (u:int) (v:int). ~(x = &0) /\ &0 <= u /\ &0 <= v ==> (x ipow u) * (x ipow v) = (x ipow (u + v))` (LABEL_TAC "lem1") THENL [ @@ -86,20 +86,20 @@ let IPOW_ADD_EXP = REWRITE_TAC[ipow] THEN ASM_REWRITE_TAC[] THEN USE_THEN "uge0" (fun uge0 -> USE_THEN "vge0" (fun vge0 -> - REWRITE_TAC[MATCH_MP + REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (u:int) /\ &0 <= (v:int) ==> &0 <= u + v`) (CONJ uge0 vge0)])) THEN - USE_THEN "uge0" (fun uge0 -> X_CHOOSE_THEN `n:num` + USE_THEN "uge0" (fun uge0 -> X_CHOOSE_THEN `n:num` (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] uge0)) THEN - USE_THEN "vge0" (fun vge0 -> X_CHOOSE_THEN `m:num` + USE_THEN "vge0" (fun vge0 -> X_CHOOSE_THEN `m:num` (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] vge0)) THEN REWRITE_TAC[INT_OF_NUM_ADD] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[GSYM REAL_POW_ADD]; ALL_TAC] THEN (* lemma 2: proof when u negative, v non-negative *) - SUBGOAL_THEN `!(x:real) (u:int) (v:int). + SUBGOAL_THEN `!(x:real) (u:int) (v:int). ~(x = &0) /\ u < &0 /\ &0 <= v ==> (x ipow u) * (x ipow v) = (x ipow (u + v))` (LABEL_TAC "lem2") THENL [ @@ -114,7 +114,7 @@ let IPOW_ADD_EXP = USE_THEN "ul0" (fun ul0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(u:int) < &0 ==> ~(&0 <= u)`) ul0]) THEN USE_THEN "ul0" (fun ul0 -> X_CHOOSE_THEN `n:num` (LABEL_TAC "ueqn") - (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] + (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] (MATCH_MP (ARITH_RULE `(x:int) < &0 ==> &0 <= --x`) ul0))) THEN USE_THEN "vge0" (fun vge0 -> X_CHOOSE_THEN `m:num` (LABEL_TAC "veqm") (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] vge0)) THEN @@ -126,8 +126,8 @@ let IPOW_ADD_EXP = USE_THEN "ueqn" (fun ueqn -> USE_THEN "veqm" (fun veqm -> USE_THEN "upvge0" (fun upvge0 -> LABEL_TAC "nlem" (REWRITE_RULE [INT_OF_NUM_LE] - (REWRITE_RULE [ueqn; veqm] (MATCH_MP - (ARITH_RULE `&0 <= (u:int) + (v:int) ==> --u <= v`) upvge0)))))) + (REWRITE_RULE [ueqn; veqm] (MATCH_MP + (ARITH_RULE `&0 <= (u:int) + (v:int) ==> --u <= v`) upvge0)))))) THEN USE_THEN "nlem" (fun nlem -> REWRITE_TAC [MATCH_MP INT_OF_NUM_SUB nlem]) THEN @@ -135,7 +135,7 @@ let IPOW_ADD_EXP = ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN REWRITE_TAC[GSYM real_div] THEN USE_THEN "xn0" (fun xn0 -> - REWRITE_TAC [MATCH_MP REAL_DIV_POW2 xn0]) THEN + REWRITE_TAC [MATCH_MP REAL_DIV_POW2 xn0]) THEN ASM_REWRITE_TAC[]; (* u + v negative *) @@ -146,11 +146,11 @@ let IPOW_ADD_EXP = USE_THEN "ueqn" (fun ueqn -> USE_THEN "veqm" (fun veqm -> USE_THEN "upvnge0" (fun upvnge0 -> LABEL_TAC "mln" (REWRITE_RULE [INT_OF_NUM_LT] - (REWRITE_RULE [ueqn; veqm] (MATCH_MP + (REWRITE_RULE [ueqn; veqm] (MATCH_MP (ARITH_RULE `~(&0 <= (u:int) + (v:int)) ==> v < --u`) upvnge0)))))) THEN USE_THEN "mln" (fun mln -> - REWRITE_TAC [MATCH_MP INT_OF_NUM_SUB (MATCH_MP + REWRITE_TAC [MATCH_MP INT_OF_NUM_SUB (MATCH_MP (ARITH_RULE `m < n ==> m <= n`) mln)]) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN @@ -166,12 +166,12 @@ let IPOW_ADD_EXP = (* u non-negative *) ASM_CASES_TAC `&0 <= (v:int)` THENL [ (* v non-negative; use lemma 1 *) - USE_THEN "lem1" (fun lem1 -> + USE_THEN "lem1" (fun lem1 -> MATCH_MP_TAC lem1 THEN ASM_REWRITE_TAC[]); (* v negative; use lemma 2 *) ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:int) + (b:int) = b + a`] THEN - USE_THEN "lem2" (fun lem2 -> + USE_THEN "lem2" (fun lem2 -> MATCH_MP_TAC lem2 THEN ASM_ARITH_TAC)]; (* u negative *) ASM_CASES_TAC `&0 <= (v:int)` THENL [ @@ -186,10 +186,10 @@ let IPOW_ADD_EXP = USE_THEN "lem1" (fun lem1 -> MATCH_MP_TAC lem1) THEN ASM_ARITH_TAC]]);; -let IPOW_EQ_EXP = - prove(`!(r:num) (i:int). &0 <= i ==> ?(m:num). m = num_of_int(i) /\ +let IPOW_EQ_EXP = + prove(`!(r:num) (i:int). &0 <= i ==> ?(m:num). m = num_of_int(i) /\ &r ipow i = &(r EXP m)`, - REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN(fun thm -> + REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN(fun thm -> LABEL_TAC "ige0" thm) THEN EXISTS_TAC `num_of_int(i)` THEN ASM_REWRITE_TAC[] THEN @@ -200,13 +200,13 @@ let IPOW_EQ_EXP = let IPOW_EQ_EXP_P = prove(`!(r:num) (p:num). 0 < p ==> &r ipow (&p - &1) = &(r EXP (p - 1))`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> LABEL_TAC "pg0" thm) THEN - USE_THEN "pg0" (fun pg0 -> (LABEL_TAC "pm1ge0" (MATCH_MP + USE_THEN "pg0" (fun pg0 -> (LABEL_TAC "pm1ge0" (MATCH_MP (ARITH_RULE `0 < p ==> 0 <= p - 1`) pg0))) THEN USE_THEN "pm1ge0" (fun pm1ge0 -> LABEL_TAC "intge0" (REWRITE_RULE[GSYM INT_OF_NUM_LE] pm1ge0)) THEN USE_THEN "intge0" (fun intge0 -> CHOOSE_THEN (fun thm -> LABEL_TAC "m" thm) (MATCH_MP (SPEC `r:num` IPOW_EQ_EXP) intge0)) THEN - USE_THEN "m" (fun m -> MAP_EVERY (fun pair -> (LABEL_TAC + USE_THEN "m" (fun m -> MAP_EVERY (fun pair -> (LABEL_TAC (fst pair) (snd pair))) (zip ["m1"; "m2"] (CONJUNCTS m))) THEN USE_THEN "pg0" (fun pg0 -> REWRITE_TAC[MATCH_MP INT_OF_NUM_SUB (REWRITE_RULE[ARITH_RULE `0 < x <=> 1 <= x`] @@ -217,11 +217,11 @@ let IPOW_EQ_EXP_P = ASM_REWRITE_TAC[]);; let IPOW_BETWEEN = - prove(`!(x:real) (y:num) (z:num) (e:int). + prove(`!(x:real) (y:num) (z:num) (e:int). &0 < x /\ &y * x ipow e <= &z * x ipow e /\ &z * x ipow e <= (&y + &1) * x ipow e ==> z = y \/ z = y + 1`, - REPEAT GEN_TAC THEN + REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgt0"; "ineq1"; "ineq2"]) THEN (* lemma: y <= z *) SUBGOAL_THEN `(y:num) <= z` (LABEL_TAC "ylez") THENL [ @@ -240,7 +240,7 @@ let IPOW_BETWEEN = ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IPOW_LT_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - ASM_ARITH_TAC);; + ASM_ARITH_TAC);; let IPOW_TO_1 = prove(`!(x:real). x ipow &1 = x`, @@ -256,9 +256,9 @@ let IPOW_TO_0 = let IPOW_LE_1 = prove(`!(x:real) (e:int). &1 <= x /\ &0 <= e ==> &1 <= x ipow e`, - REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN + REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgeq1"; "egeq0"]) THEN - ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[] THEN USE_THEN "egeq0" (fun egeq0 -> CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] egeq0)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC REAL_POW_LE_1 THEN @@ -266,15 +266,15 @@ let IPOW_LE_1 = let IPOW_LT_1 = prove(`!(x:real) (e:int). &1 < x /\ &0 < e ==> &1 < x ipow e`, - REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN + REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgt1"; "egt0"]) THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 < (e:int) ==> ((&0 <= e) <=> T)`) (ASSUME `&0 < (e:int)`)] THEN - USE_THEN "egt0" (fun egt0 -> CHOOSE_THEN (LABEL_TAC "eeqn") + USE_THEN "egt0" (fun egt0 -> CHOOSE_THEN (LABEL_TAC "eeqn") (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (MATCH_MP (ARITH_RULE `&0 < (e:int) ==> &0 <= e`) egt0))) THEN ASM_REWRITE_TAC[] THEN - REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN + REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC (SPEC `n:num` REAL_POW_LT_1) THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN @@ -295,8 +295,8 @@ let IPOW_LE_NUM = (* inductive step *) DISCH_THEN (LABEL_TAC "rgeq2") THEN USE_THEN "rgeq2" (fun rgeq2 -> CHOOSE_THEN (LABEL_TAC "nleqpow") - (MATCH_MP - (ASSUME + (MATCH_MP + (ASSUME `2 <= r ==> (?e. &0 <= e /\ &n <= &r ipow e)`) rgeq2)) THEN EXISTS_TAC `e + (&1:int)` THEN REWRITE_TAC[ADD1] THEN CONJ_TAC THENL [ @@ -311,7 +311,7 @@ let IPOW_LE_NUM = CONJ_TAC THENL [ ONCE_REWRITE_TAC[ARITH_RULE `&2 * x = x + (x:real)`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN - MATCH_MP_TAC (ARITH_RULE + MATCH_MP_TAC (ARITH_RULE `x <= (y:real) /\ z <= w ==> x + z <= y + w`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IPOW_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; @@ -324,21 +324,21 @@ let IPOW_LE_NUM = ASM_ARITH_TAC]]) in prove(`!(r:num) (n:num). 2 <= r ==> ?(e:int). &n <= &r ipow e`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> CHOOSE_TAC - (SPEC `n:num` (MATCH_MP lem1 thm))) THEN EXISTS_TAC `e:int` THEN + (SPEC `n:num` (MATCH_MP lem1 thm))) THEN EXISTS_TAC `e:int` THEN ASM_REWRITE_TAC[]);; let IPOW_LE_REAL = prove(`!(r:num) (z:real). 2 <= r ==> ?(e:int). z <= &r ipow e`, - REPEAT GEN_TAC THEN + REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "rgeq2") THEN CHOOSE_THEN (LABEL_TAC "nbound") (SPEC `z:real` REAL_ARCH_SIMPLE) THEN - USE_THEN "rgeq2" (fun rgeq2 -> + USE_THEN "rgeq2" (fun rgeq2 -> CHOOSE_TAC (SPEC `n:num` (MATCH_MP IPOW_LE_NUM rgeq2))) THEN EXISTS_TAC `e:int` THEN ASM_ARITH_TAC);; let IPOW_LE_REAL_2 = prove(`!(r:num) (z:real). &0 < z /\ 2 <= r ==> ?(e:int). &r ipow e <= z`, - REPEAT GEN_TAC THEN + REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["zgt0"; "rgeq2"]) THEN USE_THEN "rgeq2" (fun rgeq2 -> CHOOSE_THEN (LABEL_TAC "recip") (SPEC `&1 / (z:real)` (MATCH_MP IPOW_LE_REAL rgeq2))) THEN @@ -356,7 +356,7 @@ let IPOW_LE_REAL_2 = REWRITE_TAC[GSYM real_div] THEN ASM_REWRITE_TAC[]]);; let IPOW_MONOTONE = - prove(`!(x:num) (e1:int) (e2:int). 2 <= x /\ &x ipow e1 <= &x ipow e2 ==> + prove(`!(x:num) (e1:int) (e2:int). 2 <= x /\ &x ipow e1 <= &x ipow e2 ==> e1 <= e2`, REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN @@ -366,10 +366,10 @@ let IPOW_MONOTONE = (* 0 <= e2 *) ASM_REWRITE_TAC[] THEN CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) - (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] + (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (e1:int)`)) THEN CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) - (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] + (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (e2:int)`)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[REAL_OF_NUM_POW] THEN @@ -386,15 +386,15 @@ let IPOW_MONOTONE = DISCH_THEN (LABEL_TAC "xgeq2") THEN SUBGOAL_THEN `&x ipow e2 = inv (&x ipow -- e2)` (fun thm -> REWRITE_TAC[thm]) THENL [ - MATCH_MP_TAC IPOW_INV_NEG THEN + MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `?e2':int. &0 < e2' /\ --e2 = e2'` + SUBGOAL_THEN `?e2':int. &0 < e2' /\ --e2 = e2'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e2pgeq0"; "e2eq"])) THENL [ EXISTS_TAC `-- e2:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `inv (&x ipow e2') < &x ipow e1` (LABEL_TAC "e2plte1") THENL [ - MATCH_MP_TAC + MATCH_MP_TAC (ARITH_RULE `!y. (x:real) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `&1:real` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[ @@ -403,10 +403,10 @@ let IPOW_MONOTONE = ARITH_TAC; MATCH_MP_TAC IPOW_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; MATCH_MP_TAC IPOW_LE_1 THEN - REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; ALL_TAC] THEN DISCH_TAC THEN ASM_ARITH_TAC]; - + (* e1 < 0 *) ASM_CASES_TAC `&0 <= (e2:int)` THENL [ (* 0 <= e2 *) @@ -415,31 +415,31 @@ let IPOW_MONOTONE = (* e2 < 0 *) REWRITE_TAC[GSYM ipow] THEN REWRITE_TAC[GSYM IMP_IMP] THEN DISCH_THEN (LABEL_TAC "xgeq2") THEN - SUBGOAL_THEN `&x ipow e1 = inv (&x ipow -- e1)` + SUBGOAL_THEN `&x ipow e1 = inv (&x ipow -- e1)` (LABEL_TAC "e1eqinv") THENL [ - MATCH_MP_TAC IPOW_INV_NEG THEN + MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&x ipow e2 = inv (&x ipow -- e2)` (LABEL_TAC "e2eqinv") THENL [ - MATCH_MP_TAC IPOW_INV_NEG THEN + MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN - SUBGOAL_THEN `&x ipow -- e2 <= &x ipow -- e1` + SUBGOAL_THEN `&x ipow -- e2 <= &x ipow -- e1` MP_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN - USE_THEN "e1eqinv" + USE_THEN "e1eqinv" (fun e1eqinv -> REWRITE_TAC[GSYM e1eqinv]) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `?e1':int. &0 <= e1' /\ --e1 = e1'` + SUBGOAL_THEN `?e1':int. &0 <= e1' /\ --e1 = e1'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e1pgeq0"; "e1eq"])) THENL [ EXISTS_TAC `-- e1:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `?e2':int. &0 <= e2' /\ --e2 = e2'` + SUBGOAL_THEN `?e2':int. &0 <= e2' /\ --e2 = e2'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e2pgeq0"; "e2eq"])) THENL [ EXISTS_TAC `-- e2:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `e1 <= (e2:int) <=> e2' <= (e1':int)` + SUBGOAL_THEN `e1 <= (e2:int) <=> e2' <= (e1':int)` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN @@ -462,16 +462,16 @@ let IPOW_MONOTONE = ASM_ARITH_TAC; ASM_REWRITE_TAC[]]]]);; let IPOW_MONOTONE_2 = - prove(`!(x:real) (e1:int) (e2:int). &1 <= x /\ e1 <= e2 ==> + prove(`!(x:real) (e1:int) (e2:int). &1 <= x /\ e1 <= e2 ==> x ipow e1 <= x ipow e2`, - REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC + REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgeq1"; "e1leqe2"]) THEN REWRITE_TAC[ipow] THEN ASM_CASES_TAC `&0 <= (e1:int)` THENL [ (* 0 <= e1 *) SUBGOAL_THEN `&0 <= (e2:int)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[] THEN CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (e1:int)`)) THEN CHOOSE_THEN ASSUME_TAC @@ -482,7 +482,7 @@ let IPOW_MONOTONE_2 = (* e1 < 0 *) REWRITE_TAC[GSYM ipow] THEN ASM_CASES_TAC `&0 <= (e2:int)` THENL [ - MATCH_MP_TAC REAL_LE_TRANS THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1:real` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[MATCH_MP IPOW_INV_NEG (MATCH_MP (ARITH_RULE `&1 <= (x:real) ==> ~(x = &0)`) @@ -504,17 +504,17 @@ let IPOW_MONOTONE_2 = (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e2geq0"; "e2eq"])) THENL [ EXISTS_TAC `-- e2:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN - USE_THEN "xgeq1" (fun xgeq1 -> - REWRITE_TAC[MATCH_MP (SPEC `x:real` IPOW_LT_0) (MATCH_MP + USE_THEN "xgeq1" (fun xgeq1 -> + REWRITE_TAC[MATCH_MP (SPEC `x:real` IPOW_LT_0) (MATCH_MP (ARITH_RULE `&1 <= (x:real) ==> &0 < x`) xgeq1)]) THEN - ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ipow] THEN USE_THEN "e1geq0" (fun e1geq0 -> CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] e1geq0)) THEN USE_THEN "e2geq0" (fun e2geq0 -> CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] e2geq0)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN - MATCH_MP_TAC REAL_POW_MONO THEN ASM_ARITH_TAC]]);; + MATCH_MP_TAC REAL_POW_MONO THEN ASM_ARITH_TAC]]);; let IPOW_MUL_INV_EQ_1 = prove(`!(x:real) (i:int). &0 < x ==> x ipow i * x ipow (-- i) = &1`, @@ -522,14 +522,14 @@ let IPOW_MUL_INV_EQ_1 = SUBGOAL_THEN `~(x = &0)` (LABEL_TAC "xneq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> - GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) [MATCH_MP IPOW_INV_NEG xneq0]) THEN ONCE_REWRITE_TAC[ARITH_RULE `x * y = y * (x:real)`] THEN MATCH_MP_TAC REAL_MUL_RINV THEN MATCH_MP_TAC (ARITH_RULE `&0 < z ==> ~(z = &0)`) THEN MATCH_MP_TAC IPOW_LT_0 THEN ASM_REWRITE_TAC[]);; - + (* -------------------------------------------------------------------------- *) (* rerror *) @@ -549,18 +549,18 @@ let closer = define (* Misc helpful theorems *) (* -------------------------------------------------------------------------- *) -let DOUBLE_NOT_ODD = +let DOUBLE_NOT_ODD = prove(`!(n:num). ODD(2 * n) <=> F`, REWRITE_TAC[GSYM NOT_EVEN] THEN REWRITE_TAC[EVEN_DOUBLE]);; -let DOUBLE_NEG_1_ODD = +let DOUBLE_NEG_1_ODD = prove(`!(f:num). 0 < f ==> ODD(2 * f - 1)`, GEN_TAC THEN DISCH_THEN(fun thm -> CHOOSE_TAC (REWRITE_RULE[ADD] (REWRITE_RULE[LT_EXISTS] thm))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `2 * SUC(d) - 1 = SUC(2 *d)`] THEN REWRITE_TAC[ODD_DOUBLE]);; -let REAL_MULT_NOT_0 = +let REAL_MULT_NOT_0 = REAL_RING `z = x * y /\ ~(z = &0) ==> ~(x = &0) /\ ~(y = &0)`;; let EXP_LE_1 = @@ -575,7 +575,7 @@ let EXP_LE_1 = let NUM_LE_MUL_1 = prove(`!(a:num) (b:num). 1 <= a * b ==> 1 <= a`, - REPEAT GEN_TAC THEN + REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE `a = 0 \/ 1 <= a`) THENL [ DISJ_CASES_TAC (ARITH_RULE `b = 0 \/ 1 <= b`) THENL [ ASM_REWRITE_TAC[] THEN ARITH_TAC; @@ -606,7 +606,7 @@ let SUP_NUM_BOUNDED = ?(n':num). sup_num s = n' /\ is_sup_num s n'`, GEN_TAC THEN INDUCT_TAC THENL [ (* base case *) - DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN + DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN EXISTS_TAC `0:num` THEN SUBGOAL_THEN `is_sup_num s 0` (LABEL_TAC "supeq0") THENL [ REWRITE_TAC[is_sup_num] THEN ASM_REWRITE_TAC[] THEN @@ -622,30 +622,30 @@ let SUP_NUM_BOUNDED = REWRITE_TAC[GSYM (ASSUME `x = 0`)] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `!x. is_sup_num s x ==> x = 0` + SUBGOAL_THEN `!x. is_sup_num s x ==> x = 0` (LABEL_TAC "all0") THENL [ GEN_TAC THEN REWRITE_TAC[is_sup_num] THEN DISCH_THEN ( LABEL_CONJUNCTS_TAC - ["xins"; "bound2"]) THEN + ["xins"; "bound2"]) THEN MATCH_MP_TAC (ARITH_RULE `x <= 0 ==> x = 0`) THEN USE_THEN "bound" - (fun bound -> - REWRITE_TAC[MATCH_MP bound (ASSUME `(x:num) IN s`)]); + (fun bound -> + REWRITE_TAC[MATCH_MP bound (ASSUME `(x:num) IN s`)]); ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN REWRITE_TAC[sup_num] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[sup_num] THEN SELECT_ELIM_TAC THEN GEN_TAC THEN USE_THEN "supeq0" (fun supeq0 -> USE_THEN "all0" (fun all0 -> DISCH_THEN (fun thm -> REWRITE_TAC[MATCH_MP all0 (MATCH_MP thm supeq0)]))); - + (* inductive step *) - DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN + DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN ASM_CASES_TAC `SUC(b) IN s` THENL [ - EXISTS_TAC `SUC(b)` THEN + EXISTS_TAC `SUC(b)` THEN SUBGOAL_THEN `is_sup_num s (SUC b)` (LABEL_TAC "supeq") THENL [ REWRITE_TAC[is_sup_num] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `!x. is_sup_num s x ==> x = SUC b` + SUBGOAL_THEN `!x. is_sup_num s x ==> x = SUC b` (LABEL_TAC "alleq") THENL [ GEN_TAC THEN REWRITE_TAC[is_sup_num] THEN DISCH_THEN ( LABEL_CONJUNCTS_TAC ["xins"; "bound2"]) THEN @@ -654,19 +654,19 @@ let SUP_NUM_BOUNDED = REWRITE_TAC[MATCH_MP bound xins])); ALL_TAC] THEN SUBGOAL_THEN `SUC b <= x` ASSUME_TAC THENL [ USE_THEN "bound2" (fun bound -> - REWRITE_TAC[MATCH_MP bound (ASSUME `SUC b IN s`)]); + REWRITE_TAC[MATCH_MP bound (ASSUME `SUC b IN s`)]); ALL_TAC] THEN ASM_ARITH_TAC; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN REWRITE_TAC[sup_num] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[sup_num] THEN SELECT_ELIM_TAC THEN GEN_TAC THEN USE_THEN "supeq" (fun supeq -> USE_THEN "alleq" (fun alleq -> DISCH_THEN (fun thm -> REWRITE_TAC[MATCH_MP alleq (MATCH_MP thm supeq)]))); (* suc b not in s *) - SUBGOAL_THEN `!n. n IN s ==> n <= (b:num)` + SUBGOAL_THEN `!n. n IN s ==> n <= (b:num)` (LABEL_TAC "bound2") THENL [ GEN_TAC THEN DISCH_TAC THEN - MATCH_MP_TAC + MATCH_MP_TAC (ARITH_RULE `~(n = SUC b) /\ n <= (SUC b) ==> n <= b`) THEN USE_THEN "bound" (fun bound -> REWRITE_TAC[MATCH_MP bound (ASSUME `(n:num) IN s`)]) THEN @@ -680,34 +680,34 @@ let SUP_NUM_BOUNDED = (CONJ snote bound2)]))]]);; let SUP_INT_BOUNDED = - let lem1 = + let lem1 = prove(`!(s:int->bool) (b:int). ~(s = {}) /\ (!e. e IN s ==> e <= b) ==> ?(e':int). is_sup_int s e'`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN - SUBGOAL_THEN `?e. (e:int) IN s` + SUBGOAL_THEN `?e. (e:int) IN s` (CHOOSE_THEN (LABEL_TAC "eins")) THENL [ USE_THEN "snote" (fun snote -> ASSUME_TAC( MATCH_MP CHOICE_DEF snote)) THEN - EXISTS_TAC `CHOICE (s:int->bool)` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `CHOICE (s:int->bool)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `~({n | ?(e'':int). n = num_of_int(e'' - e) /\ - e'' IN s /\ e <= e''} = {})` + SUBGOAL_THEN `~({n | ?(e'':int). n = num_of_int(e'' - e) /\ + e'' IN s /\ e <= e''} = {})` (LABEL_TAC "nnote") THENL [ - REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `0:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `e:int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_LE_REFL] THEN REWRITE_TAC[ARITH_RULE `e - (e:int) = &0`] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM]; ALL_TAC] THEN - SUBGOAL_THEN `?(bn:num). !n. n IN - {n | ?(e'':int). n = num_of_int(e'' - e) /\ + SUBGOAL_THEN `?(bn:num). !n. n IN + {n | ?(e'':int). n = num_of_int(e'' - e) /\ e'' IN s /\ e <= e''} ==> n <= bn` (CHOOSE_THEN (LABEL_TAC "bound2")) THENL [ EXISTS_TAC `num_of_int(b - e)` THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (fun thm -> - CHOOSE_THEN - (LABEL_CONJUNCTS_TAC ["eqn"; "eins2"; "eleq"]) thm) THEN + CHOOSE_THEN + (LABEL_CONJUNCTS_TAC ["eqn"; "eins2"; "eleq"]) thm) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN SUBGOAL_THEN `&0 <= e'' - (e:int)` (fun thm -> REWRITE_TAC[REWRITE_RULE[NUM_OF_INT] thm]) THENL [ @@ -731,26 +731,26 @@ let SUP_INT_BOUNDED = ["nins"; "nbounds"] (REWRITE_RULE[is_sup_num] issupnum)) THEN SUBGOAL_THEN `?(e'':int). e'' IN s /\ e <= e'' /\ (int_of_num n') = e'' - e` - (CHOOSE_THEN + (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["eins2"; "eleq"; "emine"])) THENL [ USE_THEN "nins" (fun nins -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC - ["eins2"; "emine"; "eleq"]) + ["eins2"; "emine"; "eleq"]) (REWRITE_RULE[IN_ELIM_THM] nins)) THEN EXISTS_TAC `e'':int` THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&0 <= e'' - (e:int)` (fun thm -> + SUBGOAL_THEN `&0 <= e'' - (e:int)` (fun thm -> REWRITE_TAC[REWRITE_RULE[NUM_OF_INT] thm]) THENL [ ASM_ARITH_TAC]; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(e:int) - e' + e' = e`] THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "epins") THEN ASM_CASES_TAC `e' < (e:int)` THENL [ ASM_ARITH_TAC; - ONCE_REWRITE_TAC[ARITH_RULE + ONCE_REWRITE_TAC[ARITH_RULE `(z:int) <= y <=> z - e <= y - e`] THEN USE_THEN "emine" (fun emine -> REWRITE_TAC[GSYM emine]) THEN SUBGOAL_THEN `&0 <= (e':int) - e` (fun thm -> - CHOOSE_THEN (LABEL_TAC "eqepmine") + CHOOSE_THEN (LABEL_TAC "eqepmine") (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] thm)) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "eqepmine" (fun eqepmine -> REWRITE_TAC[eqepmine]) THEN @@ -765,4 +765,4 @@ let SUP_INT_BOUNDED = REPEAT GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `sup_int s` THEN REWRITE_TAC[] THEN REWRITE_TAC[sup_int] THEN SELECT_ELIM_TAC THEN MATCH_MP_TAC lem1 THEN EXISTS_TAC `b:int` THEN ASM_REWRITE_TAC[]);; - + diff --git a/IsabelleLight/README b/IsabelleLight/README index c092154f..d5d05200 100644 --- a/IsabelleLight/README +++ b/IsabelleLight/README @@ -9,8 +9,8 @@ This directory is distributed under the same license as HOL-Light (BSD-2-Clause) - - - - This README contains some brief information on the usage of this system. -Please refer to the paper [1] for a general description as well as the comments -in the code for details on each available function. +Please refer to the paper [1] for a general description as well as the comments +in the code for details on each available function. - - - - @@ -42,9 +42,9 @@ FULL_SIMP_TAC thl : SIMP_TAC then FULL_REWRITE_TAC. X_MATCH_GEN_TAC tm : X_GEN_TAC, X_CHOOSE_TAC, EXISTS_TAC with X_MATCH_CHOOSE_TAC tm type matching -MATCH_EXISTS_TAC tm +MATCH_EXISTS_TAC tm -gen_case_tac : Applies case_tac to leading universally quantified +gen_case_tac : Applies case_tac to leading universally quantified variable in the goal. induct_tac : Induction with any inductive datatype. @@ -110,7 +110,7 @@ frulen_tac - - - - -[1] Papapanagiotou, P. and Fleuriot, J.: -An Isabelle-Like Procedural Mode for HOL Light. +[1] Papapanagiotou, P. and Fleuriot, J.: +An Isabelle-Like Procedural Mode for HOL Light. Logic for Programming, Artificial Intelligence, and Reasoning, # -pp 565-580, Springer (2010) \ No newline at end of file +pp 565-580, Springer (2010) diff --git a/IsabelleLight/meta_rules.ml b/IsabelleLight/meta_rules.ml index f03f8aa5..bd7d1a91 100644 --- a/IsabelleLight/meta_rules.ml +++ b/IsabelleLight/meta_rules.ml @@ -69,7 +69,7 @@ let MTAUT tm = (* ------------------------------------------------------------------------- *) -(* RULE to replace implication by meta-level implication to easily create *) +(* RULE to replace implication by meta-level implication to easily create *) (* meta-theorems from normal theorems. *) (* ------------------------------------------------------------------------- *) @@ -100,8 +100,8 @@ let (MDISCH_TAC: tactic) = (* Also gets rid of meta-level implication in the undischarged term. *) (* ------------------------------------------------------------------------- *) -let MUNDISCH th = - let mth = BETA_RULE (AP_THM (AP_THM MIMP_DEF `p:bool`) `q:bool`) in +let MUNDISCH th = + let mth = BETA_RULE (AP_THM (AP_THM MIMP_DEF `p:bool`) `q:bool`) in let th = PURE_ONCE_REWRITE_RULE [mth] th in try let undisch_tm = (rand o rator o concl) th in PROVE_HYP ((UNDISCH o snd o EQ_IMP_RULE o MIMP_TO_IMP_CONV) undisch_tm) (UNDISCH th) @@ -167,7 +167,7 @@ let REV_PART_MATCH_I = let rec (term_to_asm_match: term list -> term -> (string * thm) list -> (string * thm) list * (thm * instantiation)) = fun avoids key asms -> if (asms = []) then failwith ("No assumptions match `" ^ (string_of_term key) ^ "`!") - else try + else try let asm = (snd o hd) asms in let i = REV_PART_MATCH_I avoids I asm key in (tl asms),(asm,i) @@ -189,7 +189,7 @@ let rec (term_to_asm_n_match: term list -> term -> (string * thm) list -> int -> fun avoids key asms n -> if (asms = []) then failwith "No such assumption found!" else try match n with - 0 -> + 0 -> let asm = (snd o hd) asms in let i = REV_PART_MATCH_I avoids I asm key in (tl asms),(asm,i) @@ -209,8 +209,8 @@ let gmm t = warn true ("Free variables in goal: "^errmsg) else ()); let rec split_mimp = fun tm -> - if (is_mimp tm) - then + if (is_mimp tm) + then let (a,b) = dest_mimp tm in let (asms, concl) = split_mimp b in (a::asms,concl) @@ -237,7 +237,7 @@ let gm t = ignore( g t ) ; e (REPEAT MDISCH_TAC);; let conjI = MTAUT `p===>q===>p/\q`;; let conjunct1 = MTAUT `p/\q===>p`;; let conjunct2 = MTAUT `p/\q===>q`;; -let conjE = MTAUT `p/\q===>(p===>q===>r)===>r`;; +let conjE = MTAUT `p/\q===>(p===>q===>r)===>r`;; let disjI1 = MTAUT `p===>p\/q`;; let disjI2 = MTAUT `q===>p\/q`;; let disjE = MTAUT `p\/q===>(p===>r)===>(q===>r)===>r`;; @@ -251,10 +251,10 @@ let iffE = MTAUT `(a<=>b)===>((a==>b) ===> (b==>a) ===> r) ===> r`;; let allE = prove( `(!x:A. P x) ===> (P (a:A) ===> (r:bool)) ===> r` , MIMP_TAC THEN MESON_TAC[]);; -let exI = prove (`P (a:A)===> ?x:A. P x`, +let exI = prove (`P (a:A)===> ?x:A. P x`, MIMP_TAC THEN - DISCH_TAC THEN - (EXISTS_TAC `a:A`) THEN + DISCH_TAC THEN + (EXISTS_TAC `a:A`) THEN (FIRST_ASSUM ACCEPT_TAC));; let notI = MTAUT `(p===>F)===> ~p`;; @@ -307,7 +307,7 @@ let notE = MTAUT `~a ===> a ===> r`;; type meta_rule = term * goal list * thm;; -let print_meta_rule: meta_rule->unit = +let print_meta_rule: meta_rule->unit = fun (c,glist,j) -> print_term c ; hd (map (print_newline () ; print_goal) glist) ; print_newline () ; print_thm j ; print_newline ();; @@ -334,7 +334,7 @@ let inst_meta_rule:instantiation->meta_rule->meta_rule = let REWRITE_META_RULE:thm list->meta_rule->meta_rule = fun thl (c,glist,j) -> - let rewr = rhs o concl o (REWRITE_CONV thl) + let rewr = rhs o concl o (REWRITE_CONV thl) and rewrg = (hd o snd3 o (REWRITE_ASM_TAC thl THEN REWRITE_TAC thl)) in rewr c, map (rewrg) glist, @@ -361,13 +361,13 @@ let meta_rule_frees: meta_rule -> term list = (* Returns the new meta_rule and the instantiation for the variable renaming.*) (* ------------------------------------------------------------------------- *) -let meta_rule_mk_primed_vars_I: term list -> meta_rule -> meta_rule * instantiation = +let meta_rule_mk_primed_vars_I: term list -> meta_rule -> meta_rule * instantiation = fun avoids r -> let fvars = meta_rule_frees r in let rec mk_primed_l = fun avoids vars -> - match vars with + match vars with [] -> null_inst - | v::rest -> + | v::rest -> let new_v = mk_primed_var avoids v in compose_insts (term_match [] v new_v) (mk_primed_l (new_v::avoids) rest) in @@ -381,7 +381,7 @@ let meta_rule_mk_primed_vars_I: term list -> meta_rule -> meta_rule * instantiat (* Applies mk_primed_var to all the free variables in a meta_rule. *) (* ------------------------------------------------------------------------- *) -let meta_rule_mk_primed_vars: term list -> meta_rule -> meta_rule = +let meta_rule_mk_primed_vars: term list -> meta_rule -> meta_rule = fun avoids r -> fst (meta_rule_mk_primed_vars_I avoids r);; @@ -430,24 +430,24 @@ let inst_meta_rule_vars: (term * term) list -> meta_rule -> term list -> meta_ru fun instlist r gfrees -> let rfrees = meta_rule_frees r in let vars,subs = List.split instlist in - + let match_var = fun tm1 tm2 -> let inst = try term_match [] tm1 tm2 with Failure _ -> [],[tm2,tm1],[] in match inst with [],[],_ -> tm2 | _ -> failwith "match_var: no match" in - + let mcheck_var = fun tm -> if (not (is_var tm)) then failwith ("inst_meta_rule_vars: `" ^ string_of_term tm ^ "` is not a variable") - else try tryfind (match_var tm) rfrees + else try tryfind (match_var tm) rfrees with Failure _ -> failwith ("inst_meta_rule_vars: `" ^ string_of_term tm ^ "` could not be found in the meta_rule") in let mcheck_gvar = fun var -> try let mvar = tryfind (match_var var) gfrees in term_match [] var mvar - with Failure _ -> + with Failure _ -> warn true ("inst_meta_rule_vars: `" ^ string_of_term var ^ "` could not be found in the goal") ; - null_inst in + null_inst in let new_r,prim_inst = meta_rule_mk_primed_vars_I gfrees r in let new_vars = map ((instantiate prim_inst) o mcheck_var) vars in @@ -493,20 +493,20 @@ let inst_meta_rule_vars: (term * term) list -> meta_rule -> term list -> meta_ru let (mk_meta_rule: thm -> meta_rule) = fun thm -> let rec undisch_premises th = - if is_mimp (concl th) + if is_mimp (concl th) then let rest,res_th = undisch_premises (MUNDISCH th) in (rand(rator(concl th)))::rest,res_th else [],th in let (prems,thm) = undisch_premises thm in let rec mk_meta_subgoal tm = ( - if (is_mimp(tm)) then + if (is_mimp(tm)) then let (a,c) = dest_mimp tm in let (prems,concl) = mk_meta_subgoal c in ("",ASSUME a)::prems,concl else [],tm ) in concl thm,map mk_meta_subgoal prems,MIMP_TO_IMP_RULE thm;; - + (* ------------------------------------------------------------------------- *) (* Isabelle's natural deduction inference rules as meta_rules. *) @@ -616,7 +616,7 @@ let notEm:meta_rule = ], (UNDISCH o UNDISCH o TAUT) `~a==>a==>r` );; - + (* ------------------------------------------------------------------------- *) (* rulem_tac: ((term * term) list -> meta_rule -> tactic): *) @@ -675,7 +675,7 @@ let (rulem_tac: (term*term) list->meta_rule->tactic) = if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in - + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> @@ -723,36 +723,36 @@ let (erulem_tac: (term * term) list -> meta_rule->tactic) = fun instlist r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in - let ins = try ( term_match (gl_frees g) c w ) + let ins = try ( term_match (gl_frees g) c w ) with Failure _ -> failwith "Rule doesn't match!" in let new_hyps = map (inst_goal ins) hyps in - let (prems,prim_hyp) = - if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" + let (prems,prim_hyp) = + if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" else hd new_hyps in let avoids = gl_frees g in - let asl,(prim_thm,elim_inst) = - if (prems = []) - then try term_to_asm_match avoids prim_hyp asl with Failure s -> failwith ("erule: " ^ s) + let asl,(prim_thm,elim_inst) = + if (prems = []) + then try term_to_asm_match avoids prim_hyp asl with Failure s -> failwith ("erule: " ^ s) else failwith "erule: Not a proper elimination rule: major premise has assumptions!" in let (_,prim_hyp)::new_hyps = map (inst_goal elim_inst) new_hyps in let thm = INSTANTIATE_ALL elim_inst thm in - + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = map (create_goal asl) new_hyps in - let rec create_dischl = - fun (asms,g) -> - if (asms = []) then [] + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in - (mvs,null_inst),new_goals,fun i l -> + (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i prim_thm in - List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) + List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (zip dischls l)));; @@ -765,7 +765,7 @@ let (erulem_tac: (term * term) list -> meta_rule->tactic) = (* The assumption is removed from the list and the trivial goal is proven *) (* automatically. *) (* A "proper" destructio rule H1 is of the form ?- H1 (ie. has no premises) *) -(* The goal A1,A2,...,Am,G ?- C is also added. *) +(* The goal A1,A2,...,Am,G ?- C is also added. *) (* ------------------------------------------------------------------------- *) (* Same as erulem with a few differences. *) (* [+] Does not try to match the goal c. *) @@ -773,30 +773,30 @@ let (erulem_tac: (term * term) list -> meta_rule->tactic) = (* [+] The new goal is treated slightly different in the justification. *) (* It is the one whose premises must be proven so as to get to the final *) (* goal. So it gets proven using PROVE_HYP by the result of the *) -(* justification on the original rule. *) +(* justification on the original rule. *) (* ------------------------------------------------------------------------- *) let (drulem_tac: (term * term) list -> meta_rule->tactic) = fun instlist r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in - let (prems,major_prem) = - if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" + let (prems,major_prem) = + if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in - let asl,(major_thm,elim_inst) = + let asl,(major_thm,elim_inst) = if (prems = []) - then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("drule: " ^ s) + then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("drule: " ^ s) else failwith "drule: not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in - let rec create_dischl = - fun (asms,g) -> - if (asms = []) then [] + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in (* We add an empty discharge list at the end for the extra goal. *) let dischls = map create_dischl new_hyps @ [[]] in @@ -804,7 +804,7 @@ let (drulem_tac: (term * term) list -> meta_rule->tactic) = let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in - (mvs,null_inst),new_goals,fun i l -> + (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (zip dischls l))) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; @@ -823,30 +823,30 @@ let (frulem_tac: (term * term) list -> meta_rule->tactic) = fun instlist r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in - let (prems,major_prem) = - if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" + let (prems,major_prem) = + if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in - let _,(major_thm,elim_inst) = - if (prems = []) - then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("frule: " ^ s) + let _,(major_thm,elim_inst) = + if (prems = []) + then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("frule: " ^ s) else failwith "frule: Not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in - let rec create_dischl = - fun (asms,g) -> - if (asms = []) then [] + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps @ [[]] in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in - (mvs,null_inst),new_goals,fun i l -> + (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: ((map (disch_pair i)) o (zip dischls)) l) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; @@ -879,36 +879,36 @@ let (erulenm_tac: (term * term) list -> int -> meta_rule->tactic) = fun instlist n r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in - let ins = try ( term_match [] c w ) + let ins = try ( term_match [] c w ) with Failure _ -> failwith "Rule doesn't match!" in let new_hyps = map (inst_goal ins) hyps in - let (prems,prim_hyp) = - if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" + let (prems,prim_hyp) = + if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" else hd new_hyps in let avoids = gl_frees g in - let asl,(prim_thm,elim_inst) = - if (prems = []) - then try term_to_asm_n_match avoids prim_hyp (rev asl) n with Failure s -> failwith ("erule: " ^ s) + let asl,(prim_thm,elim_inst) = + if (prems = []) + then try term_to_asm_n_match avoids prim_hyp (rev asl) n with Failure s -> failwith ("erule: " ^ s) else failwith "erule: Not a proper elimination rule: major premise has assumptions!" in let (_,prim_hyp)::new_hyps = map (inst_goal elim_inst) new_hyps in let thm = INSTANTIATE_ALL elim_inst thm in - + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = map (create_goal asl) new_hyps in - let rec create_dischl = - fun (asms,g) -> - if (asms = []) then [] + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in - (mvs,null_inst),new_goals,fun i l -> + (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i prim_thm in - List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) + List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l)));; @@ -916,23 +916,23 @@ let (drulenm_tac: (term * term) list -> int -> meta_rule->tactic) = fun instlist n r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in - let (prems,major_prem) = - if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" + let (prems,major_prem) = + if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in - let asl,(major_thm,elim_inst) = + let asl,(major_thm,elim_inst) = if (prems = []) - then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("drule: " ^ s) + then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("drule: " ^ s) else failwith "drule: not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in - let rec create_dischl = - fun (asms,g) -> - if (asms = []) then [] + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in (* We add an empty discharge list at the end for the extra goal. *) let dischls = map create_dischl new_hyps @ [[]] in @@ -940,7 +940,7 @@ let (drulenm_tac: (term * term) list -> int -> meta_rule->tactic) = let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in - (mvs,null_inst),new_goals,fun i l -> + (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l))) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; @@ -950,30 +950,30 @@ let (frulenm_tac: (term * term) list -> int -> meta_rule->tactic) = fun instlist n r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in - let (prems,major_prem) = - if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" + let (prems,major_prem) = + if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in - let _,(major_thm,elim_inst) = - if (prems = []) - then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("frule: " ^ s) + let _,(major_thm,elim_inst) = + if (prems = []) + then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("frule: " ^ s) else failwith "frule: Not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in - let rec create_dischl = - fun (asms,g) -> - if (asms = []) then [] + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps @ [[]] in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in - (mvs,null_inst),new_goals,fun i l -> + (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: ((map (disch_pair i)) o (List.combine dischls)) l) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; diff --git a/IsabelleLight/support.ml b/IsabelleLight/support.ml index a95cccca..c01764a9 100644 --- a/IsabelleLight/support.ml +++ b/IsabelleLight/support.ml @@ -27,7 +27,7 @@ let thd3 (_,_,x) = x;; (* ------------------------------------------------------------------------- *) let (terms_match: term list -> term -> term list -> instantiation ) = - fun consts key tlist -> + fun consts key tlist -> try (tryfind (term_match consts key) tlist) with Failure _ -> failwith "terms_match: No terms match!";; @@ -39,7 +39,7 @@ let (terms_match: term list -> term -> term list -> instantiation ) = (* ------------------------------------------------------------------------- *) let try_type tp tm = - try inst (type_match (type_of tm) tp []) tm + try inst (type_match (type_of tm) tp []) tm with Failure _ -> tm;; @@ -71,7 +71,7 @@ let gl_frees : goal -> term list = (* ------------------------------------------------------------------------- *) (* (+) Used in the justification of erule and drule to add the eliminated *) (* assumption to the proven subgoals. *) -(* (+) Could have been based on ADD_ASSUM but it's more convenient this way. *) +(* (+) Could have been based on ADD_ASSUM but it's more convenient this way. *) (* ------------------------------------------------------------------------- *) let ADD_HYP hyp_thm thm = CONJUNCT2 (CONJ hyp_thm thm);; @@ -84,12 +84,12 @@ let ADD_HYP hyp_thm thm = CONJUNCT2 (CONJ hyp_thm thm);; let rec (DISCHL: term list -> thm -> thm) = fun tms thm -> - if (tms = []) then thm + if (tms = []) then thm else DISCH (hd tms) (DISCHL (tl tms) thm);; (* ------------------------------------------------------------------------- *) -(* top_metas : goalstack -> term list *) +(* top_metas : goalstack -> term list *) (* Returns the list of metavariables in the current goalstate. *) (* ------------------------------------------------------------------------- *) @@ -123,7 +123,7 @@ let show_types,hide_types = (* ------------------------------------------------------------------------- *) -(* print_goalstack : *) +(* print_goalstack : *) (* Upgrade to print_goalstack that also prints a list of metavariables with *) (* their types. *) (* ------------------------------------------------------------------------- *) @@ -139,7 +139,7 @@ let (print_goalstack_meta:goalstack->unit) = print_string s; print_newline(); if (length mvs > 0) then ( print_string "Metas:" ; let _ = map print_mv mvs in () ; print_newline() - ) ; + ) ; if gl = [] then () else do_list (print_goal o C el gl) (rev(0--(k-1))) in fun l -> diff --git a/Jordan/num_ext_gcd.ml b/Jordan/num_ext_gcd.ml index 42a0d367..ffc5a715 100644 --- a/Jordan/num_ext_gcd.ml +++ b/Jordan/num_ext_gcd.ml @@ -1,4 +1,4 @@ -(* +(* Author: Thomas C. Hales, 2003 GCD_CONV takes two HOL-light terms (NUMERALs) a and b and @@ -12,7 +12,7 @@ prioritize_num();; -let DIVIDE = new_definition(`DIVIDE a b = ?m. (b = m*a )`);; +let DIVIDE = new_definition(`DIVIDE a b = ?m. (b = m*a )`);; parse_as_infix("||",(16,"right"));; @@ -23,7 +23,7 @@ override_interface("||",`DIVIDE:num->num->bool`);; let DIV_TAC t = EVERY[ REP_GEN_TAC; REWRITE_TAC[DIVIDE]; DISCH_ALL_TAC; - REPEAT (FIRST_X_ASSUM CHOOSE_TAC); + REPEAT (FIRST_X_ASSUM CHOOSE_TAC); TRY (EXISTS_TAC t)];; @@ -34,7 +34,7 @@ let DIVIDE_DIVIDE = prove_by_refinement( ASM_REWRITE_TAC[MULT_ASSOC] ]);; -let DIVIDE_EQ = prove_by_refinement( +let DIVIDE_EQ = prove_by_refinement( `! a b. (((a || b) /\ (b || a)) ==> (a = b))`, [ DIV_TAC `1`; @@ -78,7 +78,7 @@ let DIVIDE_PROD2 = prove_by_refinement( ASM_REWRITE_TAC[MULT_AC] ]);; -let GCD = new_definition(`GCD a b = @g. +let GCD = new_definition(`GCD a b = @g. ((g || a) /\ (g || b) /\ (!h. (((h || a) /\ (h || b)) ==> (h || g))))`);; @@ -107,7 +107,7 @@ let gcd_certificate = prove(`!a b g. ((? r s r' s' a' b'. ) and gdivy_branch = ( - (UNDISCH_TAC + (UNDISCH_TAC (`(y||a) /\ (y ||b) /\ (!h. (((h||a)/\(h||b))==> (h||y)))`)) THEN (TAUT_TAC (` (A ==> B) ==> ((C /\ D/\ A)==> B)`)) THEN (DISCH_TAC) @@ -132,11 +132,11 @@ let gcd_certificate = prove(`!a b g. ((? r s r' s' a' b'. ) in tac1 THENL [ygbranch THENL [ydivg_branch;gdivy_branch];yghyp_branch]);; -(* Now compute gcd with CAML num calculations, +(* Now compute gcd with CAML num calculations, then check the answer in HOL-light *) let gcd_num x1 x2 = - let rec gcd_data (a1,b1,x1,a2,b2,x2) = - if (x1 < (Int 0)) then + let rec gcd_data (a1,b1,x1,a2,b2,x2) = + if (x1 < (Int 0)) then gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2) else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num b2,minus_num x2) @@ -149,8 +149,8 @@ let gcd_num x1 x2 = gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);; let gcd_num x1 x2 = - let rec gcd_data (a1,b1,x1,a2,b2,x2) = - if (x1 < (Int 0)) then + let rec gcd_data (a1,b1,x1,a2,b2,x2) = + if (x1 < (Int 0)) then gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2) else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num b2,minus_num x2) @@ -163,7 +163,7 @@ let gcd_num x1 x2 = gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);; (* g = gcd, (a',b') = (a,b)/g, g +r1'*a+s1'*b = r1*a+s1*b *) -let gcd_numdata a b = +let gcd_numdata a b = let a = abs_num a in let b = abs_num b in let Z = Int 0 in @@ -177,7 +177,7 @@ let gcd_numdata a b = let (s1,s1') = if (s >/ Z) then (s,Z) else (Z,minus_num s) in (g,a,b,a',b',r1',s1',r1,s1);; -(* Here is the conversion. +(* Here is the conversion. Example: GCD_CONV (`66`) (`144`) @@ -214,14 +214,14 @@ pop_priority();; (* test code *) -exception Test_suite_num_ext_gcd of string;; +exception Test_suite_num_ext_gcd of string;; (* For the tests we use integers a and b. These can overflow if a and b are too large, so that we should confine ourselves to tests that are not too large. *) -let test_num_ext_gcd (a, b) = +let test_num_ext_gcd (a, b) = let a1 = string_of_int (abs a) in let b1 = string_of_int (abs b) in let c = gcd a b in @@ -232,9 +232,9 @@ let test_num_ext_gcd (a, b) = else if (not (concl th = (parse_term ("GCD "^a1^" "^b1^"="^c1)))) then raise (failwith ("num_ext_gcd test suite failure "^a1^" "^b1)) else ();; - -let test_suite_num_ext_gcd = + +let test_suite_num_ext_gcd = let _ = map test_num_ext_gcd [(0,0);(0,1);(1,0);(-0,-0); @@ -246,4 +246,4 @@ let test_suite_num_ext_gcd = let divide = DIVIDE and gcd = GCD and gcd_conv = GCD_CONV;; - + diff --git a/Jordan/parse_ext_override_interface.ml b/Jordan/parse_ext_override_interface.ml index 10d1a2db..928df745 100644 --- a/Jordan/parse_ext_override_interface.ml +++ b/Jordan/parse_ext_override_interface.ml @@ -15,10 +15,10 @@ In the same way, we remove ambiguities between natural numbers and integers by appending a character. We have chosen to use - the character `|` for natural number operations + the character `|` for natural number operations and the character `:` for integer operations. - The character `&` continues to denote the embedding of + The character `&` continues to denote the embedding of natural numbers into the integers or reals. HOL-light parsing does not permit an operator mixing alphanumeric @@ -36,7 +36,7 @@ -let unambiguous_interface() = +let unambiguous_interface() = parse_as_infix("+|",(16,"right")); parse_as_infix("-|",(18,"left")); parse_as_infix("*|",(20,"right")); @@ -61,7 +61,7 @@ override_interface(">=|",`(>=):num->(num->bool)`); parse_as_infix("+:",(16,"right")); parse_as_infix("-:",(18,"left")); parse_as_infix("*:",(20,"right")); -parse_as_infix("**:",(24,"left")); +parse_as_infix("**:",(24,"left")); parse_as_infix("<:",(12,"right")); parse_as_infix("<=:",(12,"right")); parse_as_infix(">:",(12,"right")); @@ -83,7 +83,7 @@ override_interface("||:",`int_abs:int->int`); parse_as_infix("+.",(16,"right")); parse_as_infix("-.",(18,"left")); parse_as_infix("*.",(20,"right")); -parse_as_infix("**.",(24,"left")); +parse_as_infix("**.",(24,"left")); parse_as_infix("<.",(12,"right")); parse_as_infix("<=.",(12,"right")); parse_as_infix(">.",(12,"right")); @@ -102,7 +102,7 @@ override_interface("--.",`real_neg:real->real`); override_interface("&.",`real_of_num:num->real`); override_interface("||.",`real_abs:real->real`);; -let ambiguous_interface() = +let ambiguous_interface() = reduce_interface("+|",`(+):num->(num->num)`); reduce_interface("-|",`(-):num->(num->num)`); reduce_interface("*|",`( * ):num->(num->num)`); @@ -143,9 +143,9 @@ reduce_interface("&.",`real_of_num:num->real`); reduce_interface("||.",`real_abs:real->real`);; (* add to Harrison's priorities the functions pop_priority and get_priority *) -let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = +let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = let v = ref ([]:string list) in - let prioritize_int() = + let prioritize_int() = v:= "int"::!v; overload_interface ("+",`int_add:int->int->int`); overload_interface ("-",`int_sub:int->int->int`); @@ -158,7 +158,7 @@ let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = overload_interface ("pow",`int_pow:int->num->int`); overload_interface ("abs",`int_abs:int->int`); override_interface ("&",`int_of_num:num->int`) and - prioritize_num() = + prioritize_num() = v:= "num"::!v; overload_interface ("+",`(+):num->num->num`); overload_interface ("-",`(-):num->num->num`); @@ -182,7 +182,7 @@ let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = overload_interface ("inv",`real_inv:real->real`); overload_interface ("abs",`real_abs:real->real`); override_interface ("&",`real_of_num:num->real`) and - pop_priority() = + pop_priority() = if (length !v <= 1) then (print_string "priority unchanged\n") else let (a::b::c) = !v in v:= (b::c); @@ -192,7 +192,7 @@ let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = "int" -> prioritize_int() | "real"-> prioritize_real()| _ -> () and - get_priority() = + get_priority() = if (!v=[]) then "unknown" else let (a::b) = !v in a in diff --git a/Jordan/real_ext_geom_series.ml b/Jordan/real_ext_geom_series.ml index 46e8565f..601da1e6 100644 --- a/Jordan/real_ext_geom_series.ml +++ b/Jordan/real_ext_geom_series.ml @@ -1,28 +1,28 @@ prioritize_real();; -let (TRY_RULE:(thm->thm) -> (thm->thm)) = +let (TRY_RULE:(thm->thm) -> (thm->thm)) = fun rl t -> try (rl t) with _ -> t;; let REAL_MUL_RTIMES = - prove ((`!x a b. + prove ((`!x a b. (((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==> (a = b))`), MESON_TAC[REAL_EQ_MUL_RCANCEL]);; let GEOMETRIC_SUM = prove( - `!m n x.(~(x=(&1)) ==> + `!m n x.(~(x=(&1)) ==> (sum(m,n) (\k.(x pow k)) = ((x pow m) - (x pow (m+n)))/((&1)-x)))`, - let tac1 = + let tac1 = GEN_TAC THEN INDUCT_TAC THEN GEN_TAC THEN DISCH_TAC THEN (REWRITE_TAC - [sum_DEF;real_pow;ADD_CLAUSES;real_div;REAL_SUB_RDISTRIB; + [sum_DEF;real_pow;ADD_CLAUSES;real_div;REAL_SUB_RDISTRIB; REAL_SUB_REFL]) in - let tac2 = + let tac2 = (RULE_ASSUM_TAC (TRY_RULE (SPEC (`x:real`)))) THEN (UNDISCH_EL_TAC 1) THEN (UNDISCH_EL_TAC 0) @@ -33,7 +33,7 @@ let GEOMETRIC_SUM = prove( THEN (ABBREV_TAC (`b:real = x pow (m+n)`)) in let tac3 = (MATCH_MP_TAC (SPEC (`&1 - x`) REAL_MUL_RTIMES)) - THEN CONJ_TAC + THEN CONJ_TAC THENL [ALL_TAC; (UNDISCH_TAC (`~(x = (&1))`)) THEN (ACCEPT_TAC (REAL_ARITH (`~(x=(&1)) ==> ~((&1 - x = (&0)))`)))] THEN (REWRITE_TAC diff --git a/Jordan/tactics_refine.ml b/Jordan/tactics_refine.ml index 788a20bc..270093b7 100644 --- a/Jordan/tactics_refine.ml +++ b/Jordan/tactics_refine.ml @@ -6,22 +6,22 @@ let labels_flag = ref false;; -let LABEL_ALL_TAC:tactic = +let LABEL_ALL_TAC:tactic = let mk_label avoid = - let rec mk_one_label i avoid = + let rec mk_one_label i avoid = let label = "Z-"^(string_of_int i) in if not(mem label avoid) then label else mk_one_label (i+1) avoid in mk_one_label 0 avoid in - let update_label i asl = + let update_label i asl = let rec f_at_i f j = function [] -> [] | a::b -> if (j=0) then (f a)::b else a::(f_at_i f (j-1) b) in let avoid = map fst asl in let current = el i avoid in let new_label = mk_label avoid in - if (String.length current > 0) then asl else + if (String.length current > 0) then asl else f_at_i (fun (_,y) -> (new_label,y) ) i asl in - fun (asl,w) -> + fun (asl,w) -> let aslp = ref asl in (for i=0 to ((length asl)-1) do (aslp := update_label i !aslp) done; (ALL_TAC (!aslp,w)));; @@ -29,24 +29,24 @@ let LABEL_ALL_TAC:tactic = (* global_var *) let (EVERY_STEP_TAC:tactic ref) = ref ALL_TAC;; -let (e:tactic ->goalstack) = - fun tac -> refine(by(VALID +let (e:tactic ->goalstack) = + fun tac -> refine(by(VALID (if !labels_flag then (tac THEN (!EVERY_STEP_TAC)) THEN LABEL_ALL_TAC else tac)));; -let has_stv t = +let has_stv t = let typ = (type_vars_in_term t) in can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;; -let prove_by_refinement(t,(tacl:tactic list)) = - if (length (frees t) > 0) +let prove_by_refinement(t,(tacl:tactic list)) = + if (length (frees t) > 0) then failwith "prove_by_refinement: free vars" else - if (has_stv t) + if (has_stv t) then failwith "prove_by_refinement: has stv" else let gstate = mk_goalstate ([],t) in - let _,sgs,just = rev_itlist - (fun tac gs -> by - (if !labels_flag then (tac THEN + let _,sgs,just = rev_itlist + (fun tac gs -> by + (if !labels_flag then (tac THEN (!EVERY_STEP_TAC) THEN LABEL_ALL_TAC ) else tac) gs) tacl gstate in let th = if sgs = [] then just null_inst [] @@ -68,13 +68,13 @@ let mem_thm tm = Hashtbl.mem !saved_thm tm;; let remove_thm tm = Hashtbl.remove !saved_thm tm;; let find_thm tm = Hashtbl.find !saved_thm tm;; -let dump_thm file_name = +let dump_thm file_name = let ch = open_out_bin file_name in (output_value ch !saved_thm; close_out ch);; let load_thm file_name = - let ch = open_in_bin file_name in + let ch = open_in_bin file_name in (saved_thm := input_value ch; close_in ch);; @@ -90,17 +90,17 @@ let set_fast_load file_name = (fast_load := true; load_thm file_name);; -let set_slow_load () = +let set_slow_load () = (fast_load := false;);; -let prove (x, tac) = +let prove (x, tac) = if (!fast_load) then (try(find_thm x) with failure -> old_prove(x,tac)) else (let t = old_prove(x,tac) in (save_thm t; t));; -let prove_by_refinement (x, tacl) = - if (!fast_load) then (try(find_thm x) +let prove_by_refinement (x, tacl) = + if (!fast_load) then (try(find_thm x) with failure -> old_prove_by_refinement(x,tacl)) else (let t = old_prove_by_refinement(x,tacl) in (save_thm t; t));; -if (false) then (set_fast_load "thm.dump") else (fast_load:=false);; +if (false) then (set_fast_load "thm.dump") else (fast_load:=false);; diff --git a/LP_arith/Makefile b/LP_arith/Makefile index 25eeed24..de0f1947 100644 --- a/LP_arith/Makefile +++ b/LP_arith/Makefile @@ -6,7 +6,7 @@ CC = $(GXX) CCLD = $(CC) -.SUFFIXES: .c .o +.SUFFIXES: .c .o COMPILE = $(CC) -O2 -DHAVE_LIBGMP=1 -DGMPRATIONAL -I. -I$(CDDLIBPATH) -I$(CDDINCLUDEPATH) diff --git a/LP_arith/cdd_cert.c b/LP_arith/cdd_cert.c index c99fd391..4cc62d0a 100644 --- a/LP_arith/cdd_cert.c +++ b/LP_arith/cdd_cert.c @@ -19,57 +19,57 @@ void printsol(dd_LPSolutionPtr lps) { } int main(int argc, char *argv[]) -{ +{ dd_ErrorType err=dd_NoError; - dd_LPSolverType solver=dd_DualSimplex; + dd_LPSolverType solver=dd_DualSimplex; dd_LPPtr lp; - + dd_LPSolutionPtr lps; - + dd_MatrixPtr M; int found_contradiction=0; dd_set_global_constants(); - - + + /* Input an LP using the cdd library */ - + if (err!=dd_NoError) goto _Err; M=dd_PolyFile2Matrix(stdin, &err); if (err!=dd_NoError) goto _Err; - + lp=dd_Matrix2LP(M, &err); if (err!=dd_NoError) goto _Err; - + /* Solve the LP */ - + dd_LPSolve(lp, solver, &err); /* Solve the LP */ if (err!=dd_NoError) goto _Err; - - + + /* process solution */ - + lps=dd_CopyLPSolution(lp); - + switch (lps->LPS) { case dd_Optimal: found_contradiction=dd_EqualToZero(lps->optvalue)?1:0; break; - + case dd_DualInconsistent: case dd_StrucDualInconsistent: found_contradiction=1; break; - + case dd_Inconsistent: case dd_StrucInconsistent: - + default: nocontra(); } - + if (found_contradiction) { printsol(lps); } else { @@ -82,7 +82,7 @@ int main(int argc, char *argv[]) dd_FreeMatrix(M); return 0; - + _Err:; if (err!=dd_NoError) dd_WriteErrorMessages(stdout, err); return 1; diff --git a/Library/bitsize.ml b/Library/bitsize.ml index 5df4885f..b80c3b37 100644 --- a/Library/bitsize.ml +++ b/Library/bitsize.ml @@ -108,7 +108,7 @@ let LE_BITSIZE_ALT = prove REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN AP_TERM_TAC THEN ASM_ARITH_TAC);; let BITSIZE_UNIQUE_EQ = prove - (`!n k. bitsize n = k <=> + (`!n k. bitsize n = k <=> n < 2 EXP k /\ (~(k = 0) ==> 2 EXP k <= 2 * n)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = k <=> k <= n /\ ~(k + 1 <= n)`] THEN diff --git a/Library/calc_real.ml b/Library/calc_real.ml index 9462c73d..8619ff8e 100644 --- a/Library/calc_real.ml +++ b/Library/calc_real.ml @@ -1095,7 +1095,7 @@ let STEPS_EXP_1 = prove (!k. SUC k < 1 ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) - ==> abs(sum(0,1) t - &2 pow n * sum(0,1)(\i. x pow i / &(FACT i))) + ==> abs(sum(0,1) t - &2 pow n * sum(0,1)(\i. x pow i / &(FACT i))) <= &2 * &1`, CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN diff --git a/Logic/fole.ml b/Logic/fole.ml index b677588a..d5cb277f 100644 --- a/Logic/fole.ml +++ b/Logic/fole.ml @@ -919,19 +919,19 @@ let FUNCTIONS_TERM_FNV1 = prove (`functions_term (Fn p (MAP FST (Varpairs n))) = {(p,n)}`, REWRITE_TAC[functions_term; LENGTH_MAP; LENGTH_VARPAIRS] THEN AP_TERM_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN - INDUCT_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[MAP; Varpairs_DEF; functions_term; LIST_UNION] THEN ASM_REWRITE_TAC[UNION_EMPTY]);; let FUNCTIONS_FORM_FNV1 = prove (`!n. LIST_UNION (MAP functions_term (MAP FST (Varpairs n))) = EMPTY`, - INDUCT_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[MAP; Varpairs_DEF; functions_term; LIST_UNION] THEN ASM_REWRITE_TAC[UNION_EMPTY]);; let FUNCTIONS_FORM_FNV2 = prove (`!n. LIST_UNION (MAP functions_term (MAP SND (Varpairs n))) = EMPTY`, - INDUCT_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[MAP; Varpairs_DEF; functions_term; LIST_UNION] THEN ASM_REWRITE_TAC[UNION_EMPTY]);; @@ -939,7 +939,7 @@ let FUNCTIONS_TERM_FNV2 = prove (`functions_term (Fn p (MAP SND (Varpairs n))) = {(p,n)}`, REWRITE_TAC[functions_term; LENGTH_MAP; LENGTH_VARPAIRS] THEN AP_TERM_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN - INDUCT_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[MAP; Varpairs_DEF; functions_term; LIST_UNION] THEN ASM_REWRITE_TAC[UNION_EMPTY]);; @@ -956,9 +956,9 @@ let FUNCTIONS_EQAXIOM_FUNC = prove (`!fa. functions_form (Eqaxiom_Func fa) = {fa}`, REWRITE_TAC[FORALL_PAIR_THM; Eqaxiom_Func] THEN REWRITE_TAC[FUNCTIONS_FORM_UCLOSE] THEN - REWRITE_TAC[functions_form; Equal_DEF; MAP; LIST_UNION] THEN - REWRITE_TAC[FUNCTIONS_TERM_FNV1; FUNCTIONS_TERM_FNV2] THEN - REWRITE_TAC[FUNCTIONS_EQCONJ] THEN + REWRITE_TAC[functions_form; Equal_DEF; MAP; LIST_UNION] THEN + REWRITE_TAC[FUNCTIONS_TERM_FNV1; FUNCTIONS_TERM_FNV2] THEN + REWRITE_TAC[FUNCTIONS_EQCONJ] THEN REWRITE_TAC[UNION_EMPTY; UNION_IDEMPOT]);; let FUNCTIONS_EQAXIOM_PRED = prove diff --git a/Logic/herbrand.ml b/Logic/herbrand.ml index 9c1b7bbf..a4810e18 100644 --- a/Logic/herbrand.ml +++ b/Logic/herbrand.ml @@ -101,8 +101,8 @@ let HERBRAND_HERBRAND_OF_PROP = prove let INTERPRETATION_HERBRAND_OF_PROP = prove (`!L d. interpretation L (herbrand_of_prop L d)`, - REWRITE_TAC[FORALL_PAIR_THM; interpretation; herbrand_of_prop; Fun_DEF; - Dom_DEF; IN; ETA_AX] THEN + REWRITE_TAC[FORALL_PAIR_THM; interpretation; herbrand_of_prop; Fun_DEF; + Dom_DEF; IN; ETA_AX] THEN MESON_TAC[herbase_RULES; IN]);; (* ------------------------------------------------------------------------- *) diff --git a/Logic/support.ml b/Logic/support.ml index a3ede00b..f5852b35 100644 --- a/Logic/support.ml +++ b/Logic/support.ml @@ -690,7 +690,7 @@ let SOS_RESOLUTION_COMPLETE = prove [REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[QFREE_INTERP]; ALL_TAC] THEN SUBGOAL_THEN `?d. d psatisfies - {formsubst v p | v,p | + {formsubst v p | v,p | (!x. v x IN herbase (functions (IMAGE interp hyps))) /\ p IN IMAGE interp (hyps DIFF sos)}` MP_TAC THENL diff --git a/Minisat/minisat_resolve.ml b/Minisat/minisat_resolve.ml index b616f8dc..8250727d 100644 --- a/Minisat/minisat_resolve.ml +++ b/Minisat/minisat_resolve.ml @@ -83,11 +83,11 @@ let getClause lfn mcth cl ci = where v is the only var that occurs with opposite signs in c0 and c1 *) (* if n0 then v negated in c0 *) (* (but remember we are working with dualised clauses) *) -let resolve = +let resolve = let pth = UNDISCH(TAUT `F ==> p`) in - let p = concl pth + let p = concl pth and f_tm = hd(hyp pth) in - fun v n0 rth0 rth1 -> + fun v n0 rth0 rth1 -> let th0 = DEDUCT_ANTISYM_RULE (INST [v,p] pth) (if n0 then rth0 else rth1) and th1 = DEDUCT_ANTISYM_RULE (INST [mk_iff(v,f_tm),p] pth) (if n0 then rth1 else rth0) in diff --git a/Minisat/sat_script.ml b/Minisat/sat_script.ml index d227a21f..556bbbe3 100644 --- a/Minisat/sat_script.ml +++ b/Minisat/sat_script.ml @@ -5,7 +5,7 @@ let AND_IMP2 = prove (`!a b c. a /\ b ==> c <=> (a<=>T) ==> b ==> c`,CONV_TAC TAUT);; let AND_IMP3 = prove (`!a b c. ~a /\ b ==> c <=> (a<=>F) ==> b ==> c`,CONV_TAC TAUT);; - + let NOT_NOT = GEN_ALL (hd (CONJUNCTS (SPEC_ALL NOT_CLAUSES)));; let AND_INV = prove @@ -13,15 +13,15 @@ let AND_INV = prove let AND_INV_IMP = prove (`!a. a ==> ~a ==> F`,CONV_TAC TAUT);; - + let OR_DUAL = prove - (`(~(a \/ b) ==> F) = (~a ==> ~b ==> F)`,CONV_TAC TAUT);; + (`(~(a \/ b) ==> F) = (~a ==> ~b ==> F)`,CONV_TAC TAUT);; let OR_DUAL2 = prove - (`(~(a \/ b) ==> F) = ((a==>F) ==> ~b ==> F)`,CONV_TAC TAUT);; + (`(~(a \/ b) ==> F) = ((a==>F) ==> ~b ==> F)`,CONV_TAC TAUT);; let OR_DUAL3 = prove - (`(~(~a \/ b) ==> F) = (a ==> ~b ==> F)`,CONV_TAC TAUT);; + (`(~(~a \/ b) ==> F) = (a ==> ~b ==> F)`,CONV_TAC TAUT);; let AND_INV2 = prove (`(~a ==> F) ==> (a==>F) ==> F`,CONV_TAC TAUT) diff --git a/Minisat/zc2mso/README b/Minisat/zc2mso/README index 2855fc57..052eda0e 100644 --- a/Minisat/zc2mso/README +++ b/Minisat/zc2mso/README @@ -12,7 +12,7 @@ probably be the same or very similar in other versions.) #define VERIFY_ON -2. Change the filename around line 51 from "resolve_trace" to +2. Change the filename around line 51 from "resolve_trace" to "/tmp/resolve_trace", so it becomes: ofstream verify_out("/tmp/resolve_trace"); diff --git a/Multivariate/geom.ml b/Multivariate/geom.ml index b89d0541..0b936852 100644 --- a/Multivariate/geom.ml +++ b/Multivariate/geom.ml @@ -359,15 +359,15 @@ let VECTOR_ANGLE_EQ_0_LEFT = prove MESON_TAC[VECTOR_ANGLE_EQ_0_RIGHT; VECTOR_ANGLE_SYM]);; let VECTOR_ANGLE_EQ_PI_RIGHT = prove - (`!x y z:real^N. vector_angle x y = pi + (`!x y z:real^N. vector_angle x y = pi ==> (vector_angle x z = pi - vector_angle y z)`, - REPEAT STRIP_TAC THEN - MP_TAC(ISPECL [`--x:real^N`; `y:real^N`; `z:real^N`] - VECTOR_ANGLE_EQ_0_RIGHT) THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`--x:real^N`; `y:real^N`; `z:real^N`] + VECTOR_ANGLE_EQ_0_RIGHT) THEN ASM_REWRITE_TAC[VECTOR_ANGLE_LNEG] THEN REAL_ARITH_TAC);; - + let VECTOR_ANGLE_EQ_PI_LEFT = prove - (`!x y z:real^N. vector_angle x y = pi + (`!x y z:real^N. vector_angle x y = pi ==> (vector_angle z x = pi - vector_angle z y)`, MESON_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; VECTOR_ANGLE_SYM]);; @@ -608,13 +608,13 @@ let ANGLE_EQ_0_LEFT = prove (`!A B C. angle(A,B,C) = &0 ==> angle(D,B,A) = angle(D,B,C)`, MESON_TAC[ANGLE_EQ_0_RIGHT; ANGLE_SYM]);; -let ANGLE_EQ_PI_RIGHT = prove +let ANGLE_EQ_PI_RIGHT = prove (`!A B C. angle(A,B,C) = pi ==> angle(D,B,A) = pi - angle(D,B,C)`, REWRITE_TAC[VECTOR_ANGLE_EQ_PI_LEFT; angle]);; - -let ANGLE_EQ_PI_LEFT = prove + +let ANGLE_EQ_PI_LEFT = prove (`!A B C. angle(A,B,C) = pi ==> angle(A,B,D) = pi - angle(C,B,D)`, - MESON_TAC[ANGLE_EQ_PI_RIGHT; ANGLE_SYM]);; + MESON_TAC[ANGLE_EQ_PI_RIGHT; ANGLE_SYM]);; let COS_ANGLE = prove (`!a b c. cos(angle(a,b,c)) = if a = b \/ c = b then &0 diff --git a/Multivariate/misc.ml b/Multivariate/misc.ml index 91ea26e5..1618ef45 100644 --- a/Multivariate/misc.ml +++ b/Multivariate/misc.ml @@ -797,7 +797,7 @@ let FINITE_INDEX_NUMSEG_SPECIAL = prove CARD_EQ_BIJECTIONS_SPECIAL) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]] THEN ASM_REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; IN_NUMSEG; LE_REFL] THEN - ASM_SIMP_TAC[CARD_EQ_0; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[CARD_EQ_0; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) diff --git a/Multivariate/msum.ml b/Multivariate/msum.ml index b0bb81d5..f7aca390 100644 --- a/Multivariate/msum.ml +++ b/Multivariate/msum.ml @@ -110,7 +110,7 @@ let MSUM_MATRIX_LMUL = prove SIMP_TAC[MSUM_CLAUSES; MATRIX_MUL_RZERO; MATRIX_ADD_LDISTRIB]);; let MSUM_IMAGE = prove - (`!(f:A->B) (g:B->real^M^N) s. + (`!(f:A->B) (g:B->real^M^N) s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> msum (IMAGE f s) g = msum s (g o f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CART_EQ_FULL; MSUM_COMPONENT] THEN diff --git a/ProofTrace/fusion.ml.diff b/ProofTrace/fusion.ml.diff index 505cdd37..6b5f7047 100644 --- a/ProofTrace/fusion.ml.diff +++ b/ProofTrace/fusion.ml.diff @@ -3,9 +3,9 @@ index a08ad1c..7d67f20 100644 --- a/fusion.ml +++ b/fusion.ml @@ -23,6 +23,23 @@ module type Hol_kernel = - + type thm - + + type proof = private + Proof of (int * thm * proof_content) + and proof_content = private @@ -35,12 +35,12 @@ index a08ad1c..7d67f20 100644 + val proof_of : thm -> proof + val proof_at: int -> proof end;; - + (* ------------------------------------------------------------------------- *) @@ -101,7 +122,49 @@ module Hol : Hol_kernel = struct | Comb of term * term | Abs of term * term - + - type thm = Sequent of (term list * term) + + type thm = Sequent of (term list * term * int) @@ -85,34 +85,34 @@ index a08ad1c..7d67f20 100644 + + let proof_at p = + Hashtbl.find the_proofs p - + (* ------------------------------------------------------------------------- *) (* List of current type constants with their arities. *) @@ -485,43 +548,57 @@ module Hol : Hol_kernel = struct (* Basic theorem destructors. *) (* ------------------------------------------------------------------------- *) - + - let dest_thm (Sequent(asl,c)) = (asl,c) + let dest_thm (Sequent(asl,c,_)) = (asl,c) + + let hyp (Sequent(asl,c,_)) = asl - + - let hyp (Sequent(asl,c)) = asl + let concl (Sequent(asl,c,_)) = c - + - let concl (Sequent(asl,c)) = c + let proof_of(Sequent(_,_,p)) = Hashtbl.find the_proofs p - + (* ------------------------------------------------------------------------- *) (* Basic equality properties; TRANS is derivable but included for efficiency *) (* ------------------------------------------------------------------------- *) - + let REFL tm = - Sequent([],safe_mk_eq tm tm) + let idx = next_proof_idx() in + let th = Sequent([],safe_mk_eq tm tm,idx) in + new_proof (Proof(idx,th,Prefl tm)) - + - let TRANS (Sequent(asl1,c1)) (Sequent(asl2,c2)) = + let TRANS (Sequent(asl1,c1,p1)) (Sequent(asl2,c2,p2)) = match (c1,c2) with @@ -124,11 +124,11 @@ index a08ad1c..7d67f20 100644 + new_proof (Proof(idx,th,Ptrans(Hashtbl.find the_proofs p1, + Hashtbl.find the_proofs p2))) | _ -> failwith "TRANS" - + (* ------------------------------------------------------------------------- *) (* Congruence properties of equality. *) (* ------------------------------------------------------------------------- *) - + - let MK_COMB(Sequent(asl1,c1),Sequent(asl2,c2)) = + let MK_COMB(Sequent(asl1,c1,p1),Sequent(asl2,c2,p2)) = match (c1,c2) with @@ -146,7 +146,7 @@ index a08ad1c..7d67f20 100644 + Hashtbl.find the_proofs p2))) | _ -> failwith "MK_COMB: types do not agree") | _ -> failwith "MK_COMB: not both equations" - + - let ABS v (Sequent(asl,c)) = + let ABS v (Sequent(asl,c,p)) = match (v,c) with @@ -157,10 +157,10 @@ index a08ad1c..7d67f20 100644 + let th = Sequent(asl,safe_mk_eq (Abs(v,l)) (Abs(v,r)),idx) in + new_proof (Proof(idx,th,Pabs(Hashtbl.find the_proofs p, v))) | _ -> failwith "ABS";; - + (* ------------------------------------------------------------------------- *) @@ -530,8 +607,10 @@ module Hol : Hol_kernel = struct - + let BETA tm = match tm with - Comb(Abs(v,bod),arg) when Pervasives.compare arg v = 0 @@ -170,11 +170,11 @@ index a08ad1c..7d67f20 100644 + let th = Sequent([],safe_mk_eq tm bod,idx) in + new_proof (Proof(idx,th,Pbeta(tm))) | _ -> failwith "BETA: not a trivial beta-redex" - + (* ------------------------------------------------------------------------- *) @@ -539,30 +618,43 @@ module Hol : Hol_kernel = struct (* ------------------------------------------------------------------------- *) - + let ASSUME tm = - if Pervasives.compare (type_of tm) bool_ty = 0 then Sequent([tm],tm) + if Pervasives.compare (type_of tm) bool_ty = 0 then @@ -182,7 +182,7 @@ index a08ad1c..7d67f20 100644 + let th = Sequent([tm],tm,idx) in + new_proof (Proof(idx,th,Passume(tm))) else failwith "ASSUME: not a proposition" - + - let EQ_MP (Sequent(asl1,eq)) (Sequent(asl2,c)) = + let EQ_MP (Sequent(asl1,eq,p1)) (Sequent(asl2,c,p2)) = match eq with @@ -194,7 +194,7 @@ index a08ad1c..7d67f20 100644 + new_proof (Proof(idx,th,Peqmp(Hashtbl.find the_proofs p1, + Hashtbl.find the_proofs p2))) | _ -> failwith "EQ_MP" - + - let DEDUCT_ANTISYM_RULE (Sequent(asl1,c1)) (Sequent(asl2,c2)) = + let DEDUCT_ANTISYM_RULE (Sequent(asl1,c1,p1)) (Sequent(asl2,c2,p2)) = let asl1' = term_remove c2 asl1 and asl2' = term_remove c1 asl2 in @@ -203,11 +203,11 @@ index a08ad1c..7d67f20 100644 + let th = Sequent(term_union asl1' asl2',safe_mk_eq c1 c2,idx) in + new_proof (Proof(idx,th,Pdeduct(Hashtbl.find the_proofs p1, + Hashtbl.find the_proofs p2))) - + (* ------------------------------------------------------------------------- *) (* Type and term instantiation. *) (* ------------------------------------------------------------------------- *) - + - let INST_TYPE theta (Sequent(asl,c)) = + let INST_TYPE theta (Sequent(asl,c,p)) = + let idx = next_proof_idx() in @@ -215,7 +215,7 @@ index a08ad1c..7d67f20 100644 - Sequent(term_image inst_fn asl,inst_fn c) + let th = Sequent(term_image inst_fn asl,inst_fn c,idx) in + new_proof (Proof(idx,th,Pinstt(Hashtbl.find the_proofs p,theta))) - + - let INST theta (Sequent(asl,c)) = + let INST theta (Sequent(asl,c,p)) = + let idx = next_proof_idx() in @@ -223,11 +223,11 @@ index a08ad1c..7d67f20 100644 - Sequent(term_image inst_fun asl,inst_fun c) + let th = Sequent(term_image inst_fun asl,inst_fun c,idx) in + new_proof (Proof(idx,th,Pinst(Hashtbl.find the_proofs p,theta))) - + (* ------------------------------------------------------------------------- *) (* Handling of axioms. *) @@ -574,8 +666,10 @@ module Hol : Hol_kernel = struct - + let new_axiom tm = if Pervasives.compare (type_of tm) bool_ty = 0 then - let th = Sequent([],tm) in @@ -237,7 +237,7 @@ index a08ad1c..7d67f20 100644 + (the_axioms := th::(!the_axioms); + new_proof (Proof(idx,th,Paxiom(tm)))) else failwith "new_axiom: Not a proposition" - + (* ------------------------------------------------------------------------- *) @@ -593,8 +687,11 @@ module Hol : Hol_kernel = struct else if not (subset (type_vars_in_term r) (tyvars ty)) @@ -251,12 +251,12 @@ index a08ad1c..7d67f20 100644 + (the_definitions := dth::(!the_definitions); + new_proof (Proof(idx,dth,Pdef(dtm,cname,ty)))) | _ -> failwith "new_basic_definition" - + (* ------------------------------------------------------------------------- *) @@ -610,7 +707,7 @@ module Hol : Hol_kernel = struct (* Where "abs" and "rep" are new constants with the nominated names. *) (* ------------------------------------------------------------------------- *) - + - let new_basic_type_definition tyname (absname,repname) (Sequent(asl,c)) = + let new_basic_type_definition tyname (absname,repname) (Sequent(asl,c,p)) = if exists (can get_const_type) [absname; repname] then @@ -282,6 +282,6 @@ index a08ad1c..7d67f20 100644 + new_proof (Proof(ridx, + rth, + Pdeft(Hashtbl.find the_proofs p,rtm,repname,repty)))) - + end;; - + diff --git a/Proofrecording/diffs/tactics.ml b/Proofrecording/diffs/tactics.ml index c3b0dba2..2e9762bf 100644 --- a/Proofrecording/diffs/tactics.ml +++ b/Proofrecording/diffs/tactics.ml @@ -554,13 +554,13 @@ let (MATCH_MP_TAC :thm_tactic) = (* ------------------------------------------------------------------------- *) let (CONJUNCTS_THEN2:thm_tactic->thm_tactic->thm_tactic) = - fun ttac1 ttac2 cth -> - let c1,c2 = dest_conj(concl cth) in + fun ttac1 ttac2 cth -> + let c1,c2 = dest_conj(concl cth) in fun gl -> let ti,gls,jfn = (ttac1(ASSUME c1) THEN ttac2(ASSUME c2)) gl in - let jfn' i ths = - let th1,th2 = CONJ_PAIR(INSTANTIATE_ALL i cth) in - PROVE_HYP th1 (PROVE_HYP th2 (jfn i ths)) in - ti,gls,jfn';; + let jfn' i ths = + let th1,th2 = CONJ_PAIR(INSTANTIATE_ALL i cth) in + PROVE_HYP th1 (PROVE_HYP th2 (jfn i ths)) in + ti,gls,jfn';; let (CONJUNCTS_THEN: thm_tactical) = W CONJUNCTS_THEN2;; diff --git a/Proofrecording/tools/startcore.ml b/Proofrecording/tools/startcore.ml index bbdcee24..64e589d1 100644 --- a/Proofrecording/tools/startcore.ml +++ b/Proofrecording/tools/startcore.ml @@ -1,5 +1,5 @@ -set_jrh_lexer;; (* Uppercase idents *) +set_jrh_lexer;; (* Uppercase idents *) Gc.set { (Gc.get()) with Gc.stack_limit = 16777216 };; (* Up the stack size *) diff --git a/QBF/mygraph.ml b/QBF/mygraph.ml index 6d277f20..5752ce0e 100644 --- a/QBF/mygraph.ml +++ b/QBF/mygraph.ml @@ -1,9 +1,9 @@ unset_jrh_lexer;; module Intvertex = struct - type t = int + type t = int let compare : t -> t -> int = Pervasives.compare - let hash = Hashtbl.hash + let hash = Hashtbl.hash let equal = (=) let default = 0 end;; diff --git a/QBF/qbfr.ml b/QBF/qbfr.ml index 02cb1614..719585c5 100644 --- a/QBF/qbfr.ml +++ b/QBF/qbfr.ml @@ -8,48 +8,48 @@ exception Read_dimacs_error;; let prefix = ref "v_" let intToPrefixedLiteral n = - if n >= 0 + if n >= 0 then mk_var(((!prefix) ^ (string_of_int n)), bool_ty) else mk_neg(mk_var((!prefix) ^ (string_of_int(abs n)), bool_ty)) let buildClause l = - List.fold_left + List.fold_left (fun t n -> mk_disj(intToPrefixedLiteral n, t)) (intToPrefixedLiteral (hd l)) - (tl l) + (tl l) let rec dropLine ins = match Stream.peek ins with Some '\n' -> Stream.junk ins | Some _ -> (Stream.junk ins; dropLine ins) | None -> raise Read_dimacs_error - + let rec stripPreamble ins = match Stream.peek ins with - Some 'c' -> (dropLine ins; stripPreamble ins) - | Some 'p' -> (dropLine ins; stripPreamble ins) + Some 'c' -> (dropLine ins; stripPreamble ins) + | Some 'p' -> (dropLine ins; stripPreamble ins) | Some _ -> Some () | None -> None -let rec getIntClause lex acc = - match +let rec getIntClause lex acc = + match (try Stream.next lex with - Stream.Failure -> Genlex.Kwd "EOF" (* EOF *)) + Stream.Failure -> Genlex.Kwd "EOF" (* EOF *)) with (Genlex.Int 0) -> Some acc | (Genlex.Int i) -> getIntClause lex (i::acc) | (Genlex.Kwd "EOF") -> - if List.length acc = 0 + if List.length acc = 0 then None - else Some acc - | _ -> raise Read_dimacs_error + else Some acc + | _ -> raise Read_dimacs_error -let rec getIntClause2 lex acc = +let rec getIntClause2 lex acc = match Stream.next lex with (Genlex.Int 0) -> acc | (Genlex.Int i) -> i::(getIntClause2 lex acc) - | _ -> raise Read_dimacs_error - + | _ -> raise Read_dimacs_error + let getTerms lex start_acc = let rec loop acc = match getIntClause lex [] with @@ -61,19 +61,19 @@ let getTerms lex start_acc = type qs = Qe of int list | Qa of int list;; -let read_quant lex = +let read_quant lex = let rec loop acc = match Stream.next lex with - Genlex.Kwd "e" -> + Genlex.Kwd "e" -> let vars = getIntClause2 lex [] in let (acc',var) = loop acc in ((Qe vars)::acc',var) - | Genlex.Kwd "a" -> + | Genlex.Kwd "a" -> let vars = getIntClause2 lex [] in let (acc',var) = loop acc in ((Qa vars)::acc',var) | Genlex.Int i -> (acc,i) - | _ -> raise Read_dimacs_error + | _ -> raise Read_dimacs_error in loop [] @@ -87,10 +87,10 @@ let add_quantifiers quant body = ) quant body -let readTerms ins = +let readTerms ins = match stripPreamble ins with - Some _ -> - let lex = (Genlex.make_lexer ["EOF";"e";"a"] ins) in + Some _ -> + let lex = (Genlex.make_lexer ["EOF";"e";"a"] ins) in let (quant,var) = read_quant lex in ( match getTerms lex [var] with Some body -> Some (add_quantifiers quant body) @@ -101,6 +101,6 @@ let readQDimacs filename = let inf = open_in filename in let ins = Stream.of_channel inf in let term = readTerms ins in - (close_in inf; + (close_in inf; match term with Some t -> t | None -> raise Read_dimacs_error) - \ No newline at end of file + diff --git a/QUICK_REFERENCE.txt b/QUICK_REFERENCE.txt index 3415dc5f..5b8533dc 100644 --- a/QUICK_REFERENCE.txt +++ b/QUICK_REFERENCE.txt @@ -1216,7 +1216,7 @@ MESON_TAC thl Tries to prove the goal using meson; ignores assumptions. GEN_MESON_TAC min max step thl -Like MESON_TAC but with explicit start (min), finish (max) and step (step) for +Like MESON_TAC but with explicit start (min), finish (max) and step (step) for the iterative deepening. quot: @@ -1254,7 +1254,7 @@ lift_theorem: recursion.ml: -Functions for defining recursive functions. Mostly subsumed by "define", but +Functions for defining recursive functions. Mostly subsumed by "define", but sometimes useful for efficiency or other reasons. pair.ml: @@ -1361,7 +1361,7 @@ LET_TAC replaces "let x = t in p[x]" in goal with "p[x]" given a new hypothesis "t = x". -GEN_BETA_CONV reduces generalized beta-redexes such as +GEN_BETA_CONV reduces generalized beta-redexes such as `(\(x,y). x + y) (1,2)` num.ml: @@ -1810,7 +1810,7 @@ val ( WF_REFL ) : thm = |- !x. WF (<<) ==> ~(x << x) val ( WF_REC_TAIL ) : thm = |- !P g h. ?f. !x. f x = (if P x then f (g x) else h x) -WF_INDUCT_THEN +WF_INDUCT_THEN WF_INDUCT_TAC Perform wellfounded induction over a nominated measure function. Sometimes avoids explicit "!n t. size(t) = n ==> ..." goal. diff --git a/RichterHilbertAxiomGeometry/miz3/Miz3Tips b/RichterHilbertAxiomGeometry/miz3/Miz3Tips index 94e2466f..076dd378 100644 --- a/RichterHilbertAxiomGeometry/miz3/Miz3Tips +++ b/RichterHilbertAxiomGeometry/miz3/Miz3Tips @@ -10,7 +10,7 @@ because you will get an error Exception: Failure "new_type: type point has already been declared". You will see 190 or so definitions and proved theorems, in perhaps 15 -minutes. +minutes. How to check the Hilbert axiomatic geometry proofs HilbertAxiom.ml, which are a formalization in the proof assistant HOL Light of @@ -25,7 +25,7 @@ HOL proof assistants, e.g. HOL4 & Isabelle. Two outstanding advantages of HOL Light are Freek's miz3 and that HOL Light is the preferred proof assistant of Tom Hales, who is ambituously trying to formalize his proof of the Kepler sphere-packing theorem. I suspect -that John Harrison's leadership is involved in both advantages. +that John Harrison's leadership is involved in both advantages. Mizar was the first proof assistant allowing readable formal proofs. Miz3 now allows readable formal proofs in HOL Light. Miz3 @@ -46,20 +46,20 @@ particularly good at equational reasoning, as one sees in this example from the Hilbert code (using fancy fonts for readability): let B4 = new_axiom - `∀ l A B C. Line l ∧ ¬Collinear A B C ∧ - A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ - (∃ X. X ∈ l ∧ Between A X C) ⇒ + `∀ l A B C. Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + (∃ X. X ∈ l ∧ Between A X C) ⇒ (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C)`;; let B4' = thm `; - ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ - A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ X ∈ open (A,C)) ⇒ - (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) + (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) by IN_Interval, B4; `;; -B4' does nothing but substitute into B4 the definition +B4' does nothing but substitute into B4 the definition IN_Interval |- ∀ A B X. X ∈ open (A,B) ⇔ Between A X B This is equational reasoning, and B4' times out with the default timeout value of 1 (5 suffices), and then, a longer proof is needed: @@ -67,14 +67,14 @@ timeout value of 1 (5 suffices), and then, a longer proof is needed: let B4prime = thm `; let l be point_set; let A B C be point; - assume Line l ∧ ¬Collinear A B C ∧ - A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + assume Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ X ∈ open (A,C)) [H1]; thus (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) proof - Line l ∧ ¬Collinear A B C ∧ - A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ Between A X C) by H1, IN_Interval; (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C) by -, B4; qed by -, IN_Interval; @@ -88,7 +88,7 @@ HOL Light tactic that might be helpful here is REWRITE_TAC, which is used in equational reasoning, an interesting area of HOL. It pay to write a `skeleton' of your proof before filling in the -details, and I always start with this: +details, and I always start with this: proof @@ -123,17 +123,17 @@ always a thesis, which changes from line to line. "Thus thesis" means the thesis is proven, and then one writes "end" to end the proof. In the cases construction above, each of the 3 forks have their own thesis, A, B and C resp., and each proofs end with qed. So in the -final line, there is no thesis! So we merely write "end". +final line, there is no thesis! So we merely write "end". In the proof B4prime above, "thus" seems to have two separate meanings. The first thus seems to be stating the theorem, and the second thus (contained in the qed) is is ending the proof. In a sense -thus has the same meaning. Let's simplify B4prime as +thus has the same meaning. Let's simplify B4prime as let B4prime = thm `; - [...] + [...] thus α ∨ β proof - [...] + [...] thus thesis by -, IN_Interval; end; `;; @@ -141,14 +141,14 @@ The entire "proof [...] IN_Interval;" is as a justification of the statement α ∨ β, even though there is no "by". So we could in a sense rewrite B4prime as let B4prime = thm `; - [...] + [...] thus α ∨ β by [...]; end; `;; -As the thesis is α ∨ β on the "thus" line, this is analogous to +As the thesis is α ∨ β on the "thus" line, this is analogous to thus thesis by -, IN_Interval; -which ends the proof. +which ends the proof. My code uses a fair amount of set theory, which is explained in John's tutorial briefly in sec 14, and in more detail in his reference @@ -169,11 +169,11 @@ copy and paste with the mouse. Open a terminal window. Paste in these 4 commands and type RET: ocaml -#use "hol.ml";; +#use "hol.ml";; #load "unix.cma";; loadt "miz3/miz3.ml";; -After a short while you will see +After a short while you will see val it : unit = () # Now select the entire file HilbertAxiom.ml and paste it in. This will @@ -194,15 +194,15 @@ session. Sometimes even when only changing theorems it's good to start a new session. To end your ocam/HOL-Light/miz3 session, type -C-d -If you paste in bad input, sometimes you can fix the problem by typing +C-d +If you paste in bad input, sometimes you can fix the problem by typing C-c (or the signal BREAK in an Emacs shell C-c C-c). To learn the thesis in a statement in a miz3 proof, insert -exec GOAL_TAC; -after the statement, and the type +exec GOAL_TAC; +after the statement, and the type p();; -at the end of the proof. +at the end of the proof. There are two problems with pasting into a terminal window, both solved by using intead an Emacs shell, created with M-x shell. After @@ -229,11 +229,11 @@ problem with HOL Light. Some tips on the error messages: #1 inference error means that miz3 asserts that your `by' justification is impossible. A simple way to earn a #1 error is to mix up `qed' and `end' in a cases -construction. +construction. #2 inference time-out means that miz3 was unable to calculate your `by' justification before -timing out. There are two possibilities: +timing out. There are two possibilities: 1) your `by' justification doesn't work, so you should fix it; 2) you need more time, in which case you can increase the value of timeout, to e.g. 50 as is done here, with @@ -244,7 +244,7 @@ As Freek explains, this is useful in checking ones proofs on a slower machine than the one on which the miz3 proofs were debugged on. #3 skeleton error -require a good understanding of miz3's version of Mizar's (barely documented) notion of the skeleton, which is the outline of the proof. Freek's paper contains a reasonably good explanation of miz3 skeletons. +require a good understanding of miz3's version of Mizar's (barely documented) notion of the skeleton, which is the outline of the proof. Freek's paper contains a reasonably good explanation of miz3 skeletons. The first line with an error message may not be the first line with a mistake on it. Consider this fragment of a miz3 error messages: @@ -257,12 +257,12 @@ Mizar_error assume seg B A === seg C B [H2]; :: #3 :: 3: skeleton error - thus angle BCA === angle CAB + thus angle BCA === angle CAB :: #8 :: 8: syntax or type error hol - + proof - [...] + [...] There is nothing wrong with the line with the #3 error message. The problem is in the next line with the #8 error, where `BCA' & `CAB' @@ -273,13 +273,13 @@ Mizar_error let A B C be point; assume ~Collinear A B C [H1]; assume seg B A === seg B C [H2]; - thus angle B C A === angle C A B - + thus angle B C A === angle C A B + proof - [...] + [...] -Here's another example where the first line with a reported error is fine, and the real error occurs later: +Here's another example where the first line with a reported error is fine, and the real error occurs later: cases; suppose G = A; @@ -362,10 +362,10 @@ the `by' is missing, but sometimes HOL Light expertise is needed. You can not e.g. define (by `let') the letter `o' as a variable, because it already means the composition operator. Evaluating type_of `o`;; -tells you the hol_type of `o' is +tells you the hol_type of `o' is `:(?143901->?143903)->(?143902->?143901)->?143902->?143903` meaning that `o' is a function taking two selfmaps and returning the -composition. You can see that `o' is infix operator by evaluting +composition. You can see that `o' is infix operator by evaluting infixes();; which gives all the infix operators plus precedence info, including ("o", (26, "right")) @@ -375,13 +375,13 @@ might mean that there's a colon (:) instead of a semicolon (;) at the end of the line, or a ;;, or there is no ; at the end of the line, there is a blank between two commas in the `by' list. i.e. statement [label] by X1, X2, , X3, X4; -or that there are two occurrences of `by' on the line, as in +or that there are two occurrences of `by' on the line, as in ray D C = ray D G [rDCrDG] by by DCG, IntervalRay_THM; Exception: Failure "lex1". may means you have a bad character, perhaps obtained by pasting from a pdf file, where you can the fancy quote (’) which HOL Light will not -parse, and you must replace it by the quote ('). +parse, and you must replace it by the quote ('). Use `thm' in miz3 for a theorem/proof. The style used here is @@ -399,7 +399,7 @@ let CarefullyChosenName_THM = thm `; Begin with `let' variable bindings, `assume' assumptions, then state the theorem with `thus', then give the proof beginning with `proof', and end the proof with `qed' or `end'. Notice that the `thus' and -`proof' statement do not end in a semicolon (;). +`proof' statement do not end in a semicolon (;). The miz3 comment symbol in a `thm' body is a double colon (::). Outside a `thm' body, use the Hol Light (* ... *) comment convention. diff --git a/RichterHilbertAxiomGeometry/miz3/README b/RichterHilbertAxiomGeometry/miz3/README index 8cbd5998..15844c4e 100644 --- a/RichterHilbertAxiomGeometry/miz3/README +++ b/RichterHilbertAxiomGeometry/miz3/README @@ -13,7 +13,7 @@ information on how to use miz3. FontHilbertAxiom.ml is a version of HilbertAxiom.ml written with mathematical characters ⇒, ⇔, ¬, ∨, ∧, ∀, ∃, ⊂, ∈, ∪, ∩ and ∅ -which HOL4, Isabelle and readable.ml allow. It requires +which HOL4, Isabelle and readable.ml allow. It requires hol-light-fonts.el is needed to run the miz3 code FontHilbertAxiom.ml. hol-light-fonts.elc is the byte-compiled version of the Emacs code. diff --git a/RichterHilbertAxiomGeometry/miz3/hol-light-fonts.el b/RichterHilbertAxiomGeometry/miz3/hol-light-fonts.el index 8f8af6c3..75324203 100644 --- a/RichterHilbertAxiomGeometry/miz3/hol-light-fonts.el +++ b/RichterHilbertAxiomGeometry/miz3/hol-light-fonts.el @@ -1,6 +1,6 @@ ;; The function Math-fonts-for-HOL-Light replace the expressions -;; ==>, <=>, ~, \/, /\, !, ?, SUBSET, IN, UNION, INTER and {} -;; in a file with the mathematical characters (used by Isabelle) +;; ==>, <=>, ~, \/, /\, !, ?, SUBSET, IN, UNION, INTER and {} +;; in a file with the mathematical characters (used by Isabelle) ;; ⇒, ⇔, ¬, ∨, ∧, ∀, ∃, ⊂, ∈, ∪, ∩ and ∅. ;; The function Remove-math-fonts-for-HOL-Light turns the mathematical characters ;; ⇒, ⇔, ¬ etc back to HOL Light expressions ==>, <=>, ~ etc. @@ -260,7 +260,7 @@ ;; Assuming the function key F2 is an unbound prefix key in Emacs, and ;; this code binds the keys -;; F2 i, F2 b (for biconditional) etc +;; F2 i, F2 b (for biconditional) etc ;; to inserting the symbols (sometimes padded with spaces), as indicated: (global-set-key '[f2 73] '(lambda () (interactive) (insert " ⇒ "))) ;; F2 I @@ -299,12 +299,12 @@ (global-set-key '[f2 79] '(lambda () (interactive) (insert " ∘ "))) ;; F2 O (global-set-key '[f2 68] '(lambda () (interactive) (insert " ◼ "))) ;; F2 D -;; Two Emacs functions are useful in this context: +;; Two Emacs functions are useful in this context: ;; (string-to-char "⇒") => 8658 ;; (char-to-string 8660) => "⇔" ;; Here's my low-level system using math symbols in HOL-Light/Miz3 . -;; In the Emacs buffer containing math symbols, type +;; In the Emacs buffer containing math symbols, type ;; M-x remove-math-fonts-for-HOL-Light ;; and then mouse-paste into a terminal window (or Emacs shell) ;; running ocaml/HOL Light/miz3. The X selection pasted by the mouse @@ -313,14 +313,14 @@ ;; The command M-x remove-math-fonts-for-HOL-Light will be in the ;; command history, and you can recall it with repeat-complex-command, -;; which I bind to the function key F8 by +;; which I bind to the function key F8 by ;; (global-set-key [f8] 'repeat-complex-command) (setq auto-mode-alist (append `(("ml\\'" . text-mode)) auto-mode-alist)) (add-hook 'text-mode-hook 'turn-off-auto-fill) (add-hook 'text-mode-hook 'turn-on-visual-line-mode) -(add-hook 'text-mode-hook +(add-hook 'text-mode-hook (lambda () (setq comment-start "::"))) diff --git a/RichterHilbertAxiomGeometry/miz3/make.ml b/RichterHilbertAxiomGeometry/miz3/make.ml index 8fc517fc..bd6088f2 100644 --- a/RichterHilbertAxiomGeometry/miz3/make.ml +++ b/RichterHilbertAxiomGeometry/miz3/make.ml @@ -1,3 +1,3 @@ -#load "unix.cma";; -loadt "miz3/miz3.ml";; +#load "unix.cma";; +loadt "miz3/miz3.ml";; loadt "RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml";; diff --git a/RichterHilbertAxiomGeometry/thmTopology b/RichterHilbertAxiomGeometry/thmTopology index 1d95bf8a..f80967c5 100644 --- a/RichterHilbertAxiomGeometry/thmTopology +++ b/RichterHilbertAxiomGeometry/thmTopology @@ -445,7 +445,7 @@ ConnectedClosedIn ConnectedSubtopology |- ∀α s. s ⊂ topspace α - ⇒ (Connected (subtopology α s) ⇔ + ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅))) @@ -536,7 +536,7 @@ ConnectedInduction |- ∀α P Q s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀t a. open_in (subtopology α s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ - (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ + (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ∧ Q a ⇒ Q b) @@ -565,7 +565,7 @@ ConnectedInductionSimple ConnectedEquivalenceRelation |- ∀α R s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ - (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ + (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ (∀x. x ∈ t ⇒ R a x))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ⇒ R a b) @@ -943,7 +943,7 @@ FrontierDisjointEq |- ∀α s. s ⊂ topspace α ⇒ (Frontier α s ∩ s = ∅ ⇔ open_in α s) FrontierInterSubset - |- ∀α s t. s ∪ t ⊂ topspace α + |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∩ t) ⊂ Frontier α s ∪ Frontier α t FrontierUnionSubset @@ -954,7 +954,7 @@ FrontierInteriors |- ∀α s. s ⊂ topspace α ⇒ Frontier α s = topspace α ━ Interior α s ━ Interior α (topspace α ━ s) -FrontierFrontierSubset +FrontierFrontierSubset |- ∀α s. s ⊂ topspace α ⇒ Frontier α (Frontier α s) ⊂ Frontier α s InteriorFrontier @@ -974,7 +974,7 @@ UnionFrontierPart1 UnionFrontierPart2 |- ∀α s t. s ∪ t ⊂ topspace α - ⇒ Frontier α s ━ Frontier α t ⊂ + ⇒ Frontier α s ━ Frontier α t ⊂ Frontier α (s ∩ t) ∪ Frontier α (s ∪ t) UnionFrontierPart3 @@ -985,7 +985,7 @@ UnionFrontierPart3 UnionFrontier |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α s ∪ Frontier α t = - Frontier α (s ∪ t) ∪ + Frontier α (s ∪ t) ∪ Frontier α (s ∩ t) ∪ Frontier α s ∩ Frontier α t @@ -1016,7 +1016,7 @@ FrontierInterSubsetInter Closure α s ∩ Frontier α t ∪ Frontier α s ∩ Closure α t FrontierUnionPart1 - |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ + |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ ⇒ Frontier α s ∩ Interior α (s ∪ t) = ∅ FrontierUnion @@ -1354,7 +1354,7 @@ CONNECTED_FROM_OPEN_UNION_AND_INTER CONNECTED_INDUCTION |- ∀P Q s. connected s ∧ - (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t + (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y))) @@ -1378,15 +1378,15 @@ CONNECTED_EQUIVALENCE_RELATION_GEN ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b) CONNECTED_INDUCTION_SIMPLE - |- ∀P s. connected s ∧ (∀a. a ∈ s + |- ∀P s. connected s ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ⇒ P y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ⇒ P b) CONNECTED_EQUIVALENCE_RELATION - |- ∀R s. connected s ∧ + |- ∀R s. connected s ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ - (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ + (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x. x ∈ t ⇒ R a x))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ⇒ R a b) @@ -1593,7 +1593,7 @@ INTERIOR_CLOSURE_INTER_OPEN interior (closure s) ∩ interior (closure t) CLOSURE_INTERIOR_UNION_CLOSED - |- ∀s t. closed s ∧ closed t ⇒ + |- ∀s t. closed s ∧ closed t ⇒ closure (interior (s ∪ t)) = closure (interior s) ∪ closure (interior t) REGULAR_OPEN_INTER @@ -1667,7 +1667,7 @@ INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER |- ∀s. closed s ∧ interior s = ∅ ⇔ (∃t. open t ∧ s = frontier t) FRONTIER_UNION - |- ∀s t. closure s ∩ closure t = ∅ + |- ∀s t. closure s ∩ closure t = ∅ ⇒ frontier (s ∪ t) = frontier s ∪ frontier t CLOSURE_UNION_FRONTIER |- ∀s. closure s = s ∪ frontier s diff --git a/Rqe/condense.ml b/Rqe/condense.ml index bd4cb897..ef14acb3 100644 --- a/Rqe/condense.ml +++ b/Rqe/condense.ml @@ -2,17 +2,17 @@ (* CONDENSE *) (* ====================================================================== *) (* -let merge_interpsign ord_thm (thm1,thm2,thm3) = +let merge_interpsign ord_thm (thm1,thm2,thm3) = let thm1' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm1) in - let thm2' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm2) in + let thm2' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm2) in let thm3' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm3) in let set1,_,_ = dest_interpsign thm1 in let _,s1 = dest_abs set1 in let set3,_,_ = dest_interpsign thm3 in let _,s3 = dest_abs set3 in - let gthm = - if is_conj s1 && is_conj s3 then gen_thm - else if is_conj s1 && not (is_conj s3) then gen_thm_noright + let gthm = + if is_conj s1 && is_conj s3 then gen_thm + else if is_conj s1 && not (is_conj s3) then gen_thm_noright else if not (is_conj s1) && is_conj s3 then gen_thm_noleft else gen_thm_noboth in PURE_REWRITE_RULE[GSYM interpsign] (MATCH_MPL[gthm;ord_thm;thm1';thm2';thm3']);; @@ -79,8 +79,8 @@ merge_interpsign ord_thm (thm1,thm2,thm3);; (* }}} *) (* let rec merge_three l1 l2 l3 = - match l1 with - [] -> [] + match l1 with + [] -> [] | h::t -> (hd l1,hd l2,hd l3)::merge_three (tl l1) (tl l2) (tl l3);; *) @@ -99,7 +99,7 @@ let rec merge_three l1 l2 l3 = [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x2 < x /\ x < x3) [Unknown; Pos; Pos; Neg]; ---> +--> |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x1 < x /\ x < x3) @@ -107,7 +107,7 @@ let rec merge_three l1 l2 l3 = *) (* }}} *) (* -let combine_interpsigns ord_thm thm1 thm2 thm3 = +let combine_interpsigns ord_thm thm1 thm2 thm3 = let _,_,s1 = dest_interpsigns thm1 in let _,_,s2 = dest_interpsigns thm2 in let _,_,s3 = dest_interpsigns thm3 in @@ -118,13 +118,13 @@ let combine_interpsigns ord_thm thm1 thm2 thm3 = let thms3 = CONJUNCTS(PURE_REWRITE_RULE[interpsigns;ALL2] thm3) in let thms = butlast (merge_three thms1 thms2 thms3) (* ignore the T at end *) in let thms' = map (merge_interpsign ord_thm) thms in - mk_interpsigns thms' + mk_interpsigns thms' with Failure s -> failwith ("combine_interpsigns: " ^ s);; *) (* {{{ Examples *) (* -let thm = combine_interpsigns +let thm = combine_interpsigns let ord_thm,thm1,thm2,thm3 = ord_thm5 ,ci1 ,ci2 ,ci3 @@ -134,19 +134,19 @@ let thm1,thm2,thm3 = int1,pt,int2 let tmp = (ith 0 thms) merge_interpsign ord_thm tmp -let thm1 = ASSUME +let thm1 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x1 < x /\ x < x2) [Unknown; Pos; Pos; Neg]`;; -let thm2 = ASSUME +let thm2 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x2) [Unknown; Pos; Pos; Neg]`;; -let thm3 = ASSUME +let thm3 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x2 < x /\ x < x3) @@ -158,19 +158,19 @@ combine_interpsigns ord_thm thm1 thm2 thm3;; -let thm1 = ASSUME +let thm1 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x < x5) [Unknown; Pos; Pos; Neg]`;; -let thm2 = ASSUME +let thm2 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x5) [Unknown; Pos; Pos; Neg]`;; -let thm3 = ASSUME +let thm3 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x5 < x /\ x < x6) @@ -181,19 +181,19 @@ let ord_thm = ASSUME `x5 < x6`;; combine_interpsigns ord_thm thm1 thm2 thm3;; -let thm1 = ASSUME +let thm1 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x < x6) [Unknown; Pos; Pos; Neg]`;; -let thm2 = ASSUME +let thm2 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x6) [Unknown; Pos; Pos; Neg]`;; -let thm3 = ASSUME +let thm3 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x6 < x) @@ -204,7 +204,7 @@ let ord_thm = ASSUME `x5 < x6`;; combine_interpsigns ord_thm thm1 thm2 thm3;; -*) +*) (* }}} *) @@ -212,11 +212,11 @@ combine_interpsigns ord_thm thm1 thm2 thm3;; (* {{{ Doc *) (* get_bounds `\x. x < x1` `\x. x1 < x /\ x < x2` - --> + --> x1 < x2 get_bounds `\x. x0 < x < x1` `\x. x1 < x /\ x < x2` - --> + --> x0 < x1 /\ x1 < x2 get_bounds `\x. x < x1` `\x. x1 < x` @@ -229,22 +229,22 @@ combine_interpsigns ord_thm thm1 thm2 thm3;; let get_bounds set1 set2 = let _,s1 = dest_abs set1 in let _,s2 = dest_abs set2 in - let c1 = - if is_conj s1 then + let c1 = + if is_conj s1 then let l,r = dest_conj s1 in let l1,l2 = dest_binop rlt l in let l3,l4 = dest_binop rlt r in mk_binop rlt l1 l4 else t_tm in - let c2 = - if is_conj s2 then + let c2 = + if is_conj s2 then let l,r = dest_conj s2 in let l1,l2 = dest_binop rlt l in let l3,l4 = dest_binop rlt r in mk_binop rlt l1 l4 else t_tm in - if c1 = t_tm then c2 - else if c2 = t_tm then c1 + if c1 = t_tm then c2 + else if c2 = t_tm then c1 else mk_conj (c1,c2);; *) (* {{{ Examples *) @@ -261,7 +261,7 @@ let get_bounds set1 set2 = (* {{{ Doc *) -(* collect_pts +(* collect_pts |- interpsigns ... (\x. x < x1) ... |- interpsigns ... (\x. x1 < x /\ x < x4) ... |- interpsigns ... (\x. x4 < x /\ x < x7) ... @@ -274,24 +274,24 @@ let get_bounds set1 set2 = (* }}} *) (* -let rec collect_pts thms = +let rec collect_pts thms = match thms with - [] -> [] - | h::t -> + [] -> [] + | h::t -> let rest = collect_pts t in - let _,set,_ = dest_interpsigns h in + let _,set,_ = dest_interpsigns h in let x,b = dest_abs set in - let bds = - if b = t_tm then [] + let bds = + if b = t_tm then [] else if is_conj b then let l,r = dest_conj b in [fst(dest_binop rlt l);snd(dest_binop rlt r)] - else + else let _,l,r = get_binop b in if x = l then [r] else [l] in match rest with [] -> bds - | h::t -> if not (h = (last bds)) then failwith "pts not in order" + | h::t -> if not (h = (last bds)) then failwith "pts not in order" else if length bds = 2 then hd bds::rest else rest;; *) (* {{{ Examples *) @@ -316,51 +316,51 @@ let t4 = ASSUME `interpsigns [[&1]] (\x. x7 < x) [Pos]` collect_pts [t1;t2;t3;t4] -let t1 = ASSUME +let t1 = ASSUME `interpsigns - [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x < x1) [Unknown; Pos; Pos; Pos]`;; -let t2 = ASSUME +let t2 = ASSUME `interpsigns - [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x1) [Neg; Pos; Pos; Zero]`;; -let t3 = ASSUME +let t3 = ASSUME `interpsigns - [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x1 < x /\ x < x4) [Unknown; Pos; Pos; Neg]`;; -let t4 = ASSUME +let t4 = ASSUME `interpsigns - [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x4) [Pos; Pos; Zero; Neg]`;; -let t5 = ASSUME +let t5 = ASSUME `interpsigns - [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x4 < x /\ x < x5) [Unknown; Pos; Neg; Neg]`;; -let t6 = ASSUME +let t6 = ASSUME `interpsigns - [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x5) [Pos; Pos; Zero; Zero]`;; -let t7 = ASSUME +let t7 = ASSUME `interpsigns - [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x5 < x) [Unknown; Pos; Pos; Pos]`;; @@ -369,7 +369,7 @@ let thms = [t1;t2;t3;t4;t5;t6;t7] collect_pts thms *) - + @@ -380,30 +380,30 @@ combine_identical_lines |- ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) (partition_line [x1; x2; x3; x4; x5]) - [[Unknown; Pos; Pos; Pos]; + [[Unknown; Pos; Pos; Pos]; x1 [Neg; Pos; Pos; Zero]; - [Unknown; Pos; Pos; Neg]; -x2 [Unknown; Pos; Pos; Neg]; - [Unknown; Pos; Pos; Neg]; -x3 [Unknown; Pos; Pos; Neg]; - [Unknown; Pos; Pos; Neg]; -x4 [Pos; Pos; Zero; Neg]; - [Unknown; Pos; Neg; Neg]; -x5 [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Neg]; +x2 [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; +x3 [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; +x4 [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; +x5 [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]] --> - + |- ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) (partition_line [x1; x4; x5]) - [[Unknown; Pos; Pos; Pos]; + [[Unknown; Pos; Pos; Pos]; x1 [Neg; Pos; Pos; Zero]; - [Unknown; Pos; Pos; Neg]; -x4 [Pos; Pos; Zero; Neg]; - [Unknown; Pos; Neg; Neg]; -x5 [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Neg]; +x4 [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; +x5 [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]] *) @@ -411,13 +411,13 @@ x5 [Pos; Pos; Zero; Zero]; (* }}} *) (* -let sublist i j l = +let sublist i j l = let _,r = chop_list i l in let l2,r2 = chop_list (j-i+1) r in l2;; *) (* {{{ Examples *) -(* +(* let i,j,l = 1,4,[1;2;3;4;5;6;7] sublist 1 4 [1;2;3;4;5;6;7] sublist 2 4 [1;2;3;4;5;6;7] @@ -426,25 +426,25 @@ sublist 1 1 [1;2;3;4;5;6;7] (* }}} *) (* -let rec combine ord_thms l = - let lem = REWRITE_RULE[AND_IMP_THM] REAL_LT_TRANS in - match l with - [int] -> [int] - | [int1;int2] -> [int1;int2] - | int1::pt::int2::rest -> - try +let rec combine ord_thms l = + let lem = REWRITE_RULE[AND_IMP_THM] REAL_LT_TRANS in + match l with + [int] -> [int] + | [int1;int2] -> [int1;int2] + | int1::pt::int2::rest -> + try let _,set1,_ = dest_interpsigns int1 in let _,set2,_ = dest_interpsigns int2 in let ord_tm = get_bounds set1 set2 in if ord_tm = t_tm then let h1 = combine_interpsigns TRUTH int1 pt int2 in - combine ord_thms (h1::rest) + combine ord_thms (h1::rest) else - let lt,rt = + let lt,rt = if is_conj ord_tm then let c1,c2 = dest_conj ord_tm in - let l,_ = dest_binop rlt c1 in - let _,r = dest_binop rlt c2 in + let l,_ = dest_binop rlt c1 in + let _,r = dest_binop rlt c2 in l,r else dest_binop rlt ord_tm in let e1 = find (fun x -> lt = fst(dest_binop rlt (concl x))) ord_thms in @@ -454,14 +454,14 @@ let rec combine ord_thms l = let ord_thms' = sublist i1 i2 ord_thms in let ord_thm = end_itlist (fun x y -> MATCH_MPL[lem;x;y]) ord_thms' in let h1 = combine_interpsigns ord_thm int1 pt int2 in - combine ord_thms (h1::rest) - with - Failure "combine_interpsigns: signs not equal" -> + combine ord_thms (h1::rest) + with + Failure "combine_interpsigns: signs not equal" -> int1::pt::(combine ord_thms(int2::rest));; *) (* -let combine_identical_lines rol_thm all_thm = +let combine_identical_lines rol_thm all_thm = let tmp,mat = dest_comb (concl all_thm) in let _,line = dest_comb tmp in let _,pts = dest_comb line in @@ -484,23 +484,23 @@ let int1::pt::int2::rest = snd (chop_list 0 thms) let int1::pt::int2::rest = snd (chop_list 2 thms) let l = thms -let int1::pt::int2::rest = l +let int1::pt::int2::rest = l combine thms let rol_thm = ASSUME `real_ordered_list [x1; x2; x3; x4; x5]` -let all_thm = ASSUME +let all_thm = ASSUME `ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) (partition_line [x1; x2; x3; x4; x5]) - [[Unknown; Pos; Pos; Pos]; + [[Unknown; Pos; Pos; Pos]; [Neg; Pos; Pos; Zero]; - [Unknown; Pos; Pos; Neg]; - [Unknown; Pos; Pos; Neg]; - [Unknown; Pos; Pos; Neg]; - [Unknown; Pos; Pos; Neg]; - [Unknown; Pos; Pos; Neg]; - [Pos; Pos; Zero; Neg]; - [Unknown; Pos; Neg; Neg]; - [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; + [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]]`;; let all_thm' = combine_identical_lines rol_thm all_thm @@ -511,17 +511,17 @@ let all_thm' = combine_identical_lines rol_thm all_thm (* {{{ Doc *) (* -assumes l2 is a sublist of l1 +assumes l2 is a sublist of l1 list_diff [1;2;3;4] [2;3] --> [1;4] *) (* }}} *) (* -let rec list_diff l1 l2 = +let rec list_diff l1 l2 = match l1 with [] -> if l2 = [] then [] else failwith "l2 not a sublist of l1" - | h::t -> + | h::t -> match l2 with [] -> l1 | h'::t' -> if h = h' then list_diff t t' @@ -537,67 +537,67 @@ list_diff [1;2;3;4] [1;3;4] (* let CONDENSE mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in - let pts = dest_list (snd (dest_comb (concl rol_thm))) in + let pts = dest_list (snd (dest_comb (concl rol_thm))) in let all_thm' = combine_identical_lines rol_thm all_thm in - let _,part,_ = dest_all2 (concl all_thm) in + let _,part,_ = dest_all2 (concl all_thm) in let plist = dest_list (snd (dest_comb part)) in - let _,part',_ = dest_all2 (concl all_thm') in + let _,part',_ = dest_all2 (concl all_thm') in let plist' = dest_list (snd (dest_comb part')) in let rol_thm' = itlist ROL_REMOVE (list_diff plist plist') rol_thm in - let mat_thm' = mk_interpmat_thm rol_thm' all_thm' in + let mat_thm' = mk_interpmat_thm rol_thm' all_thm' in mat_thm';; *) (* ---------------------------------------------------------------------- *) (* OPT *) (* ---------------------------------------------------------------------- *) -let rec triple_index l = +let rec triple_index l = match l with [] -> failwith "triple_index" | [x] -> failwith "triple_index" | [x;y] -> failwith "triple_index" | x::y::z::rest -> if x = y && y = z then 0 else 1 + triple_index (y::z::rest);; -let tmp = ref TRUTH;; +let tmp = ref TRUTH;; (* -let +let tmp let mat_thm = !tmp let mat_thm = mat_thm' *) let rec CONDENSE = - let real_app = `APPEND:real list -> real list -> real list` in + let real_app = `APPEND:real list -> real list -> real list` in let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in - let real_len = `LENGTH:real list -> num` in + let real_len = `LENGTH:real list -> num` in let sign_len = `LENGTH:(sign list) list -> num` in let num_mul = `( * ):num -> num -> num` in let real_ty = `:real` in let two = `2` in let sl_ty = `:sign list` in - fun mat_thm -> - try - tmp := mat_thm; + fun mat_thm -> + try + tmp := mat_thm; let pts,_,sgns = dest_interpmat (concl mat_thm) in let sgnl = dest_list sgns in let ptl = dest_list pts in let i = triple_index sgnl (* fail here if fully condensed *) in if not (i mod 2 = 0) then failwith "misshifted matrix" else - if i = 0 then + if i = 0 then if length ptl = 1 then MATCH_MP INTERPMAT_SING mat_thm else CONDENSE (MATCH_MP INTERPMAT_TRIO mat_thm) else - let l,r = chop_list (i - 2) sgnl in + let l,r = chop_list (i - 2) sgnl in let sgn1,sgn2 = mk_list(l,sl_ty),mk_list(r,sl_ty) in - let sgns' = mk_comb(mk_comb(sign_app,sgn1),sgn2) in + let sgns' = mk_comb(mk_comb(sign_app,sgn1),sgn2) in let sgn_thm = prove(mk_eq(sgns,sgns'),REWRITE_TAC[APPEND]) in let l',r' = chop_list (i / 2 - 1) ptl (* i always even *) in let pt1,pt2 = mk_list(l',real_ty),mk_list(r',real_ty) in - let pts' = mk_comb(mk_comb(real_app,pt1),pt2) in + let pts' = mk_comb(mk_comb(real_app,pt1),pt2) in let pt_thm = prove(mk_eq(pts,pts'),REWRITE_TAC[APPEND]) in let mat_thm' = ONCE_REWRITE_RULE[sgn_thm;pt_thm] mat_thm in let len_thm = prove((mk_eq(mk_comb(sign_len,sgn1),mk_binop num_mul two (mk_comb(real_len,pt1)))),REWRITE_TAC[LENGTH] THEN ARITH_TAC) in - CONDENSE (REWRITE_RULE[APPEND] + CONDENSE (REWRITE_RULE[APPEND] (MATCH_MP (MATCH_MP INTERPMAT_TRIO_INNER mat_thm') len_thm)) - with + with Failure "triple_index" -> mat_thm | Failure x -> failwith ("CONDENSE: " ^ x);; @@ -610,42 +610,42 @@ let mat_thm = mat_thm' CONDENSE mat_thm -let mat_thm = ASSUME - `interpmat [x1; x2; x3; x4; x5] - [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] [ - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Pos; Neg; Neg; Neg]; - [Zero; Pos; Pos; Neg; Neg; Neg]; - [Neg; Pos; Pos; Neg; Neg; Neg] - ]` - - -let mat_thm = ASSUME - `interpmat [x1; x2; x3; x4; x5] - [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Zero; Pos; Pos; Neg; Neg; Neg]; + [Neg; Pos; Pos; Neg; Neg; Neg] + ]` + + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] - [[Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Zero; Zero; Neg; Neg]; - [Pos; Pos; Neg; Pos; Neg; Neg]; - [Pos; Pos; Neg; Pos; Neg; Zero]; - [Pos; Pos; Neg; Pos; Neg; Pos]; - [Pos; Pos; Neg; Pos; Zero; Pos]; - [Pos; Pos; Neg; Pos; Pos; Pos]; - [Pos; Zero; Neg; Pos; Pos; Pos]; - [Pos; Neg; Neg; Pos; Pos; Pos]; - [Pos; Zero; Zero; Pos; Pos; Pos]; - [Pos; Pos; Pos; Pos; Pos; Pos]]` - -let mat_thm' = INFERPSIGN vars sgns mat_thm div_thms + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` + +let mat_thm' = INFERPSIGN vars sgns mat_thm div_thms CONDENSE mat_thm @@ -661,7 +661,7 @@ CONDENSE mat_thm let CONDENSE mat_thm = let start_time = Sys.time() in - let res = CONDENSE mat_thm in + let res = CONDENSE mat_thm in condense_timer +.= (Sys.time() -. start_time); res;; diff --git a/Rqe/condense_thms.ml b/Rqe/condense_thms.ml index c7760d5d..72721f8b 100644 --- a/Rqe/condense_thms.ml +++ b/Rqe/condense_thms.ml @@ -9,12 +9,12 @@ let gt_aux = prove( REAL_ARITH_TAC);; let gen_thm = prove_by_refinement( - `!P x1 x2 x3. - (x1 < x3) ==> - (!x. x1 < x /\ x < x2 ==> P x) ==> - (!x. (x = x2) ==> P x) ==> - (!x. x2 < x /\ x < x3 ==> P x) ==> - (!x. x1 < x /\ x < x3 ==> P x)`, + `!P x1 x2 x3. + (x1 < x3) ==> + (!x. x1 < x /\ x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x /\ x < x3 ==> P x) ==> + (!x. x1 < x /\ x < x3 ==> P x)`, (* {{{ Proof *) [ @@ -24,28 +24,28 @@ let gen_thm = prove_by_refinement( (* }}} *) let gen_thm_noleft = prove( - `!P x2 x3. - (x2 < x3) ==> - (!x. x < x2 ==> P x) ==> - (!x. (x = x2) ==> P x) ==> - (!x. x2 < x /\ x < x3 ==> P x) ==> - (!x. x < x3 ==> P x)`, + `!P x2 x3. + (x2 < x3) ==> + (!x. x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x /\ x < x3 ==> P x) ==> + (!x. x < x3 ==> P x)`, MESON_TAC[real_cases;gt_aux]);; let gen_thm_noright = prove( - `!P x1 x2. - (x1 < x2) ==> - (!x. x1 < x /\ x < x2 ==> P x) ==> - (!x. (x = x2) ==> P x) ==> - (!x. x2 < x ==> P x) ==> - (!x. x1 < x ==> P x)`, + `!P x1 x2. + (x1 < x2) ==> + (!x. x1 < x /\ x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x ==> P x) ==> + (!x. x1 < x ==> P x)`, MESON_TAC[real_cases;gt_aux]);; let gen_thm_noboth = prove( - `!P Q x2. - Q ==> - (!x. x < x2 ==> P x) ==> - (!x. (x = x2) ==> P x) ==> - (!x. x2 < x ==> P x) ==> - (!x. T ==> P x)`, + `!P Q x2. + Q ==> + (!x. x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x ==> P x) ==> + (!x. T ==> P x)`, MESON_TAC[real_cases;gt_aux]);; diff --git a/Rqe/dedmatrix.ml b/Rqe/dedmatrix.ml index c0bbb7eb..cdff7b94 100644 --- a/Rqe/dedmatrix.ml +++ b/Rqe/dedmatrix.ml @@ -8,18 +8,18 @@ (* ------------------------------------------------------------------------- *) let prove_nonconstant = - let nonconstant_tm = `nonconstant` in - fun pdiff_thm normal_thm -> + let nonconstant_tm = `nonconstant` in + fun pdiff_thm normal_thm -> let thm = ONCE_REWRITE_RULE[GSYM pdiff_thm] normal_thm in let ret = REWRITE_RULE[GSYM NORMAL_PDIFF] thm in let f,_ = strip_comb (concl ret) in if not (f = nonconstant_tm) then failwith "prove_nonconstant" else ret;; -let REMOVE_COLUMN1 mat_thm = +let REMOVE_COLUMN1 mat_thm = let mat_thm1 = MATCH_MP REMOVE_COL1 mat_thm in REWRITE_RULE[MAP;HD;TL] mat_thm1;; -let APPENDIZE l n = +let APPENDIZE l n = let lty = type_of l in let ty = hd(snd(dest_type lty)) in let app_tm = mk_const("APPEND",[ty,aty]) in @@ -30,26 +30,26 @@ let APPENDIZE l n = let REMOVE_INFINITIES thm = let thm' = MATCH_MP INTERPMAT_TRIO thm in let pts,_,sgns = dest_interpmat (concl thm') in - let p_thm = APPENDIZE pts (length (dest_list pts) - 2) in + let p_thm = APPENDIZE pts (length (dest_list pts) - 2) in let pts',_,sgns = dest_interpmat (concl thm') in - let s_thm = APPENDIZE sgns (length (dest_list sgns) - 5) in + let s_thm = APPENDIZE sgns (length (dest_list sgns) - 5) in let thm'' = MATCH_MP INTERPMAT_TRIO_TL (ONCE_REWRITE_RULE[p_thm;s_thm] thm') in REWRITE_RULE[APPEND] thm'';; -let get_dirs = +let get_dirs = let pos = `Pos` in let neg = `Neg` in - fun lb_deriv ub_deriv -> + fun lb_deriv ub_deriv -> if lb_deriv = pos && ub_deriv = pos then INFIN_POS_POS else if lb_deriv = pos && ub_deriv = neg then INFIN_POS_NEG else if lb_deriv = neg && ub_deriv = pos then INFIN_NEG_POS else if lb_deriv = neg && ub_deriv = neg then INFIN_NEG_NEG else failwith "get_dirs: bad signs";; -let get_sing_dirs = +let get_sing_dirs = let pos = `Pos` in let neg = `Neg` in - fun lb_deriv ub_deriv -> + fun lb_deriv ub_deriv -> if lb_deriv = pos && ub_deriv = pos then INFIN_SING_POS_POS else if lb_deriv = pos && ub_deriv = neg then INFIN_SING_POS_NEG else if lb_deriv = neg && ub_deriv = pos then INFIN_SING_NEG_POS @@ -62,15 +62,15 @@ let aitvars,aitdiff,aitnorm,aitmat = ref [],ref TRUTH,ref TRUTH,ref TRUTH;; let vars,diff_thm,normal_thm,mat_thm = !aitvars,!aitdiff,!tnorm,!tmat let vars,diff_thm,normal_thm,mat_thm = vars, pdiff_thm, normal_thm, mat_thm'' *) -let ADD_INFINITIES = - let real_app = `APPEND:real list -> real list -> real list` in +let ADD_INFINITIES = + let real_app = `APPEND:real list -> real list -> real list` in let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in let imat = `interpmat` in let pos = `Pos` in let neg = `Neg` in let sl_ty = `:sign list` in let real_ty = `:real` in - fun vars diff_thm normal_thm mat_thm -> + fun vars diff_thm normal_thm mat_thm -> aitvars := vars; aitdiff := diff_thm; aitnorm := normal_thm; @@ -81,37 +81,37 @@ let ADD_INFINITIES = let p::p'::_ = polsl in let p_thm = ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p))) in let p'_thm = ONCE_REWRITE_RULE[GSYM diff_thm] (ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p')))) in - let pols_thm = REWRITE_CONV[p_thm;p'_thm] pols in + let pols_thm = REWRITE_CONV[p_thm;p'_thm] pols in let sgnsl = dest_list sgns in let sgns_len = length sgnsl in - let thm1 = - if sgns_len = 1 then + let thm1 = + if sgns_len = 1 then let sgn = (hd(tl(dest_list (hd sgnsl)))) in - let mp_thm = - if sgn = pos then INFIN_NIL_POS + let mp_thm = + if sgn = pos then INFIN_NIL_POS else if sgn = neg then INFIN_NIL_NEG else failwith "bad sign in mat" in let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),REFL sgns) in let mat_thm2 = EQ_MP mat_thm1 mat_thm in MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm - else if sgns_len = 3 then + else if sgns_len = 3 then let lb_deriv = hd (tl (dest_list (hd sgnsl))) in let ub_deriv = hd (tl (dest_list (last sgnsl))) in let mp_thm = get_sing_dirs lb_deriv ub_deriv in let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),REFL sgns) in let mat_thm2 = EQ_MP mat_thm1 mat_thm in MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm - else + else let s1,s2 = chop_list (sgns_len - 3) sgnsl in let s3 = mk_list(s1,sl_ty) in let s4 = mk_comb(mk_comb(sign_app,s3),mk_list(s2,sl_ty)) in let sgns_thm = prove(mk_eq(sgns,s4),REWRITE_TAC[APPEND]) in let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),sgns_thm) in - let mat_thm2 = EQ_MP mat_thm1 mat_thm in + let mat_thm2 = EQ_MP mat_thm1 mat_thm in let lb_deriv = hd (tl (dest_list (hd sgnsl))) in let ub_deriv = hd (tl (dest_list (last sgnsl))) in let mp_thm = get_dirs lb_deriv ub_deriv in - MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm in + MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm in let thm2 = REWRITE_RULE[APPEND;GSYM pols_thm] thm1 in let c = concl thm2 in let x,bod = dest_exists c in @@ -119,7 +119,7 @@ let ADD_INFINITIES = let bod1 = subst [x',x] bod in let assume_thm1 = ASSUME bod1 in let x2,bod2 = dest_exists bod1 in - let x'' = new_var real_ty in + let x'' = new_var real_ty in let assume_thm2 = ASSUME (subst [x'',x2] bod2) in assume_thm2,(x',thm2),(x'',assume_thm1);; @@ -134,11 +134,11 @@ reset_timers() let tvars,tsgns,tdivs,tdiff,tnorm,tcont,tmat,tex = ref [],ref [],ref [], ref TRUTH,ref TRUTH, ref (fun x y -> x), ref TRUTH, ref [];; (* let vars,sgns,div_thms,pdiff_thm,normal_thm,cont,mat_thm,ex_thms = !tvars,!tsgns,!tdivs,!tdiff,!tnorm,!tcont,!tmat,!tex -DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms +DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms *) -let DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms = - try +let DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms = + try tvars := vars; tsgns := sgns; tdivs := div_thms; @@ -153,16 +153,16 @@ let DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms = let mat_thm'' = CONDENSE mat_thm' in let mat_thm''',(v1,exthm1),(v2,exthm2) = ADD_INFINITIES vars pdiff_thm normal_thm mat_thm'' in let mat_thm4,new_ex_pairs = INFERISIGN vars pdiff_thm mat_thm''' ((v1,exthm1)::(v2,exthm2)::ex_thms) in - let mat_thm5 = REMOVE_INFINITIES mat_thm4 in + let mat_thm5 = REMOVE_INFINITIES mat_thm4 in let mat_thm6 = REMOVE_COLUMN1 mat_thm5 in let mat_thm7 = CONDENSE mat_thm6 in - (* hack for changing renamed vars *) + (* hack for changing renamed vars *) let mat_thm8 = CONV_RULE (RATOR_CONV (RAND_CONV (LIST_CONV (ALPHA_CONV (hd vars))))) mat_thm7 in - let ex_pairs = [(v1,exthm1);(v2,exthm2)] @ new_ex_pairs in + let ex_pairs = [(v1,exthm1);(v2,exthm2)] @ new_ex_pairs in let cont' mat_thm ex_thms = cont mat_thm (ex_thms @ ex_pairs) in cont' mat_thm8 ex_thms - with (Isign (false_thm,ex_thms)) -> - raise (Isign (false_thm,ex_thms)) + with (Isign (false_thm,ex_thms)) -> + raise (Isign (false_thm,ex_thms)) | Failure x -> failwith ("DEDMATRIX: " ^ x);; (* {{{ Examples *) @@ -170,11 +170,11 @@ let DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms = (* -let NOT_NIL_CONV tm = +let NOT_NIL_CONV tm = let h,t = dest_cons tm in ISPECL [h;t] NOT_CONS_NIL;; -let NORMAL_CONV tm = +let NORMAL_CONV tm = let normalize_thm = POLY_NORMALIZE_CONV (mk_comb (`normalize`,tm)) in let nonnil_thm = NOT_NIL_CONV tm in let conj_thm = CONJ normalize_thm nonnil_thm in @@ -185,26 +185,26 @@ let cont a b = a;; let sgns = [ARITH_RULE `&1 > &0`];; let normal_thm = NORMAL_CONV `[&1; &2; &3]`;; let pdiff_thm = POLY_DIFF_CONV `poly_diff [&1; &1; &1; &1]`;; -let ex_thms = [];; +let ex_thms = [];; let _,l1 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(&1 + x * (&2 + x * &3))`;; let _,l2 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(&2 + x * (-- &3 + x * &1))`;; let _,l3 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(-- &4 + x * (&0 + x * &1))`;; let div_thms = [l1;l2;l3];; -let mat_thm = ASSUME - `interpmat [x1; x2; x3; x4; x5] - [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] - [[Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Zero; Zero; Neg; Neg]; - [Pos; Pos; Neg; Pos; Neg; Neg]; - [Pos; Zero; Neg; Pos; Neg; Zero]; - [Pos; Pos; Neg; Pos; Neg; Pos]; - [Pos; Pos; Zero; Pos; Zero; Pos]; - [Pos; Pos; Neg; Pos; Pos; Pos]; - [Pos; Zero; Neg; Pos; Zero; Pos]; - [Pos; Neg; Neg; Pos; Pos; Pos]; - [Pos; Zero; Zero; Pos; Pos; Pos]; + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Zero; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Zero; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Zero; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos; Pos; Pos]]` ;; time (DEDMATRIX vars sgns div_thms pdiff_thm normal_thm (fun x y -> x) mat_thm) [] @@ -219,19 +219,19 @@ time (DEDMATRIX vars sgns div_thms pdiff_thm normal_thm (fun x y -> x) mat_thm) (* Timing *) (* ---------------------------------------------------------------------- *) -let REMOVE_COLUMN1 mat_thm = +let REMOVE_COLUMN1 mat_thm = let start_time = Sys.time() in let res = REMOVE_COLUMN1 mat_thm in remove_column1_timer +.= (Sys.time() -. start_time); res;; -let ADD_INFINITIES vars pdiff_thm normal_thm mat_thm = +let ADD_INFINITIES vars pdiff_thm normal_thm mat_thm = let start_time = Sys.time() in let res = ADD_INFINITIES vars pdiff_thm normal_thm mat_thm in add_infinities_timer +.= (Sys.time() -. start_time); res;; -let REMOVE_INFINITIES thm = +let REMOVE_INFINITIES thm = let start_time = Sys.time() in let res = REMOVE_INFINITIES thm in remove_infinities_timer +.= (Sys.time() -. start_time); diff --git a/Rqe/dedmatrix_thms.ml b/Rqe/dedmatrix_thms.ml index 4b24cbdf..e54e2680 100644 --- a/Rqe/dedmatrix_thms.ml +++ b/Rqe/dedmatrix_thms.ml @@ -1,6 +1,6 @@ let le_lem = prove_by_refinement( - `(!y. y <= Y ==> P y) ==> - (!y. y < Y ==> P y) /\ + `(!y. y <= Y ==> P y) ==> + (!y. y < Y ==> P y) /\ (!y. (y = Y) ==> P y)`, (* {{{ Proof *) [ @@ -14,7 +14,7 @@ let le_lem = prove_by_refinement( let lt_int_lem = prove_by_refinement( - `(!y. y < Y ==> P y) ==> X < Y ==> + `(!y. y < Y ==> P y) ==> X < Y ==> (!y. X < y /\ y < Y ==> P y)`, (* {{{ Proof *) [ @@ -25,8 +25,8 @@ let lt_int_lem = prove_by_refinement( (* }}} *) let ge_lem = prove_by_refinement( - `(!y. Y <= y ==> P y) ==> - (!y. Y < y ==> P y) /\ + `(!y. Y <= y ==> P y) ==> + (!y. Y < y ==> P y) /\ (!y. (y = Y) ==> P y)`, (* {{{ Proof *) [ @@ -39,7 +39,7 @@ let ge_lem = prove_by_refinement( (* }}} *) let gt_int_lem = prove_by_refinement( - `(!y. Y < y ==> P y) ==> Y < X ==> + `(!y. Y < y ==> P y) ==> Y < X ==> (!y. Y < y /\ y < X ==> P y)`, (* {{{ Proof *) [ @@ -116,9 +116,9 @@ let INTERPSIGN_SUBSET = prove_by_refinement( [ REWRITE_TAC[SUBSET;IN]; REPEAT_N 4 STRIP_TAC; - STRUCT_CASES_TAC (ISPEC `s:sign` SIGN_CASES) THEN + STRUCT_CASES_TAC (ISPEC `s:sign` SIGN_CASES) THEN REWRITE_TAC[interpsign] THEN MESON_TAC[]; -]);; +]);; (* }}} *) let INTERPSIGNS_SUBSET = prove_by_refinement( @@ -129,25 +129,25 @@ let INTERPSIGNS_SUBSET = prove_by_refinement( REPEAT_N 2 STRIP_TAC; LIST_INDUCT_TAC; LIST_INDUCT_TAC; - REWRITE_TAC[ALL2;interpsigns;interpsign]; - REWRITE_TAC[ALL2;interpsigns;interpsign]; + REWRITE_TAC[ALL2;interpsigns;interpsign]; + REWRITE_TAC[ALL2;interpsigns;interpsign]; LIST_INDUCT_TAC; - REWRITE_TAC[ALL2;interpsigns;interpsign]; - REWRITE_TAC[ALL2;interpsigns;interpsign]; - (* save *) + REWRITE_TAC[ALL2;interpsigns;interpsign]; + REWRITE_TAC[ALL2;interpsigns;interpsign]; + (* save *) REPEAT STRIP_TAC; MATCH_MP_TAC INTERPSIGN_SUBSET; ASM_MESON_TAC[SUBSET;IN]; - REWRITE_ASSUMS[ALL2;interpsigns;interpsign]; + REWRITE_ASSUMS[ALL2;interpsigns;interpsign]; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; -]);; +]);; (* }}} *) let NOPOINT_LEM = prove_by_refinement( - `!pl sl. interpsigns pl (\x. T) sl ==> - (interpsigns pl (\x. x < &0) sl /\ - interpsigns pl (\x. x = &0) sl /\ + `!pl sl. interpsigns pl (\x. T) sl ==> + (interpsigns pl (\x. x < &0) sl /\ + interpsigns pl (\x. x = &0) sl /\ interpsigns pl (\x. &0 < x) sl)`, (* {{{ Proof *) diff --git a/Rqe/inferisign.ml b/Rqe/inferisign.ml index 9b404e03..e8eab5bb 100644 --- a/Rqe/inferisign.ml +++ b/Rqe/inferisign.ml @@ -9,69 +9,69 @@ let get_mp = let pos = `Pos` in let zero = `Zero` in let neg = `Neg` in - fun upper_sign lower_sign deriv_sign -> + fun upper_sign lower_sign deriv_sign -> (* Pos Pos *) - if upper_sign = pos && - lower_sign = pos && + if upper_sign = pos && + lower_sign = pos && deriv_sign = pos then INFERISIGN_POS_POS_POS - else if upper_sign = pos && - lower_sign = pos && + else if upper_sign = pos && + lower_sign = pos && deriv_sign = neg then INFERISIGN_POS_POS_NEG (* Pos Neg *) - else if upper_sign = pos && - lower_sign = neg && + else if upper_sign = pos && + lower_sign = neg && deriv_sign = pos then INFERISIGN_POS_NEG_POS - else if upper_sign = pos && - lower_sign = neg && + else if upper_sign = pos && + lower_sign = neg && deriv_sign = neg then INFERISIGN_POS_NEG_NEG (* Pos Zero *) - else if upper_sign = pos && - lower_sign = zero && + else if upper_sign = pos && + lower_sign = zero && deriv_sign = pos then INFERISIGN_POS_ZERO_POS - else if upper_sign = pos && - lower_sign = zero && + else if upper_sign = pos && + lower_sign = zero && deriv_sign = neg then INFERISIGN_POS_ZERO_NEG (* Neg Pos *) - else if upper_sign = neg && - lower_sign = pos && + else if upper_sign = neg && + lower_sign = pos && deriv_sign = pos then INFERISIGN_NEG_POS_POS - else if upper_sign = neg && - lower_sign = pos && + else if upper_sign = neg && + lower_sign = pos && deriv_sign = neg then INFERISIGN_NEG_POS_NEG (* Neg Neg *) - else if upper_sign = neg && - lower_sign = neg && + else if upper_sign = neg && + lower_sign = neg && deriv_sign = pos then INFERISIGN_NEG_NEG_POS - else if upper_sign = neg && - lower_sign = neg && + else if upper_sign = neg && + lower_sign = neg && deriv_sign = neg then INFERISIGN_NEG_NEG_NEG (* Neg Zero *) - else if upper_sign = neg && - lower_sign = zero && + else if upper_sign = neg && + lower_sign = zero && deriv_sign = pos then INFERISIGN_NEG_ZERO_POS - else if upper_sign = neg && - lower_sign = zero && + else if upper_sign = neg && + lower_sign = zero && deriv_sign = neg then INFERISIGN_NEG_ZERO_NEG (* Zero Pos *) - else if upper_sign = zero && - lower_sign = pos && + else if upper_sign = zero && + lower_sign = pos && deriv_sign = pos then INFERISIGN_ZERO_POS_POS - else if upper_sign = zero && - lower_sign = pos && + else if upper_sign = zero && + lower_sign = pos && deriv_sign = neg then INFERISIGN_ZERO_POS_NEG (* Zero Neg *) - else if upper_sign = zero && - lower_sign = neg && + else if upper_sign = zero && + lower_sign = neg && deriv_sign = pos then INFERISIGN_ZERO_NEG_POS - else if upper_sign = zero && - lower_sign = neg && + else if upper_sign = zero && + lower_sign = neg && deriv_sign = neg then INFERISIGN_ZERO_NEG_NEG (* Zero Zero *) - else if upper_sign = zero && - lower_sign = zero && + else if upper_sign = zero && + lower_sign = zero && deriv_sign = pos then INFERISIGN_ZERO_ZERO_POS - else if upper_sign = zero && - lower_sign = zero && + else if upper_sign = zero && + lower_sign = zero && deriv_sign = neg then INFERISIGN_ZERO_ZERO_NEG else failwith "bad signs in thm";; @@ -81,13 +81,13 @@ let tvars,tdiff,tmat,tex = ref [],ref TRUTH,ref TRUTH,ref [];; let vars,diff_thm,mat_thm,ex_thms = !tvars,!tdiff,!tmat,!tex INFERISIGN vars diff_thm mat_thm ex_thms -let vars,diff_thm,mat_thm,ex_thms = vars, pdiff_thm, mat_thm''', ((v1,exthm1)::(v2,exthm2)::ex_thms) +let vars,diff_thm,mat_thm,ex_thms = vars, pdiff_thm, mat_thm''', ((v1,exthm1)::(v2,exthm2)::ex_thms) *) let rec INFERISIGN = - let real_app = `APPEND:real list -> real list -> real list` in + let real_app = `APPEND:real list -> real list -> real list` in let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in - let real_len = `LENGTH:real list -> num` in + let real_len = `LENGTH:real list -> num` in let sign_len = `LENGTH:(sign list) list -> num` in let unknown = `Unknown` in let pos = `Pos` in @@ -101,12 +101,12 @@ let rec INFERISIGN = let f = `F` in let imat = `interpmat` in let sl_ty = `:sign list` in - fun vars diff_thm mat_thm ex_thms -> - try + fun vars diff_thm mat_thm ex_thms -> + try tvars := vars; tdiff := diff_thm; - tmat := mat_thm; - tex := ex_thms; + tmat := mat_thm; + tex := ex_thms; let pts,ps,sgns = dest_interpmat (concl mat_thm) in let pts' = dest_list pts in if pts' = [] then mat_thm,ex_thms else @@ -118,7 +118,7 @@ let rec INFERISIGN = let p_thm = ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p))) in let p'_thm = ONCE_REWRITE_RULE[GSYM diff_thm] (ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p')))) in let pts1,qts1 = chop_list (i / 2 - 1) pts' in - let ps_thm = REWRITE_CONV[p_thm;p'_thm] ps in + let ps_thm = REWRITE_CONV[p_thm;p'_thm] ps in let pts2 = mk_list(pts1,real_ty) in let pts3 = mk_comb(mk_comb(real_app,pts2),mk_list(qts1,real_ty)) in let pts_thm = prove(mk_eq(pts,pts3),REWRITE_TAC[APPEND]) in @@ -130,43 +130,43 @@ let rec INFERISIGN = let len2 = mk_binop num_add (mk_binop num_mul two (mk_comb(real_len,pts2))) one in let len_thm = prove(mk_eq(len1,len2),REWRITE_TAC[LENGTH] THEN ARITH_TAC) in let mat_thm1 = MK_COMB(MK_COMB((AP_TERM imat pts_thm), ps_thm),sgns_thm) in - let mat_thm2 = EQ_MP mat_thm1 mat_thm in + let mat_thm2 = EQ_MP mat_thm1 mat_thm in let upper_sign = hd (ith (i - 1) sgnl) in let lower_sign = hd (ith (i + 1) sgnl) in let deriv_sign = hd (tl (ith i sgnl)) in let mp_thm = get_mp upper_sign lower_sign deriv_sign in - let mat_thm3 = MATCH_MP (MATCH_MP mp_thm mat_thm2) len_thm in + let mat_thm3 = MATCH_MP (MATCH_MP mp_thm mat_thm2) len_thm in let mat_thm4 = REWRITE_RULE[GSYM p_thm;GSYM p'_thm;APPEND] mat_thm3 in let c = concl mat_thm4 in if c = f then raise (Isign (mat_thm4,ex_thms)) else - if not (is_exists c) then + if not (is_exists c) then INFERISIGN vars diff_thm mat_thm4 ex_thms else let x,bod = dest_exists c in - let x' = new_var real_ty in + let x' = new_var real_ty in let assume_thm = ASSUME (subst [x',x] bod) in INFERISIGN vars diff_thm assume_thm ((x',mat_thm4)::ex_thms) - with + with Failure "get_index" -> mat_thm,ex_thms | Failure x -> failwith ("INFERISIGN: " ^ x);; -(* +(* let vars,diff_thm,mat_thm,ex_thms = vars,pdiff_thm, mat_thm''',[] let mat_thm = ASSUME ` interpmat [x_25; x1; x2; x4; x5; x_26] - [\x. &1 + x * (&1 + x * (&1 + x * &1)); \x. &1 + x * (&2 + x * &3); + [\x. &1 + x * (&1 + x * (&1 + x * &1)); \x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1)] - [[Neg; Pos; Pos; Pos]; - [Neg; Pos; Pos; Pos]; - [Unknown; Pos; Pos; Pos]; - [Pos; Pos; Pos; Zero]; - [Unknown; Neg; Pos; Neg]; - [Unknown; Neg; Neg; Neg]; + [[Neg; Pos; Pos; Pos]; + [Neg; Pos; Pos; Pos]; + [Unknown; Pos; Pos; Pos]; + [Pos; Pos; Pos; Zero]; + [Unknown; Neg; Pos; Neg]; + [Unknown; Neg; Neg; Neg]; [Unknown; Neg; Pos; Neg]; - [Pos; Zero; Zero; Neg]; - [Unknown; Pos; Neg; Neg]; - [Pos; Pos; Zero; Zero]; + [Pos; Zero; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; + [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]; - [Pos; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos]]` *) @@ -176,7 +176,7 @@ let mat_thm = ASSUME ` interpmat [x_25; x1; x2; x4; x5; x_26] (* Timing *) (* ---------------------------------------------------------------------- *) -let INFERISIGN vars diff_thm mat_thm ex_thms = +let INFERISIGN vars diff_thm mat_thm ex_thms = let start_time = Sys.time() in let res = INFERISIGN vars diff_thm mat_thm ex_thms in inferisign_timer +.= (Sys.time() -. start_time); @@ -187,7 +187,7 @@ let INFERISIGN vars diff_thm mat_thm ex_thms = (* let is_thms = isigns_thms''' -let vars,diff_thm,mat_thm = +let vars,diff_thm,mat_thm = [`w:real`; `z:real`; `y:real`; `x:real`], ASSUME `poly_diff [&0 + y * (&0 + x * &1); &0 + z * -- &1] = [&0 + z * -- &1]`, ASSUME `interpmat [x_178; x_179] @@ -197,15 +197,15 @@ ASSUME `interpmat [x_178; x_179] INFERISIGN vars pdiff_thm mat_thm let diff -let vars,diff_thm,mat_thm = +let vars,diff_thm,mat_thm = -let vars,diff_thm,mat_thm = +let vars,diff_thm,mat_thm = [`x:real`], ASSUME `poly_diff [&0; &2; &0; &4] = [&2; &0; &12]`, ASSUME `interpmat [x_79; x_68; x_80] - [\x. &0 + x * (&2 + x * (&0 + x * &4)); \x. &2 + x * (&0 + x * &12); + [\x. &0 + x * (&2 + x * (&0 + x * &4)); \x. &2 + x * (&0 + x * &12); \x. &4 + x * (&0 + x * &2)] [[Neg; Pos; Pos]; [Neg; Pos; Pos]; [Unknown; Pos; Pos]; [Unknown; Pos; Pos]; [Unknown; Pos; Pos]; [Pos; Pos; Pos]; [Pos; Pos; Pos]]` @@ -220,20 +220,20 @@ let diff_thm = POLY_DIFF_CONV `poly_diff [&1; &1; &1; &1]`;; let vars = [`x:real`] let mat_thm = ASSUME - `interpmat + `interpmat [xminf; x1; x4; x5; xinf] [\x. &1 + x * (&1 + x * (&1 + x * &1)); \x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1)] - [[Neg; Pos; Pos; Pos]; - [Neg; Pos; Pos; Pos]; - [Unknown; Pos; Pos; Pos]; - [Neg; Pos; Pos; Zero]; - [Unknown; Pos; Pos; Neg]; - [Pos; Pos; Zero; Neg]; - [Unknown; Pos; Neg; Neg]; - [Pos; Pos; Zero; Zero]; - [Unknown; Pos; Pos; Pos]; - [Pos; Pos; Pos; Pos]; - [Pos; Pos; Pos; Pos]]`;; + [[Neg; Pos; Pos; Pos]; + [Neg; Pos; Pos; Pos]; + [Unknown; Pos; Pos; Pos]; + [Neg; Pos; Pos; Zero]; + [Unknown; Pos; Pos; Neg]; + [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; + [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos]]`;; let mat_thm1,_ = INFERISIGN vars diff_thm mat_thm [] diff --git a/Rqe/inferisign_thms.ml b/Rqe/inferisign_thms.ml index c9993374..9df6cb63 100644 --- a/Rqe/inferisign_thms.ml +++ b/Rqe/inferisign_thms.ml @@ -1,7 +1,7 @@ let inferisign_lem00 = prove_by_refinement( - `x1 < x3 ==> x3 < x2 ==> (!x. x1 < x /\ x < x2 ==> P x) ==> - (!x. x1 < x /\ x < x3 ==> P x) /\ - (!x. (x = x3) ==> P x) /\ + `x1 < x3 ==> x3 < x2 ==> (!x. x1 < x /\ x < x2 ==> P x) ==> + (!x. x1 < x /\ x < x3 ==> P x) /\ + (!x. (x = x3) ==> P x) /\ (!x. x3 < x /\ x < x2 ==> P x)`, (* {{{ Proof *) @@ -16,7 +16,7 @@ let inferisign_lem00 = prove_by_refinement( ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; - MATCH_MP_TAC REAL_LT_TRANS; + MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x3`; ASM_REWRITE_TAC[]; ]);; @@ -24,8 +24,8 @@ let inferisign_lem00 = prove_by_refinement( (* }}} *) let neg_neg_neq_thm = prove_by_refinement( - `!x y p. x < y /\ poly p x < &0 /\ poly p y < &0 /\ - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y /\ poly p x < &0 /\ poly p y < &0 /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ @@ -50,7 +50,7 @@ let neg_neg_neq_thm = prove_by_refinement( USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; @@ -94,8 +94,8 @@ let neg_neg_neq_thm = prove_by_refinement( (* }}} *) let neg_neg_neq_thm2 = prove_by_refinement( - `!x y p. x < y ==> poly p x < &0 ==> poly p y < &0 ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y ==> poly p x < &0 ==> poly p y < &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ @@ -106,8 +106,8 @@ let neg_neg_neq_thm2 = prove_by_refinement( (* }}} *) let pos_pos_neq_thm = prove_by_refinement( - `!x y p. x < y /\ &0 < poly p x /\ &0 < poly p y /\ - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y /\ &0 < poly p x /\ &0 < poly p y /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> &0 < poly p z)`, (* {{{ Proof *) [ @@ -132,7 +132,7 @@ let pos_pos_neq_thm = prove_by_refinement( USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; @@ -176,8 +176,8 @@ let pos_pos_neq_thm = prove_by_refinement( (* }}} *) let pos_pos_neq_thm2 = prove_by_refinement( - `!x y p. x < y ==> poly p x > &0 ==> poly p y > &0 ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y ==> poly p x > &0 ==> poly p y > &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) [ @@ -189,10 +189,10 @@ let pos_pos_neq_thm2 = prove_by_refinement( (* }}} *) let pos_neg_neq_thm = prove_by_refinement( - `!x y p. x < y /\ &0 < poly p x /\ poly p y < &0 /\ - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> - ?X. x < X /\ X < y /\ (poly p X = &0) /\ - (!z. x < z /\ z < X ==> &0 < poly p z) /\ + `!x y p. x < y /\ &0 < poly p x /\ poly p y < &0 /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ (poly p X = &0) /\ + (!z. x < z /\ z < X ==> &0 < poly p z) /\ (!z. X < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) @@ -207,7 +207,7 @@ let pos_neg_neq_thm = prove_by_refinement( ASM_REWRITE_TAC[]; STRIP_TAC; REPEAT STRIP_TAC; - (* save *) + (* save *) ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); @@ -229,10 +229,10 @@ let pos_neg_neq_thm = prove_by_refinement( USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; - DISCH_THEN (X_CHOOSE_TAC `M:real`); + DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 < &0 - poly p z`; LABEL_ALL_TAC; @@ -263,7 +263,7 @@ let pos_neg_neq_thm = prove_by_refinement( ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; - (* save *) + (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; @@ -276,7 +276,7 @@ let pos_neg_neq_thm = prove_by_refinement( EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) POP_ASSUM (ASSUME_TAC o GSYM); MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; @@ -297,7 +297,7 @@ let pos_neg_neq_thm = prove_by_refinement( EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) REPEAT STRIP_TAC; ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; @@ -319,11 +319,11 @@ let pos_neg_neq_thm = prove_by_refinement( USE_THEN "Z-7" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); LABEL_ALL_TAC; USE_THEN "Z-6" (REWRITE_TAC o list); - DISCH_THEN (X_CHOOSE_TAC `M:real`); + DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `poly p y - poly p z < &0`; LABEL_ALL_TAC; @@ -355,7 +355,7 @@ let pos_neg_neq_thm = prove_by_refinement( ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; - (* save *) + (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; @@ -368,7 +368,7 @@ let pos_neg_neq_thm = prove_by_refinement( EXISTS_TAC `M`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; REAL_SIMP_TAC; @@ -394,11 +394,11 @@ let pos_neg_neq_thm = prove_by_refinement( let pos_neg_neq_thm2 = prove_by_refinement( - `!x y p. x < y ==> poly p x > &0 ==> poly p y < &0 ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> - ?X. x < X /\ X < y /\ - (!z. (z = X) ==> (poly p z = &0)) /\ - (!z. x < z /\ z < X ==> poly p z > &0) /\ + `!x y p. x < y ==> poly p x > &0 ==> poly p y < &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ + (!z. (z = X) ==> (poly p z = &0)) /\ + (!z. x < z /\ z < X ==> poly p z > &0) /\ (!z. X < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ @@ -413,10 +413,10 @@ let pos_neg_neq_thm2 = prove_by_refinement( (* }}} *) let neg_pos_neq_thm = prove_by_refinement( - `!x y p. x < y /\ poly p x < &0 /\ &0 < poly p y /\ - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> - ?X. x < X /\ X < y /\ (poly p X = &0) /\ - (!z. x < z /\ z < X ==> poly p z < &0) /\ + `!x y p. x < y /\ poly p x < &0 /\ &0 < poly p y /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ (poly p X = &0) /\ + (!z. x < z /\ z < X ==> poly p z < &0) /\ (!z. X < z /\ z < y ==> &0 < poly p z)`, (* {{{ Proof *) @@ -431,7 +431,7 @@ let neg_pos_neq_thm = prove_by_refinement( ASM_REWRITE_TAC[]; STRIP_TAC; REPEAT STRIP_TAC; - (* save *) + (* save *) ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); @@ -453,10 +453,10 @@ let neg_pos_neq_thm = prove_by_refinement( USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; - DISCH_THEN (X_CHOOSE_TAC `M:real`); + DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 - poly p z < &0`; LABEL_ALL_TAC; @@ -487,7 +487,7 @@ let neg_pos_neq_thm = prove_by_refinement( ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; - (* save *) + (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; @@ -500,7 +500,7 @@ let neg_pos_neq_thm = prove_by_refinement( EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; REAL_SIMP_TAC; @@ -520,7 +520,7 @@ let neg_pos_neq_thm = prove_by_refinement( EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) REPEAT STRIP_TAC; ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; @@ -542,11 +542,11 @@ let neg_pos_neq_thm = prove_by_refinement( USE_THEN "Z-7" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); LABEL_ALL_TAC; USE_THEN "Z-6" (REWRITE_TAC o list); - DISCH_THEN (X_CHOOSE_TAC `M:real`); + DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 < poly p y - poly p z`; LABEL_ALL_TAC; @@ -578,7 +578,7 @@ let neg_pos_neq_thm = prove_by_refinement( ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; - (* save *) + (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; @@ -591,7 +591,7 @@ let neg_pos_neq_thm = prove_by_refinement( EXISTS_TAC `M`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) POP_ASSUM (ASSUME_TAC o GSYM); MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; @@ -617,11 +617,11 @@ let neg_pos_neq_thm = prove_by_refinement( (* }}} *) let neg_pos_neq_thm2 = prove_by_refinement( - `!x y p. x < y ==> poly p x < &0 ==> poly p y > &0 ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> - ?X. x < X /\ X < y /\ - (!z. (z = X) ==> (poly p z = &0)) /\ - (!z. x < z /\ z < X ==> poly p z < &0) /\ + `!x y p. x < y ==> poly p x < &0 ==> poly p y > &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ + (!z. (z = X) ==> (poly p z = &0)) /\ + (!z. x < z /\ z < X ==> poly p z < &0) /\ (!z. X < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) [ @@ -653,7 +653,7 @@ let gt_nz_thm = prove_by_refinement( (* }}} *) let eq_eq_false_thm = prove_by_refinement( - `!x y p. x < y ==> (poly p x = &0) ==> (poly p y = &0) ==> + `!x y p. x < y ==> (poly p x = &0) ==> (poly p y = &0) ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> F`, (* {{{ Proof *) @@ -667,7 +667,7 @@ let eq_eq_false_thm = prove_by_refinement( ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_THEN (REWRITE_ASSUMS o list); - CLAIM `&0 < y - x`; + CLAIM `&0 < y - x`; USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; POP_ASSUM (MP_TAC o ISPEC `x':real`); RULE_ASSUM_TAC GSYM; @@ -681,8 +681,8 @@ let eq_eq_false_thm = prove_by_refinement( (* }}} *) let neg_zero_neg_thm = prove_by_refinement( - `!x y p. x < y ==> poly p x < &0 ==> (poly p y = &0) ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y ==> poly p x < &0 ==> (poly p y = &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) @@ -714,7 +714,7 @@ let neg_zero_neg_thm = prove_by_refinement( DISJ2_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_ANTISYM]; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; @@ -736,7 +736,7 @@ let neg_zero_neg_thm = prove_by_refinement( REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; - (* save *) + (* save *) CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; @@ -755,7 +755,7 @@ let neg_zero_neg_thm = prove_by_refinement( EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) MP_TAC (ISPECL[`z:real`;`y:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; @@ -770,8 +770,8 @@ let neg_zero_neg_thm = prove_by_refinement( (* }}} *) let pos_zero_pos_thm = prove_by_refinement( - `!x y p. x < y ==> poly p x > &0 ==> (poly p y = &0) ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y ==> poly p x > &0 ==> (poly p y = &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) @@ -803,7 +803,7 @@ let pos_zero_pos_thm = prove_by_refinement( DISJ2_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_ANTISYM]; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; @@ -825,7 +825,7 @@ let pos_zero_pos_thm = prove_by_refinement( REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; - (* save *) + (* save *) CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; @@ -844,7 +844,7 @@ let pos_zero_pos_thm = prove_by_refinement( EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) MP_TAC (ISPECL[`z:real`;`y:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; @@ -859,8 +859,8 @@ let pos_zero_pos_thm = prove_by_refinement( (* }}} *) let zero_neg_neg_thm = prove_by_refinement( - `!x y p. x < y ==> (poly p x = &0) ==> (poly p y < &0) ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y ==> (poly p x = &0) ==> (poly p y < &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) @@ -892,7 +892,7 @@ let zero_neg_neg_thm = prove_by_refinement( DISJ2_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_ANTISYM]; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; @@ -915,7 +915,7 @@ let zero_neg_neg_thm = prove_by_refinement( REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; - (* save *) + (* save *) CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; @@ -934,7 +934,7 @@ let zero_neg_neg_thm = prove_by_refinement( EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) MP_TAC (ISPECL[`x:real`;`z:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; @@ -949,8 +949,8 @@ let zero_neg_neg_thm = prove_by_refinement( (* }}} *) let zero_pos_pos_thm = prove_by_refinement( - `!x y p. x < y ==> (poly p x = &0) ==> (poly p y > &0) ==> - (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + `!x y p. x < y ==> (poly p x = &0) ==> (poly p y > &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) @@ -977,7 +977,7 @@ let zero_pos_pos_thm = prove_by_refinement( USE_THEN "Z-1" MP_TAC; USE_THEN "Z-7" MP_TAC; REAL_ARITH_TAC; - (* save *) + (* save *) MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; @@ -999,7 +999,7 @@ let zero_pos_pos_thm = prove_by_refinement( REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; - (* save *) + (* save *) CLAIM `x'' < x'`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; @@ -1018,7 +1018,7 @@ let zero_pos_pos_thm = prove_by_refinement( EXISTS_TAC `x'`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; - (* save *) + (* save *) MP_TAC (ISPECL[`x:real`;`z:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; diff --git a/Rqe/inferpsign.ml b/Rqe/inferpsign.ml index 76cd756e..b61c2c17 100644 --- a/Rqe/inferpsign.ml +++ b/Rqe/inferpsign.ml @@ -11,15 +11,15 @@ (* ---------------------------------------------------------------------- *) -let isign_eq_zero thm = +let isign_eq_zero thm = let __,_,sign = dest_interpsign thm in sign = szero_tm;; -let isign_lt_zero thm = +let isign_lt_zero thm = let __,_,sign = dest_interpsign thm in sign = sneg_tm;; -let isign_gt_zero thm = +let isign_gt_zero thm = let __,_,sign = dest_interpsign thm in sign = spos_tm;; @@ -42,20 +42,20 @@ let inferpsign_row vars sgns p_thm q_thm div_thms = let pq,r = dest_plus pqr in let p,q = dest_mult pq in let parity_thm = PARITY_CONV k in - let evenp = fst(dest_comb (concl parity_thm)) = even_tm in + let evenp = fst(dest_comb (concl parity_thm)) = even_tm in let sign_thm = FINDSIGN vars sgns a in let op,_,_ = get_binop (concl sign_thm) in - if evenp then - let nz_thm = - if op = rlt then MATCH_MP ips_lt_nz_thm sign_thm - else if op = rgt then MATCH_MP ips_gt_nz_thm sign_thm - else if op = rneq then sign_thm + if evenp then + let nz_thm = + if op = rlt then MATCH_MP ips_lt_nz_thm sign_thm + else if op = rgt then MATCH_MP ips_gt_nz_thm sign_thm + else if op = rneq then sign_thm else failwith "inferpsign: 0" in - let imp_thms = + let imp_thms = CONJUNCTS(ISPEC set (MATCH_MPL[EVEN_DIV_LEM;div_thm';nz_thm;parity_thm])) in let _,_,qsign = dest_interpsign qthm in - let mp_thm = - if qsign = sneg_tm then ith 0 imp_thms + let mp_thm = + if qsign = sneg_tm then ith 0 imp_thms else if qsign = spos_tm then ith 1 imp_thms else if qsign = szero_tm then ith 2 imp_thms else failwith "inferpsign: 1" in @@ -63,17 +63,17 @@ let inferpsign_row vars sgns p_thm q_thm div_thms = mk_interpsigns (final_thm::pthms) else (* k is odd *) if op = rgt then (* a > &0 *) - let imp_thms = + let imp_thms = CONJUNCTS(ISPEC set (MATCH_MPL[GT_DIV_LEM;div_thm';sign_thm])) in let _,_,qsign = dest_interpsign qthm in - let mp_thm = - if qsign = sneg_tm then ith 0 imp_thms + let mp_thm = + if qsign = sneg_tm then ith 0 imp_thms else if qsign = spos_tm then ith 1 imp_thms else if qsign = szero_tm then ith 2 imp_thms else failwith "inferpsign: 1" in let final_thm = MATCH_MPL[mp_thm;pthm;qthm] in mk_interpsigns (final_thm::pthms) - else + else failwith "inferpsign: shouldn`t reach this point with an odd power and negative sign! See PDIVIDES and return the correct div_thm" else (* no zero *) let p = snd(dest_mult (lhs(concl (hd div_thms)))) in @@ -82,12 +82,12 @@ let inferpsign_row vars sgns p_thm q_thm div_thms = mk_interpsigns (pthm::pthms);; (* {{{ Doc *) -(* +(* split_interpsigns |- interpsigns [p0; p1; p2; q0; q1; q2] (\x. x < x1) - [Pos; Pos; Pos; Neg; Neg; Neg] + [Pos; Pos; Pos; Neg; Neg; Neg] --> @@ -100,25 +100,25 @@ split_interpsigns |- interpsigns [q0; q1; q2] (\x. x < x1) - [ Neg; Neg; Neg] + [ Neg; Neg; Neg] ) *) (* }}} *) -let split_interpsigns thm = +let split_interpsigns thm = let thms = interpsigns_thms2 thm in let n = length thms / 2 in let l,r = chop_list n thms in (mk_interpsigns l,mk_interpsigns r);; -let INFERPSIGN vars sgns mat_thm div_thms = +let INFERPSIGN vars sgns mat_thm div_thms = let pts,pols,signs = dest_interpmat (concl mat_thm) in let n = length (dest_list pols) / 2 in let rol_thm,sgn_thm = interpmat_thms mat_thm in let part_thm = PARTITION_LINE_CONV (snd (dest_comb (concl rol_thm))) in let conj_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] sgn_thm) in - let split_thms = map split_interpsigns conj_thms in + let split_thms = map split_interpsigns conj_thms in let conj_thms' = map (fun (x,y) -> inferpsign_row vars sgns x y div_thms) split_thms in - let all_thm = mk_all2_interpsigns part_thm conj_thms' in + let all_thm = mk_all2_interpsigns part_thm conj_thms' in let mat_thm' = mk_interpmat_thm rol_thm all_thm in mat_thm';; @@ -132,32 +132,32 @@ let MK_REP = let one = `1` in let two = `2` in let unknown = `Unknown` in - fun pts -> + fun pts -> let num = mk_binop np (mk_binop nm two (mk_comb(len_tm,pts))) one in let len = length (dest_list pts) in - let num2 = MK_SUC (2 * len + 1) in + let num2 = MK_SUC (2 * len + 1) in let lthm = ARITH_SIMP_CONV[LENGTH] num in let lthm2 = TRANS lthm num2 in let lthm3 = AP_THM (AP_TERM rep_tm lthm2) unknown in REWRITE_RULE[REPLICATE] lthm3;; -let INSERT_UNKNOWN_COL = - fun mat_thm p -> +let INSERT_UNKNOWN_COL = + fun mat_thm p -> let pts,_,_ = dest_interpmat (concl mat_thm) in - let rep_thm = MK_REP pts in + let rep_thm = MK_REP pts in let mat_thm' = MATCH_MP INFERPSIGN_MATINSERT_THM mat_thm in let mat_thm'' = PURE_REWRITE_RULE[MAP2;rep_thm] mat_thm' in ISPEC p mat_thm'';; -let REMOVE_QS = - fun mat_thm -> +let REMOVE_QS = + fun mat_thm -> let _,pols,_ = dest_interpmat (concl mat_thm) in let len = length (dest_list pols) in if not (len mod 2 = 1) then failwith "odd pols?" else let mat_thm' = funpow (len / 2) (MATCH_MP REMOVE_LAST) mat_thm in REWRITE_RULE[MAP;BUTLAST;NOT_CONS_NIL;TL;HD;] mat_thm';; -let SPLIT_LIST n l ty = +let SPLIT_LIST n l ty = let l' = dest_list l in let l1',l2' = chop_list n l' in let l1,l2 = (mk_list(l1',ty),mk_list(l2',ty)) in @@ -169,11 +169,11 @@ let SPLIT_LIST n l ty = let thm = asign *) -let prove_nonzero thm = +let prove_nonzero thm = let op,_,_ = get_binop (concl thm) in if op = rgt then MATCH_MP ips_gt_nz_thm thm else if op = rlt then MATCH_MP ips_lt_nz_thm thm - else if op = rneq then thm + else if op = rneq then thm else failwith "prove_nonzero: bad op";; (* @@ -182,7 +182,7 @@ let ind = 7 *) -let INFERPT = +let INFERPT = let unknown = `Unknown` in let zero = `Zero` in let pos = `Pos` in @@ -198,8 +198,8 @@ let INFERPT = let s_length = mk_const("LENGTH",[s_ty,aty]) in let sl_length = mk_const("LENGTH",[sl_ty,aty]) in let imat = `interpmat` in - fun vars sgns mat_thm div_thms ind -> - let pts,pols,signs = dest_interpmat (concl mat_thm) in + fun vars sgns mat_thm div_thms ind -> + let pts,pols,signs = dest_interpmat (concl mat_thm) in let pols' = dest_list pols in let signsl = dest_list signs in let signs' = map dest_list signsl in @@ -208,36 +208,36 @@ let INFERPT = let pt_sgnl = ith ind signsl in let pt_sgns = ith ind signs' in let zind = index zero pt_sgns in - if zind > pols_len2 then mat_thm else (* return if not a zero of a p, only a q *) + if zind > pols_len2 then mat_thm else (* return if not a zero of a p, only a q *) let psgn = ith (pols_len2 + zind) pt_sgns in - let div_thm = ith (zind - 1) div_thms in + let div_thm = ith (zind - 1) div_thms in let a,n = dest_binop pow (fst (dest_binop rm (lhs (concl div_thm)))) in let asign = FINDSIGN vars sgns a in let op,_,_ = get_binop (concl asign) in let par_thm = PARITY_CONV n in let par = fst(dest_comb(concl par_thm)) in - let mp_thm = + let mp_thm = (* note: by def of PDIVIDES, we can`t have negative sign and odd power at this point *) (* n is even *) - if par = even_tm then + if par = even_tm then if psgn = pos then INFERPSIGN_POS_EVEN else if psgn = neg then INFERPSIGN_NEG_EVEN else if psgn = zero then INFERPSIGN_ZERO_EVEN else failwith "INFERPT: bad sign" else (* n is odd *) - if psgn = pos then INFERPSIGN_POS_ODD_POS - else if psgn = neg then INFERPSIGN_NEG_ODD_POS - else if psgn = zero then INFERPSIGN_ZERO_ODD_POS + if psgn = pos then INFERPSIGN_POS_ODD_POS + else if psgn = neg then INFERPSIGN_NEG_ODD_POS + else if psgn = zero then INFERPSIGN_ZERO_ODD_POS else failwith "INFERPT: bad sign" in (* pols *) - let split_pols1 = SPLIT_LIST zind pols rr_ty in + let split_pols1 = SPLIT_LIST zind pols rr_ty in let _,l2 = chop_list zind pols' in let split_pols2 = SPLIT_LIST pols_len2 (mk_list(l2,rr_ty)) rr_ty in let s1,t1 = dest_comb (rhs (concl split_pols1)) in let split_pols_thm = TRANS split_pols1 (AP_TERM s1 split_pols2) in (* pt_sgns *) - let split_sgns1 = SPLIT_LIST zind pt_sgnl s_ty in + let split_sgns1 = SPLIT_LIST zind pt_sgnl s_ty in let _,l3 = chop_list zind pt_sgns in let split_sgns2 = SPLIT_LIST pols_len2 (mk_list(l3,s_ty)) s_ty in let s2,t2 = dest_comb (rhs (concl split_sgns1)) in @@ -256,30 +256,30 @@ let INFERPT = (* length thms *) (* LENGTH ps = LENGTH s1 *) let ps = mk_list(tl(dest_list(snd(dest_comb s1))),rr_ty) in - let ps_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,ps)) in + let ps_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,ps)) in let ss = mk_list(tl(dest_list(snd(dest_comb s2))),s_ty) in - let ss_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,ss)) in + let ss_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,ss)) in let ps_s1_thm = TRANS ps_len (SYM ss_len) in (* LENGTH qs = LENGTH s2 *) let k1 = tl (fst (chop_list pols_len2 (dest_list t1))) in - let qs = mk_list(k1,rr_ty) in - let qs_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,qs)) in + let qs = mk_list(k1,rr_ty) in + let qs_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,qs)) in let k2 = tl (fst (chop_list pols_len2 (dest_list t2))) in - let s2s = mk_list(k2,s_ty) in - let s2s_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,s2s)) in + let s2s = mk_list(k2,s_ty) in + let s2s_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,s2s)) in let qs_s2_thm = TRANS qs_len (SYM s2s_len) in (* ODD (LENGTH sgns) *) let _,hdsgns = dest_comb r1 in - let odd_thm = EQT_ELIM(REWRITE_CONV[LENGTH;ODD;EVEN;NOT_ODD;NOT_EVEN] (mk_comb(odd_tm,mk_comb(sl_length,hdsgns)))) in + let odd_thm = EQT_ELIM(REWRITE_CONV[LENGTH;ODD;EVEN;NOT_ODD;NOT_EVEN] (mk_comb(odd_tm,mk_comb(sl_length,hdsgns)))) in (* a <> 0 *) - let a_thm = - if par = even_tm then prove_nonzero asign + let a_thm = + if par = even_tm then prove_nonzero asign else asign in - let div_thm' = GEN (hd vars) div_thm in + let div_thm' = GEN (hd vars) div_thm in (* main *) let thm1 = BETA_RULE(MATCH_MPL[mp_thm;mat_thm3;ps_s1_thm;qs_s2_thm;odd_thm]) in - let thm2 = - if par = even_tm then MATCH_MPL[thm1;div_thm';a_thm;par_thm] + let thm2 = + if par = even_tm then MATCH_MPL[thm1;div_thm';a_thm;par_thm] else MATCH_MPL[thm1;div_thm';a_thm] in REWRITE_RULE[APPEND] thm2;; @@ -314,7 +314,7 @@ let INFERPSIGN2 vars sgns mat_thm div_thms = (* Timing *) (* ---------------------------------------------------------------------- *) -let INFERPSIGN vars sgns mat_thm div_thms = +let INFERPSIGN vars sgns mat_thm div_thms = let start_time = Sys.time() in let res = INFERPSIGN vars sgns mat_thm div_thms in inferpsign_timer +.= (Sys.time() -. start_time); @@ -322,31 +322,31 @@ let INFERPSIGN vars sgns mat_thm div_thms = (* -let l1 = PDIVIDE [`x:real`] +let l1 = PDIVIDE [`x:real`] `&1 + x * (&1 + x * (&1 + x * &1))` `&1 + x * (&2 + x * &3)`;; -let l2 = PDIVIDE [`x:real`] +let l2 = PDIVIDE [`x:real`] `&1 + x * (&1 + x * (&1 + x * &1))` `&2 + x * (-- &3 + x * &1)`;; -let l3 = PDIVIDE [`x:real`] +let l3 = PDIVIDE [`x:real`] `&1 + x * (&1 + x * (&1 + x * &1))` `-- &4 + x * (&0 + x * &1)`;; let div_thms = [l1;l2;l3];; let vars = [`x:real`];; let sgns = [ARITH_RULE `&1 > &0`];; -let mat_thm = ASSUME - `interpmat [x1; x2; x3; x4; x5] - [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] - [[Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Zero; Zero; Neg; Neg]; - [Pos; Pos; Neg; Pos; Neg; Neg]; - [Pos; Pos; Neg; Pos; Neg; Zero]; - [Pos; Pos; Neg; Pos; Neg; Pos]; - [Pos; Pos; Neg; Pos; Zero; Pos]; - [Pos; Pos; Neg; Pos; Pos; Pos]; - [Pos; Zero; Neg; Pos; Pos; Pos]; - [Pos; Neg; Neg; Pos; Pos; Pos]; - [Pos; Zero; Zero; Pos; Pos; Pos]; + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos; Pos; Pos]]` ;; INFERPSIGN vars sgns mat_thm div_thms diff --git a/Rqe/inferpsign_thms.ml b/Rqe/inferpsign_thms.ml index 37387ca2..07dc7a41 100644 --- a/Rqe/inferpsign_thms.ml +++ b/Rqe/inferpsign_thms.ml @@ -1,16 +1,16 @@ let EVEN_DIV_LEM = prove_by_refinement( - `!set p q c d a n. - (!x. a pow n * p x = c x * q x + d x) ==> - a <> &0 ==> - EVEN n ==> - ((interpsign set q Zero) ==> - (interpsign set d Neg) ==> - (interpsign set p Neg)) /\ - ((interpsign set q Zero) ==> - (interpsign set d Pos) ==> - (interpsign set p Pos)) /\ - ((interpsign set q Zero) ==> - (interpsign set d Zero) ==> + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> + a <> &0 ==> + EVEN n ==> + ((interpsign set q Zero) ==> + (interpsign set d Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) @@ -22,7 +22,7 @@ let EVEN_DIV_LEM = prove_by_refinement( POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; - CLAIM `&0 < a pow n`; + CLAIM `&0 < a pow n`; ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; STRIP_TAC; CLAIM `a pow n * p x < &0`; @@ -35,7 +35,7 @@ let EVEN_DIV_LEM = prove_by_refinement( POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; - CLAIM `&0 < a pow n`; + CLAIM `&0 < a pow n`; ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; STRIP_TAC; CLAIM `a pow n * p x > &0`; @@ -48,7 +48,7 @@ let EVEN_DIV_LEM = prove_by_refinement( POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; - CLAIM `&0 < a pow n`; + CLAIM `&0 < a pow n`; ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; STRIP_TAC; CLAIM `a pow n * p x = &0`; @@ -61,17 +61,17 @@ let EVEN_DIV_LEM = prove_by_refinement( (* }}} *) let GT_DIV_LEM = prove_by_refinement( - `!set p q c d a n. - (!x. a pow n * p x = c x * q x + d x) ==> - a > &0 ==> - ((interpsign set q Zero) ==> - (interpsign set d Neg) ==> - (interpsign set p Neg)) /\ - ((interpsign set q Zero) ==> - (interpsign set d Pos) ==> - (interpsign set p Pos)) /\ - ((interpsign set q Zero) ==> - (interpsign set d Zero) ==> + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> + a > &0 ==> + ((interpsign set q Zero) ==> + (interpsign set d Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) [ @@ -91,7 +91,7 @@ let GT_DIV_LEM = prove_by_refinement( REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; @@ -114,18 +114,18 @@ let GT_DIV_LEM = prove_by_refinement( (* }}} *) let NEG_ODD_LEM = prove_by_refinement( - `!set p q c d a n. - (!x. a pow n * p x = c x * q x + d x) ==> + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> a < &0 ==> - ODD n ==> - ((interpsign set q Zero) ==> - (interpsign set (\x. -- d x) Neg) ==> - (interpsign set p Neg)) /\ - ((interpsign set q Zero) ==> - (interpsign set (\x. -- d x) Pos) ==> - (interpsign set p Pos)) /\ - ((interpsign set q Zero) ==> - (interpsign set (\x. -- d x) Zero) ==> + ODD n ==> + ((interpsign set q Zero) ==> + (interpsign set (\x. -- d x) Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. -- d x) Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. -- d x) Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) [ @@ -146,7 +146,7 @@ let NEG_ODD_LEM = prove_by_refinement( REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; @@ -169,18 +169,18 @@ let NEG_ODD_LEM = prove_by_refinement( (* }}} *) let NEQ_ODD_LEM = prove_by_refinement( - `!set p q c d a n. - (!x. a pow n * p x = c x * q x + d x) ==> + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> a <> &0 ==> - ODD n ==> - ((interpsign set q Zero) ==> - (interpsign set (\x. a * d x) Neg) ==> - (interpsign set p Neg)) /\ - ((interpsign set q Zero) ==> - (interpsign set (\x. a * d x) Pos) ==> - (interpsign set p Pos)) /\ - ((interpsign set q Zero) ==> - (interpsign set (\x. a * d x) Zero) ==> + ODD n ==> + ((interpsign set q Zero) ==> + (interpsign set (\x. a * d x) Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. a * d x) Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. a * d x) Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) [ @@ -192,7 +192,7 @@ let NEQ_ODD_LEM = prove_by_refinement( ASM_REWRITE_TAC[]; LABEL_ALL_TAC; STRIP_TAC; - (* save *) + (* save *) CLAIM `a pow n < &0`; ASM_MESON_TAC[PARITY_POW_LT]; STRIP_TAC; @@ -219,7 +219,7 @@ let NEQ_ODD_LEM = prove_by_refinement( REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; @@ -252,7 +252,7 @@ let NEQ_ODD_LEM = prove_by_refinement( CLAIM `a pow n * p x = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; - (* save *) + (* save *) CLAIM `a pow n > &0`; ASM_MESON_TAC[EVEN_ODD_POW;NEQ;real_gt]; STRIP_TAC; @@ -283,7 +283,7 @@ let NEQ_ODD_LEM = prove_by_refinement( REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; - (* save *) + (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; @@ -320,37 +320,37 @@ let NEQ_ODD_LEM = prove_by_refinement( (* }}} *) let NEQ_MULT_LT_LEM = prove_by_refinement( - `!a q d d' set. + `!a q d d' set. a < &0 ==> - ((interpsign set d Neg) ==> - (interpsign set (\x. a * d x) Pos)) /\ - ((interpsign set d Pos) ==> - (interpsign set (\x. a * d x) Neg)) /\ - ((interpsign set d Zero) ==> + ((interpsign set d Neg) ==> + (interpsign set (\x. a * d x) Pos)) /\ + ((interpsign set d Pos) ==> + (interpsign set (\x. a * d x) Neg)) /\ + ((interpsign set d Zero) ==> (interpsign set (\x. a * d x) Zero))`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;POLY_NEG]; REPEAT STRIP_TAC; - ASM_MESON_TAC[REAL_MUL_GT;real_gt]; - ASM_MESON_TAC[REAL_MUL_LT;real_gt]; + ASM_MESON_TAC[REAL_MUL_GT;real_gt]; + ASM_MESON_TAC[REAL_MUL_LT;real_gt]; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; ]);; (* }}} *) let NEQ_MULT_GT_LEM = prove_by_refinement( - `!a q d d' set. + `!a q d d' set. a > &0 ==> - ((interpsign set d Neg) ==> - (interpsign set (\x. a * d x) Neg)) /\ - ((interpsign set d Pos) ==> - (interpsign set (\x. a * d x) Pos)) /\ - ((interpsign set d Zero) ==> + ((interpsign set d Neg) ==> + (interpsign set (\x. a * d x) Neg)) /\ + ((interpsign set d Pos) ==> + (interpsign set (\x. a * d x) Pos)) /\ + ((interpsign set d Zero) ==> (interpsign set (\x. a * d x) Zero))`, (* {{{ Proof *) [ - REWRITE_TAC[interpsign;POLY_NEG] THEN - MESON_TAC[REAL_MUL_LT;REAL_ENTIRE;REAL_NOT_EQ;REAL_MUL_GT;real_gt]; + REWRITE_TAC[interpsign;POLY_NEG] THEN + MESON_TAC[REAL_MUL_LT;REAL_ENTIRE;REAL_NOT_EQ;REAL_MUL_GT;real_gt]; ]);; (* }}} *) diff --git a/Rqe/lift_qelim.ml b/Rqe/lift_qelim.ml index 0af26fff..618f28df 100644 --- a/Rqe/lift_qelim.ml +++ b/Rqe/lift_qelim.ml @@ -28,7 +28,7 @@ let QE_SIMPLIFY_CONV = TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;; -let OR_ASSOC = TAUT `(a \/ b) \/ c <=> a \/ b \/ c`;; +let OR_ASSOC = TAUT `(a \/ b) \/ c <=> a \/ b \/ c`;; let forall_thm = prove(`!P. (!x. P x) <=> ~ (?x. ~ P x)`,MESON_TAC[]) and or_exists_conv = PURE_REWRITE_CONV[OR_EXISTS_THM] and triv_exists_conv = REWR_CONV EXISTS_SIMP @@ -87,15 +87,15 @@ let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = (* -let afn_conv,nfn_conv,qfn_conv = POLYATOM_CONV,(EVALC_CONV THENC SIMPLIFY_CONV),BASIC_REAL_QELIM_CONV -let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = +let afn_conv,nfn_conv,qfn_conv = POLYATOM_CONV,(EVALC_CONV THENC SIMPLIFY_CONV),BASIC_REAL_QELIM_CONV +let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = fun fm -> ((qelift_conv (frees fm)) THENC QE_SIMPLIFY_CONV) fm;; let k0 = (TRANS thm1a thm2a) let k1 = thm3a let k2 = CONV_RULE (LAND_CONV (RAND_CONV (ALPHA_CONV `x:real`))) k1 -TRANS k0 k2 +TRANS k0 k2 let vars = [] diff --git a/Rqe/list_rewrites.ml b/Rqe/list_rewrites.ml index 0584fd51..65140106 100644 --- a/Rqe/list_rewrites.ml +++ b/Rqe/list_rewrites.ml @@ -28,9 +28,9 @@ NOT_NIL; let LIST_SIMP_TAC = REWRITE_TAC ( !LIST_REWRITES -);; +);; -let extend_list_rewrites l = +let extend_list_rewrites l = LIST_REWRITES := !LIST_REWRITES @ l;; BASIC_REWRITES := !LIST_REWRITES @ !BASIC_REWRITES;; diff --git a/Rqe/main_thms.ml b/Rqe/main_thms.ml index 0d245fd3..f8321895 100644 --- a/Rqe/main_thms.ml +++ b/Rqe/main_thms.ml @@ -11,24 +11,24 @@ let empty_mat = prove_by_refinement( let empty_sgns = [ARITH_RULE `&1 > &0`];; let monic_isign_lem = prove( - `(!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Pos ==> interpsign s p Pos) /\ - (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Pos ==> interpsign s p Neg) /\ - (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Neg ==> interpsign s p Neg) /\ - (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Neg ==> interpsign s p Pos) /\ - (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Zero ==> interpsign s p Zero) /\ + `(!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Pos ==> interpsign s p Pos) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Pos ==> interpsign s p Neg) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Neg ==> interpsign s p Neg) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Neg ==> interpsign s p Pos) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Zero ==> interpsign s p Zero) /\ (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Zero ==> interpsign s p Zero)`, (* {{{ Proof *) - REWRITE_TAC[interpsign] THEN REPEAT STRIP_TAC THEN - POP_ASSUM (fun x -> POP_ASSUM (fun y -> MP_TAC (MATCH_MP y x))) THEN - POP_ASSUM MP_TAC THEN - POP_ASSUM (ASSUME_TAC o GSYM o (ISPEC `x:real`)) THEN - ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_ENTIRE] THEN + REWRITE_TAC[interpsign] THEN REPEAT STRIP_TAC THEN + POP_ASSUM (fun x -> POP_ASSUM (fun y -> MP_TAC (MATCH_MP y x))) THEN + POP_ASSUM MP_TAC THEN + POP_ASSUM (ASSUME_TAC o GSYM o (ISPEC `x:real`)) THEN + ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_ENTIRE] THEN REAL_ARITH_TAC);; (* }}} *) -let gtpos::ltpos::gtneg::ltneg::gtzero::ltzero::[] = CONJUNCTS monic_isign_lem;; +let gtpos::ltpos::gtneg::ltneg::gtzero::ltzero::[] = CONJUNCTS monic_isign_lem;; let main_lem000 = prove_by_refinement( `!l n. (LENGTH l = SUC n) ==> 0 < LENGTH l`, @@ -48,11 +48,11 @@ let main_lem001 = prove_by_refinement( [MESON_TAC[]]);; let main_lem002 = prove_by_refinement( - `(x <> y ==> x <> y) /\ - (x < y ==> x <> y) /\ - (x > y ==> x <> y) /\ - (~(x >= y) ==> x <> y) /\ - (~(x <= y) ==> x <> y) /\ + `(x <> y ==> x <> y) /\ + (x < y ==> x <> y) /\ + (x > y ==> x <> y) /\ + (~(x >= y) ==> x <> y) /\ + (~(x <= y) ==> x <> y) /\ (~(x = y) ==> x <> y)`, (* {{{ Proof *) @@ -63,7 +63,7 @@ let main_lem002 = prove_by_refinement( (* }}} *) let factor_pos_pos = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Pos ==> + `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Pos ==> (!x. x pow k * p x = q x) ==> interpsign s q Pos`, (* {{{ Proof *) [ @@ -79,7 +79,7 @@ let factor_pos_pos = prove_by_refinement( (* }}} *) let factor_pos_neg = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Neg ==> + `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Neg ==> (!x. x pow k * p x = q x) ==> interpsign s q Neg`, (* {{{ Proof *) [ @@ -95,7 +95,7 @@ let factor_pos_neg = prove_by_refinement( (* }}} *) let factor_pos_zero = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Zero ==> + `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Zero ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ @@ -109,7 +109,7 @@ let factor_pos_zero = prove_by_refinement( (* }}} *) let factor_zero_pos = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Pos ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Pos ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ @@ -125,7 +125,7 @@ let factor_zero_pos = prove_by_refinement( (* }}} *) let factor_zero_neg = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Neg ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Neg ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ @@ -141,7 +141,7 @@ let factor_zero_neg = prove_by_refinement( (* }}} *) let factor_zero_zero = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Zero ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Zero ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ @@ -155,7 +155,7 @@ let factor_zero_zero = prove_by_refinement( (* }}} *) let factor_neg_even_pos = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> EVEN k ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> EVEN k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Pos`, (* {{{ Proof *) [ @@ -171,7 +171,7 @@ let factor_neg_even_pos = prove_by_refinement( (* }}} *) let factor_neg_even_neg = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> EVEN k ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> EVEN k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Neg`, (* {{{ Proof *) [ @@ -187,7 +187,7 @@ let factor_neg_even_neg = prove_by_refinement( (* }}} *) let factor_neg_even_zero = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> EVEN k ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> EVEN k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ @@ -201,7 +201,7 @@ let factor_neg_even_zero = prove_by_refinement( (* }}} *) let factor_neg_odd_pos = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> ODD k ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> ODD k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Neg`, (* {{{ Proof *) [ @@ -212,12 +212,12 @@ let factor_neg_odd_pos = prove_by_refinement( ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; DISJ1_TAC; - ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; + ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; ]);; (* }}} *) let factor_neg_odd_neg = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> ODD k ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> ODD k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Pos`, (* {{{ Proof *) [ @@ -228,12 +228,12 @@ let factor_neg_odd_neg = prove_by_refinement( ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; DISJ1_TAC; - ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; + ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; ]);; (* }}} *) let factor_neg_odd_zero = prove_by_refinement( - `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> ODD k ==> ~(k = 0) ==> + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> ODD k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ diff --git a/Rqe/matinsert.ml b/Rqe/matinsert.ml index eddb00a0..f45fea86 100644 --- a/Rqe/matinsert.ml +++ b/Rqe/matinsert.ml @@ -1,15 +1,15 @@ let ROWINSERT = let lxt = `\x:real. T` in - fun i const_thm interpsigns_thm -> + fun i const_thm interpsigns_thm -> let isigns_thms = interpsigns_thms2 interpsigns_thm in let isigns_thm = hd isigns_thms in - let set,_,_ = - if concl isigns_thm = t_tm then lxt,t_tm,t_tm else + let set,_,_ = + if concl isigns_thm = t_tm then lxt,t_tm,t_tm else dest_interpsign (hd isigns_thms) in - let const_thm' = MATCH_MP (ISPEC set matinsert_lem0) const_thm in + let const_thm' = MATCH_MP (ISPEC set matinsert_lem0) const_thm in let const_thm'' = PURE_REWRITE_RULE[GSYM interpsign] const_thm' in - let isigns_thms' = insertat i const_thm'' isigns_thms in + let isigns_thms' = insertat i const_thm'' isigns_thms in let isigns_thms'' = if isigns_thm = TRUTH then butlast isigns_thms' else isigns_thms' in mk_interpsigns isigns_thms'';; @@ -29,29 +29,29 @@ let MATINSERT vars i const_thm cont mat_thm = (* Opt *) (* ---------------------------------------------------------------------- *) -(* OPT FAILED... slightly slower, even with hashtables *) +(* OPT FAILED... slightly slower, even with hashtables *) -let rec mk_suc = +let rec mk_suc = let zero = `0` in let suc = `SUC` in - fun n -> - match n with - 0 -> zero + fun n -> + match n with + 0 -> zero | n -> mk_comb(suc,mk_suc (n-1));; -let rec MK_SUC = +let rec MK_SUC = let f n = prove(mk_eq(mk_small_numeral n,mk_suc n),ARITH_TAC) in let size = 100 in let range = 0--size in let suc_tbl = Hashtbl.create size in map2 (Hashtbl.add suc_tbl) range (map f range); - fun n -> + fun n -> try Hashtbl.find suc_tbl n with _ -> f n;; -let PL_LENGTH = +let PL_LENGTH = let pl_tm = `partition_line` in let len_tm = `LENGTH:(real -> bool) list -> num` in - fun pts -> + fun pts -> let lpts = mk_comb(len_tm,mk_comb(pl_tm,pts)) in let lthm = ARITH_SIMP_CONV[PARTITION_LINE_LENGTH;LENGTH] lpts in let pts' = snd(dest_eq(concl lthm)) in @@ -60,7 +60,7 @@ let PL_LENGTH = TRANS lthm suc_thm;; -let rec MK_LT = +let rec MK_LT = let f(n1,n2) = prove(mk_binop nle (mk_suc n1) (mk_suc n2),ARITH_TAC) in let size1 = 20 in let size2 = 20 in @@ -69,7 +69,7 @@ let rec MK_LT = let range = filter (fun (x,y) -> x <= y) (allpairs (fun x y -> x,y) range1 range2) in let suc_tbl = Hashtbl.create (size1 * size2) in map2 (Hashtbl.add suc_tbl) range (map f range); - fun (n1,n2) -> + fun (n1,n2) -> try Hashtbl.find suc_tbl (n1,n2) with _ -> f(n1,n2);; diff --git a/Rqe/pdivides.ml b/Rqe/pdivides.ml index 13313777..076314d4 100644 --- a/Rqe/pdivides.ml +++ b/Rqe/pdivides.ml @@ -3,7 +3,7 @@ (* PDIVIDES *) (* ---------------------------------------------------------------------- *) -let PDIVIDES vars sgns p q = +let PDIVIDES vars sgns p q = let s_thm = FINDSIGN vars sgns (head vars q) in let op,l1,r1 = get_binop (concl s_thm) in if op = req then failwith "PDIVIDES : head coefficient is zero" else @@ -14,7 +14,7 @@ let PDIVIDES vars sgns p q = let ak,s = dest_mult asx in let a,k = dest_pow ak in let k' = dest_small_numeral k in - if op = rgt || even k' then + if op = rgt || even k' then r,div_thm else if odd k' && op = rlt then let par_thm = PARITY_CONV k in @@ -22,15 +22,15 @@ let PDIVIDES vars sgns p q = let mp_thm1 = (CONV_RULE (LAND_CONV (LAND_CONV (LAND_CONV POLY_NEG_CONV)))) mp_thm in let mp_thm2 = (CONV_RULE (RAND_CONV (LAND_CONV (LAND_CONV (POLY_NEG_CONV))))) mp_thm1 in let mp_thm3 = (CONV_RULE (RAND_CONV (RAND_CONV POLY_NEG_CONV))) mp_thm2 in - let ret = (snd o dest_plus o rhs o concl) mp_thm3 in + let ret = (snd o dest_plus o rhs o concl) mp_thm3 in ret,mp_thm3 - else if odd k' && op = rneq then + else if odd k' && op = rneq then let par_thm = PARITY_CONV k in let mp_thm = MATCH_MPL[mul_odd_lem;div_thm;par_thm] in let mp_thm1 = (CONV_RULE (LAND_CONV (LAND_CONV (LAND_CONV (POLYNATE_CONV vars))))) mp_thm in let mp_thm2 = (CONV_RULE (RAND_CONV (LAND_CONV (POLYNATE_CONV vars)))) mp_thm1 in let mp_thm3 = (CONV_RULE (RAND_CONV (RAND_CONV (POLY_MUL_CONV vars)))) mp_thm2 in - let ret = (snd o dest_plus o rhs o concl) mp_thm3 in + let ret = (snd o dest_plus o rhs o concl) mp_thm3 in ret,mp_thm3 else failwith "PDIVIDES: 1";; @@ -38,7 +38,7 @@ let PDIVIDES vars sgns p q = (* Timing *) (* ---------------------------------------------------------------------- *) -let PDIVIDES vars sgns mat_thm div_thms = +let PDIVIDES vars sgns mat_thm div_thms = let start_time = Sys.time() in let res = PDIVIDES vars sgns mat_thm div_thms in pdivides_timer +.= (Sys.time() -. start_time); @@ -47,7 +47,7 @@ let PDIVIDES vars sgns mat_thm div_thms = (* -PDIVIDES vars sgns p +PDIVIDES vars sgns p let q = (ith 2 qs) diff --git a/Rqe/pdivides_thms.ml b/Rqe/pdivides_thms.ml index 170ec14b..18dd2bbc 100644 --- a/Rqe/pdivides_thms.ml +++ b/Rqe/pdivides_thms.ml @@ -1,7 +1,7 @@ let neg_odd_lem = prove_by_refinement( `!a n p c q d. - (a pow n * p x = c x * q x + d x) ==> - ODD n ==> + (a pow n * p x = c x * q x + d x) ==> + ODD n ==> ((-- a) pow n * p x = (-- c x) * q x + (-- d x))`, (* {{{ Proof *) @@ -36,8 +36,8 @@ let neg_odd_lem = prove_by_refinement( let mul_odd_lem = prove_by_refinement( `!a n p c q d. - (a pow n * p x = c x * q x + d x) ==> - ODD n ==> + (a pow n * p x = c x * q x + d x) ==> + ODD n ==> ((a * a pow n) * p x = (a * c x) * q x + (a * d x))`, (* {{{ Proof *) [ diff --git a/Rqe/rewrites.ml b/Rqe/rewrites.ml index 5955ff79..46d973fd 100644 --- a/Rqe/rewrites.ml +++ b/Rqe/rewrites.ml @@ -16,9 +16,9 @@ ARITH_RULE `1 * x = x`; ARITH_RULE `x * 1 = x`; ];; -let NUM_SIMP_TAC = REWRITE_TAC !NUM_REWRITES;; +let NUM_SIMP_TAC = REWRITE_TAC !NUM_REWRITES;; -let extend_num_rewrites l = +let extend_num_rewrites l = NUM_REWRITES := !NUM_REWRITES @ l;; (* ---------------------------------------------------------------------- *) @@ -26,7 +26,7 @@ let extend_num_rewrites l = (* ---------------------------------------------------------------------- *) (* -search [`(pow)`;rp] +search [`(pow)`;rp] *) let REAL_REWRITES = ref [ @@ -80,11 +80,11 @@ real_div; let REAL_SIMP_TAC = REWRITE_TAC ( !REAL_REWRITES -);; +);; let REAL_SOLVE_TAC = ASM_MESON_TAC (!REAL_REWRITES @ !REAL_ELIM);; -let extend_real_rewrites l = +let extend_real_rewrites l = REAL_REWRITES := !REAL_REWRITES @ l;; let BASIC_REWRITES = ref (!REAL_REWRITES @ !NUM_REWRITES);; diff --git a/Rqe/rqe_lib.ml b/Rqe/rqe_lib.ml index bdaebb16..ccf2845f 100644 --- a/Rqe/rqe_lib.ml +++ b/Rqe/rqe_lib.ml @@ -39,30 +39,30 @@ let rec insertat i x l = | h::t -> h::(insertat (i-1) x t);; let rec allcombs f l = - match l with + match l with [] -> [] - | h::t -> + | h::t -> map (f h) t @ allcombs f t;; -let rec assoc_list keys assl = +let rec assoc_list keys assl = match keys with [] -> [] | h::t -> assoc h assl::assoc_list t assl;; -let add_to_list l1 l2 = +let add_to_list l1 l2 = l1 := !l1 @ l2;; let list x = [x];; -let rec ith i l = +let rec ith i l = if i = 0 then hd l else ith (i-1) (tl l);; let rev_ith i l = ith (length l - i - 1) l;; -let get_index p l = - let rec get_index p l n = - match l with +let get_index p l = + let rec get_index p l n = + match l with [] -> failwith "get_index" | h::t -> if p h then n else get_index p t (n + 1) in get_index p l 0;; @@ -71,8 +71,8 @@ let get_index p l = *) -let bindex p l = - let rec bindex p l i = +let bindex p l = + let rec bindex p l i = match l with [] -> failwith "bindex: not found" | h::t -> if p h then i else bindex p t (i + 1) in @@ -80,21 +80,21 @@ let bindex p l = let cons x y = x :: y;; -let rec swap_lists l store = +let rec swap_lists l store = match l with [] -> store - | h::t -> + | h::t -> let store' = map2 cons h store in - swap_lists t store';; + swap_lists t store';; (* -swap_lists [[1;2;3];[4;5;6];[7;8;9];[10;11;12]] ---> +swap_lists [[1;2;3];[4;5;6];[7;8;9];[10;11;12]] +--> [[1; 4; 7; 10]; [2; 5; 8; 11]; [3; 6; 9; 12]] *) -let swap_lists l = +let swap_lists l = let n = length (hd l) in let l' = swap_lists l (replicate [] n) in map rev l';; @@ -110,34 +110,34 @@ let fst3 (a,_,_) = a;; let snd3 (_,a,_) = a;; let thd3 (_,_,a) = a;; -let odd n = (n mod 2 = 1);; -let even n = (n mod 2 = 0);; +let odd n = (n mod 2 = 1);; +let even n = (n mod 2 = 0);; (* ---------------------------------------------------------------------- *) (* Terms *) (* ---------------------------------------------------------------------- *) -let dest_var_or_const t = +let dest_var_or_const t = match t with Var(s,ty) -> s,ty | Const(s,ty) -> s,ty - | _ -> failwith "not a var or const";; + | _ -> failwith "not a var or const";; -let can_match t1 t2 = - try +let can_match t1 t2 = + try let n1,_ = dest_var_or_const t1 in let n2,_ = dest_var_or_const t2 in n1 = n2 && can (term_match [] t1) t2 with Failure _ -> false;; let dest_quant tm = - if is_forall tm then dest_forall tm + if is_forall tm then dest_forall tm else if is_exists tm then dest_exists tm else failwith "dest_quant: not a quantified term";; let get_binop tm = try let f,r = dest_comb tm in let xop,l = dest_comb f in - xop,l,r + xop,l,r with Failure _ -> failwith "get_binop";; diff --git a/Rqe/rqe_list.ml b/Rqe/rqe_list.ml index 9761cf8e..f2704502 100644 --- a/Rqe/rqe_list.ml +++ b/Rqe/rqe_list.ml @@ -1,14 +1,14 @@ let aacons_tm = `CONS:A -> A list -> A list` ;; -let HD_CONV conv tm = +let HD_CONV conv tm = let h::rest = dest_list tm in - let ty = type_of h in + let ty = type_of h in let thm = conv h in let thm2 = REFL (mk_list(rest,ty)) in let cs = inst [ty,aty] aacons_tm in MK_COMB ((AP_TERM cs thm),thm2);; -let TL_CONV conv tm = +let TL_CONV conv tm = (* try *) let h::t = dest_list tm in let lty = type_of h in @@ -16,9 +16,9 @@ let TL_CONV conv tm = MK_COMB ((AP_TERM cs (REFL h)), (LIST_CONV conv (mk_list(t,lty)))) (* with _ -> failwith "TL_CONV" *) -let rec EL_CONV conv i tm = +let rec EL_CONV conv i tm = if i = 0 then HD_CONV conv tm - else + else let h::t = dest_list tm in let lty = type_of h in let cs = inst [lty,aty] aacons_tm in @@ -29,9 +29,9 @@ let rec EL_CONV conv i tm = let conv = (REWRITE_CONV[ARITH_RULE `x + x = &2 * x`]) let tm = `[&5 + &5; &6 + &6; &7 + &7]` - HD_CONV conv tm - TL_CONV conv tm - HD_CONV(TL_CONV conv) tm + HD_CONV conv tm + TL_CONV conv tm + HD_CONV(TL_CONV conv) tm CONS_CONV conv tm EL_CONV conv 0 tm EL_CONV conv 1 tm @@ -50,14 +50,14 @@ let NOT_CONS = prove_by_refinement( (* }}} *) let REMOVE = new_recursive_definition list_RECURSION - `(REMOVE x [] = []) /\ - (REMOVE x (CONS (h:A) t) = + `(REMOVE x [] = []) /\ + (REMOVE x (CONS (h:A) t) = let rest = REMOVE x t in - if x = h then rest else CONS h rest)`;; + if x = h then rest else CONS h rest)`;; let CHOP_LIST = new_recursive_definition num_RECURSION - `(CHOP_LIST 0 l = [],l) /\ - (CHOP_LIST (SUC n) l = + `(CHOP_LIST 0 l = [],l) /\ + (CHOP_LIST (SUC n) l = let a,b = CHOP_LIST n (TL l) in CONS (HD l) a,b)`;; @@ -132,7 +132,7 @@ let LAST_CONS = prove_by_refinement( (* {{{ Proof *) [ ASM_MESON_TAC[LAST]; -]);; +]);; (* }}} *) @@ -144,7 +144,7 @@ let LAST_CONS_CONS = prove_by_refinement( MESON_TAC[LAST;NOT_CONS_NIL;COND_CLAUSES]; ]);; (* }}} *) - + let HD_APPEND = prove_by_refinement( `!h t l. HD (APPEND (CONS h t) l) = h`, (* {{{ Proof *) @@ -196,10 +196,10 @@ let LIST_TRI = prove_by_refinement( DISJ_CASES_TAC (ISPEC `p:A list` list_CASES); ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN STRIP_TAC; - DISJ_CASES_TAC (ISPEC `t:A list` list_CASES); + DISJ_CASES_TAC (ISPEC `t:A list` list_CASES); ASM_MESON_TAC[]; ASM_MESON_TAC[]; -]);; +]);; (* }}} *) let LENGTH_PAIR = prove_by_refinement( @@ -214,7 +214,7 @@ let LENGTH_PAIR = prove_by_refinement( MP_TAC (ISPEC `t:A list` list_CASES); STRIP_TAC; ASM_MESON_TAC[LENGTH_1;ARITH_RULE `~(1 = 2)`]; - MP_TAC (ISPEC `t':A list` list_CASES); + MP_TAC (ISPEC `t':A list` list_CASES); STRIP_TAC; EXISTS_TAC `h:A`; EXISTS_TAC `h':A`; @@ -222,7 +222,7 @@ let LENGTH_PAIR = prove_by_refinement( CLAIM `p = CONS h (CONS h' (CONS h'' t''))`; ASM_MESON_TAC[]; STRIP_TAC; - CLAIM `2 < LENGTH p`; + CLAIM `2 < LENGTH p`; POP_ASSUM SUBST1_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; @@ -249,7 +249,7 @@ let LENGTH_SING = prove_by_refinement( CLAIM `p = CONS h (CONS h' t')`; ASM_MESON_TAC[]; STRIP_TAC; - CLAIM `1 < LENGTH p`; + CLAIM `1 < LENGTH p`; POP_ASSUM SUBST1_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; @@ -272,7 +272,7 @@ let TL_NIL = prove_by_refinement( ASM_REWRITE_TAC[TL]; ASM_MESON_TAC !LIST_REWRITES; ASM_MESON_TAC !LIST_REWRITES; -]);; +]);; (* }}} *) let LAST_TL = prove_by_refinement( @@ -283,7 +283,7 @@ let LAST_TL = prove_by_refinement( REWRITE_TAC[]; REWRITE_TAC[TL;LAST]; ASM_MESON_TAC[NOT_CONS_NIL]; -]);; +]);; (* }}} *) let LENGTH_TL = prove_by_refinement( diff --git a/Rqe/rqe_main.ml b/Rqe/rqe_main.ml index fb1969b0..c30ff7ec 100644 --- a/Rqe/rqe_main.ml +++ b/Rqe/rqe_main.ml @@ -1,24 +1,24 @@ -let TRAPOUT cont mat_thm ex_thms fm = - try - cont mat_thm ex_thms - with Isign (false_thm,ex_thms) -> - let ftm = mk_eq(fm,f_tm) in +let TRAPOUT cont mat_thm ex_thms fm = + try + cont mat_thm ex_thms + with Isign (false_thm,ex_thms) -> + let ftm = mk_eq(fm,f_tm) in let fthm = CONTR ftm false_thm in let ex_thms' = sort (fun x y -> xterm_lt (fst y) (fst x)) ex_thms in let fthm' = rev_itlist CHOOSE ex_thms' fthm in fthm';; -let get_repeats l = - let rec get_repeats l seen ind = +let get_repeats l = + let rec get_repeats l seen ind = match l with [] -> [] - | h::t -> + | h::t -> if mem h seen then ind::get_repeats t seen (ind + 1) else get_repeats t (h::seen) (ind + 1) in get_repeats l [] 0;; -let subtract_index l = - let rec subtract_index l ind = +let subtract_index l = + let rec subtract_index l ind = match l with [] -> [] | h::t -> (h - ind):: (subtract_index t (ind + 1)) in @@ -28,76 +28,76 @@ let subtract_index l = subtract_index (get_repeats [1; 2; 1; 2 ; 3]) *) -let remove_column n isigns_thm = +let remove_column n isigns_thm = let thms = interpsigns_thms2 isigns_thm in let l,r = chop_list n thms in let thms' = l @ tl r in mk_interpsigns thms';; -let REMOVE_COLUMN n mat_thm = +let REMOVE_COLUMN n mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in - let isigns_thms' = map (remove_column n) isigns_thms in - let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let isigns_thms' = map (remove_column n) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; -let SETIFY_CONV mat_thm = +let SETIFY_CONV mat_thm = let _,pols,_ = dest_interpmat(concl mat_thm) in let pols' = dest_list pols in let sols = setify (dest_list pols) in - let indices = map (fun p -> try index p sols with _ -> failwith "SETIFY: no index") pols' in + let indices = map (fun p -> try index p sols with _ -> failwith "SETIFY: no index") pols' in let subtract_cols = subtract_index (get_repeats indices) in rev_itlist REMOVE_COLUMN subtract_cols mat_thm;; (* -SETIFY_CONV +SETIFY_CONV (ASSUME `interpmat [] [(\x. x + &1); (\x. x + &1); (\x. x + &2); (\x. x + &3); (\x. x + &1); (\x. x + &2)][[Pos; Pos; Pos; Pos; Neg; Zero]]`) *) (* -let duplicate_column i j isigns_thm = +let duplicate_column i j isigns_thm = let thms = interpsigns_thms2 isigns_thm in let col = ith i thms in let l,r = chop_list j thms in let thms' = l @ (col :: r) in mk_interpsigns thms';; -let DUPLICATE_COLUMN i j mat_thm = +let DUPLICATE_COLUMN i j mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in - let isigns_thms' = map (duplicate_column i j) isigns_thms in - let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let isigns_thms' = map (duplicate_column i j) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; *) -let duplicate_columns new_cols isigns_thm = +let duplicate_columns new_cols isigns_thm = let thms = interpsigns_thms2 isigns_thm in let thms' = map (fun i -> el i thms) new_cols in mk_interpsigns thms';; -let DUPLICATE_COLUMNS mat_thm ls = +let DUPLICATE_COLUMNS mat_thm ls = if ls = [] then if mat_thm = empty_mat then empty_mat else failwith "empty duplication list" else let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in - let isigns_thms' = map (duplicate_columns ls) isigns_thms in - let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let isigns_thms' = map (duplicate_columns ls) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; -let DUPLICATE_COLUMNS mat_thm ls = +let DUPLICATE_COLUMNS mat_thm ls = let start_time = Sys.time() in let res = DUPLICATE_COLUMNS mat_thm ls in duplicate_columns_timer +.= (Sys.time() -. start_time); @@ -109,14 +109,14 @@ let UNMONICIZE_ISIGN vars monic_thm isign_thm = let const = (fst o dest_mult o lhs o concl) monic_thm in let const_thm = SIGN_CONST const in let op,_,_ = get_binop (concl const_thm) in - let mp_thm = - if op = rgt then - if sign = spos_tm then gtpos + let mp_thm = + if op = rgt then + if sign = spos_tm then gtpos else if sign = sneg_tm then gtneg else if sign = szero_tm then gtzero else failwith "bad sign" - else if op = rlt then - if sign = spos_tm then ltpos + else if op = rlt then + if sign = spos_tm then ltpos else if sign = sneg_tm then ltneg else if sign = szero_tm then ltzero else failwith "bad sign" @@ -124,25 +124,25 @@ let UNMONICIZE_ISIGN vars monic_thm isign_thm = let monic_thm' = GEN (hd vars) monic_thm in MATCH_MPL[mp_thm;monic_thm';const_thm;isign_thm];; -let UNMONICIZE_ISIGNS vars monic_thms isigns_thm = +let UNMONICIZE_ISIGNS vars monic_thms isigns_thm = let isign_thms = interpsigns_thms2 isigns_thm in let isign_thms' = map2 (UNMONICIZE_ISIGN vars) monic_thms isign_thms in mk_interpsigns isign_thms';; -let UNMONICIZE_MAT vars monic_thms mat_thm = +let UNMONICIZE_MAT vars monic_thms mat_thm = if monic_thms = [] then mat_thm else let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let consts = map (fst o dest_mult o lhs o concl) monic_thms in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in - let isigns_thms' = map (UNMONICIZE_ISIGNS vars monic_thms) isigns_thms in - let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let isigns_thms' = map (UNMONICIZE_ISIGNS vars monic_thms) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; -let UNMONICIZE_MAT vars monic_thms mat_thm = +let UNMONICIZE_MAT vars monic_thms mat_thm = let start_time = Sys.time() in let res = UNMONICIZE_MAT vars monic_thms mat_thm in unmonicize_mat_timer +.= (Sys.time() -. start_time); @@ -152,7 +152,7 @@ let UNMONICIZE_MAT vars monic_thms mat_thm = (* {{{ Examples *) (* -let vars,monic_thms,mat_thm = +let vars,monic_thms,mat_thm = [], [], empty_mat @@ -170,7 +170,7 @@ let ls = [0;1;2;0;1;2] let mat_thm,ls = empty_mat,[] 1,3, -DUPLICATE_COLUMNS +DUPLICATE_COLUMNS (ASSUME `interpmat [] [(\x. x + &1); (\x. x + &1); (\x. x + &2); (\x. x + &3); (\x. x + &1); (\x. x + &2)][[Pos; Pos; Pos; Pos; Neg; Zero]]`) [5] @@ -184,12 +184,12 @@ let isigns_thm = hd isigns_thms (* }}} *) -let SWAP_HEAD_COL_ROW i isigns_thm = +let SWAP_HEAD_COL_ROW i isigns_thm = let s_thms = interpsigns_thms2 isigns_thm in let s_thms' = insertat i (hd s_thms) (tl s_thms) in mk_interpsigns s_thms';; -let SWAP_HEAD_COL i mat_thm = +let SWAP_HEAD_COL i mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in @@ -198,19 +198,19 @@ let SWAP_HEAD_COL i mat_thm = let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in mk_interpmat_thm rol_thm all_thm';; -let SWAP_HEAD_COL i mat_thm = +let SWAP_HEAD_COL i mat_thm = let start_time = Sys.time() in let res = SWAP_HEAD_COL i mat_thm in swap_head_col_timer +.= (Sys.time() -. start_time); res;; -let LENGTH_CONV = +let LENGTH_CONV = let alength_tm = `LENGTH:(A list) -> num` in - fun tm -> + fun tm -> try let ty = type_of tm in - let lty,[cty] = dest_type ty in + let lty,[cty] = dest_type ty in if lty <> "list" then failwith "LENGTH_CONV: not a list" else let ltm = mk_comb(inst[cty,aty] alength_tm,tm) in let lthm = REWRITE_CONV[LENGTH] ltm in @@ -219,22 +219,22 @@ let LENGTH_CONV = let LAST_NZ_CONV = let alast_tm = `LAST:(A list) -> A` in - fun nz_thm tm -> + fun nz_thm tm -> try let ty = type_of tm in - let lty,[cty] = dest_type ty in + let lty,[cty] = dest_type ty in if lty <> "list" then failwith "LAST_NZ_CONV: not a list" else let ltm = mk_comb(inst[cty,aty] alast_tm,tm) in let lthm = REWRITE_CONV[LAST;NOT_CONS_NIL] ltm in MATCH_MPL[main_lem001;nz_thm;lthm] with _ -> failwith "LAST_NZ_CONV";; -let rec first f l = - match l with +let rec first f l = + match l with [] -> failwith "first" | h::t -> if can f h then f h else first f t;; -let NEQ_RULE thm = +let NEQ_RULE thm = let thms = CONJUNCTS main_lem002 in first (C MATCH_MP thm) thms;; @@ -242,12 +242,12 @@ let NEQ_RULE thm = NEQ_CONV (ARITH_RULE `~(&11 <= &2)`) *) -let NORMAL_LIST_CONV nz_thm tm = +let NORMAL_LIST_CONV nz_thm tm = let nz_thm' = NEQ_RULE nz_thm in let len_thm = LENGTH_CONV tm in let last_thm = LAST_NZ_CONV nz_thm' tm in - let cthm = CONJ len_thm last_thm in - MATCH_EQ_MP (GSYM (REWRITE_RULE[GSYM NEQ] NORMAL_ID)) cthm;; + let cthm = CONJ len_thm last_thm in + MATCH_EQ_MP (GSYM (REWRITE_RULE[GSYM NEQ] NORMAL_ID)) cthm;; (* |- poly_diff [&0; &0; &0 + a * &1] = [&0; &0 + a * &2] @@ -261,9 +261,9 @@ let GEN_POLY_DIFF_CONV vars tm = let thm3 = CONV_RULE (RAND_CONV (LIST_CONV (POLYNATE_CONV vars))) thm2 in thm3;; -(* +(* if \x. p = \x. q, where \x. p is the leading polynomial - replace p by q in mat_thm, + replace p by q in mat_thm, *) @@ -271,15 +271,15 @@ let GEN_POLY_DIFF_CONV vars tm = let peq,mat_thm = !rppeq,!rpmat *) let rppeq,rpmat = ref TRUTH,ref TRUTH;; -let REPLACE_POL = +let REPLACE_POL = let imat_tm = `interpmat` in - fun peq mat_thm -> + fun peq mat_thm -> rppeq := peq; rpmat := mat_thm; let pts,pols,sgnll = dest_interpmat (concl mat_thm) in let rep_p = lhs(concl peq) in let i = try index rep_p (dest_list pols) with _ -> failwith "REPLACE_POL: index" in - let thm1 = EL_CONV (fun x -> GEN_REWRITE_CONV I [peq] x) i pols in + let thm1 = EL_CONV (fun x -> GEN_REWRITE_CONV I [peq] x) i pols in end_itlist (C (curry MK_COMB)) (rev [REFL imat_tm;REFL pts;thm1;REFL sgnll]);; @@ -293,7 +293,7 @@ let REPLACE_POL peq mat_thm = (* -let peq,mat_thm = +let peq,mat_thm = ASSUME `(\x. &0) = (\x. &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)))`, ASSUME `interpmat [x_44] [\x. (&0 + b * &1) + x * (&0 + a * &2); \x. &0] @@ -305,7 +305,7 @@ REPLACE_POL peq mat_thm is_constant [`y:real`] `&1 + x * -- &1` -let vars,pols,cont,sgns,ex_thms = +let vars,pols,cont,sgns,ex_thms = [`c:real`; `b:real`; `a:real`], [`&0 + c * &1`], (fun x y -> x), @@ -325,35 +325,35 @@ ASSUME `&0 + a * &1 = &0`; ASSUME ` &1 > &0`], (* Factoring *) (* ---------------------------------------------------------------------- *) -let UNFACTOR_ISIGN vars xsign_thm pol isign_thm = +let UNFACTOR_ISIGN vars xsign_thm pol isign_thm = let x = hd vars in - let k,pol' = weakfactor x pol in + let k,pol' = weakfactor x pol in if k = 0 then isign_thm else - let fact_thm = GEN x (GSYM (WEAKFACTOR_CONV x pol)) in + let fact_thm = GEN x (GSYM (WEAKFACTOR_CONV x pol)) in let par_thm = PARITY_CONV (mk_small_numeral k) in let _,_,xsign = dest_interpsign xsign_thm in let _,_,psign = dest_interpsign isign_thm in let parity,_ = dest_comb (concl par_thm) in if xsign = spos_tm then - let mp_thm = - if psign = spos_tm then factor_pos_pos - else if psign = sneg_tm then factor_pos_neg + let mp_thm = + if psign = spos_tm then factor_pos_pos + else if psign = sneg_tm then factor_pos_neg else if psign = szero_tm then factor_pos_zero else failwith "bad sign" in let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm]) in MATCH_MP ret fact_thm - else if xsign = szero_tm then + else if xsign = szero_tm then let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in - let mp_thm = - if psign = spos_tm then factor_zero_pos - else if psign = sneg_tm then factor_zero_neg + let mp_thm = + if psign = spos_tm then factor_zero_pos + else if psign = sneg_tm then factor_zero_neg else if psign = szero_tm then factor_zero_zero else failwith "bad sign" in let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm;k_thm]) in MATCH_MP ret fact_thm else if xsign = sneg_tm && parity = even_tm then let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in - let mp_thm = + let mp_thm = if psign = spos_tm then factor_neg_even_pos else if psign = sneg_tm then factor_neg_even_neg else if psign = szero_tm then factor_neg_even_zero @@ -362,7 +362,7 @@ let UNFACTOR_ISIGN vars xsign_thm pol isign_thm = MATCH_MP ret fact_thm else if xsign = sneg_tm && parity = odd_tm then let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in - let mp_thm = + let mp_thm = if psign = spos_tm then factor_neg_odd_pos else if psign = sneg_tm then factor_neg_odd_neg else if psign = szero_tm then factor_neg_odd_zero @@ -375,7 +375,7 @@ let UNFACTOR_ISIGN vars xsign_thm pol isign_thm = (* -let vars,xsign_thm,pol,isign_thm = +let vars,xsign_thm,pol,isign_thm = [ry;rx], `interpsign (\x. x < x1) (\x. x) Pos`, ASSUME `interpsign (\x. x < x_254) (\y. &0 + y * &1) Neg` @@ -384,7 +384,7 @@ ASSUME `interpsign (\x. x < x_254) (\y. &0 + y * &1) Neg` ASSUME `interpsign (\x. x < x1) (\x. &4 + x * &6) Pos` -let xsign_thm,pol,isign_thm = +let xsign_thm,pol,isign_thm = ASSUME `interpsign (\x. x < x1) (\x. x) Pos`, `\x. &0 + x * (&4 + x * &6)`, ASSUME `interpsign (\x. x < x1) (\x. &4 + x * &6) Pos` @@ -394,28 +394,28 @@ ASSUME `interpsign (\x. x < x1) (\x. &4 + x * &6) Pos` (* }}} *) -let UNFACTOR_ISIGNS vars pols isigns_thm = +let UNFACTOR_ISIGNS vars pols isigns_thm = let isign_thms = interpsigns_thms2 isigns_thm in let isign_thms' = map2 (UNFACTOR_ISIGN vars (hd isign_thms)) pols (tl isign_thms) in mk_interpsigns isign_thms';; -let UNFACTOR_MAT vars pols mat_thm = +let UNFACTOR_MAT vars pols mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in - let isigns_thms' = map (UNFACTOR_ISIGNS vars pols) isigns_thms in - let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let isigns_thms' = map (UNFACTOR_ISIGNS vars pols) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; -let UNFACTOR_MAT vars pols mat_thm = +let UNFACTOR_MAT vars pols mat_thm = let start_time = Sys.time() in let res = UNFACTOR_MAT vars pols mat_thm in unfactor_mat_timer +.= (Sys.time() -. start_time); res;; - + (* {{{ Examples *) (* @@ -427,7 +427,7 @@ UNFACTOR_ISIGNS pols isigns_thm let isign_thm = el 1 isign_thm pols - let isigns_thms' = map (UNFACTOR_ISIGNS pols) isigns_thms in + let isigns_thms' = map (UNFACTOR_ISIGNS pols) isigns_thms in let xsign_thm = hd isign_thms let xsign_thm = ASSUME `interpsign (\x. x < x1) (\x. x) Neg` @@ -439,25 +439,25 @@ let isigns_thm = hd isigns_thms let vars = [rx;ry;rz] -let pols = - [`\x. &0 + x * (&0 + x * (&0 + y * &1))`; `\x. &0 + x * (&4 + x * &6)`; `\x. &3 + x * (&6 + x * &9)`; +let pols = + [`\x. &0 + x * (&0 + x * (&0 + y * &1))`; `\x. &0 + x * (&4 + x * &6)`; `\x. &3 + x * (&6 + x * &9)`; `\x. &0 + x * (&0 + x * (&0 + x * (&0 + z * &1)))`; `\x. -- &4 + x * (&0 + x * &1)`] -let mat_thm = ASSUME - `interpmat [x1; x2; x3; x4; x5] - [\x. x; \x. &0 + y * &1; \x. &4 + x * &6; \x. &3 + x * (&6 + x * &9); +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. x; \x. &0 + y * &1; \x. &4 + x * &6; \x. &3 + x * (&6 + x * &9); \x. &0 + z * &1; \x. -- &4 + x * (&0 + x * &1)] - [[Pos; Pos; Pos; Neg; Neg; Neg]; - [Neg; Pos; Zero; Zero; Neg; Neg]; - [Neg; Pos; Neg; Pos; Neg; Neg]; - [Neg; Pos; Neg; Pos; Neg; Zero]; - [Neg; Pos; Neg; Pos; Neg; Pos]; - [Zero; Pos; Neg; Pos; Zero; Pos]; - [Pos; Pos; Neg; Pos; Pos; Pos]; - [Pos; Zero; Neg; Pos; Pos; Pos]; - [Pos; Neg; Neg; Pos; Pos; Pos]; - [Pos; Zero; Zero; Pos; Pos; Pos]; - [Pos; Pos; Pos; Pos; Pos; Pos]]` + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Neg; Pos; Zero; Zero; Neg; Neg]; + [Neg; Pos; Neg; Pos; Neg; Neg]; + [Neg; Pos; Neg; Pos; Neg; Zero]; + [Neg; Pos; Neg; Pos; Neg; Pos]; + [Zero; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` UNFACTOR_MAT pols mat_thm @@ -484,24 +484,24 @@ let vars,dun,pols,cont,sgns,ex_thms,fm = !szvars,!szdun,!szpols,!szcont,!szsgns, *) -let rec MATRIX vars pols cont sgns ex_thms fm = +let rec MATRIX vars pols cont sgns ex_thms fm = incr matrix_count; - if pols = [] then TRAPOUT cont empty_mat [] fm else - if exists (is_constant vars) pols then + if pols = [] then TRAPOUT cont empty_mat [] fm else + if exists (is_constant vars) pols then let p = find (is_constant vars) pols in let i = try index p pols with _ -> failwith "MATRIX: no such pol" in let pols1,pols2 = chop_list i pols in let pols' = pols1 @ tl pols2 in let cont' = MATINSERT vars i (FINDSIGN vars sgns p) cont in MATRIX vars pols' cont' sgns ex_thms fm - else - let kqs = map (weakfactor (hd vars)) pols in - if exists (fun (k,q) -> k <> 0 && not(is_constant vars q)) kqs then - let pols' = poly_var(hd vars) :: map snd kqs in - let ks = map fst kqs in - let cont' mat_thm ex_thms = cont (UNFACTOR_MAT vars pols mat_thm) ex_thms in - MATRIX vars pols' cont' sgns ex_thms fm - else + else + let kqs = map (weakfactor (hd vars)) pols in + if exists (fun (k,q) -> k <> 0 && not(is_constant vars q)) kqs then + let pols' = poly_var(hd vars) :: map snd kqs in + let ks = map fst kqs in + let cont' mat_thm ex_thms = cont (UNFACTOR_MAT vars pols mat_thm) ex_thms in + MATRIX vars pols' cont' sgns ex_thms fm + else let d = itlist (max o degree_ vars) pols (-1) in let p = find (fun p -> degree_ vars p = d) pols in let pl_thm = POLY_ENLIST_CONV vars p in @@ -512,65 +512,65 @@ let rec MATRIX vars pols cont sgns ex_thms fm = let p' = mk_comb(mk_comb(poly_tm,p'l),hd vars) in let p'thm = (POLY_DELIST_CONV THENC (POLYNATE_CONV vars)) p' in let p'c = rhs (concl p'thm) in - let hdp' = last (dest_list p'l) in + let hdp' = last (dest_list p'l) in let sign_thm = FINDSIGN vars sgns hdp' in - let normal_thm = NORMAL_LIST_CONV sign_thm p'l in + let normal_thm = NORMAL_LIST_CONV sign_thm p'l in let i = try index p pols with _ -> failwith "MATRIX: no such pol1" in let qs = let p1,p2 = chop_list i pols in p'c::p1 @ tl p2 in let gs,div_thms = unzip (map (PDIVIDES vars sgns p) qs) in let cont' mat_thm = cont (SWAP_HEAD_COL i mat_thm) in - let dedcont mat_thm ex_thms = + let dedcont mat_thm ex_thms = DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont' mat_thm ex_thms in - SPLITZERO vars qs gs dedcont sgns ex_thms fm + SPLITZERO vars qs gs dedcont sgns ex_thms fm -and SPLITZERO vars dun pols cont sgns ex_thms fm = +and SPLITZERO vars dun pols cont sgns ex_thms fm = incr splitzero_count; match pols with [] -> SPLITSIGNS vars [] dun cont sgns ex_thms fm - | p::ops -> + | p::ops -> if p = rzero then let cont' mat_thm ex_thms = MATINSERT vars (length dun) (REFL rzero) cont mat_thm ex_thms in SPLITZERO vars dun ops cont' sgns ex_thms fm - else - let hp = behead vars p in + else + let hp = behead vars p in let h = head vars p in - let nzcont = + let nzcont = let tmp = SPLITZERO vars (dun@[p]) ops cont in fun sgns ex_thms -> tmp sgns ex_thms fm in - let zcont = + let zcont = let tmp = SPLITZERO vars dun (hp :: ops) in - fun sgns ex_thms -> - let zthm = FINDSIGN vars sgns h in - let b_thm = GSYM (BEHEAD vars zthm p) in + fun sgns ex_thms -> + let zthm = FINDSIGN vars sgns h in + let b_thm = GSYM (BEHEAD vars zthm p) in let lam_thm = ABS (hd vars) b_thm in - let cont' mat_thm ex_thms = - let mat_thm' = REPLACE_POL (lam_thm) mat_thm in + let cont' mat_thm ex_thms = + let mat_thm' = REPLACE_POL (lam_thm) mat_thm in let mat_thm'' = MATCH_EQ_MP mat_thm' mat_thm in cont mat_thm'' ex_thms in - tmp cont' sgns ex_thms fm in + tmp cont' sgns ex_thms fm in SPLIT_ZERO (tl vars) sgns (head vars p) zcont nzcont ex_thms -and SPLITSIGNS vars dun pols cont sgns ex_thms fm = +and SPLITSIGNS vars dun pols cont sgns ex_thms fm = incr splitsigns_count; match pols with - [] -> MONICIZE vars dun cont sgns ex_thms fm + [] -> MONICIZE vars dun cont sgns ex_thms fm (* [] -> MATRIX vars dun cont sgns ex_thms fm *) - | p::ops -> + | p::ops -> let cont' sgns ex_thms = SPLITSIGNS vars (dun@[p]) ops cont sgns ex_thms fm in SPLIT_SIGN (tl vars) sgns (head vars p) cont' cont' ex_thms -and MONICIZE vars pols cont sgns ex_thms fm = +and MONICIZE vars pols cont sgns ex_thms fm = incr monicize_count; - let monic_thms = map (MONIC_CONV vars) pols in - let monic_pols = map (rhs o concl) monic_thms in - let sols = setify monic_pols in - let indices = map (fun p -> try index p sols with _ -> failwith "MONICIZE: no such pol") monic_pols in - let transform mat_thm = - let mat_thm' = DUPLICATE_COLUMNS mat_thm indices in + let monic_thms = map (MONIC_CONV vars) pols in + let monic_pols = map (rhs o concl) monic_thms in + let sols = setify monic_pols in + let indices = map (fun p -> try index p sols with _ -> failwith "MONICIZE: no such pol") monic_pols in + let transform mat_thm = + let mat_thm' = DUPLICATE_COLUMNS mat_thm indices in (* mat_thm' *) - UNMONICIZE_MAT vars monic_thms mat_thm' in - let cont' mat_thm ex_thms = cont (transform mat_thm) ex_thms in - MATRIX vars sols cont' sgns ex_thms fm + UNMONICIZE_MAT vars monic_thms mat_thm' in + let cont' mat_thm ex_thms = cont (transform mat_thm) ex_thms in + MATRIX vars sols cont' sgns ex_thms fm ;; (* {{{ Examples *) @@ -582,34 +582,34 @@ let mat_thm = mat_thm' monic_thms let vars = [rx] -let mat_thm = ASSUME - `interpmat [x1; x2; x3; x4; x5] +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] [(\x. &1 + x * (&2 + x * &3)); (\x. &2 + x * (&4 + x * &6)); \x. &3 + x * (&6 + x * &9); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4] - [[Pos; Pos; Pos; Neg; Neg; Neg]; - [Pos; Pos; Zero; Zero; Neg; Neg]; - [Pos; Pos; Neg; Pos; Neg; Neg]; - [Pos; Pos; Neg; Pos; Neg; Zero]; - [Pos; Pos; Neg; Pos; Neg; Pos]; - [Pos; Pos; Neg; Pos; Zero; Pos]; - [Pos; Pos; Neg; Pos; Pos; Pos]; - [Pos; Zero; Neg; Pos; Pos; Pos]; - [Pos; Neg; Neg; Pos; Pos; Pos]; - [Pos; Zero; Zero; Pos; Pos; Pos]; - [Pos; Pos; Pos; Pos; Pos; Pos]]` - -let mat_thm = ASSUME - `interpmat [x1; x2; x3; x4; x5] + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] [\x. -- &4 + x * (&0 + x * &1); \x. &2 + x * &1; \x. &2 + x * (-- &3 + x * &1); \x. &1 / &3 + x * (&2 / &3 + x * &1)] - [[Pos; Pos; Pos; Neg]; - [Pos; Pos; Zero; Zero]; - [Pos; Pos; Neg; Pos]; + [[Pos; Pos; Pos; Neg]; + [Pos; Pos; Zero; Zero]; + [Pos; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos]; - [Pos; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos]; - [Pos; Pos; Neg; Pos]; [Pos; Zero; Neg; Pos]; - [Pos; Neg; Neg; Pos]; - [Pos; Zero; Zero; Pos]; + [Pos; Neg; Neg; Pos]; + [Pos; Zero; Zero; Pos]; [Pos; Pos; Pos; Pos]]`;; let vars = [rx] @@ -624,46 +624,46 @@ let pols = [`&1 + x * (&2 + x * &3)`;`&2 + x * (&4 + x * &6)`;`&3 + x * (&6 + x (* Set up RQE *) (* ---------------------------------------------------------------------- *) -let polynomials tm = - let rec polynomials tm = +let polynomials tm = + let rec polynomials tm = if tm = t_tm || tm = f_tm then [] else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then - let _,l,r = get_binop tm in polynomials l @ polynomials r + let _,l,r = get_binop tm in polynomials l @ polynomials r else if is_neg tm then polynomials (dest_neg tm) - else if - can (dest_binop rlt) tm || - can (dest_binop rgt) tm || - can (dest_binop rle) tm || - can (dest_binop rge) tm || - can (dest_binop req) tm || - can (dest_binop rneq) tm then + else if + can (dest_binop rlt) tm || + can (dest_binop rgt) tm || + can (dest_binop rle) tm || + can (dest_binop rge) tm || + can (dest_binop req) tm || + can (dest_binop rneq) tm then let _,l,_ = get_binop tm in [l] else failwith "not a fol atom" in setify (polynomials tm);; (* {{{ Examples *) -(* +(* let pols = polynomials `(poly [&1; -- &2] x > &0 ==> poly [&1; -- &2] x >= &0 /\ (poly [&8] x = &0)) /\ ~(poly [y] x <= &0)` *) (* }}} *) -let BASIC_REAL_QELIM_CONV vars fm = +let BASIC_REAL_QELIM_CONV vars fm = let x,bod = dest_exists fm in let pols = polynomials bod in - let cont mat_thm ex_thms = + let cont mat_thm ex_thms = let ex_thms' = sort (fun x y -> xterm_lt (fst y) (fst x)) ex_thms in let comb_thm = COMBINE_TESTFORMS x mat_thm bod in let comb_thm' = rev_itlist CHOOSE ex_thms' comb_thm in comb_thm' in let ret_thm = SPLITZERO (x::vars) [] pols cont empty_sgns [] fm in - PURE_REWRITE_RULE[NEQ] ret_thm;; + PURE_REWRITE_RULE[NEQ] ret_thm;; -let REAL_QELIM_CONV fm = +let REAL_QELIM_CONV fm = reset_counts(); - ((LIFT_QELIM_CONV POLYATOM_CONV (EVALC_CONV THENC SIMPLIFY_CONV) - BASIC_REAL_QELIM_CONV) THENC EVALC_CONV THENC SIMPLIFY_CONV) fm;; + ((LIFT_QELIM_CONV POLYATOM_CONV (EVALC_CONV THENC SIMPLIFY_CONV) + BASIC_REAL_QELIM_CONV) THENC EVALC_CONV THENC SIMPLIFY_CONV) fm;; (* ---------------------------------------------------------------------- *) (* timers *) diff --git a/Rqe/rqe_num.ml b/Rqe/rqe_num.ml index a91c7d24..8ae1b9bf 100644 --- a/Rqe/rqe_num.ml +++ b/Rqe/rqe_num.ml @@ -26,9 +26,9 @@ let SUC_1 = prove( let even_tm = `EVEN`;; let odd_tm = `ODD`;; -let PARITY_CONV tm = +let PARITY_CONV tm = let k = dest_small_numeral tm in if even k then prove(mk_comb(even_tm,tm),ARITH_TAC) - else + else prove(mk_comb(odd_tm,tm),ARITH_TAC);; diff --git a/Rqe/signs.ml b/Rqe/signs.ml index f59ca53f..ee6b2c8e 100644 --- a/Rqe/signs.ml +++ b/Rqe/signs.ml @@ -2,7 +2,7 @@ (* Find sign of polynomial, using modulo-constant lookup and computation. *) (* ------------------------------------------------------------------------- *) -let xterm_lt t1 t2 = +let xterm_lt t1 t2 = try let n1,_ = dest_var t1 in let n2,_ = dest_var t2 in @@ -39,17 +39,17 @@ let FINDSIGN = let c' = term_of_rat(Int 1 // rat_of_term c) in let sth = SIGN_CONST c' in let rel_c = funpow 2 rator (concl sth) in - let rel_p = funpow 2 rator (concl pth) in + let rel_p = funpow 2 rator (concl pth) in let th1 = if rel_p = req then if rel_c = rgt then pth_0g else pth_0l else if rel_p = rgt then if rel_c = rgt then pth_gg else pth_gl - else if rel_p = rlt then if rel_c = rgt then pth_lg else pth_ll - else if rel_p = rneq then if rel_c = rgt then pth_nzg else pth_nzl + else if rel_p = rlt then if rel_c = rgt then pth_lg else pth_ll + else if rel_p = rneq then if rel_c = rgt then pth_nzg else pth_nzl else failwith "FINDSIGN" in let th2 = MP (MP (INST [p',p_tm; c',c_tm] th1) pth) sth in let th3 = EQ_MP (LAND_CONV(RAND_CONV(K(SYM mth))) (concl th2)) th2 in let th4 = MATCH_MP fth th3 in - MP th4 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th4)))) + MP th4 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th4)))) with Failure _ -> failwith "FINDSIGN" in FINDSIGN;; @@ -58,10 +58,10 @@ let FINDSIGN = let vars = [`x:real`;`y:real`] let p = `&7 + x * (&11 + x * (&10 + y * &7))` -let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) < &0`] -let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) = &0`] -let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) > &0`] -let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) < &0`] +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) = &0`] +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) > &0`] +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] FINDSIGN vars sgns p FINDSIGN vars sgns `-- &1` @@ -87,15 +87,15 @@ ASSERTSIGN [x,y] [] (|- &7 + x * (&11 + x * (&10 + y * &7)) < &0 *) -let ASSERTSIGN vars sgns sgn_thm = +let ASSERTSIGN vars sgns sgn_thm = let op,l,r = get_binop (concl sgn_thm) in - let p_thm = MONIC_CONV vars l in + let p_thm = MONIC_CONV vars l in let _,pl,pr = get_binop (concl p_thm) in let c,_ = dest_binop rm pl in - let c_thm = SIGN_CONST c in - let c_op,_,_ = get_binop (concl c_thm) in + let c_thm = SIGN_CONST c in + let c_op,_,_ = get_binop (concl c_thm) in let sgn_thm' = - if c_op = rlt && op = rlt then + if c_op = rlt && op = rlt then MATCH_MPL[signs_lem01;c_thm;sgn_thm;p_thm] else if c_op = rgt && op = rlt then MATCH_MPL[signs_lem02;c_thm;sgn_thm;p_thm] @@ -103,7 +103,7 @@ let ASSERTSIGN vars sgns sgn_thm = MATCH_MPL[signs_lem03;c_thm;sgn_thm;p_thm] else if c_op = rgt && op = rgt then MATCH_MPL[signs_lem04;c_thm;sgn_thm;p_thm] - else if c_op = rlt && op = req then + else if c_op = rlt && op = req then MATCH_MPL[signs_lem05;c_thm;sgn_thm;p_thm] else if c_op = rgt && op = req then MATCH_MPL[signs_lem06;c_thm;sgn_thm;p_thm] @@ -112,24 +112,24 @@ let ASSERTSIGN vars sgns sgn_thm = else if c_op = rgt && op = rneq then MATCH_MPL[signs_lem08;c_thm;sgn_thm;p_thm] else failwith "ASSERTSIGN : 0" in - try + try let sgn_thm'' = find (fun th -> lhand(concl th) = pr) sgns in let op1,l1,r1 = get_binop (concl sgn_thm') in let op2,l2,r2 = get_binop (concl sgn_thm'') in - if (concl sgn_thm') = (concl sgn_thm'') then sgns - else if op2 = rneq && (op1 = rlt || op1 = rgt) then sgn_thm'::snd (remove ((=) sgn_thm'') sgns) + if (concl sgn_thm') = (concl sgn_thm'') then sgns + else if op2 = rneq && (op1 = rlt || op1 = rgt) then sgn_thm'::snd (remove ((=) sgn_thm'') sgns) else failwith "ASSERTSIGN : 1" - with Failure "find" -> sgn_thm'::sgns;; - + with Failure "find" -> sgn_thm'::sgns;; + + - (* -let k0 = `&7 + x * (&11 + x * (&10 + y * -- &7))` +let k0 = `&7 + x * (&11 + x * (&10 + y * -- &7))` MONIC_CONV vars k0 -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) < &0` -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` let sgn_thm = k1 ASSERTSIGN vars [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] k1 @@ -142,21 +142,21 @@ ASSERTSIGN vars [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] k -let SPLIT_ZERO vars sgns p cont_z cont_n ex_thms = - try - let sgn_thm = FINDSIGN vars sgns p in - let op,l,r = get_binop (concl sgn_thm) in +let SPLIT_ZERO vars sgns p cont_z cont_n ex_thms = + try + let sgn_thm = FINDSIGN vars sgns p in + let op,l,r = get_binop (concl sgn_thm) in (if op = req then cont_z else cont_n) sgns ex_thms - with Failure "FINDSIGN" -> - let eq_tm = mk_eq(p,rzero) in - let neq_tm = mk_neq(p,rzero) in + with Failure "FINDSIGN" -> + let eq_tm = mk_eq(p,rzero) in + let neq_tm = mk_neq(p,rzero) in let or_thm = ISPEC p signs_lem002 in - (* zero *) - let z_thm = cont_z (ASSERTSIGN vars sgns (ASSUME eq_tm)) ex_thms in - let z_thm' = DISCH eq_tm z_thm in + (* zero *) + let z_thm = cont_z (ASSERTSIGN vars sgns (ASSUME eq_tm)) ex_thms in + let z_thm' = DISCH eq_tm z_thm in (* nonzero *) - let nz_thm = cont_n (ASSERTSIGN vars sgns (ASSUME neq_tm)) ex_thms in - let nz_thm' = DISCH neq_tm nz_thm in + let nz_thm = cont_n (ASSERTSIGN vars sgns (ASSUME neq_tm)) ex_thms in + let nz_thm' = DISCH neq_tm nz_thm in (* combine *) let ret = MATCH_MPL[signs_lem003;or_thm;z_thm';nz_thm'] in (* matching problem... must continue by hand *) @@ -181,7 +181,7 @@ let vars,sgns,p,cont_z,cont_n,ex_thms = !sz_vars, !sz_sgns, !sz_p,!sz_cont_z, !s - let ret = MATCH_MPL[lem3;or_thm;] + let ret = MATCH_MPL[lem3;or_thm;] let mp_thm = MATCH_MPL[lem3;or_thm;] in let vars, sgns, p,cont_z, cont_n = !sz_vars,!sz_sgns,!sz_p,!sz_cont_z,!sz_cont_n @@ -212,21 +212,21 @@ let k1 = ASSUME `(&0 + x * &1 = &0) /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T) MATCH_MPL[PULL_CASES_THM;!sz_z_thm;!sz_nz_thm] in let thm1 = ASSUME `(?x_32. (&0 + c * &1) + x_32 * ((&0 + b * &1) + x_32 * (&0 + a * &1)) = &0) <=> T` -let thm2 = -ASSUME `(&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 ==> +let thm2 = +ASSUME `(&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 ==> ((?x. (&0 + c * &1) + x * ((&0 + b * &1) + x * (&0 + a * &1)) = &0) <=> F)) /\ - (&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 ==> + (&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 ==> ((?x_26. (&0 + c * &1) + x_26 * ((&0 + b * &1) + x_26 * (&0 + a * &1)) = &0) <=> T)) ` -MATCH_MPL +MATCH_MPL (* let PULL_CASES_THM = prove_by_refinement( *) (* `((a = &0) ==> (p <=> p0)) ==> ((a <> &0) ==> (a < &0 ==> (p <=> p1)) /\ (a > &0 ==> (p <=> p2))) *) (* ==> (p <=> ((a = &0) /\ p0) \/ ((a < &0) /\ p1) \/ (a > &0 /\ p2))`, *) (* (\* {{{ Proof *\) [ - REWRITE_TAC[NEQ] THEN + REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN ASM_REWRITE_TAC[NEQ] THEN TRY REAL_ARITH_TAC ]);; @@ -243,7 +243,7 @@ let PULL_CASES_THM = prove (* }}} *) -let vars, sgns, p, cont_z, cont_n = +let vars, sgns, p, cont_z, cont_n = [`x:real`;`y:real`], empty_sgns, `&0 + y * &1`, @@ -251,48 +251,48 @@ let vars, sgns, p, cont_z, cont_n = (fun x -> (ASSUME `sean > steph`,[])) -SPLIT_ZERO vars sgns p cont_z cont_n +SPLIT_ZERO vars sgns p cont_z cont_n ASSERTSIGN vars empty_sgns (ASSUME `&0 + y * &1 = &0`) , let vars = [`x:real`;`y:real`] let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) -let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` +let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` let cont_z = hd let cont_n = hd SPLIT_ZERO vars sgns p cont_z cont_n -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` let sgn_thm = k1 ASSERTSIGN vars [] k1 - + *) -let SPLIT_SIGN vars sgns p cont_p cont_n ex_thms = - let sgn_thm = try FINDSIGN vars sgns p +let SPLIT_SIGN vars sgns p cont_p cont_n ex_thms = + let sgn_thm = try FINDSIGN vars sgns p with Failure "FINDSIGN" -> failwith "SPLIT_SIGN: no sign -- should have sign assumption by now" in - let gt_tm = mk_binop rgt p rzero in - let lt_tm = mk_binop rlt p rzero in - let op,_,_ = get_binop (concl sgn_thm) in + let gt_tm = mk_binop rgt p rzero in + let lt_tm = mk_binop rlt p rzero in + let op,_,_ = get_binop (concl sgn_thm) in if op = rgt then cont_p sgns ex_thms else if op = rlt then cont_n sgns ex_thms else if op = req then failwith "SPLIT_SIGN: lead coef is 0" - else if op = rneq then + else if op = rneq then let or_thm = MATCH_MP signs_lem0002 sgn_thm in - (* < *) + (* < *) let lt_sgns = ASSERTSIGN vars sgns (ASSUME lt_tm) in - let lt_thm = cont_n lt_sgns ex_thms in - let lt_thm' = DISCH lt_tm lt_thm in + let lt_thm = cont_n lt_sgns ex_thms in + let lt_thm' = DISCH lt_tm lt_thm in (* > *) let gt_sgns = ASSERTSIGN vars sgns (ASSUME gt_tm) in - let gt_thm = cont_p gt_sgns ex_thms in - let gt_thm' = DISCH gt_tm gt_thm in + let gt_thm = cont_p gt_sgns ex_thms in + let gt_thm' = DISCH gt_tm gt_thm in (* combine *) - let ret = MATCH_MPL[signs_lem0003;or_thm;gt_thm';lt_thm'] in + let ret = MATCH_MPL[signs_lem0003;or_thm;gt_thm';lt_thm'] in (* matching problem... must continue by hand *) let ldj,rdj = dest_disj (concl ret) in let lcj,rcj = dest_conj ldj in @@ -321,28 +321,28 @@ let ss_vars, ss_sgns, ss_p,ss_cont_p, ss_cont_n = ref [],ref [],ref `T`,ref (fu -let vars, sgns, p, cont_p, cont_n = +let vars, sgns, p, cont_p, cont_n = [`x:real`;`y:real`], ASSERTSIGN vars empty_sgns (ASSUME `&0 + y * &1 <> &0`) , `&0 + y * &1`, (fun x -> (ASSUME `P > def`,[])), (fun x -> (ASSUME `sean > steph`,[])) -SPLIT_SIGN vars sgns p cont_z cont_n +SPLIT_SIGN vars sgns p cont_z cont_n let vars = [`x:real`;`y:real`] let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) -let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` +let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` let cont_p = hd let cont_n = hd SPLIT_SIGN vars sgns p cont_p cont_n let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` -let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` let sgn_thm = k1 ASSERTSIGN vars [] k1 diff --git a/Rqe/signs_thms.ml b/Rqe/signs_thms.ml index c9ab0764..1be63b67 100644 --- a/Rqe/signs_thms.ml +++ b/Rqe/signs_thms.ml @@ -1,4 +1,4 @@ -let [pth_0g;pth_0l;pth_gg;pth_gl;pth_lg;pth_ll] = +let [pth_0g;pth_0l;pth_gg;pth_gl;pth_lg;pth_ll] = (CONJUNCTS o prove) (`((p = &0) ==> c > &0 ==> (c * p = &0)) /\ ((p = &0) ==> c < &0 ==> (c * p = &0)) /\ @@ -6,7 +6,7 @@ let [pth_0g;pth_0l;pth_gg;pth_gl;pth_lg;pth_ll] = (p > &0 ==> c < &0 ==> c * p < &0) /\ (p < &0 ==> c > &0 ==> c * p < &0) /\ (p < &0 ==> c < &0 ==> c * p > &0)`, - SIMP_TAC[REAL_MUL_RZERO] THEN + SIMP_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_ARITH `(x > &0 <=> &0 < x) /\ (x < &0 <=> &0 < --x)`; REAL_ARITH `~(p = &0) <=> p < &0 \/ p > &0`] THEN REWRITE_TAC[IMP_IMP] THEN @@ -128,7 +128,7 @@ let PULL_CASES_THM_NZ = prove ((p <=> a > &0 /\ p1 \/ a < &0 /\ p2)))`, (* {{{ Proof *) REWRITE_TAC[NEQ] THEN - REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN ASM_REWRITE_TAC[] THEN TRY (POP_ASSUM MP_TAC THEN REAL_ARITH_TAC) diff --git a/Rqe/simplify.ml b/Rqe/simplify.ml index 379e4257..502e8656 100644 --- a/Rqe/simplify.ml +++ b/Rqe/simplify.ml @@ -27,14 +27,14 @@ let psimplify1 fm = *) -let PSIMPLIFY1_CONV = - let nt = `~T` +let PSIMPLIFY1_CONV = + let nt = `~T` and t = `T` and f = `F` - and nf = `~F` in + and nf = `~F` in fun fm -> - try - let fm' = + try + let fm' = if fm = nt then f else if fm = nf then t else if is_conj fm then @@ -46,8 +46,8 @@ let PSIMPLIFY1_CONV = else if is_disj fm then let l,r = dest_disj fm in if l = t || r = t then t - else if l = f then r - else if r = f then l + else if l = f then r + else if r = f then l else fm else if is_imp fm then let l,r = dest_imp fm in @@ -58,12 +58,12 @@ let PSIMPLIFY1_CONV = else fm else if is_iff fm then let l,r = dest_beq fm in - if l = f then mk_neg r + if l = f then mk_neg r else if l = t then r - else if r = t then l - else if r = f then mk_neg l + else if r = t then l + else if r = f then mk_neg l else fm - else failwith "PSIMPLIFY: 0" in + else failwith "PSIMPLIFY: 0" in let fm'' = mk_eq(fm,fm') in prove(fm'',REWRITE_TAC[]) with _ -> REFL fm;; @@ -82,7 +82,7 @@ let simplify1 fm = let SIMPLIFY1_CONV fm = if is_forall fm || is_exists fm then let x,p = dest_forall fm in - if mem x (frees p) then REFL fm + if mem x (frees p) then REFL fm else prove(mk_eq(fm,p),REWRITE_TAC[]) else PSIMPLIFY1_CONV fm;; @@ -100,10 +100,10 @@ let rec simplify fm = *) let rec SIMPLIFY_CONV = - let not_tm = `(~)` + let not_tm = `(~)` and ex_tm = `(?)` in - fun fm -> - if is_neg fm then + fun fm -> + if is_neg fm then let thm1 = SIMPLIFY_CONV (dest_neg fm) in let thm2 = AP_TERM not_tm thm1 in let l,r = dest_eq (concl thm2) in @@ -148,7 +148,7 @@ let evalc_atom at = let evalc = onatoms evalc_atom;; *) -let REAL_LEAF_CONV fm = +let REAL_LEAF_CONV fm = let op,l,r = get_binop fm in if op = rlt then REAL_RAT_LT_CONV fm @@ -158,7 +158,7 @@ let REAL_LEAF_CONV fm = REAL_RAT_LE_CONV fm else if op = rge then REAL_RAT_GE_CONV fm - else if op = req then + else if op = req then REAL_RAT_EQ_CONV fm else failwith "REAL_LEAF_CONV";; diff --git a/Rqe/testform.ml b/Rqe/testform.ml index 0f2d578c..b2ead9d0 100644 --- a/Rqe/testform.ml +++ b/Rqe/testform.ml @@ -3,20 +3,20 @@ (* ====================================================================== *) let rec TESTFORM var interpsigns_thm set_thm fm = - let polys,set,signs = dest_interpsigns interpsigns_thm in + let polys,set,signs = dest_interpsigns interpsigns_thm in let polys' = dest_list polys in let signs' = dest_list signs in if fm = t_tm then BETA_RULE (ISPECL [set] t_thm) else if fm = f_tm then BETA_RULE (ISPECL [set] f_thm) - else if is_neg fm then + else if is_neg fm then let lam = mk_abs (var,dest_neg fm) in let thm = TESTFORM var interpsigns_thm set_thm (dest_neg fm) in - if is_pos (concl thm) then - MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_p)) thm - else if is_neg (concl thm) then - MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_n)) thm + if is_pos (concl thm) then + MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_p)) thm + else if is_neg (concl thm) then + MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_n)) thm else failwith "error" - else if is_conj fm then + else if is_conj fm then let a,b = dest_conj fm in let a',b' = mk_abs (var,a),mk_abs (var,b) in let thma = TESTFORM var interpsigns_thm set_thm a in @@ -54,7 +54,7 @@ let rec TESTFORM var interpsigns_thm set_thm fm = else if is_pos (concl thma) && is_pos (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] imp_thm_pp);set_thm;thmb] else failwith "error" - else if is_iff fm then + else if is_iff fm then let a,b = dest_eq fm in let a',b' = mk_abs (var,a),mk_abs (var,b) in let thma = TESTFORM var interpsigns_thm set_thm a in @@ -69,47 +69,47 @@ let rec TESTFORM var interpsigns_thm set_thm fm = MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_pp);set_thm;thma;thmb] else failwith "error" else (* an atom *) - let op,p,_ = get_binop fm in + let op,p,_ = get_binop fm in let lam = mk_abs (var,p) in - let ind = + let ind = try - index lam polys' + index lam polys' with Failure "index" -> failwith "TESTFORM: Poly not present in list" in let sign = ith ind signs' in - let thm = ith ind (interpsigns_thms interpsigns_thm) in - let thm_op,thm_p,_ = + let thm = ith ind (interpsigns_thms interpsigns_thm) in + let thm_op,thm_p,_ = get_binop (snd (dest_imp (snd (dest_forall (concl thm))))) in - if op = req then - if thm_op = req then thm - else if thm_op = rlt then + if op = req then + if thm_op = req then thm + else if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_eq_thm);thm] - else if thm_op = rgt then + else if thm_op = rgt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_eq_thm);thm] - else failwith "error" - else if op = rlt then - if thm_op = rlt then thm + else failwith "error" + else if op = rlt then + if thm_op = rlt then thm else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_lt_thm);thm] else if thm_op = rgt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_lt_thm);thm] - else failwith "error" - else if op = rgt then - if thm_op = rgt then thm + else failwith "error" + else if op = rgt then + if thm_op = rgt then thm else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_gt_thm);thm] else if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_gt_thm);thm] - else failwith "error" - else if op = rle then - if thm_op = rlt then + else failwith "error" + else if op = rle then + if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_le_thm);thm] else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_le_thm);thm] else if thm_op = rgt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_le_thm);thm] else failwith "error" - else if op = rge then - if thm_op = rlt then + else if op = rge then + if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_ge_thm);thm] else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_ge_thm);thm] @@ -130,11 +130,11 @@ let tvar,tmat,tfm = ref `T`,ref TRUTH,ref `T`;; let var,mat_thm,fm = !tvar,!tmat,!tfm *) -let COMBINE_TESTFORMS = - let lem1 = TAUT `(T ==> a) <=> a` +let COMBINE_TESTFORMS = + let lem1 = TAUT `(T ==> a) <=> a` and lem2 = TAUT `(T /\ x) <=> x` - and imat_tm = `interpmat` in - fun var mat_thm fm -> + and imat_tm = `interpmat` in + fun var mat_thm fm -> tvar := var; tmat := mat_thm; tfm := fm; @@ -144,33 +144,33 @@ let COMBINE_TESTFORMS = let ord_thms = rol_nonempty_thms rol_thm in let part_thm = PARTITION_LINE_CONV (snd(dest_comb(concl rol_thm))) in let isigns_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] all2_thm) in - let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in - if exists (fun x -> is_forall(concl x)) ex_thms then + let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in + if exists (fun x -> is_forall(concl x)) ex_thms then let witness_thm = find (fun x -> is_forall(concl x)) ex_thms in let i = try index witness_thm ex_thms with _ -> failwith "COMBINE_TESTFORMS: witness not present" in let ord_thm = ith i ord_thms in let x,bod = dest_exists (concl ord_thm) in - if bod = t_tm then - let thm1 = ISPEC var witness_thm in - let thm2 = PURE_REWRITE_RULE[lem1] thm1 in - let exists_thm = EXISTS (mk_exists(var,concl thm2),var) thm2 in - EQT_INTRO exists_thm - else + if bod = t_tm then + let thm1 = ISPEC var witness_thm in + let thm2 = PURE_REWRITE_RULE[lem1] thm1 in + let exists_thm = EXISTS (mk_exists(var,concl thm2),var) thm2 in + EQT_INTRO exists_thm + else let nv = new_var real_ty in let ord_thm' = CONV_RULE (RAND_CONV (ALPHA_CONV nv)) ord_thm in let y,bod = dest_exists (concl ord_thm') in let ass_thm = ASSUME bod in let thm = MATCH_MP witness_thm ass_thm in - let exists_thm = EXISTS (mk_exists(y,concl thm) ,y) thm in + let exists_thm = EXISTS (mk_exists(y,concl thm) ,y) thm in let ret = CHOOSE (nv,ord_thm) exists_thm in EQT_INTRO ret - else + else if length ord_thms = 1 && snd(dest_exists(concl (hd ord_thms))) = t_tm then PURE_REWRITE_RULE[lem2] (EQF_INTRO (hd ex_thms)) else let ex_thms' = map (MATCH_MP NOT_EXISTS_CONJ_THM) ex_thms in let len = length ex_thms' in let first,[t1;t2] = chop_list (len-2) ex_thms' in - let base = MATCH_MPL[testform_itlem;t1;t2] in + let base = MATCH_MPL[testform_itlem;t1;t2] in let ex_thm = itlist (fun x y -> MATCH_MPL[testform_itlem;x;y]) first base in let cover_thm = ROL_COVERS rol_thm in let pre_thm = MATCH_MP ex_thm (ISPEC var cover_thm) in @@ -191,22 +191,22 @@ let var,mat_thm,fm = rx,ASSUME `interpsigns [\x. &1 + x * (&0 + x * &1)] (\x. T) [Pos]`,ASSUME `?x:real. T` -let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in +let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in TESTFORM ry (hd isigns_thms) (hd ord_thms) fm -TESTFORM ry (hd isigns_thms) (hd ord_thms) `&1 + y * (&0 + x * -- &1) <= &0` -TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` -TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` -let fm = `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` +TESTFORM ry (hd isigns_thms) (hd ord_thms) `&1 + y * (&0 + x * -- &1) <= &0` +TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` +TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` +let fm = `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` -let var,mat_thm,fm = +let var,mat_thm,fm = ry, ASSUME `interpmat [] [\y. (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1); \y. &1 + y * (&0 + x * -- &1)] [[Neg; Pos]]`, `~((&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0 /\ &1 + y * (&0 + x * -- &1) <= &0)` -let var,mat_thm,fm = +let var,mat_thm,fm = ry, ASSUME `interpmat [x_354] - [\y. (&1 + x * -- &1) + y * (&0 + x * -- &2); \x. &1 + x * -- &1; + [\y. (&1 + x * -- &1) + y * (&0 + x * -- &2); \x. &1 + x * -- &1; \y. (&1 + x * -- &1) + y * (&0 + x * -- &2)] [[Neg; Pos; Neg]; [Neg; Zero; Neg]; [Neg; Neg; Neg]]`, `~(&1 + x * -- &1 < &0 /\ &1 + y * -- &1 < &0 diff --git a/Rqe/testform_thms.ml b/Rqe/testform_thms.ml index dc32f535..bdc64a54 100644 --- a/Rqe/testform_thms.ml +++ b/Rqe/testform_thms.ml @@ -3,30 +3,30 @@ (* ------------------------------------------------------------------------- *) (* -let rec testform pmat fm = - match fm with - Atom(R(a,[p;Fn("0",[])])) -> - let s = assoc p pmat in - if a = "=" then s = Zero - else if a = "<=" then s = Zero || s = Negative - else if a = ">=" then s = Zero || s = Positive - else if a = "<" then s = Negative - else if a = ">" then s = Positive - else failwith "testform: unknown literal" - | False -> false - | True -> true - | Not(p) -> not(testform pmat p) - | And(p,q) -> testform pmat p && testform pmat q - | Or(p,q) -> testform pmat p || testform pmat q - | Imp(p,q) -> not(testform pmat p) || testform pmat q - | Iff(p,q) -> (testform pmat p = testform pmat q) - | _ -> failwith "testform: non-propositional formula";; +let rec testform pmat fm = + match fm with + Atom(R(a,[p;Fn("0",[])])) -> + let s = assoc p pmat in + if a = "=" then s = Zero + else if a = "<=" then s = Zero || s = Negative + else if a = ">=" then s = Zero || s = Positive + else if a = "<" then s = Negative + else if a = ">" then s = Positive + else failwith "testform: unknown literal" + | False -> false + | True -> true + | Not(p) -> not(testform pmat p) + | And(p,q) -> testform pmat p && testform pmat q + | Or(p,q) -> testform pmat p || testform pmat q + | Imp(p,q) -> not(testform pmat p) || testform pmat q + | Iff(p,q) -> (testform pmat p = testform pmat q) + | _ -> failwith "testform: non-propositional formula";; The model version of testform takes a row of the sign matrix in the form (p_1,s_1),(p_2,s_2),...,(p_n,s_n) The corresponding argument of TESTFORM is a theorem representing an `interpsigns` proposition. This is natural. The next argument, -the formula to be tested, is the same. +the formula to be tested, is the same. *) @@ -57,15 +57,15 @@ let and_thm_pp = prove( (!x. set x ==> (P x /\ Q x))`,MESON_TAC[]);; let and_thm_pn = prove( - `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> + `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; let and_thm_np = prove( - `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (!x. set x ==> Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; let and_thm_nn = prove( - `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; (* -------------------------------- \/ -------------------------------- *) @@ -78,22 +78,22 @@ let or_thm_q = prove( `!P Q set. (?x. set x) ==> (!x. set x ==> Q x) ==> (!x. set x ==> (P x \/ Q x))`, MESON_TAC[]);; -let or_thm_nn = +let or_thm_nn = prove(`!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x \/ Q x))`,MESON_TAC[]);; (* ------------------------------- ==> -------------------------------- *) let imp_thm_pp = - prove(`!P Q set. (?x. set x) ==> (!x. set x ==> Q x) ==> + prove(`!P Q set. (?x. set x) ==> (!x. set x ==> Q x) ==> (!x. set x ==> (P x ==> Q x))`,MESON_TAC[]);; -let imp_thm_pn = +let imp_thm_pn = prove(`!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x ==> Q x))`,MESON_TAC[]);; -let imp_thm_n = - prove(`!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> +let imp_thm_n = + prove(`!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (!x. set x ==> (P x ==> Q x))`,MESON_TAC[]);; (* -------------------------------- = --------------------------------- *) @@ -103,15 +103,15 @@ let iff_thm_pp = prove( (!x. set x ==> (P x <=> Q x))`,MESON_TAC[]);; let iff_thm_pn = prove( - `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> + `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x <=> Q x))`,MESON_TAC[]);; let iff_thm_np = prove( - `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (!x. set x ==> Q x) ==> (~ ?x. set x /\ (P x <=> Q x))`,MESON_TAC[]);; let iff_thm_nn = prove( - `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (~ ?x. set x /\ Q x) ==> (!x. set x ==> (P x <=> Q x))`,MESON_TAC[]);; (* ---------------------------------------------------------------------- *) @@ -163,7 +163,7 @@ let gt_le_thm = prove( MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_le]);; (* -------------------------- ?x. p x >= &0 --------------------------- *) - + let lt_ge_thm = prove( `!P set. (!x. set x ==> (P x < &0)) ==> ~ ?x. set x /\ (P x >= &0)`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_ge]);; diff --git a/Rqe/timers.ml b/Rqe/timers.ml index 09fe1447..bb93171f 100644 --- a/Rqe/timers.ml +++ b/Rqe/timers.ml @@ -21,7 +21,7 @@ let swap_head_col_timer = ref 0.0;; let replace_pol_timer = ref 0.0;; let unfactor_mat_timer = ref 0.0;; -let reset_timers() = +let reset_timers() = testform_timer := 0.0; combine_testforms_timer := 0.0; @@ -50,7 +50,7 @@ let reset_timers() = let print_timers() = - print_string "\n----------TIMERS---------\n\n"; + print_string "\n----------TIMERS---------\n\n"; print_string "TESTFORM: "; print_float !testform_timer; @@ -113,7 +113,7 @@ let print_timers() = print_string "\n"; - print_string "\n-------------------------\n"; + print_string "\n-------------------------\n"; ;; diff --git a/Tutorial/Number_theory.ml b/Tutorial/Number_theory.ml index c1a55727..a43a2fa3 100644 --- a/Tutorial/Number_theory.ml +++ b/Tutorial/Number_theory.ml @@ -82,7 +82,7 @@ let FERMAT_LITTLE_VARIANT = prove (`!p a. prime p ==> (a EXP (1 + m * (p - 1)) == a) (mod p)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME_STRONG) - THENL [ASM_MESON_TAC[CONG_TRIVIAL; ADD_AC; ADD1; DIVIDES_REXP_SUC]; + THENL [ASM_MESON_TAC[CONG_TRIVIAL; ADD_AC; ADD1; DIVIDES_REXP_SUC]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN REWRITE_TAC[EXP_ADD; EXP_1] THEN MATCH_MP_TAC CONG_MULT THEN diff --git a/Tutorial/Real_analysis.ml b/Tutorial/Real_analysis.ml index dd7d2900..830d77d7 100644 --- a/Tutorial/Real_analysis.ml +++ b/Tutorial/Real_analysis.ml @@ -55,7 +55,7 @@ let CHEB_2N1 = prove (&2 * (x pow 2 - &1) * (cheb (2 * n + 2) x - &1) = (cheb (n + 2) x - cheb n x) pow 2)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN - MATCH_MP_TAC CHEB_INDUCT THEN + MATCH_MP_TAC CHEB_INDUCT THEN REWRITE_TAC[ARITH; cheb; CHEB_CONV `cheb 2 x`; CHEB_CONV `cheb 3 x`] THEN REPEAT(CHANGED_TAC (REWRITE_TAC[GSYM ADD_ASSOC; LEFT_ADD_DISTRIB; ARITH] THEN diff --git a/Unity/mk_comp_unity.ml b/Unity/mk_comp_unity.ml index 526d4be7..1f04e6ab 100644 --- a/Unity/mk_comp_unity.ml +++ b/Unity/mk_comp_unity.ml @@ -117,7 +117,7 @@ let COMP_ENSURES_thm1_lemma_1 = TAC_PROOF AND_INTRO_THM)) THEN UNDISCH_TAC (`((p:'a->bool) UNLESS q)(APPEND t GPr) /\ (p EXIST_TRANSITION q)(APPEND t GPr)`) THEN - REWRITE_TAC [SPECL [(`q:'a->bool`); (`p:'a->bool`); + REWRITE_TAC [SPECL [(`q:'a->bool`); (`p:'a->bool`); (`APPEND (t:('a->'a)list) GPr`)] (GEN_ALL (SYM (SPEC_ALL ENSURES)))] THEN DISCH_TAC THEN diff --git a/Unity/mk_ensures.ml b/Unity/mk_ensures.ml index 8be7e2c2..1aefe855 100644 --- a/Unity/mk_ensures.ml +++ b/Unity/mk_ensures.ml @@ -69,7 +69,7 @@ set_goal([], (!s. (p /\* p') s /\ ~((p /\* q' \/* p' /\* q) \/* q /\* q') s) ==> (((p /\* q' \/* p' /\* q) \/* q /\* q') (h s))`) );; - + let ENSURES_lemma1 = TAC_PROOF (([], `!(p:'a->bool) p' q q' h. @@ -141,7 +141,7 @@ let EXIST_TRANSITION_thm1 = prove_thm p EXIST_TRANSITION false in Pr -------------------------------- - ~p + ~p *) let EXIST_TRANSITION_thm2 = prove_thm ("EXIST_TRANSITION_thm2", @@ -186,8 +186,8 @@ let EXIST_TRANSITION_thm4 = prove_thm STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN - REWRITE_TAC [REWRITE_RULE - [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] + REWRITE_TAC [REWRITE_RULE + [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] ENSURES_lemma4)]);; @@ -212,11 +212,11 @@ let APPEND_lemma02 = TAC_PROOF `!st (l:('a)list). (APPEND [st] l) = (CONS st l)`), GEN_TAC THEN LIST_INDUCT_TAC THEN - REWRITE_TAC [APPEND]);; + REWRITE_TAC [APPEND]);; let APPEND_lemma03 = TAC_PROOF (([], - `!st (l1:('a)list) l2. + `!st (l1:('a)list) l2. (APPEND (APPEND l1 [st]) l2) = (APPEND l1 (CONS st l2))`), GEN_TAC THEN LIST_INDUCT_TAC THEN @@ -228,7 +228,7 @@ let APPEND_lemma03 = TAC_PROOF let APPEND_lemma04 = TAC_PROOF (([], - `!st (l1:('a)list) l2. + `!st (l1:('a)list) l2. (APPEND (CONS st l1) l2) = (CONS st (APPEND l1 l2))`), GEN_TAC THEN LIST_INDUCT_TAC THEN @@ -449,7 +449,7 @@ let ENSURES_thm2 = prove_thm p ensures false in Pr ---------------------- - ~p + ~p *) let ENSURES_thm3 = prove_thm @@ -548,8 +548,8 @@ let ENSURES_thm5 = prove_thm IMP_RES_TAC UNLESS_cor23 THEN ASM_REWRITE_TAC [] ; - REWRITE_TAC [REWRITE_RULE - [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] + REWRITE_TAC [REWRITE_RULE + [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] ENSURES_lemma4)] ; @@ -621,7 +621,7 @@ let ENSURES_cor3 = prove_thm (`((p:'a->bool) \/* q)`);(`r:'a->bool`); (`Pr:('a->'a)list`)] ENSURES_thm4)) THEN UNDISCH_TAC (`(((p:'a->bool) /\* (p \/* q)) ENSURES - (((p /\* r) \/* ((p \/* q) /\* (q \/* r))) \/* + (((p /\* r) \/* ((p \/* q) /\* (q \/* r))) \/* ((q \/* r) /\* r))) Pr`) THEN REWRITE_TAC [AND_OR_EQ_lemma] THEN REWRITE_TAC [OR_ASSOC_lemma;AND_ASSOC_lemma] THEN @@ -702,8 +702,8 @@ let ENSURES_cor7 = prove_thm REWRITE_TAC [STABLE] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC (ONCE_REWRITE_RULE [AND_COMM_lemma] - (REWRITE_RULE [AND_False_lemma;OR_False_lemma] - (ONCE_REWRITE_RULE [OR_AND_COMM_lemma] + (REWRITE_RULE [AND_False_lemma;OR_False_lemma] + (ONCE_REWRITE_RULE [OR_AND_COMM_lemma] (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL [(`r:'a->bool`);(`False:'a->bool`); (`p:'a->bool`);(`q:'a->bool`); diff --git a/Unity/mk_state_logic.ml b/Unity/mk_state_logic.ml index 8bc65651..407d22b5 100644 --- a/Unity/mk_state_logic.ml +++ b/Unity/mk_state_logic.ml @@ -476,7 +476,7 @@ let OR_COMM_lemma = prove_thm REWRITE_TAC [OR_def] THEN ASSUME_TAC DISJ_COMM_lemma THEN STRIP_ASSUME_TAC - (MK_ABS (SPECL [p;q] + (MK_ABS (SPECL [p;q] (ASSUME (`!(p:'a->bool) q s. p s \/ q s <=> q s \/ p s`)))));; let OR_OR_lemma = prove_thm @@ -581,7 +581,7 @@ let AND_COMM_lemma = prove_thm REPEAT GEN_TAC THEN ASSUME_TAC CONJ_COMM_lemma THEN STRIP_ASSUME_TAC - (MK_ABS (SPECL [p;q] + (MK_ABS (SPECL [p;q] (ASSUME (`!p q (s:'a). p s /\ q s <=> q s /\ p s`)))));; let CONJ_ASSOC_lemma = TAC_PROOF @@ -802,14 +802,14 @@ let DISJ_CONJ_lemma1 = TAC_PROOF ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_CONJ_lemma2 = TAC_PROOF - (([], `!(p:'a->bool) q r s. + (([], `!(p:'a->bool) q r s. ((p s \/ q s) /\ (p s \/ r s)) ==> (p s \/ q s /\ r s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_CONJ_lemma = TAC_PROOF - (([], `!(p:'a->bool) q r s. + (([], `!(p:'a->bool) q r s. (p s \/ q s /\ r s) <=> ((p s \/ q s) /\ (p s \/ r s))`), REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL DISJ_CONJ_lemma1) diff --git a/Unity/mk_unless.ml b/Unity/mk_unless.ml index c14e4e43..f20c3c3b 100644 --- a/Unity/mk_unless.ml +++ b/Unity/mk_unless.ml @@ -1,7 +1,7 @@ (*-------------------------------------------------------------------------*) (* File: mk_unless.ml - Description: + Description: This file defines the theorems for the UNLESS definition. diff --git a/grobner.ml b/grobner.ml index ae3f08e9..94e8f8a7 100644 --- a/grobner.ml +++ b/grobner.ml @@ -522,7 +522,7 @@ let RING_AND_IDEAL_CONV = let e = denominator c in let d,th = run_scaled_proof vars p2 in memoize prf ((d */ e),MUL_RULE vars (c */ e,xs) th)) in - fun vars prf -> + fun vars prf -> let _,ans = run_scaled_proof vars prf in (execache := []; ans)) in let th = run_proof vars prf in diff --git a/iterate.ml b/iterate.ml index cd1a2854..88b68990 100644 --- a/iterate.ml +++ b/iterate.ml @@ -116,9 +116,9 @@ let FINITE_INDEX_NUMSEG = prove FINITE s <=> ?f. (!i j. i IN 1..CARD s /\ j IN 1..CARD s /\ f i = f j ==> i = j) /\ s = IMAGE f (1..CARD s)`, - GEN_TAC THEN + GEN_TAC THEN EQ_TAC THENL [DISCH_TAC; MESON_TAC[FINITE_IMAGE; FINITE_NUMSEG]] THEN - MP_TAC(ISPECL [`1..CARD(s:A->bool)`; `s:A->bool`] + MP_TAC(ISPECL [`1..CARD(s:A->bool)`; `s:A->bool`] CARD_EQ_BIJECTIONS) THEN ASM_REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; diff --git a/miz3/Samples/bug0.ml b/miz3/Samples/bug0.ml index be1409f5..025267a0 100644 --- a/miz3/Samples/bug0.ml +++ b/miz3/Samples/bug0.ml @@ -17,7 +17,7 @@ let EGCD_INVARIANT = thm `; !d. d divides (if m = 0 then n - else + else if n = 0 then m else if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> @@ -30,7 +30,7 @@ let EGCD_INVARIANT = thm `; ==> (d divides (if n = 0 then m - else + else if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> d divides m /\ d divides n) [5] proof diff --git a/miz3/Samples/icms.ml b/miz3/Samples/icms.ml index 5d52ffcc..4428a180 100644 --- a/miz3/Samples/icms.ml +++ b/miz3/Samples/icms.ml @@ -4,18 +4,18 @@ prioritize_real();; -let REAL_POW_LBOUND = prove +let REAL_POW_LBOUND = prove (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN - INDUCT_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN - REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; - -let REAL_ARCH_POW = prove + +let REAL_ARCH_POW = prove (`!x y. &1 < x ==> ?n. y < x pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN diff --git a/miz3/Samples/robbins.ml b/miz3/Samples/robbins.ml index 10b8aabe..748f91db 100644 --- a/miz3/Samples/robbins.ml +++ b/miz3/Samples/robbins.ml @@ -5,28 +5,28 @@ horizon := 0;; timeout := 2;; (* John apparently has a faster computer :-) *) let ROBBINS = thm `; - + let (+) be A->A->A; let n be A->A; - + assume !x y. x+y = y+x [COM]; assume !x y z. x+(y+z) = (x+y)+z [ASS]; assume !a b. n(n(a+b)+n(a+n(b))) = a [ROB]; - + consider x such that x:A = x; - + set u = n(x+n(x)) [U]; set d = x+u [D]; set c = x+x+x+u [C]; set j = n(c+d) [J]; set e = u+n(x+x)+n(c) [E]; - + n(u+n(x+x)) = x [0] proof n(u+n(x+x)) = n(n(x+n(x))+n(x+x)) by U; .= x by ROB,COM; qed by -; - + n(x+u+n(x+u+n(x+x)+n(c))) = n(c) [1] proof n(x+u+n(x+u+n(x+x)+n(c))) = n((x+u)+n(x+u+n(x+x)+n(c))) by ASS,COM; @@ -35,12 +35,12 @@ let ROBBINS = thm `; .= n(n(n(x+x+x+u)+n(x+u+n(x+x)))+n(x+u+n(x+x)+n(c))) by ASS,COM; // slow .= n(n(n(c)+n(x+u+n(x+x)))+n(n(c)+x+u+n(x+x))) by ASS,COM,C; .= n(c) by ROB,ASS,COM; - qed by -; - - n(u+n(c)) = x [2] + qed by -; + + n(u+n(c)) = x [2] proof n(u+n(c)) - = n(u+n(x+x+u+x)) by C,ASS,COM; - .= n(u+n(x+x+u+n(u+n(x+x)))) by 0; + = n(u+n(x+x+u+x)) by C,ASS,COM; + .= n(u+n(x+x+u+n(u+n(x+x)))) by 0; .= n(n(n(u+x+x)+n(u+n(x+x)))+n(x+x+u+n(u+n(x+x)))) by ROB; .= n(n(x+x+u+n(u+n(x+x)))+n(n(u+x+x)+n(u+n(x+x)))) by COM; .= n(n((x+x+u)+n(u+n(x+x)))+n(n(u+x+x)+n(u+n(x+x)))) by ASS; @@ -48,7 +48,7 @@ let ROBBINS = thm `; .= n(u+n(x+x)) by ROB; .= x by 0; qed by -; - + n(j+u) = x [3] proof n(j+u) = n(n(x+c+u)+u) by J,D,COM,ASS; @@ -56,7 +56,7 @@ let ROBBINS = thm `; .= n(n(x+c+u)+n(x+n(c+u))) by 2,COM; .= x by ROB; qed by -; - + n(x+n(x+n(x+x)+u+n(c))) = n(x+x) [4] proof n(x+n(x+n(x+x)+u+n(c))) = n(n(n(x+n(u+n(c)))+n(x+u+n(c)))+n(x+n(x+x)+u+n(c))) @@ -65,7 +65,7 @@ let ROBBINS = thm `; .= n(n(n(x+x)+x+u+n(c))+n(n(x+x)+n(x+u+n(c)))) by ASS,COM; .= n(x+x) by ROB,COM; qed by -; - + n(x+n(c)) = u [5] proof n(x+n(c)) = n(x+n(x+u+n(x+u+n(x+x)+n(c)))) by 1; @@ -78,7 +78,7 @@ let ROBBINS = thm `; .= n(n(u+n(x+n(x+e)))+n(u+x+n(x+e))) by E; .= u by ROB,COM; qed by -; - + n(j+x) = u [6] proof n(j+x) = n(j+n(n(x+c)+n(x+n(c)))) by ROB; @@ -86,7 +86,7 @@ let ROBBINS = thm `; .= n(n(u+x+c)+n(u+n(x+c))) by J,D,COM,ASS; .= u by ROB; qed by -; - + n(c+d) = n(c) proof n(c+d) = j by J; @@ -97,7 +97,7 @@ let ROBBINS = thm `; .= n(n(n(c)+n(j+x))+n(n(c)+j+x)) by 6; .= n(c) by ROB,COM; qed by -; - + thus ?c d. n(c+d) = n(c) by -`;; timeout := 1;; @@ -108,31 +108,31 @@ let old_default_prover = !default_prover;; default_prover := "REWRITE_TAC",REWRITE_TAC;; let ROBBINS = thm `; - + let (+) be A->A->A; let n be A->A; - + assume !x y. x+y = y+x [COM]; assume !x y z. x+(y+z) = (x+y)+z [ASS]; assume !a b. n(n(a+b)+n(a+n(b))) = a [ROB]; - + !x y z. x+y = y+x /\ (x+y)+z = x+(y+z) /\ x+(y+z) = y+(x+z) [AC] by MESON_TAC,COM,ASS; - + consider x such that x:A = x; - + set u = n(x+n(x)) [U]; set d = x+u [D]; set c = x+x+x+u [C]; set j = n(c+d) [J]; set e = u+n(x+x)+n(c) [E]; - + n(u+n(x+x)) = x [0] proof n(u+n(x+x)) = n(n(x+x)+n(x+n(x))) by U,AC; .= x by ROB; qed by -; - + n(x+u+n(x+u+n(x+x)+n(c))) = n(c) [1] proof n(x+u+n(x+u+n(x+x)+n(c))) = n((x+u)+n(x+u+n(x+x)+n(c))) by AC; @@ -140,7 +140,7 @@ let ROBBINS = thm `; .= n(n(n(c)+x+u+n(x+x))+n(n(c)+n(x+u+n(x+x)))) by C,AC; .= n(c) by ROB; qed by -; - + n(u+n(c)) = x [2] proof n(u+n(c)) = n(u+n(x+x+u+n(u+n(x+x)))) by 0,C,AC; @@ -149,7 +149,7 @@ let ROBBINS = thm `; .= n(u+n(x+x)) by ROB; .= x by 0; qed by -; - + n(j+u) = x [3] proof n(j+u) = n(n(x+c+u)+u) by J,D,AC; @@ -157,14 +157,14 @@ let ROBBINS = thm `; .= n(n(x+c+u)+n(x+n(c+u))) by 2,AC; .= x by ROB; qed by -; - + n(x+n(x+n(x+x)+u+n(c))) = n(x+x) [4] proof n(x+n(x+n(x+x)+u+n(c))) = n(n(n(x+u+n(c))+n(x+n(u+n(c))))+n(x+n(x+x)+u+n(c))) by ROB; .= n(n(n(x+x)+x+u+n(c))+n(n(x+x)+n(x+u+n(c)))) by 2,AC; .= n(x+x) by ROB; qed by -; - + n(x+n(c)) = u [5] proof n(x+n(c)) = n(n(u+n(x+x))+n(x+u+n(x+u+n(x+x)+n(c)))) by 0,1; @@ -172,14 +172,14 @@ let ROBBINS = thm `; .= n(n(u+x+n(x+e))+n(u+n(x+n(x+e)))) by E,AC; .= u by ROB; qed by -; - + n(j+x) = u [6] proof n(j+x) = n(j+n(n(x+c)+n(x+n(c)))) by ROB; .= n(n(u+x+c)+n(u+n(x+c))) by 5,J,D,AC; .= u by ROB; qed by -; - + n(c+d) = n(c) proof n(c+d) = j by J; @@ -188,7 +188,7 @@ let ROBBINS = thm `; .= n(n(n(c)+j+x)+n(n(c)+n(j+x))) by 6,AC; .= n(c) by ROB; qed by -; - + thus ?c d. n(c+d) = n(c) by MESON_TAC,-`;; unhide_constant "+";; diff --git a/miz3/grammar/miz3.y b/miz3/grammar/miz3.y index 902a09d3..6fb2b6a8 100644 --- a/miz3/grammar/miz3.y +++ b/miz3/grammar/miz3.y @@ -9,7 +9,7 @@ extern int yylineno; /* ',' ';' '[' ']' '(' ')' */ %% steplist - : + : | steplist step ; /* @@ -52,7 +52,7 @@ step : have_thus term labels by_just ';' | EXEC ref ';' | ';' ; -cases : +cases : | cases CASE ';' proof_tail @@ -66,13 +66,13 @@ proof_tail | QED by_just ';' | END ';' ; -opttype : +opttype : | BEING term ; -labels : +labels : | labels '[' ident ']' ; -by_just : +by_just : | BY reflist | FROM reflist | BY reflist FROM reflist @@ -96,7 +96,7 @@ termitem | ',' | '(' expr ')' ; -expr : +expr : | expr expritem ; expritem @@ -113,7 +113,7 @@ identlist ident : OTHER ; have_thus - : + : | THUS ; %% diff --git a/pa_j_3.1x_6.02.1.ml b/pa_j_3.1x_6.02.1.ml index 4e5a7d9a..4d34cb52 100644 --- a/pa_j_3.1x_6.02.1.ml +++ b/pa_j_3.1x_6.02.1.ml @@ -1143,7 +1143,7 @@ value next_token_after_spaces ctx bp = jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] - *********) + *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! diff --git a/pa_j_3.1x_6.02.2.ml b/pa_j_3.1x_6.02.2.ml index f75beaab..411acb82 100644 --- a/pa_j_3.1x_6.02.2.ml +++ b/pa_j_3.1x_6.02.2.ml @@ -1125,7 +1125,7 @@ value next_token_after_spaces ctx bp = jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] - *********) + *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! diff --git a/pa_j_3.1x_6.xx.ml b/pa_j_3.1x_6.xx.ml index 80154eb8..7d06ec47 100644 --- a/pa_j_3.1x_6.xx.ml +++ b/pa_j_3.1x_6.xx.ml @@ -1137,7 +1137,7 @@ value next_token_after_spaces ctx bp = jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] - *********) + *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! diff --git a/parser.ml b/parser.ml index d5350820..d856f6e9 100644 --- a/parser.ml +++ b/parser.ml @@ -463,7 +463,7 @@ let parse_preterm = a (Resword "else") ++ preterm >> lmk_ite) - ||| ((a (Resword "if") ) ++ preterm ++ a (Resword "then") ++ preterm ++ a (Resword "else") + ||| ((a (Resword "if") ) ++ preterm ++ a (Resword "then") ++ preterm ++ a (Resword "else") >> (fun _ -> failwith "malformed else clause")) ||| ((a (Resword "if") ) ++ preterm ++ a (Resword "then") ++ preterm >> (fun _ -> failwith "missing else following then clause")) diff --git a/system.ml b/system.ml index 158b63b4..4c3573ae 100644 --- a/system.ml +++ b/system.ml @@ -28,7 +28,7 @@ let quotexpander s = else if c = ";" then "parse_qproof \""^(String.escaped s)^"\"" else let n = String.length s - 1 in if String.sub s n 1 = ":" - then "\""^(String.escaped (String.sub s 0 n))^"\"" + then "\""^(String.escaped (String.sub s 0 n))^"\"" else "parse_term \""^(String.escaped s)^"\"";; Quotation.add "tot" (Quotation.ExStr (fun x -> quotexpander));; diff --git a/wf.ml b/wf.ml index 6ddd0a85..82e3eb1f 100644 --- a/wf.ml +++ b/wf.ml @@ -187,7 +187,7 @@ parse_as_infix("<<<",(12,"right"));; let WF_SUBSET = prove (`!(<<) (<<<). (!(x:A) y. x << y ==> x <<< y) /\ WF(<<<) ==> WF(<<)`, - REPEAT GEN_TAC THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[WF] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN UNDISCH_TAC `!(x:A) (y:A). x << y ==> x <<< y` THEN MESON_TAC[]);;