diff --git a/library/init/meta/mk_dec_eq_instance.lean b/library/init/meta/mk_dec_eq_instance.lean
index c71c59e36f..8cd4bb26b4 100644
--- a/library/init/meta/mk_dec_eq_instance.lean
+++ b/library/init/meta/mk_dec_eq_instance.lean
@@ -8,6 +8,7 @@ Helper tactic for showing that a type has decidable equality.
prelude
import init.meta.contradiction_tactic init.meta.constructor_tactic
import init.meta.injection_tactic init.meta.relation_tactics
+import init.meta.rec_util
namespace tactic
open expr environment list
@@ -45,27 +46,6 @@ do lhs_type ← infer_type lhs,
f ← pp dec_type,
fail $ to_fmt "mk_dec_eq_instance failed, failed to generate instance for" ++ format.nest 2 (format.line ++ f) }
-private meta_definition is_rec_arg (I_name : name) (e : expr) : tactic bool :=
-do t ← infer_type e,
- return $ is_constant_of (get_app_fn t) I_name
-
-/- Auxiliary function for using brec_on "dictionary" -/
-private meta_definition mk_rec_inst_aux : expr → nat → tactic expr
-| F 0 := do
- F' ← mk_app `prod.pr1 [F],
- F_type ← infer_type F' >>= whnf,
- if is_pi F_type = tt
- then return F'
- else mk_app `prod.pr1 [F']
-| F (n+1) := do
- F' ← mk_app `prod.pr2 [F],
- mk_rec_inst_aux F' n
-
-/- Use brec_on F_name (dictionary) argument to create an decidable_eq instance for (i+1)-th recursive argument. -/
-private meta_definition mk_rec_inst (F_name : name) (i : nat) : tactic expr :=
-do F ← get_local F_name,
- mk_rec_inst_aux F i
-
/- Target is of the form (decidable (C ... = C ...)) where C is a constructor -/
private meta_definition dec_eq_same_constructor (I_name : name) (F_name : name) (num_rec : nat) : tactic unit :=
do
@@ -78,10 +58,10 @@ do
rhs_list : list expr ← return $ get_app_args rhs,
when (length lhs_list ≠ length rhs_list) (fail "mk_dec_eq_instance failed, constructor applications have different number of arguments"),
(lhs_arg, rhs_arg) ← find_next_target lhs_list rhs_list,
- rec ← is_rec_arg I_name lhs_arg,
+ rec ← is_type_app_of lhs_arg I_name,
inst ← if rec = tt
then do {
- inst_fn : expr ← mk_rec_inst F_name num_rec,
+ inst_fn : expr ← mk_brec_on_rec_value F_name num_rec,
return $ inst_fn rhs_arg }
else do {
mk_dec_eq_for lhs_arg rhs_arg
diff --git a/library/init/meta/rec_util.lean b/library/init/meta/rec_util.lean
new file mode 100644
index 0000000000..87d54d60e5
--- /dev/null
+++ b/library/init/meta/rec_util.lean
@@ -0,0 +1,70 @@
+/-
+Copyright (c) 2016 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Helper tactic for showing that a type has decidable equality.
+-/
+prelude
+import init.meta.tactic
+
+namespace tactic
+open expr
+
+/- Return tt iff e's type is of the form `(I_name ...)` -/
+meta_definition is_type_app_of (e : expr) (I_name : name) : tactic bool :=
+do t ← infer_type e,
+ return $ is_constant_of (get_app_fn t) I_name
+
+/- Auxiliary function for using brec_on "dictionary" -/
+private meta_definition mk_rec_inst_aux : expr → nat → tactic expr
+| F 0 := do
+ P ← mk_app `prod.pr1 [F],
+ mk_app `prod.pr1 [P]
+| F (n+1) := do
+ F' ← mk_app `prod.pr2 [F],
+ mk_rec_inst_aux F' n
+
+/- Construct brec_on "recursive value". F_name is the name of the brec_on "dictionary".
+ Type of the F_name hypothesis should be of the form (below (C ...)) where C is a constructor.
+ The result is the "recursive value" for the (i+1)-th recursive value of the constructor C. -/
+meta_definition mk_brec_on_rec_value (F_name : name) (i : nat) : tactic expr :=
+do F ← get_local F_name,
+ mk_rec_inst_aux F i
+
+meta_definition constructor_num_fields (c : name) : tactic nat :=
+do env ← get_env,
+ decl ← returnex $ environment.get env c,
+ ctype ← return $ declaration.type decl,
+ arity ← get_pi_arity ctype,
+ I ← returnopt $ environment.inductive_type_of env c,
+ nparams ← return (environment.inductive_num_params env I),
+ return $ arity - nparams
+
+private meta_definition mk_name_list_aux : name → nat → nat → list name → list name × nat
+| p i 0 l := (list.reverse l, i)
+| p i (j+1) l := mk_name_list_aux p (i+1) j (mk_num_name p i :: l)
+
+private meta_definition mk_name_list (p : name) (i : nat) (n : nat) : list name × nat :=
+mk_name_list_aux p i n []
+
+/- Return a list of names of the form [p.i, ..., p.{i+n}] where n is
+ the number of fields of the constructor c -/
+meta_definition mk_constructor_arg_names (c : name) (p : name) (i : nat) : tactic (list name × nat) :=
+do nfields ← constructor_num_fields c,
+ return $ mk_name_list p i nfields
+
+private meta_definition mk_constructors_arg_names_aux : list name → name → nat → list (list name) → tactic (list (list name))
+| [] p i r := return (list.reverse r)
+| (c::cs) p i r := do
+ v : list name × nat ← mk_constructor_arg_names c p i,
+ match v with (l, i') := mk_constructors_arg_names_aux cs p i' (l :: r) end
+
+/- Given an inductive datatype I with k constructors and where constructor i has n_i fields,
+ return the list [[p.1, ..., p.n_1], [p.{n_1 + 1}, ..., p.{n_1 + n_2}], ..., [..., p.{n_1 + ... + n_k}]] -/
+meta_definition mk_constructors_arg_names (I : name) (p : name) : tactic (list (list name)) :=
+do env ← get_env,
+ cs ← return $ environment.constructors_of env I,
+ mk_constructors_arg_names_aux cs p 1 []
+
+end tactic
diff --git a/src/library/bin_app.h b/src/library/bin_app.h
index ebd23bca47..50c7d661e2 100644
--- a/src/library/bin_app.h
+++ b/src/library/bin_app.h
@@ -13,15 +13,14 @@ bool is_bin_app(expr const & t, expr const & f);
/** \brief Return true iff \c t is of the form ((f s1) s2), if the result is true, then store a1 -> lhs, a2 -> rhs */
bool is_bin_app(expr const & t, expr const & f, expr & lhs, expr & rhs);
-/**
- \brief Return unit if num_args == 0, args[0] if num_args == 1, and
- (op args[0] (op args[1] (op ... )))
-*/
+/** \brief Return unit if num_args == 0, args[0] if num_args == 1, and
+ (op args[0] (op args[1] (op ... ))) */
expr mk_bin_rop(expr const & op, expr const & unit, unsigned num_args, expr const * args);
expr mk_bin_rop(expr const & op, expr const & unit, std::initializer_list const & l);
+/** \brief Version of foldr that only uses unit when num_args == 0 */
template
-expr foldr(MkBin && mkb, MkUnit && mku, unsigned num_args, expr const * args) {
+expr foldr_compact(MkBin && mkb, MkUnit && mku, unsigned num_args, expr const * args) {
if (num_args == 0) {
return mku();
} else {
@@ -35,10 +34,20 @@ expr foldr(MkBin && mkb, MkUnit && mku, unsigned num_args, expr const * args) {
}
}
-/**
- \brief Return unit if num_args == 0, args[0] if num_args == 1, and
- (op ... (op (op args[0] args[1]) args[2]) ...)
-*/
+/** \brief Version of foldr that only uses unit when num_args == 0 */
+template
+expr foldr(MkBin && mkb, MkUnit && mku, unsigned num_args, expr const * args) {
+ expr r = mku();
+ unsigned i = num_args;
+ while (i > 0) {
+ --i;
+ r = mkb(args[i], r);
+ }
+ return r;
+}
+
+/** \brief Return unit if num_args == 0, args[0] if num_args == 1, and
+ (op ... (op (op args[0] args[1]) args[2]) ...) */
expr mk_bin_lop(expr const & op, expr const & unit, unsigned num_args, expr const * args);
expr mk_bin_lop(expr const & op, expr const & unit, std::initializer_list const & l);
}