fix(library/equations_compiler/structural_rec): fix indices

This commit is contained in:
Gabriel Ebner 2017-05-07 15:52:39 +02:00
parent 02c744941e
commit 40bf75cbff
2 changed files with 50 additions and 5 deletions

View file

@ -339,24 +339,23 @@ struct structural_rec_fn {
expr fn_type = ctx.infer(fn);
unsigned arity = ues.get_arity_of(0);
expr rec_arg;
buffer<expr> args;
buffer<expr> other_args;
buffer<expr> pre_idx_args;
for (unsigned i = 0; i < arity; i++) {
fn_type = ctx.whnf(fn_type);
if (!is_pi(fn_type)) throw_ill_formed_eqns();
expr arg = locals.push_local_from_binding(fn_type);
args.push_back(arg);
if (i == m_arg_pos) {
rec_arg = arg;
} else if (std::find(m_indices_pos.begin(), m_indices_pos.end(), i) != m_indices_pos.end()) {
pre_idx_args.push_back(arg);
} else {
} else if (std::find(m_indices_pos.begin(), m_indices_pos.end(), i) == m_indices_pos.end()) {
other_args.push_back(arg);
}
fn_type = instantiate(binding_body(fn_type), arg);
}
buffer<expr> idx_args;
for (unsigned i : m_indices_pos)
idx_args.push_back(pre_idx_args[i]);
idx_args.push_back(args[i]);
buffer<expr> I_params;
expr I = get_app_args(ctx.relaxed_whnf(ctx.infer(rec_arg)), I_params);
unsigned nindices = m_indices_pos.size();

View file

@ -0,0 +1,46 @@
inductive ty
| base : string → ty
| arr : ty → ty → ty
namespace ty
instance : decidable_eq ty := by tactic.mk_dec_eq_instance
instance : inhabited ty := ⟨ty.base "o"⟩
end ty
@[reducible] def ctx := list ty
inductive lamexp_core : ctx → ty → Type
| var : Π {Γ : ctx} {t} (n : ), list.nth Γ n = some t → lamexp_core Γ t
| fv : Π {Γ}, string → Π t : ty, lamexp_core Γ t
| con : Π {Γ}, string → Π t : ty, lamexp_core Γ t
| app : Π {Γ} {t s}, lamexp_core Γ (ty.arr t s) → lamexp_core Γ t → lamexp_core Γ s
| abs : Π {Γ : ctx} {t s}, lamexp_core (t::Γ) s → lamexp_core Γ (ty.arr t s)
namespace lamexp_core
-- instance {Γ t} : decidable_eq (lamexp_core Γ t) := by tactic.mk_dec_eq_instance
instance {Γ t} : inhabited (lamexp_core Γ t) := ⟨lamexp_core.con "c" t⟩
end lamexp_core
@[reducible] def lamexp := lamexp_core []
namespace lamexp
lemma nth_append {α} {ys : list α} : Π {n xs}, list.nth xs n ≠ none → list.nth (xs ++ ys) n = list.nth xs n
| 0 [] h := by contradiction
| (n+1) [] h := by contradiction
| 0 (x::xs) h := rfl
| (n+1) (x::xs) h := @nth_append n xs h
def weaken_core : ∀ {Γ Δ t}, lamexp_core Γ t → lamexp_core (Γ ++ Δ) t
| Γ Δ .(t) (@lamexp_core.var .(Γ) t n h) := lamexp_core.var n $
begin rw nth_append, assumption, rw h, intro, contradiction end
| Γ Δ .(t) (lamexp_core.fv n t) := lamexp_core.fv n t
| Γ Δ .(t) (lamexp_core.con n t) := lamexp_core.con n t
| Γ Δ .(s) (@lamexp_core.app .(Γ) t s a b) := lamexp_core.app (weaken_core a) (weaken_core b)
| Γ Δ (ty.arr .(t) .(s)) (@lamexp_core.abs .(Γ) t s a) :=
lamexp_core.abs $ cast (by simp) (weaken_core a)
def weaken {Γ t} : lamexp t → lamexp_core Γ t :=
weaken_core
end lamexp