Require Import List.
Import ListNotations.
Require Omega.

(* Formalization of the definitions and lemmas in slide 1-49
 of the SOS slide set in Coq. If you want to try it yourself,
 install Coq from https://coq.inria.fr *)


Inductive t : Set :=
  | true : t
  | false : t
  | zero : t
  | succ : t -> t
  | ifthenelse : t -> t -> t -> t.

Inductive consts: t -> list t -> Prop :=
  | ctrue : consts true [true]
  | cfalse : consts false [false]
  | czero : consts zero [zero]
  | csucc : forall t c, consts t c -> consts (succ t) c
  | cite  : forall t1 c1 t2 c2 t3 c3, 
             consts t1 c1 ->
             consts t2 c2 ->
             consts t3 c3 ->
             consts (ifthenelse t1 t2 t3) (c1 ++ c2 ++ c3).

Inductive size : t -> nat -> Prop :=
  | strue : size true 1
  | sfalse : size false 1
  | szero : size zero 1
  | ssucc : forall t s, size t s -> size (succ t) (s+1)
  | site : forall t1 s1 t2 s2 t3 s3,
          size t1 s1 -> size t2 s2 -> size t3 s3 ->
          size (ifthenelse t1 t2 t3) (s1+s2+s3).

Lemma consts_is_deterministic_longproof :
  forall {tm c1 c2}, consts tm c1 -> consts tm c2 -> c1 = c2.
induction tm; intros; inversion H; inversion H0. 
- reflexivity. 
- reflexivity.
- reflexivity.
- exact (IHtm c1 c2 H2 H5).
- destruct (IHtm1 _ _ H4 H11).
  destruct (IHtm2 _ _ H6 H13).
  destruct (IHtm3 _ _ H7 H14). 
  subst. reflexivity.
Qed.

(* same lemma with more automated proof *)
Lemma consts_is_deterministic :
  forall {tm c1 c2}, consts tm c1 -> consts tm c2 -> c1 = c2.
Proof.
induction tm; intros; inversion H; inversion H0; auto.
- repeat f_equal; auto. 
Qed.


Lemma consts_is_total_long_proof: 
 forall tm, exists c, consts tm c.
Proof.
induction tm; intros.
- eexists. constructor.
- eexists. constructor.
- eexists. constructor.
- destruct IHtm as [s S]. exists (s). constructor. assumption.
- destruct IHtm1 as [s1 S1]. 
  destruct IHtm2 as [s2 S2].
  destruct IHtm3 as [s3 S3].
  exists (s1++s2++s3). constructor; assumption.
Qed.



Hint Constructors consts.

Lemma consts_is_total: 
 forall tm, exists c, consts tm c.
Proof.
induction tm; intros; 
repeat match goal with 
    | [ H : ex _ |- _ ] => destruct H
end; eauto. 
Qed.


Lemma consts_smaller_than_size_longproof:
  forall {tm c s}, (consts tm c) -> size tm s -> length c <= s.
Proof.
induction tm ; intros; inversion H; inversion H0 ; cbn.
- reflexivity.
- reflexivity.
- reflexivity.
- subst. pose proof (IHtm _ _ H2 H5). intuition.
- subst.
  rewrite (app_length c1 (c2++c3)).
  rewrite (app_length c2 c3).
  pose proof (IHtm1 c1 s1 H4 H11).
  pose proof (IHtm2 c2 s2 H6 H13).
  pose proof (IHtm3 c3 s3 H7 H14).
  rewrite Plus.plus_assoc. 
  apply Plus.plus_le_compat.
  apply Plus.plus_le_compat.
  assumption. assumption. assumption.

Qed.


(* same lemma with more automated proof *)

Hint Rewrite app_length.
Hint Rewrite Plus.plus_assoc.

Lemma consts_smaller_than_size:
  forall {tm c s}, (consts tm c) -> size tm s -> length c <= s.
Proof.
induction tm ; intros; inversion H; inversion H0; 
autorewrite with core; auto using Plus.plus_le_compat. 
intuition.
Qed.