Require Import Coq.FSets.FMapPositive.
Require Import Rustre.Common.
Require Import Rustre.Dataflow.Syntax.
Require Import Nelist.
Require Import List.

Definition clockenv := PM.t clock.

Implicit Type C: clockenv.

Inductive clk_var C (x: ident) ck: Prop :=
| Cv:
    PM.find x C = Some ck →
    clk_var C x ck.

Definition clk_vars C (xs: nelist ident) ck: Prop :=
  Nelist.Forall (fun x ⇒ clk_var C x ck) xs.

Inductive clk_clock C: clock → Prop :=
| CCbase:
    clk_clock C Cbase
| CCon:
    ∀ ck x b,
      clk_clock C ck →
      clk_var C x ck →
      clk_clock C (Con ck x b).

Inductive clk_lexp C: lexp → clock → Prop :=
| Cconst:
    ∀ c,
      clk_lexp C (Econst c) Cbase
| Cvar:
    ∀ x ck,
      clk_var C x ck →
      clk_lexp C (Evar x) ck
| Cwhen:
    ∀ e x b ck,
      clk_lexp C e ck →
      clk_var C x ck →
      clk_lexp C (Ewhen e x b) (Con ck x b)
| Cop:
    ∀ op les ck,
      Nelist.Forall (fun e ⇒ clk_lexp C e ck) les →
      clk_lexp C (Eop op les) ck.

Definition clk_lexps C (les: nelist lexp)(ck: clock): Prop :=
  Nelist.Forall (fun le ⇒ clk_lexp C le ck) les.

Inductive clk_cexp C: cexp → clock → Prop :=
| Cmerge:
    ∀ x t f ck,
      clk_var C x ck →
      clk_cexp C t (Con ck x true) →
      clk_cexp C f (Con ck x false) →
      clk_cexp C (Emerge x t f) ck
| Cexp:
    ∀ e ck,
      clk_lexp C e ck →
      clk_cexp C (Eexp e) ck.

Inductive Well_clocked_eq C: equation → Prop :=
| CEqDef:
    ∀ x ck ce,
      clk_var C x ck →
      clk_cexp C ce ck →
      Well_clocked_eq C (EqDef x ck ce)
| CEqApp:
    ∀ x ck f les,
      clk_var C x ck →
      clk_lexps C les ck →
      Well_clocked_eq C (EqApp x ck f les)
| CEqFby:
    ∀ x ck v0 le,
      clk_var C x ck →
      clk_lexp C le ck →
      Well_clocked_eq C (EqFby x ck v0 le).

Inductive Well_clocked_node C: node → Prop :=
| SNode:
    ∀ f i o eqs,
      Forall (Well_clocked_eq C) eqs →
      clk_vars C i Cbase →
      clk_var C o Cbase →
      Well_clocked_node C (mk_node f i o eqs).

Definition Well_clocked_env C : Prop :=
  ∀ x ck, PM.find x C = Some ck → clk_clock C ck.

Definition Well_clocked G : Prop :=
  Forall (fun nd⇒ ∃ C, Well_clocked_node C nd) G.

Inductive Has_clock_eq: clock → equation → Prop :=
| HcEqDef: ∀ x ck ce,
    Has_clock_eq ck (EqDef x ck ce)
| HcEqApp: ∀ x f ck les,
    Has_clock_eq ck (EqApp x ck f les)
| HcEqFby: ∀ x v0 ck le,
    Has_clock_eq ck (EqFby x ck v0 le).

Lemma clk_var_det:
  ∀ C x ck1 ck2,
    clk_var C x ck1
    → clk_var C x ck2
    → ck1 = ck2.
Proof.
  intros C x ck1 ck2.
  do 2 inversion_clear 1.
  match goal with
  | H1: PM.find x C = _, H2: PM.find x C = _ |- _
    ⇒ rewrite H1 in H2; injection H2; now auto
  end.
Qed.

Lemma Well_clocked_env_var:
  ∀ C x ck,
    Well_clocked_env C
    → clk_var C x ck
    → clk_clock C ck.
Proof.
  intros C x ck Hwc Hcv.
  unfold Well_clocked_env in Hwc.
  inversion_clear Hcv as [Hfv].
  apply Hwc with (1:=Hfv).
Qed.

Lemma clk_clock_lexp:
  ∀ C le ck,
    Well_clocked_env C
    → clk_lexp C le ck
    → clk_clock C ck.
Proof.
induction le as [| |le IH | ] using lexp_ind2.
+ inversion_clear 2; now constructor.
+ intros ck Hwc; inversion_clear 1 as [|? ? Hcv| |].
  apply Well_clocked_env_var with (1:=Hwc) (2:=Hcv).
+ intros ck Hwc.
  inversion_clear 1 as [| |? ? ? ck´ Hle Hcv |].
  constructor; [now apply IH with (1:=Hwc) (2:=Hle)|assumption].
+ intros ck Hwc; inversion_clear 1 as [| | | ? ? ? Hrec].
  induction les.
  - inversion_clear H. apply H0; trivial. now inversion_clear Hrec.
  - inversion_clear H. inversion_clear Hrec. now apply IHles.
Qed.

Lemma clk_clock_cexp:
  ∀ C ce ck,
    Well_clocked_env C
    → clk_cexp C ce ck
    → clk_clock C ck.
Proof.
  induction ce as [i ce1 IH1 ce2 IH2|].
  - intros ck Hwc.
    inversion_clear 1 as [? ? ? ? Hcv Hct Hcf|].
    apply IH1 with (1:=Hwc) in Hct.
    inversion_clear Hct; assumption.
  - intros ck Hwc; inversion_clear 1 as [|? ? Hck].
    apply clk_clock_lexp with (1:=Hwc) (2:=Hck).
Qed.

Lemma clock_no_loops:
  ∀ ck x b,
    Con ck x b ≠ ck.
Proof.
  induction ck as [|? IH]; [discriminate 1|].
  injection 1; intros ? ? Heq.
  apply IH with (1:=Heq).
Qed.

Lemma clk_clock_sub:
  ∀ C ck x b,
    Well_clocked_env C
    → clk_clock C (Con ck x b)
    → clk_var C x ck.
Proof.
  intros C ck x b Hwc Hclock.
  inversion_clear Hclock as [|? ? ? Hclock´ Hcv´].
  assumption.
Qed.