coq - Why does this rewrite fail in the context of dependent types -
i'm trying hang on dependent types, continuously run problem following. in example i'm defining abstraction arrays, such every access guarded in array using dependent typing.
i'm using coq 8.5, don't think essential in example. i'm using sflib
, libtactics
software foundations tutorial. latter found 1 work coq 8.5.
add loadpath "/home/bryan/projects/coq/sf8.5". require import sflib. (* in download https://www.cis.upenn.edu/~bcpierce/sf/current/index.html *) require import libtactics. (* https://github.com/ddcsf/iron/blob/master/done/iron/tactics/libtactics.v *) require import omega. module array.
next follows inductive , abstract definition of array.
inductive array {e: type} (sz: nat) : type := | construct_array : forall f : nat -> option e, (forall i, >= sz <-> f = none) -> array sz .
next couple of lemmas no doubt somehow available in standard library, couldn't find them except second, in classical logic part.
lemma transpose: forall f g : prop, (f -> g) -> (~ g -> ~ f). proof. auto. qed. lemma not_ex_all_not : forall u (p:u -> prop), ~ (exists n, p n) -> forall n:u, ~ p n. proof. (* intuitionistic *) unfold not. intros u p notex n abs. apply notex. exists n; trivial. qed.
the following lemma characterizes definition of array. proof feels coup force, if have suggestions simplification means.
lemma inside_array: forall e (f: nat -> option e) sz , (forall i, >= sz <-> f = none) <-> (forall i, < sz <-> exists e, f = e) . proof. introv. split; split. introv hi. remember (f i) fi. destruct fi. exists e. reflexivity. symmetry in heqfi. rewrite <- h in heqfi. exfalso. omega. introv hex. inversion hex [e he]; clear hex. specialize (h i). rewrite in h. inversion h; clear h. apply transpose in h0. searchabout ge. apply not_ge in h0. assumption. intro hcontra. inversion hcontra. intro hi. specialize (h i). inversion h. apply transpose in h1. assert (forall e, ~ f = e). apply not_ex_all_not. assumption. destruct (f i). specialize (h2 e). exfalso. auto. reflexivity. omega. intros hi. specialize (h i). inversion h. apply transpose in h0. omega. rewrite hi. intro hcontra. inversion hcontra [e hcontra']. inversion hcontra'. qed.
look element in array, provided index in range
definition lu_array {e: type} {sz: nat} (a: @array e sz) (i: nat) (c: < sz) : e. proof. intros. inversion a. remember (f i) elem. destruct (elem). apply e. symmetry in heqelem. rewrite <- h in heqelem. exfalso. omega. defined.
resize array placing new elements @ front
definition inc_l_array {e: type} {sz: nat} (a: @array e sz) (inc: nat) (d: e) : @array e (inc + sz). proof. destruct [f hi]. apply construct_array (fun j => if lt_dec j inc d else if lt_dec j (inc + sz) f (j - inc) else none). introv. split; destruct (lt_dec inc); simpl. case "i < inc ->". introv hi'. exfalso. omega. case "i >= inc ->". introv hi'. destruct (lt_dec (inc + sz)). scase "i < (inc + sz)". exfalso. omega. scase "i >= (inc + sz)". reflexivity. case "i < inc <-". introv hcontra. inversion hcontra. case "i >= inc <-". destruct (lt_dec (inc + sz)). scase "i < (inc + sz)". rewrite <- hi. omega. scase "i >= (inc + sz)". introv htriv. omega. defined.
and next problematic lemma specifies resize should do. of proof falls through, stuck @ marked rewrite.
lemma inc_l_array_spec : forall e sz (a: @array e sz) (inc: nat) (d: e) (a': @array e (inc + sz)) , inc_l_array inc d = a' -> forall (ci' : < inc + sz) , ( < inc -> lu_array a' ci' = d) /\ ( inc <= < inc + sz -> exists (ci: i-inc < sz), lu_array a' ci' = lu_array (i-inc) ci ) . proof. introv heq. introv. subst a'. destruct [f hf]. split; introv hin. case "i < inc". simpl. unfold inc_l_array, lu_array. destruct (lt_dec inc). scase "i < inc". reflexivity. scase "i >= inc". contradiction. case "inc <= < inc+sz". assert (ci: i-inc < sz) omega. exists ci. unfold inc_l_array, lu_array. destruct (lt_dec inc). scase "i < inc". exfalso. omega. scase "i >= inc". destruct (lt_dec (inc+sz)). sscase "i < inc + sz". assert (hf': forall i, < sz <-> exists e, f = e). apply inside_array. assumption. specialize (hf' (i-inc)). inversion hf'. remember ci ci''. clear heqci''. apply h in ci. inversion ci [e he]. rewrite he. (* <---- rewrite fails *) sscase "i >= inc + sz". exfalso. omega. qed. end array.
i've tried working way around in other ways, hits problem. error message looks like:
error: abstracting on term "f (i - inc)" leads term fun o : option e => (... long term ...) ill-typed. reason is: illegal application: term "@relationclasses.symmetry" of type "forall (a : type) (r : relation_definitions.relation a), relationclasses.symmetric r -> forall x y : a, r x y -> r y x" cannot applied terms "prop" : "type" "iff" : "prop -> prop -> prop" "relationclasses.iff_symmetric" : "relationclasses.symmetric iff" "i - inc >= sz" : "prop" "o = none" : "prop" "hf (i - inc)" : "i - inc >= sz <-> f (i - inc) = none" 6th term has type "i - inc >= sz <-> f (i - inc) = none" should coercible "i - inc >= sz <-> o = none".
the o = none
looks me culprit, because seems cover case i'm not handling @ moment. honestly, don't understand going on. mentioning of f (i - inc)
in 6th term worrying me, intended rewrite away.
the above approach rely on proof irrelevance connect type dependent guards. not understand how invoke axiom in above situation.
my concrete questions are: why rewrite fail? , how can remedy this?
i had closer @ doing , indeed here few comments:
- you relying on transparent proofs, in general bit of pandora box, of proof terms "opaque", , in general make things bit difficult.
- you try separate bit more proofs , "data".
- you try have more "computational" definitions. is, why not have array actual list?
see below 5 mins take on code, hope helps.
from mathcomp require import ssreflect ssrfun ssrbool eqtype ssrnat seq choice fintype. set implicit arguments. unset strict implicit. unset printing implicit defensive. section array. variable e : type. implicit types n : nat. definition i_fun := nat -> option e. implicit types arr : i_fun. identity coercion i_fun_c : i_fun >-> funclass. (* maybe better approach work reflect predicates *) (* definition up_axiom arr n := forall i, *) (* reflect (arr = none) (n <= i). *) definition up_axiom arr n := forall i, (arr = none) <-> (n <= i). definition down_axiom arr n := forall i, (exists e, arr = e) <-> (i < n). definition array n := { arr | up_axiom arr n }. coercion arr_fun n (arr : array n) := tag arr. (* sadly can't reflect *) lemma inside_array arr n : up_axiom arr n <-> down_axiom arr n. proof. split=> ax i; split. + case=> [e he]; rewrite ltnnge; apply/negp/ax; rewrite he. + move=> hi; case ha: (arr i) => [w|]; first exists w. move/ax: ha; rewrite leqngt hi. + have := ax i; case: (arr i) => // -[h1 h2 _]. rewrite leqngt; apply/negp=> /h2 []. + have := ax i; case: (arr i) => // e [h1 h2]. have h: < n; first apply: h1; exists e. rewrite leqngt h. qed. (* being transparent not useful... *) definition optdef t d (e : option t) : t := match e | x => x | none => d end. definition get_array n d arr (i : nat) : e := optdef d (arr i). definition inc_array n arr (inc : nat) (d: e) : i_fun := fun => if < n arr else if < n + inc d else none. lemma inc_arrayp n (arr : array n) inc d : up_axiom (inc_array n arr (n+inc) d) (n+inc). proof. case: arr => a_f a_ax i; have [h1 h2] := a_ax i. rewrite /inc_array /arr_fun; case: ifp => hi /=. + split; [move/h1; rewrite leqngt hi //|]. move=> hil; rewrite (leq_trans (leq_addr inc _)) // in h2. exact: h2.
Comments
Post a Comment