diff --git a/src/library/unifier.cpp b/src/library/unifier.cpp index 1d473dea7..f7c688bdd 100644 --- a/src/library/unifier.cpp +++ b/src/library/unifier.cpp @@ -28,6 +28,9 @@ namespace lean { static name g_unifier_max_steps {"unifier", "max_steps"}; RegisterUnsignedOption(g_unifier_max_steps, LEAN_DEFAULT_UNIFIER_MAX_STEPS, "(unifier) maximum number of steps"); unsigned get_unifier_max_steps(options const & opts) { return opts.get_unsigned(g_unifier_max_steps, LEAN_DEFAULT_UNIFIER_MAX_STEPS); } +static name g_unifier_expensive {"unifier", "expensive"}; +RegisterBoolOption(g_unifier_expensive, LEAN_DEFAULT_UNIFIER_EXPENSIVE, "(unifier) enable/disable expensive (and more complete) procedure"); +bool get_unifier_expensive(options const & opts) { return opts.get_bool(g_unifier_expensive, LEAN_DEFAULT_UNIFIER_EXPENSIVE); } /** \brief Return true iff \c [begin_locals, end_locals) contains \c local */ template bool contains_local(expr const & local, It const & begin_locals, It const & end_locals) { @@ -253,6 +256,7 @@ struct unifier_fn { bool m_use_exception; //!< True if we should throw an exception when there are no more solutions. unsigned m_max_steps; unsigned m_num_steps; + bool m_expensive; bool m_first; //!< True if we still have to generate the first solution. unsigned m_next_assumption_idx; //!< Next assumption index. unsigned m_next_cidx; //!< Next constraint index. @@ -344,9 +348,9 @@ struct unifier_fn { unifier_fn(environment const & env, unsigned num_cs, constraint const * cs, name_generator const & ngen, substitution const & s, - bool use_exception, unsigned max_steps): + bool use_exception, unsigned max_steps, bool expensive): m_env(env), m_ngen(ngen), m_subst(s), m_plugin(get_unifier_plugin(env)), - m_use_exception(use_exception), m_max_steps(max_steps), m_num_steps(0) { + m_use_exception(use_exception), m_max_steps(max_steps), m_num_steps(0), m_expensive(expensive) { m_tc[0] = mk_type_checker_with_hints(env, m_ngen.mk_child(), false); m_tc[1] = mk_type_checker_with_hints(env, m_ngen.mk_child(), true); m_next_assumption_idx = 0; @@ -1471,12 +1475,14 @@ struct unifier_fn { buffer alts; process_flex_rigid_core(lhs, rhs, j, relax, alts); append_auxiliary_constraints(alts, to_list(aux.begin(), aux.end())); - expr rhs_whnf = whnf(rhs, j, relax, aux); - if (rhs_whnf != rhs) { - buffer alts2; - process_flex_rigid_core(lhs, rhs_whnf, j, relax, alts2); - append_auxiliary_constraints(alts2, to_list(aux.begin(), aux.end())); - alts.append(alts2); + if (m_expensive) { + expr rhs_whnf = whnf(rhs, j, relax, aux); + if (rhs_whnf != rhs) { + buffer alts2; + process_flex_rigid_core(lhs, rhs_whnf, j, relax, alts2); + append_auxiliary_constraints(alts2, to_list(aux.begin(), aux.end())); + alts.append(alts2); + } } if (alts.empty()) { @@ -1674,21 +1680,21 @@ lazy_list unify(std::shared_ptr u) { } lazy_list unify(environment const & env, unsigned num_cs, constraint const * cs, name_generator const & ngen, - bool use_exception, unsigned max_steps) { - return unify(std::make_shared(env, num_cs, cs, ngen, substitution(), use_exception, max_steps)); + bool use_exception, unsigned max_steps, bool expensive) { + return unify(std::make_shared(env, num_cs, cs, ngen, substitution(), use_exception, max_steps, expensive)); } lazy_list unify(environment const & env, unsigned num_cs, constraint const * cs, name_generator const & ngen, bool use_exception, options const & o) { - return unify(env, num_cs, cs, ngen, use_exception, get_unifier_max_steps(o)); + return unify(env, num_cs, cs, ngen, use_exception, get_unifier_max_steps(o), get_unifier_expensive(o)); } lazy_list unify(environment const & env, expr const & lhs, expr const & rhs, name_generator const & ngen, - bool relax, substitution const & s, unsigned max_steps) { + bool relax, substitution const & s, unsigned max_steps, bool expensive) { substitution new_s = s; expr _lhs = new_s.instantiate(lhs); expr _rhs = new_s.instantiate(rhs); - auto u = std::make_shared(env, 0, nullptr, ngen, new_s, false, max_steps); + auto u = std::make_shared(env, 0, nullptr, ngen, new_s, false, max_steps, expensive); if (!u->m_tc[relax]->is_def_eq(_lhs, _rhs)) return lazy_list(); else @@ -1697,7 +1703,7 @@ lazy_list unify(environment const & env, expr const & lhs, expr co lazy_list unify(environment const & env, expr const & lhs, expr const & rhs, name_generator const & ngen, bool relax, substitution const & s, options const & o) { - return unify(env, lhs, rhs, ngen, relax, s, get_unifier_max_steps(o)); + return unify(env, lhs, rhs, ngen, relax, s, get_unifier_max_steps(o), get_unifier_expensive(o)); } static int unify_simple(lua_State * L) { diff --git a/src/library/unifier.h b/src/library/unifier.h index c64b4169c..5dca5b99c 100644 --- a/src/library/unifier.h +++ b/src/library/unifier.h @@ -19,6 +19,10 @@ Author: Leonardo de Moura #define LEAN_DEFAULT_UNIFIER_MAX_STEPS 10000 #endif +#ifndef LEAN_DEFAULT_UNIFIER_EXPENSIVE +#define LEAN_DEFAULT_UNIFIER_EXPENSIVE false +#endif + namespace lean { unsigned get_unifier_max_steps(options const & opts); bool get_unifier_unfold_opaque(options const & opts); @@ -37,11 +41,11 @@ unify_status unify_simple(substitution & s, level const & lhs, level const & rhs unify_status unify_simple(substitution & s, constraint const & c); lazy_list unify(environment const & env, unsigned num_cs, constraint const * cs, name_generator const & ngen, - bool use_exception = true, unsigned max_steps = LEAN_DEFAULT_UNIFIER_MAX_STEPS); + bool use_exception = true, unsigned max_steps = LEAN_DEFAULT_UNIFIER_MAX_STEPS, bool expensive = LEAN_DEFAULT_UNIFIER_EXPENSIVE); lazy_list unify(environment const & env, unsigned num_cs, constraint const * cs, name_generator const & ngen, bool use_exception, options const & o); lazy_list unify(environment const & env, expr const & lhs, expr const & rhs, name_generator const & ngen, bool relax_main_opaque, - substitution const & s = substitution(), unsigned max_steps = LEAN_DEFAULT_UNIFIER_MAX_STEPS); + substitution const & s = substitution(), unsigned max_steps = LEAN_DEFAULT_UNIFIER_MAX_STEPS, bool expensive = LEAN_DEFAULT_UNIFIER_MAX_STEPS); lazy_list unify(environment const & env, expr const & lhs, expr const & rhs, name_generator const & ngen, bool relax_main_opaque, substitution const & s, options const & o); diff --git a/tests/lean/run/list_elab1.lean b/tests/lean/run/list_elab1.lean index 1599ed19d..a144d25f8 100644 --- a/tests/lean/run/list_elab1.lean +++ b/tests/lean/run/list_elab1.lean @@ -11,7 +11,7 @@ import nat using nat eq_proofs - +set_option unifier.expensive true inductive list (T : Type) : Type := | nil {} : list T | cons : T → list T → list T diff --git a/tests/lean/slow/list_elab2.lean b/tests/lean/slow/list_elab2.lean new file mode 100644 index 000000000..313099e22 --- /dev/null +++ b/tests/lean/slow/list_elab2.lean @@ -0,0 +1,234 @@ +---------------------------------------------------------------------------------------------------- +--- Copyright (c) 2014 Parikshit Khanna. All rights reserved. +--- Released under Apache 2.0 license as described in the file LICENSE. +--- Authors: Parikshit Khanna, Jeremy Avigad +---------------------------------------------------------------------------------------------------- + +-- Theory list +-- =========== +-- +-- Basic properties of lists. + +import tactic +import nat +-- import congr + +set_option unifier.expensive true +using nat +-- using congr +using eq_proofs + +namespace list + + +-- Type +-- ---- + +inductive list (T : Type) : Type := +| nil {} : list T +| cons : T → list T → list T + +infix `::` : 65 := cons + +section + +variable {T : Type} + +theorem list_induction_on {P : list T → Prop} (l : list T) (Hnil : P nil) + (Hind : forall x : T, forall l : list T, forall H : P l, P (cons x l)) : P l := +list_rec Hnil Hind l + +theorem list_cases_on {P : list T → Prop} (l : list T) (Hnil : P nil) + (Hcons : forall x : T, forall l : list T, P (cons x l)) : P l := +list_induction_on l Hnil (take x l IH, Hcons x l) + +notation `[` l:(foldr `,` (h t, cons h t) nil) `]` := l + + +-- Concat +-- ------ + +definition concat (s t : list T) : list T := +list_rec t (fun x : T, fun l : list T, fun u : list T, cons x u) s + +infixl `++` : 65 := concat + +theorem nil_concat (t : list T) : nil ++ t = t := refl _ + +theorem cons_concat (x : T) (s t : list T) : (x :: s) ++ t = x :: (s ++ t) := refl _ + +theorem concat_nil (t : list T) : t ++ nil = t := +list_induction_on t (refl _) + (take (x : T) (l : list T) (H : concat l nil = l), + H ▸ (refl (cons x (concat l nil)))) + +theorem concat_nil2 (t : list T) : t ++ nil = t := +list_induction_on t (refl _) + (take (x : T) (l : list T) (H : concat l nil = l), + -- H ▸ (refl (cons x (concat l nil)))) + H ▸ (refl (concat (cons x l) nil))) + +theorem concat_assoc (s t u : list T) : s ++ t ++ u = s ++ (t ++ u) := +list_induction_on s (refl _) + (take x l, + assume H : concat (concat l t) u = concat l (concat t u), + H ▸ refl _) + +theorem concat_assoc2 (s t u : list T) : s ++ t ++ u = s ++ (t ++ u) := +list_induction_on s (refl _) + (take x l, + assume H : concat (concat l t) u = concat l (concat t u), + calc concat (concat (cons x l) t) u = cons x (concat (concat l t) u) : refl _ + ... = concat (cons x l) (concat t u) : { H }) + +theorem concat_assoc3 (s t u : list T) : s ++ t ++ u = s ++ (t ++ u) := +list_induction_on s (refl _) + (take x l, + assume H : concat (concat l t) u = concat l (concat t u), + calc concat (concat (cons x l) t) u = cons x (concat l (concat t u)) : { H } + ... = concat (cons x l) (concat t u) : refl _) + +theorem concat_assoc4 (s t u : list T) : s ++ t ++ u = s ++ (t ++ u) := +list_induction_on s (refl _) + (take x l, + assume H : concat (concat l t) u = concat l (concat t u), + calc + concat (concat (cons x l) t) u = cons x (concat (concat l t) u) : refl _ + ... = cons x (concat l (concat t u)) : { H } + ... = concat (cons x l) (concat t u) : refl _) + +-- Length +-- ------ + +definition length : list T → ℕ := list_rec 0 (fun x l m, succ m) + +-- TODO: cannot replace zero by 0 +theorem length_nil : length (@nil T) = zero := refl _ + +theorem length_cons (x : T) (t : list T) : length (x :: t) = succ (length t) := refl _ + +theorem length_concat (s t : list T) : length (s ++ t) = length s + length t := +list_induction_on s + (calc + length (concat nil t) = length t : refl _ + ... = zero + length t : {symm (add_zero_left (length t))} + ... = length (@nil T) + length t : refl _) + (take x s, + assume H : length (concat s t) = length s + length t, + calc + length (concat (cons x s) t ) = succ (length (concat s t)) : refl _ + ... = succ (length s + length t) : { H } + ... = succ (length s) + length t : {symm (add_succ_left _ _)} + ... = length (cons x s) + length t : refl _) + +-- Reverse +-- ------- + +definition reverse : list T → list T := list_rec nil (fun x l r, r ++ [x]) + +theorem reverse_nil : reverse (@nil T) = nil := refl _ + +theorem reverse_cons (x : T) (l : list T) : reverse (x :: l) = (reverse l) ++ (cons x nil) := refl _ + +-- opaque_hint (hiding reverse) + +theorem reverse_concat (s t : list T) : reverse (s ++ t) = (reverse t) ++ (reverse s) := +list_induction_on s + (calc + reverse (concat nil t) = reverse t : { nil_concat _ } + ... = concat (reverse t) nil : symm (concat_nil _) + ... = concat (reverse t) (reverse nil) : {symm (reverse_nil)}) + (take x l, + assume H : reverse (concat l t) = concat (reverse t) (reverse l), + calc + reverse (concat (cons x l) t) = concat (reverse (concat l t)) (cons x nil) : refl _ + ... = concat (concat (reverse t) (reverse l)) (cons x nil) : { H } + ... = concat (reverse t) (concat (reverse l) (cons x nil)) : concat_assoc _ _ _ + ... = concat (reverse t) (reverse (cons x l)) : refl _) + + +-- -- add_rewrite length_nil length_cons +theorem reverse_reverse (l : list T) : reverse (reverse l) = l := +list_induction_on l (refl _) + (take x l', + assume H: reverse (reverse l') = l', + show reverse (reverse (cons x l')) = cons x l', from + calc + reverse (reverse (cons x l')) = + concat (reverse (cons x nil)) (reverse (reverse l')) : {reverse_concat _ _} + ... = cons x l' : {H}) +-- Append +-- ------ + +-- TODO: define reverse from append + +definition append (x : T) : list T → list T := list_rec (x :: nil) (fun y l l', y :: l') + +theorem append_nil (x : T) : append x nil = [x] := refl _ + +theorem append_cons (x : T) (y : T) (l : list T) : append x (y :: l) = y :: (append x l) := refl _ + +theorem append_eq_concat (x : T) (l : list T) : append x l = l ++ [x] := +list_induction_on l (refl _) + (take y l, + assume P : append x l = concat l [x], + P ▸ refl _) + +set_option unifier.expensive false +theorem append_eq_reverse_cons (x : T) (l : list T) : append x l = reverse (x :: reverse l) := +list_induction_on l + (calc + append x nil = [x] : (refl _) + ... = concat nil [x] : {symm (nil_concat _)} + ... = concat (reverse nil) [x] : {symm (reverse_nil)} + ... = reverse [x] : {symm (reverse_cons _ _)} + ... = reverse (x :: (reverse nil)) : {symm (reverse_nil)}) + (take y l', + assume H : append x l' = reverse (x :: reverse l'), + calc + append x (y :: l') = (y :: l') ++ [ x ] : append_eq_concat _ _ + ... = concat (reverse (reverse (y :: l'))) [ x ] : {symm (reverse_reverse _)} + ... = reverse (x :: (reverse (y :: l'))) : refl _) + +exit +-- Head and tail +-- ------------- + +definition head (x0 : T) : list T → T := list_rec x0 (fun x l h, x) + +theorem head_nil (x0 : T) : head x0 (@nil T) = x0 := refl _ + +theorem head_cons (x : T) (x0 : T) (t : list T) : head x0 (x :: t) = x := refl _ + +theorem head_concat (s t : list T) (x0 : T) : s ≠ nil → (head x0 (s ++ t) = head x0 s) := +list_cases_on s + (take H : nil ≠ nil, absurd_elim (head x0 (concat nil t) = head x0 nil) (refl nil) H) + (take x s, + take H : cons x s ≠ nil, + calc + head x0 (concat (cons x s) t) = head x0 (cons x (concat s t)) : {cons_concat _ _ _} + ... = x : {head_cons _ _ _} + ... = head x0 (cons x s) : {symm ( head_cons x x0 s)}) + +definition tail : list T → list T := list_rec nil (fun x l b, l) + +theorem tail_nil : tail (@nil T) = nil := refl _ + +theorem tail_cons (x : T) (l : list T) : tail (cons x l) = l := refl _ + +theorem cons_head_tail (x0 : T) (l : list T) : l ≠ nil → (head x0 l) :: (tail l) = l := +list_cases_on l + (assume H : nil ≠ nil, absurd_elim _ (refl _) H) + (take x l, assume H : cons x l ≠ nil, refl _) + + +-- List membership +-- --------------- + +definition mem (x : T) : list T → Prop := list_rec false (fun y l H, x = y ∨ H) + +infix `∈` : 50 := mem + +theorem mem_nil (x : T) : mem x nil ↔ false := iff_refl _ + +theorem mem_cons (x : T) (y : T) (l : list T) : mem x (cons y l) ↔ (x = y ∨ mem x l) := iff_refl _