Definition iszero (n : nat) : bool :=
match n with
| O => true
| _ => false
end.
Functional Scheme iszero_ind := Induction for iszero Sort Prop.
intros x eg.
functional induction iszero x; simpl.
trivial.
inversion eg.
Qed.
Function ftest (n m : nat) : nat :=
match n with
| O => match m with
| O => 0
| _ => 1
end
| S p => 0
end.
(* MS: FIXME: apparently can't define R_ftest_complete. Rest of the file goes through. *)
intros n m.
functional induction ftest n m; auto.
Qed.
intros m.
functional induction ftest 0 m.
auto.
auto.
auto with *.
Qed.
Function lamfix (m n : nat) {struct n } : nat :=
match n with
| O => m
| S p => lamfix m p
end.
(* Parameter v1 v2 : nat. *)
intros v1 v2.
functional induction lamfix v1 v2.
trivial.
assumption.
Defined.
(* polymorphic function *)
Functional Scheme app_ind := Induction for app Sort Prop.
intros A l l'.
functional induction app A l l';  intuition.
rewrite <- H0; trivial.
Qed.
Require Export Arith.
Function trivfun (n : nat) : nat :=
match n with
| O => 0
| S m => trivfun m
end.
(* essaie de parametre variables non locaux:*)
Parameter varessai : nat.
functional induction trivfun varessai.
trivial.
assumption.
Defined.
Functional Scheme triv_ind := Induction for trivfun Sort Prop.
intros n'.
functional induction trivfun n'.
trivial.
assumption.
Qed.
Function iseven (n : nat) : bool :=
match n with
| O => true
| S (S m) => iseven m
| _ => false
end.
Function funex (n : nat) : nat :=
match iseven n with
| true => n
| false => match n with
| O => 0
| S r => funex r
end
end.
Function nat_equal_bool (n m : nat) {struct n} : bool :=
match n with
| O => match m with
| O => true
| _ => false
end
| S p => match m with
| O => false
| S q => nat_equal_bool p q
end
end.
Require Export Div2.
Functional Scheme div2_ind := Induction for div2 Sort Prop.
intros n.
functional induction div2 n.
auto.
auto.
apply le_S.
apply le_n_S.
exact IHn0.
Qed.
(* reuse this lemma as a scheme:*)
Function nested_lam (n : nat) : nat -> nat :=
match n with
| O => fun m : nat => 0
| S n' => fun m : nat => m + nested_lam n' m
end.
intros n m.
functional induction nested_lam n m; simpl;auto.
Qed.
Function essai (x : nat) (p : nat * nat) {struct x} : nat :=
let (n, m) := (p: nat*nat) in
match n with
| O => 0
| S q => match x with
| O => 1
| S r => S (essai r (q, m))
end
end.
intros x p.
functional induction essai x p; intros.
inversion H.
auto with arith.
auto with arith.
Qed.
Function plus_x_not_five'' (n m : nat) {struct n} : nat :=
let x := nat_equal_bool m 5 in
let y := 0 in
match n with
| O => y
| S q =>
let recapp := plus_x_not_five'' q m in
match x with
| true => S recapp
| false => S recapp
end
end.
intros a b.
functional induction plus_x_not_five'' a b; intros hyp; simpl; auto.
Qed.
intros n m.
functional induction nat_equal_bool n m; simpl; intros hyp; auto.
rewrite <- hyp in y; simpl in y;tauto.
inversion hyp.
Qed.
intros n m.
functional induction nat_equal_bool n m; simpl; intros eg; auto.
inversion eg.
inversion eg.
Qed.
Inductive istrue : bool -> Prop :=
istrue0 : istrue true.
Functional Scheme add_ind := Induction for add Sort Prop.
intros n m.
functional induction add n m; intros.
auto with arith.
auto with arith.
Qed.
intros n.
unfold plus.
functional induction plus n 0; intros.
auto with arith.
apply le_n_S.
assumption.
Qed.
intros n.
functional induction plus 0 n; intros; auto with arith.
Qed.
Function mod2 (n : nat) : nat :=
match n with
| O => 0
| S (S m) => S (mod2 m)
| _ => 0
end.
intros n.
functional induction mod2 n; simpl; auto with arith.
Qed.
Function isfour (n : nat) : bool :=
match n with
| S (S (S (S O))) => true
| _ => false
end.
Function isononeorfour (n : nat) : bool :=
match n with
| S O => true
| S (S (S (S O))) => true
| _ => false
end.
intros n.
functional induction isononeorfour n; intros istr; simpl;
inversion istr.
apply istrue0.
destruct n. inversion istr.
destruct n. tauto.
destruct n. inversion istr.
destruct n. inversion istr.
destruct n. tauto.
simpl in *. inversion H0.
Qed.
intros n.
functional induction isononeorfour n; intros m istr; inversion istr.
apply istrue0.
rewrite H in y; simpl in y;tauto.
Qed.
Function ftest4 (n m : nat) : nat :=
match n with
| O => match m with
| O => 0
| S q => 1
end
| S p => match m with
| O => 0
| S r => 1
end
end.
intros n m.
functional induction ftest n m; auto with arith.
Qed.
intros n m.
assert ({n0 | n0 = S n}).
exists (S n);reflexivity.
destruct H as [n0 H1].
rewrite <- H1;revert H1.
functional induction ftest4 n0 m.
inversion 1.
inversion 1.
auto with arith.
auto with arith.
Qed.
Function ftest44 (x : nat * nat) (n m : nat) : nat :=
let (p, q) := (x: nat*nat) in
match n with
| O => match m with
| O => 0
| S q => 1
end
| S p => match m with
| O => 0
| S r => 1
end
end.
intros pq n m o r s.
functional induction ftest44 pq n (S m).
auto with arith.
auto with arith.
auto with arith.
auto with arith.
Qed.
Function ftest2 (n m : nat) {struct n} : nat :=
match n with
| O => match m with
| O => 0
| S q => 0
end
| S p => ftest2 p m
end.
intros n m.
functional induction ftest2 n m; simpl; intros; auto.
Qed.
Function ftest3 (n m : nat) {struct n} : nat :=
match n with
| O => 0
| S p => match m with
| O => ftest3 p 0
| S r => 0
end
end.
intros n m.
functional induction ftest3 n m.
intros.
auto.
intros.
auto.
intros.
simpl.
auto.
Qed.
Function ftest5 (n m : nat) {struct n} : nat :=
match n with
| O => 0
| S p => match m with
| O => ftest5 p 0
| S r => ftest5 p r
end
end.
intros n m.
functional induction ftest5 n m.
intros.
auto.
intros.
auto.
intros.
simpl.
auto.
Qed.
Function ftest7 (n : nat) : nat :=
match ftest5 n 0 with
| O => 0
| S r => 0
end.
intros hyp1 hyp2 n.
functional induction ftest7 n; auto.
Qed.
Function ftest6 (n m : nat) {struct n} : nat :=
match n with
| O => 0
| S p => match ftest5 p 0 with
| O => ftest6 p 0
| S r => ftest6 p r
end
end.

Lemma princ6 :
(forall n m : nat, n = 0 -> ftest6 0 m <= 2) ->
(forall n m p : nat,
ftest6 p 0 <= 2 -> ftest5 p 0 = 0 -> n = S p -> ftest6 (S p) m <= 2) ->
(forall n m p r : nat,
ftest6 p r <= 2 -> ftest5 p 0 = S r -> n = S p -> ftest6 (S p) m <= 2) ->
forall x y : nat, ftest6 x y <= 2.