Require Export prosa.util.all.
Require Export prosa.behavior.all.
Require Export prosa.model.processor.platform_properties.

(** * Service *)

(** In this file, we establish basic facts about the service received by
    jobs. *)

(** To begin with, we provide some simple but handy rewriting rules for
      [service] and [service_during]. *)
Section Composition.

  (** Consider any job type and any processor state. *)
  Context {Job: JobType}.
  Context {PState: Type}.
  Context `{ProcessorState Job PState}.

  (** For any given schedule... *)
  Variable sched: schedule PState.

  (** ...and any given job... *)
  Variable j: Job.

  (** ...we establish a number of useful rewriting rules that decompose
     the service received during an interval into smaller intervals. *)

  (** As a trivial base case, no job receives any service during an empty
     interval. *)
  Lemma service_during_geq:
    forall t1 t2,
      t1 >= t2 -> service_during sched j t1 t2 = 0.
  Proof.
    move=> t1 t2 t1t2.
    rewrite /service_during big_geq //.
  Qed.

  (** Equally trivially, no job has received service prior to time zero. *)
  Corollary service0:
    service sched j 0 = 0.
  Proof.
    rewrite /service service_during_geq //.
  Qed.

  (** Trivially, an interval consisting of one time unit is equivalent to
     [service_at].  *)
  Lemma service_during_instant:
    forall t,
      service_during sched j t t.+1 = service_at sched j t.
  Proof.
    move => t.
     by rewrite /service_during big_nat_recr ?big_geq //.
  Qed.

  (** Next, we observe that we can look at the service received during an
     interval <<[t1, t3)>> as the sum of the service during [t1, t2) and [t2, t3)
     for any t2 \in [t1, t3]. (The "_cat" suffix denotes the concatenation of
     the two intervals.) *)
  Lemma service_during_cat:
    forall t1 t2 t3,
      t1 <= t2 <= t3 ->
      (service_during sched j t1 t2) + (service_during sched j t2 t3)
      = service_during sched j t1 t3.
  Proof.
    move => t1 t2 t3 /andP [t1t2 t2t3].
      by rewrite /service_during -big_cat_nat /=.
  Qed.

  (** Since [service] is just a special case of [service_during], the same holds
     for [service]. *)
  Lemma service_cat:
    forall t1 t2,
      t1 <= t2 ->
      (service sched j t1) + (service_during sched j t1 t2)
      = service sched j t2.
  Proof.
    move=> t1 t2 t1t2.
    rewrite /service service_during_cat //.
  Qed.

  (** As a special case, we observe that the service during an interval can be
     decomposed into the first instant and the rest of the interval. *)
  Lemma service_during_first_plus_later:
    forall t1 t2,
      t1 < t2 ->
      (service_at sched j t1) + (service_during sched j t1.+1 t2)
      = service_during sched j t1 t2.
  Proof.
    move => t1 t2 t1t2.
    have TIMES: t1 <= t1.+1 <= t2 by rewrite /(_ && _) ifT //.
    have SPLIT := service_during_cat t1 t1.+1 t2 TIMES.
      by rewrite -service_during_instant //.
  Qed.

  (** Symmetrically, we have the same for the end of the interval. *)
  Lemma service_during_last_plus_before:
    forall t1 t2,
      t1 <= t2 ->
      (service_during sched j t1 t2) + (service_at sched j t2)
      = service_during sched j t1 t2.+1.
  Proof.
    move=> t1 t2 t1t2.
    rewrite -(service_during_cat t1 t2 t2.+1); last by rewrite /(_ && _) ifT //.
    rewrite service_during_instant //.
  Qed.

  (** And hence also for [service]. *)
  Corollary service_last_plus_before:
    forall t,
      (service sched j t) + (service_at sched j t)
      = service sched j t.+1.
  Proof.
    move=> t.
    rewrite /service. rewrite -service_during_last_plus_before //.
  Qed.

  (** Finally, we deconstruct the service received during an interval <<[t1, t3)>>
     into the service at a midpoint t2 and the service in the intervals before
     and after. *)
  Lemma service_split_at_point:
    forall t1 t2 t3,
      t1 <= t2 < t3 ->
      (service_during sched j t1 t2) + (service_at sched j t2) + (service_during sched j t2.+1 t3)
      = service_during sched j t1 t3.
  Proof.
    move => t1 t2 t3 /andP [t1t2 t2t3].
    rewrite -addnA service_during_first_plus_later// service_during_cat// /(_ && _) ifT//.
      by exact: ltnW.
  Qed.

End Composition.

(** As a common special case, we establish facts about schedules in which a
    job receives either 1 or 0 service units at all times. *)
Section UnitService.

  (** Consider any job type and any processor state. *)
  Context {Job: JobType}.
  Context {PState: Type}.
  Context `{ProcessorState Job PState}.

  (** Let's consider a unit-service model... *)
  Hypothesis H_unit_service: unit_service_proc_model PState.

  (** ...and a given schedule. *)
  Variable sched: schedule PState.

  (** Let [j] be any job that is to be scheduled. *)
  Variable j: Job.

  (** First, we prove that the instantaneous service cannot be greater than 1, ... *)
  Lemma service_at_most_one:
    forall t, service_at sched j t <= 1.
  Proof.
      by move=> t; rewrite /service_at.
  Qed.

  (** ...which implies that the cumulative service received by job [j] in any
     interval of length delta is at most delta. *)
  Lemma cumulative_service_le_delta:
    forall t delta,
      service_during sched j t (t + delta) <= delta.
  Proof.
    unfold service_during; intros t delta.
    apply leq_trans with (n := \sum_(t <= t0 < t + delta) 1);
      last by rewrite sum_of_ones.
    by apply: leq_sum => t' _; apply: service_at_most_one.
  Qed.

  Section ServiceIsAStepFunction.

    (** We show that the service received by any job [j] is a step function. *)
    Lemma service_is_a_step_function:
      is_step_function (service sched j).
    Proof.
      rewrite /is_step_function => t.
      rewrite addn1 -service_last_plus_before leq_add2l.
      apply service_at_most_one.
    Qed.

    (** Next, consider any time [t]... *)
    Variable t: instant.

    (** ...and let [s0] be any value less than the service received
       by job [j] by time [t]. *)
    Variable s0: duration.
    Hypothesis H_less_than_s: s0 < service sched j t.

    (** Then, we show that there exists an earlier time [t0] where job [j] had [s0]
       units of service. *)
    Corollary exists_intermediate_service:
      exists t0,
        t0 < t /\
        service sched j t0 = s0.
    Proof.
      feed (exists_intermediate_point (service sched j));
        [by apply service_is_a_step_function | intros EX].
      feed (EX 0 t); first by done.
      feed (EX s0);
        first by rewrite /service /service_during big_geq //.
        by move: EX => /= [x_mid EX]; exists x_mid.
    Qed.
  End ServiceIsAStepFunction.

End UnitService.

(** We establish a basic fact about the monotonicity of service. *)
Section Monotonicity.

  (** Consider any job type and any processor model. *)
  Context {Job: JobType}.
  Context {PState: Type}.
  Context `{ProcessorState Job PState}.

  (** Consider any given schedule... *)
  Variable sched: schedule PState.

  (** ...and a given job that is to be scheduled. *)
  Variable j: Job.

  (** We observe that the amount of service received is monotonic by definition. *)
  Lemma service_monotonic:
    forall t1 t2,
      t1 <= t2 ->
      service sched j t1 <= service sched j t2.
  Proof.
    move=> t1 t2 let1t2.
      by rewrite -(service_cat sched j t1 t2 let1t2); apply: leq_addr.
  Qed.

End Monotonicity.

(** Consider any job type and any processor model. *)
Section RelationToScheduled.

  Context {Job: JobType}.
  Context {PState: Type}.
  Context `{ProcessorState Job PState}.

  (** Consider any given schedule... *)
  Variable sched: schedule PState.

  (** ...and a given job that is to be scheduled. *)
  Variable j: Job.

  (** We observe that a job that isn't scheduled cannot possibly receive service. *)
  Lemma not_scheduled_implies_no_service:
    forall t,
      ~~ scheduled_at sched j t -> service_at sched j t = 0.
  Proof.
    rewrite /service_at /scheduled_at.
    move=> t NOT_SCHED.
    rewrite service_implies_scheduled //.
  Qed.

  (** Conversely, if a job receives service, then it must be scheduled. *)
  Lemma service_at_implies_scheduled_at:
    forall t,
      service_at sched j t > 0 -> scheduled_at sched j t.
  Proof.
    move=> t.
    destruct (scheduled_at sched j t) eqn:SCHEDULED; first trivial.
    rewrite not_scheduled_implies_no_service // negbT //.
  Qed.

  (** Thus, if the cumulative amount of service changes, then it must be
     scheduled, too. *)
  Lemma service_delta_implies_scheduled:
    forall t,
      service sched j t < service sched j t.+1 -> scheduled_at sched j t.
  Proof.
    move => t.
    rewrite -service_last_plus_before -{1}(addn0 (service sched j t)) ltn_add2l.
    apply: service_at_implies_scheduled_at.
  Qed.

  (** We observe that a job receives cumulative service during some interval iff
     it receives services at some specific time in the interval. *)
  Lemma service_during_service_at:
    forall t1 t2,
      service_during sched j t1 t2 > 0
      <->
      exists t,
        t1 <= t < t2 /\
        service_at sched j t > 0.
  Proof.
    split.
    {
      move=> NONZERO.
      case (boolP([exists t: 'I_t2,
                      (t >= t1) && (service_at sched j t > 0)])) => [EX | ALL].
      - move: EX => /existsP [x /andP [GE SERV]].
        exists x; split => //.
        apply /andP; by split.
      - rewrite negb_exists in ALL; move: ALL => /forallP ALL.
        rewrite /service_during big_nat_cond in NONZERO.
        rewrite big1 ?ltn0 // in NONZERO => i.
        rewrite andbT; move => /andP [GT LT].
        specialize (ALL (Ordinal LT)); simpl in ALL.
        rewrite GT andTb -eqn0Ngt in ALL.
        apply /eqP => //.
    }
    {
      move=> [t [TT SERVICE]].
      case (boolP (0 < service_during sched j t1 t2)) => // NZ.
      exfalso.
      rewrite -eqn0Ngt in NZ. move/eqP: NZ.
      rewrite big_nat_eq0 => IS_ZERO.
      have NO_SERVICE := IS_ZERO t TT.
      apply lt0n_neq0 in SERVICE.
        by move/neqP in SERVICE; contradiction.
    }
  Qed.

  (** Thus, any job that receives some service during an interval must be
      scheduled at some point during the interval... *)
  Corollary cumulative_service_implies_scheduled:
    forall t1 t2,
      service_during sched j t1 t2 > 0 ->
      exists t,
        t1 <= t < t2 /\
        scheduled_at sched j t.
  Proof.
    move=> t1 t2.
    rewrite service_during_service_at.
    move=> [t' [TIMES SERVICED]].
    exists t'; split => //.
    by apply: service_at_implies_scheduled_at.
 Qed.

  (** ...which implies that any job with positive cumulative service must have
     been scheduled at some point. *)
  Corollary positive_service_implies_scheduled_before:
    forall t,
      service sched j t > 0 -> exists t', (t' < t /\ scheduled_at sched j t').
  Proof.
    move=> t2.
    rewrite /service => NONZERO.
    have EX_SCHED := cumulative_service_implies_scheduled 0 t2 NONZERO.
    by move: EX_SCHED => [t [TIMES SCHED_AT]]; exists t; split.
  Qed.

  (** If we can assume that a scheduled job always receives service,
      we can further prove the converse. *)
  Section GuaranteedService.

    (** Assume [j] always receives some positive service. *)
    Hypothesis H_scheduled_implies_serviced: ideal_progress_proc_model PState.

    (** In other words, not being scheduled is equivalent to receiving zero
       service. *)
    Lemma no_service_not_scheduled:
      forall t,
        ~~ scheduled_at sched j t <-> service_at sched j t = 0.
    Proof.
      move=> t. rewrite /scheduled_at /service_at.
      split => [NOT_SCHED | NO_SERVICE].
      - by rewrite service_implies_scheduled //.
      - apply (contra (H_scheduled_implies_serviced j (sched t))).
        by rewrite -eqn0Ngt; apply /eqP => //.
    Qed.

    (** Then, if a job does not receive any service during an interval, it
       is not scheduled. *)
    Lemma no_service_during_implies_not_scheduled:
      forall t1 t2,
        service_during sched j t1 t2 = 0 ->
        forall t,
          t1 <= t < t2 -> ~~ scheduled_at sched j t.
    Proof.
      move=> t1 t2 ZERO_SUM t /andP [GT_t1 LT_t2].
      rewrite no_service_not_scheduled.
      move: ZERO_SUM.
      rewrite /service_during big_nat_eq0 => IS_ZERO.
      by apply (IS_ZERO t); apply /andP; split => //.
    Qed.

    (** Conversely, if a job is not scheduled during an interval, then
        it does not receive any service in that interval *)
    Lemma not_scheduled_during_implies_zero_service:
      forall t1 t2,
        (forall t, t1 <= t < t2 -> ~~ scheduled_at sched j t) ->
        service_during sched j t1 t2 = 0.
    Proof.
      intros t1 t2 NSCHED.
      apply big_nat_eq0; move=> t NEQ.
      by apply no_service_not_scheduled, NSCHED.
    Qed.

    (** If a job is scheduled at some point in an interval, it receives
       positive cumulative service during the interval... *)
    Lemma scheduled_implies_cumulative_service:
      forall t1 t2,
        (exists t,
            t1 <= t < t2 /\
            scheduled_at sched j t) ->
        service_during sched j t1 t2 > 0.
    Proof.
      move=> t1 t2 [t' [TIMES SCHED]].
      rewrite service_during_service_at.
      exists t'; split => //.
      move: SCHED. rewrite /scheduled_at /service_at.
        by apply (H_scheduled_implies_serviced j (sched t')).
    Qed.

    (** ...which again applies to total service, too. *)
    Corollary scheduled_implies_nonzero_service:
      forall t,
        (exists t',
            t' < t /\
            scheduled_at sched j t') ->
        service sched j t > 0.
    Proof.
      move=> t [t' [TT SCHED]].
      rewrite /service. apply scheduled_implies_cumulative_service.
      exists t'; split => //.
    Qed.

  End GuaranteedService.

  (** Furthermore, if we know that jobs are not released early, then we can
      narrow the interval during which they must have been scheduled. *)
  Section AfterArrival.

    Context `{JobArrival Job}.

    (** Assume that jobs must arrive to execute. *)
    Hypothesis H_jobs_must_arrive:
      jobs_must_arrive_to_execute sched.

    (** We prove that any job with positive cumulative service at time [t] must
       have been scheduled some time since its arrival and before time [t]. *)
    Lemma positive_service_implies_scheduled_since_arrival:
      forall t,
        service sched j t > 0 ->
        exists t', (job_arrival j <= t' < t /\ scheduled_at sched j t').
    Proof.
      move=> t SERVICE.
      have EX_SCHED := positive_service_implies_scheduled_before t SERVICE.
      inversion EX_SCHED as [t'' [TIMES SCHED_AT]].
      exists t''; split; last by assumption.
      rewrite /(_ && _) ifT //.
      move: H_jobs_must_arrive. rewrite /jobs_must_arrive_to_execute /has_arrived => ARR.
        by apply: ARR; exact.
    Qed.

    Lemma not_scheduled_before_arrival:
      forall t, t < job_arrival j -> ~~ scheduled_at sched j t.
    Proof.
      move=> t EARLY.
      apply: (contra (H_jobs_must_arrive j t)).
      rewrite /has_arrived -ltnNge //.
   Qed.

    (** We show that job [j] does not receive service at any time [t] prior to its
        arrival. *)
    Lemma service_before_job_arrival_zero:
      forall t,
        t < job_arrival j ->
        service_at sched j t = 0.
    Proof.
      move=> t NOT_ARR.
      rewrite not_scheduled_implies_no_service // not_scheduled_before_arrival //.
    Qed.

    (** Note that the same property applies to the cumulative service. *)
    Lemma cumulative_service_before_job_arrival_zero :
      forall t1 t2 : instant,
        t2 <= job_arrival j ->
        service_during sched j t1 t2 = 0.
    Proof.
      move=> t1 t2 EARLY.
      rewrite /service_during.
      have ZERO_SUM: \sum_(t1 <= t < t2) service_at sched j t = \sum_(t1 <= t < t2) 0;
        last by rewrite ZERO_SUM sum0.
      rewrite big_nat_cond [in RHS]big_nat_cond.
      apply: eq_bigr => i /andP [TIMES _]. move: TIMES => /andP [le_t1_i lt_i_t2].
      apply (service_before_job_arrival_zero i).
        by apply leq_trans with (n := t2); auto.
    Qed.

    (** Hence, one can ignore the service received by a job before its arrival
       time... *)
    Lemma ignore_service_before_arrival:
      forall t1 t2,
        t1 <= job_arrival j ->
        t2 >= job_arrival j ->
        service_during sched j t1 t2 = service_during sched j (job_arrival j) t2.
    Proof.
      move=> t1 t2 le_t1 le_t2.
      rewrite -(service_during_cat sched j t1 (job_arrival j) t2).
      rewrite cumulative_service_before_job_arrival_zero //.
        by apply/andP; split; exact.
    Qed.

    (** ... which we can also state in terms of cumulative service. *)
    Corollary no_service_before_arrival:
      forall t,
        t <= job_arrival j -> service sched j t = 0.
    Proof.
      move=> t EARLY.
      rewrite /service cumulative_service_before_job_arrival_zero //.
    Qed.

  End AfterArrival.

  (** In this section, we prove some lemmas about time instants with same
      service. *)
  Section TimesWithSameService.

    (** Consider any time instants [t1] and [t2]... *)
    Variable t1 t2: instant.

    (** ...where [t1] is no later than [t2]... *)
    Hypothesis H_t1_le_t2: t1 <= t2.

    (** ...and where job [j] has received the same amount of service. *)
    Hypothesis H_same_service: service sched j t1 = service sched j t2.

    (** First, we observe that this means that the job receives no service
       during <<[t1, t2)>>... *)
    Lemma constant_service_implies_no_service_during:
      service_during sched j t1 t2 = 0.
    Proof.
      move: H_same_service.
      rewrite -(service_cat sched j t1 t2) // -[service sched j t1 in LHS]addn0 => /eqP.
      by rewrite eqn_add2l => /eqP //.
    Qed.

    (** ...which of course implies that it does not receive service at any
       point, either. *)
    Lemma constant_service_implies_not_scheduled:
      forall t,
        t1 <= t < t2 -> service_at sched j t = 0.
    Proof.
      move=> t /andP [GE_t1 LT_t2].
      move: constant_service_implies_no_service_during.
      rewrite /service_during big_nat_eq0 => IS_ZERO.
      apply IS_ZERO. apply /andP; split => //.
    Qed.

    (** We show that job [j] receives service at some point [t < t1]
       iff [j] receives service at some point [t' < t2]. *)
    Lemma same_service_implies_serviced_at_earlier_times:
      [exists t: 'I_t1, service_at sched j t > 0] =
      [exists t': 'I_t2, service_at sched j t' > 0].
    Proof.
      apply /idP/idP => /existsP [t SERVICED].
      {
        have LE: t < t2
          by apply: (leq_trans _ H_t1_le_t2) => //.
        by apply /existsP; exists (Ordinal LE).
      }
      {
        case (boolP (t < t1)) => LE.
        - by apply /existsP; exists (Ordinal LE).
        - exfalso.
          have TIMES: t1 <= t < t2
            by apply /andP; split => //; rewrite leqNgt //.
          have NO_SERVICE := constant_service_implies_not_scheduled t TIMES.
          by rewrite NO_SERVICE in SERVICED.
      }
    Qed.

    (** Then, under the assumption that scheduled jobs receives service,
        we can translate this into a claim about scheduled_at. *)

    (** Assume [j] always receives some positive service. *)
    Hypothesis H_scheduled_implies_serviced: ideal_progress_proc_model PState.

    (** We show that job [j] is scheduled at some point [t < t1] iff [j] is scheduled
       at some point [t' < t2].  *)
    Lemma same_service_implies_scheduled_at_earlier_times:
      [exists t: 'I_t1, scheduled_at sched j t] =
      [exists t': 'I_t2, scheduled_at sched j t'].
    Proof.
      have CONV: forall B, [exists b: 'I_B, scheduled_at sched j b]
                           = [exists b: 'I_B, service_at sched j b > 0].
      {
        move=> B. apply/idP/idP => /existsP [b P]; apply /existsP; exists b.
        - by move: P; rewrite /scheduled_at /service_at;
            apply (H_scheduled_implies_serviced j (sched b)).
        - by apply service_at_implies_scheduled_at.
      }
      rewrite !CONV.
      apply same_service_implies_serviced_at_earlier_times.
    Qed.
  End TimesWithSameService.

End RelationToScheduled.

Section ServiceInTwoSchedules.

  (** Consider any job type and any processor model. *)
  Context {Job: JobType}.
  Context {PState: Type}.
  Context `{ProcessorState Job PState}.

  (** Consider any two given schedules... *)
  Variable sched1 sched2: schedule PState.

  (** Given an interval in which the schedules provide the same service
      to a job at each instant, we can prove that the cumulative service
      received during the interval has to be the same. *)
  Section ServiceDuringEquivalentInterval.

    (** Consider two time instants...  *)
    Variable t1 t2 : instant.

    (** ...and a given job that is to be scheduled. *)
    Variable j: Job.

    (** Assume that, in any instant between [t1] and [t2] the service
        provided to [j] from the two schedules is the same. *)
    Hypothesis H_sched1_sched2_same_service_at:
      forall t, t1 <= t < t2 ->
           service_at sched1 j t = service_at sched2 j t.

    (** It follows that the service provided during [t1] and [t2]
        is also the same. *)
    Lemma same_service_during:
      service_during sched1 j t1 t2 = service_during sched2 j t1 t2.
    Proof.
      rewrite /service_during.
      apply eq_big_nat.
      by apply H_sched1_sched2_same_service_at.
    Qed.

  End ServiceDuringEquivalentInterval.

  (** We can leverage the previous lemma to conclude that two schedules
      that match in a given interval will also have the same cumulative
      service across the interval. *)
  Corollary equal_prefix_implies_same_service_during:
    forall t1 t2,
      (forall t, t1 <= t < t2 -> sched1 t = sched2 t) ->
      forall j, service_during sched1 j t1 t2 = service_during sched2 j t1 t2.
  Proof.
    move=> t1 t2 SCHED_EQ j.
    apply same_service_during => t' RANGE.
    by rewrite /service_at SCHED_EQ.
  Qed.

End ServiceInTwoSchedules.


Require Import Strings.String.
Require Import List.
Local Open Scope string_scope.
Scheme Equality for string.

Inductive defaultNat :=
  | error_nat : defaultNat
  | natural : nat -> defaultNat.

Inductive defaultBool :=
  | error_bool : defaultBool
  | boolean : bool -> defaultBool.

Inductive defaultStr :=
  | error_str : defaultStr
  | str : string -> defaultStr.

Coercion natural : nat >-> defaultNat.
Coercion boolean : bool >-> defaultBool.
Coercion str : string >-> defaultStr.

Inductive AExp :=
  | var_a: string -> AExp
  | default_a: defaultNat -> AExp
  | add: AExp -> AExp -> AExp
  | diff: AExp -> AExp -> AExp
  | mul: AExp -> AExp -> AExp
  | div: AExp -> AExp -> AExp
  | modulo: AExp -> AExp -> AExp
  | arr_a_element: string -> AExp -> AExp
  | struct_a_member: string -> string -> AExp
  | function_a_return: string -> AExp.

Inductive BExp:=
  | true_b
  | false_b
  | var_b: string -> BExp
  | default_b: defaultBool -> BExp
  | not_b: BExp -> BExp
  | and_b: BExp -> BExp -> BExp
  | or_b: BExp -> BExp -> BExp
  | lessthan: AExp -> AExp -> BExp
  | lessthaneq: AExp -> AExp -> BExp
  | gtthan: AExp-> AExp -> BExp
  | gtthaneq: AExp -> AExp -> BExp
  | eq_b: AExp -> AExp -> BExp
  | neq_b: AExp -> AExp -> BExp
  | arr_b_element: string -> AExp -> BExp
  | struct_b_member: string -> string -> BExp
  | function_b_return: string -> BExp.

Inductive SExp :=
  | var_s : string -> SExp
  | default_s: defaultStr -> SExp
  | str_concat: SExp -> SExp -> SExp
  | arr_s_element: string -> AExp -> SExp
  | struct_s_member: string -> string -> SExp
  | function_s_return: string -> SExp.

Inductive Stmt :=
  | assgn_n : string -> AExp -> Stmt
  | assgn_b : string -> BExp -> Stmt
  | assgn_s : string -> SExp -> Stmt
  | assgn_arr_n : string -> AExp -> AExp -> Stmt
  | assgn_arr_b : string -> AExp -> BExp -> Stmt
  | assgn_arr_s : string -> AExp -> SExp -> Stmt
  | assgn_str_n : string -> string -> AExp -> Stmt
  | assgn_str_b : string -> string -> BExp -> Stmt
  | assgn_str_s : string -> string -> SExp -> Stmt
  | def_f: string -> Stmt -> Stmt
  | seq : Stmt -> Stmt -> Stmt
  | while : BExp -> Stmt -> Stmt
  | ifthen : BExp -> Stmt -> Stmt
  | ifelse : BExp -> Stmt -> Stmt -> Stmt
  | switch_case : AExp -> list Case -> Stmt
    with Case :=
      | default_case : Stmt -> Case
      | case__ : AExp -> Stmt -> Case.

Coercion default_a : defaultNat >-> AExp.
Coercion var_a : string >-> AExp.

Coercion default_b : defaultBool >-> BExp.
Coercion var_b : string >-> BExp.

Coercion default_s : defaultStr >-> SExp.
Coercion var_s : string >-> SExp.

Notation "A +' B" := (add A B)(at level 50, left associativity).
Notation "A -' B" := (diff A B)(at level 50, left associativity).
Notation "A *' B" := (mul A B)(at level 49, left associativity).
Notation "A /' B" := (div A B)(at level 49, left associativity).
Notation "A %' B" := (modulo A B)(at level 49, left associativity).
Notation "'get_a' S [ N ]" := (arr_a_element S N) (at level 41).

Notation "!' A" := (not_b A) (at level 45, right associativity).
Notation "A &&' B" := (and_b A B) (at level 55, left associativity).
Notation "A ||' B" := (or_b A B) (at level 56, left associativity).
Notation "A <' B" := (lessthan A B) (at level 52, left associativity).
Notation "A <=' B" := (lessthaneq A B) (at level 52, left associativity).
Notation "A >' B" := (gtthan A B) (at level 52, left associativity).
Notation "A >=' B" := (gtthaneq A B) (at level 52, left associativity).
Notation "A ==' B" := (eq_b A B) (at level 53, left associativity).
Notation "A !=' B" := (neq_b A B) (at level 53, left associativity).
Notation "'get_b' S [ N ]" := (arr_b_element S N) (at level 41).

Notation "S0 +' +' S1" := (str_concat S0 S1) (at level 50, left associativity).
Notation "'get_s' S [ N ]" := (arr_s_element S N) (at level 41).

Notation "'get_a' S .' A" := (struct_a_member S A) (at level 40, left associativity).
Notation "'get_b' S .' A" := (struct_b_member S A) (at level 40, left associativity).
Notation "'get_s' S .' A" := (struct_s_member S A) (at level 40, left associativity).
Notation "'get_a' S ( P0 ',' P1 ',' .. ',' Pn )" := (function_a_return S (cons P0(cons P1 .. (cons Pn nil) ..))) (at level 41).
Notation "'get_b' S ( P0 ',' P1 ',' .. ',' Pn )" := (function_b_return S (cons P0(cons P1 .. (cons Pn nil) ..))) (at level 41).
Notation "'get_s' S ( P0 ',' P1 ',' .. ',' Pn )" := (function_s_return S (cons P0(cons P1 .. (cons Pn nil) ..))) (at level 41).

Notation "'nat_' X ::= Y" := (assgn_n X Y) (at level 80).
Notation "'bool_' X ::= Y" := (assgn_b X Y) (at level 80).
Notation "'str_' X ::= Y" := (assgn_s X Y) (at level 80).
Notation "A ;; B" := (seq A B) (at level 87).
Notation "'while_' ( B ) { S }" := (while B S) (at level 86).
Notation "'if_' B { S }" := (ifthen B S) (at level 86).
Notation "'if_' B { S0 } 'else_' { S1 }" := (ifelse B S0 S1) (at level 86).
Notation "'default' { S }" := (default_case S) (at level 85).
Notation "'case' ( A ) { S }" := (case__ A S) (at level 85).
Notation "'switch' ( A ) { C0  C1  ..  Cn }" := (switch_case A (cons C0(cons C1 .. (cons Cn nil) ..))) (at level 86).

Notation "'nat_' S [ A ] ::= X" := (assgn_arr_n S A X) (at level 80).
Notation "'bool_' S [ A ] ::= X" := (assgn_arr_b S A X) (at level 80).
Notation "'str_' S [ A ] ::= X" := (assgn_arr_s S A X) (at level 80).

Notation "'nat_' S .' M ::= X" := (assgn_str_n S M X) (at level 80).
Notation "'bool_' S .' M ::= X" := (assgn_str_b S M X) (at level 80).
Notation "'str_' S .' M ::= X" := (assgn_str_s S M X) (at level 80).

Notation "'func_' F '()' { S }" := (def_f F S) (at level 81).

(*Definition test_func :=
  nat_f "test_function" # nat_p "param0", bool_p "param1", str_p "param2" #
  {
    str_ "test" ::= "iagefh";;
    nat_ "thing" ::= 124
  }
.

Definition test_struct :=
  struct "test"
  {
    nat_m "test" ;;
    bool_m "test1" ;;
    str_m "test2"
  }
.*)

Definition NEnv := string -> nat.
Definition BEnv := string -> bool.
Definition SEnv := string -> string.

Definition NArrEnv := string -> nat -> nat.
Definition BArrEnv := string -> nat -> bool.
Definition SArrEnv := string -> nat -> string.

Definition NStrEnv := string -> string -> nat.
Definition BStrEnv := string -> string -> bool.
Definition SStrEnv := string -> string -> string.

Definition FEnv := string -> Stmt.

Inductive Env :=
  | env_pack : NEnv -> BEnv -> SEnv -> NArrEnv -> BArrEnv -> SArrEnv -> NStrEnv -> BStrEnv -> SStrEnv -> FEnv -> Env.

Definition def_nenv : NEnv :=
  fun var => 0.

Definition def_benv : BEnv :=
  fun var => false.

Definition def_senv : SEnv :=
  fun var => "".

Definition def_narrenv : NArrEnv :=
  fun var idx => 0.

Definition def_barrenv : BArrEnv :=
  fun var idx => false.

Definition def_sarrenv : SArrEnv :=
  fun var idx => "".

Definition def_nstrenv : NStrEnv :=
  fun var memb => 0.

Definition def_bstrenv : BStrEnv :=
  fun var memb => false.

Definition def_sstrenv : SStrEnv :=
  fun var memb => "".

Definition def_fenv : FEnv :=
  fun name_ => (assgn_n "return" 0).

Definition def_env : Env := env_pack def_nenv def_benv def_senv def_narrenv def_barrenv def_sarrenv def_nstrenv def_bstrenv def_sstrenv def_fenv.

Definition FUpdate (env : FEnv) (name_ : string) (stmts : Stmt) : FEnv :=
  fun name' => if (eqb name_ name')
               then stmts
               else (env name').

Definition NUpdate (env : NEnv) (var : string) (value : nat) : NEnv :=
  fun var' => if (eqb var' var)
                then value
                else (env var').

Definition NArrUpdate (env : NArrEnv) (var : string) (index : nat) (value : nat) : NArrEnv :=
  fun var' index' => if (andb (eqb var' var) (Nat.eqb index index'))
                     then value
                     else (env var' index').

Definition NStrUpdate (env : NStrEnv) (var : string) (memb : string) (value : nat) : NStrEnv :=
  fun var' memb' => if (andb (eqb var' var) (eqb memb memb'))
                     then value
                     else (env var' memb').

Definition BUpdate (env : BEnv) (var : string) (value : bool) : BEnv :=
  fun var' => if (eqb var' var)
                then value
                else (env var').

Definition BArrUpdate (env : BArrEnv) (var : string) (index : nat) (value : bool) : BArrEnv :=
  fun var' index' => if (andb (eqb var' var) (Nat.eqb index index'))
                     then value
                     else (env var' index').

Definition BStrUpdate (env : BStrEnv) (var : string) (memb : string) (value : bool) : BStrEnv :=
  fun var' memb' => if (andb (eqb var' var) (eqb memb memb'))
                     then value
                     else (env var' memb').

Definition SUpdate (env : SEnv) (var : string) (value : string) : SEnv :=
  fun var' => if (eqb var' var)
                then value
                else (env var').

Definition SArrUpdate (env : SArrEnv) (var : string) (index : nat) (value : string) : SArrEnv :=
  fun var' index' => if (andb (eqb var' var) (Nat.eqb index index'))
                     then value
                     else (env var' index').

Definition SStrUpdate (env : SStrEnv) (var : string) (memb : string) (value : string) : SStrEnv :=
  fun var' memb' => if (andb (eqb var' var) (eqb memb memb'))
                     then value
                     else (env var' memb').

Definition env_test : NEnv :=
  fun var => if (string_dec var "hatz") then 69 else 0.

Compute (env_test "hatz").
Compute (env_test "not_hatz").

Definition senv_test : SEnv :=
  fun var => if (string_dec var "hatz") then "gionule" else "".

Compute (senv_test "hatz").
Compute (senv_test "not_hatz").

Definition benv_arr_test : BArrEnv :=
  fun var idx => if (andb (eqb var "testing") (Nat.eqb idx 0)) then true else false.

Compute (benv_arr_test "testing" 0).
Compute ((BArrUpdate benv_arr_test "testing" 0 false) "testing" 0).

Fixpoint AEval (a : AExp) (env : Env) : nat :=
  match env with
  | env_pack nenv benv senv narrenv barrenv sarrenv nstrenv bstrenv sstrenv fenv =>
  match a with
    | var_a var => nenv var
    | default_a def_ => match def_ with
                          | error_nat => 0
                          | natural n => n
                        end
    | add a0 a1 => (AEval a0 env) + (AEval a1 env)
    | diff a0 a1 => (AEval a0 env) - (AEval a1 env)
    | mul a0 a1 => (AEval a0 env) * (AEval a1 env)
    | div a0 a1 => Nat.div (AEval a0 env) (AEval a1 env)
    | modulo a0 a1 => Nat.modulo (AEval a0 env) (AEval a1 env)
    | arr_a_element arr idx => narrenv arr (AEval idx env)
    | struct_a_member s0 s1 => nstrenv s0 s1
    | function_a_return name_ => 0
  end
  end.

Fixpoint BEval (b : BExp) (env : Env) : bool :=
  match env with
    | env_pack nenv benv senv narrenv barrenv sarrenv nstrenv bstrenv sstrnev fenv =>
  match b with
    | true_b => true
    | false_b => false
    | var_b var => benv var
    | default_b def_ => match def_ with
                          | error_bool => false
                          | boolean bv => bv
                        end
    | not_b b0 => negb (BEval b0 env)
    | and_b b0 b1 => andb (BEval b0 env) (BEval b1 env)
    | or_b b0 b1 => orb (BEval b0 env) (BEval b1 env)
    | lessthan a0 a1 => Nat.leb (AEval a0 env) (AEval a1 env)
    | lessthaneq a0 a1 => orb (Nat.eqb (AEval a0 env) (AEval a1 env)) (Nat.leb (AEval a0 env) (AEval a1 env))
    | gtthan a0 a1 => Nat.leb (AEval a1 env) (AEval a0 env)
    | gtthaneq a0 a1 => orb (Nat.eqb (AEval a0 env) (AEval a1 env)) (Nat.leb (AEval a1 env) (AEval a0 env))
    | eq_b a0 a1 => Nat.eqb (AEval a0 env) (AEval a1 env)
    | neq_b a0 a1 => negb (Nat.eqb (AEval a0 env) (AEval a1 env))
    | arr_b_element arr idx => barrenv arr (AEval idx env)
    | struct_b_member s0 s1 => bstrenv s0 s1
    | function_b_return name_ => false
  end
  end.

Fixpoint SEval (s : SExp) (env : Env) : string :=
  match env with
    | env_pack nenv benv senv narrenv barrenv sarrenv nstrenv bstrenv sstrenv fenv =>
  match s with
    | var_s var => senv var
    | default_s def_ => match def_ with
                          | error_str => ""
                          | str sv => sv
                        end
    | str_concat s0 s1 => (SEval s0 env) ++ (SEval s1 env)
    | arr_s_element arr idx => sarrenv arr (AEval idx env)
    | struct_s_member s0 s1 => sstrenv s0 s1
    | function_s_return name_ => ""
  end
  end.

Fixpoint eval (s : Stmt) (env : Env) (gas : nat) : Env :=
  match gas with
    | 0 => env
    | S gas' => match env with
      | env_pack nenv benv senv narrenv barrenv sarrenv nstrenv bstrenv sstrenv fenv => match s with
          | assgn_n var a => env_pack (NUpdate nenv var (AEval a env)) benv senv narrenv barrenv sarrenv nstrenv bstrenv sstrenv fenv
          | assgn_b var b => env_pack nenv (BUpdate benv var (BEval b env)) senv narrenv barrenv sarrenv nstrenv bstrenv sstrenv fenv
          | assgn_s var s => env_pack nenv benv (SUpdate senv var (SEval s env)) narrenv barrenv sarrenv nstrenv bstrenv sstrenv fenv
          | assgn_arr_n arr idx a => env_pack nenv benv senv (NArrUpdate narrenv arr (AEval idx env) (AEval a env)) barrenv sarrenv nstrenv bstrenv sstrenv fenv
          | assgn_arr_b arr idx b => env_pack nenv benv senv narrenv (BArrUpdate barrenv arr (AEval idx env) (BEval b env)) sarrenv nstrenv bstrenv sstrenv fenv
          | assgn_arr_s arr idx s => env_pack nenv benv senv narrenv barrenv (SArrUpdate sarrenv arr (AEval idx env) (SEval s env)) nstrenv bstrenv sstrenv fenv
          | assgn_str_n strc memb a => env_pack nenv benv senv narrenv barrenv sarrenv (NStrUpdate nstrenv strc memb (AEval a env)) bstrenv sstrenv fenv
          | assgn_str_b strc memb b => env_pack nenv benv senv narrenv barrenv sarrenv nstrenv (BStrUpdate bstrenv strc memb (BEval b env)) sstrenv fenv
          | assgn_str_s strc memb s => env_pack nenv benv senv narrenv barrenv sarrenv nstrenv bstrenv (SStrUpdate sstrenv strc memb (SEval s env)) fenv
          | seq s0 s1 => eval s0 (eval s1 env gas') gas'
          | while cond s => if (BEval cond env)
                            then eval (seq s (while cond s)) env gas'
                            else env
          | ifthen b s => if (BEval b env)
                          then eval s env gas'
                          else env
          | ifelse b s0 s1 => if (BEval b env)
                              then eval s0 env gas'
                              else eval s1 env gas'
          | switch_case a0 case_list => match case_list with
                                        | nil => env
                                        | c :: rest_of_list => match c with
                                                      | default_case s => env
                                                      | case__ a1 s => if (BEval (eq_b a0 a1) env)
                                                                     then eval s env gas'
                                                                     else eval (switch_case a0 rest_of_list) env gas'
                                                      end
                                       end
          | def_f name_ stmts => env_pack nenv benv senv narrenv barrenv sarrenv nstrenv bstrenv sstrenv (FUpdate fenv name_ stmts)
          end
      end
  end.

Definition test_stmt :=
  nat_ "test" [100] ::= 1;;
  nat_ "hatz" ::= get_a "test"[69];;
  nat_ "test" ::= 1337;;
  bool_ "test1" ::= true;;
  str_ "test2" ::= "hatz";;
  str_ "test2" ::= "test2" +'+' "iaeohfg";;

  while_ ("test" >' 0) {
    nat_ "test" ::= "test" -' 1;;
    str_ "test"[2077] ::= "eigfhjao"
  } ;;

  switch ("test"){
    case (1) {
      str_ "test2" ::= get_s "test"[100]
    }
    case (1337) {
      str_ "test2" ::= "ceva"
    }
    default {
      str_ "test2" ::= "altceva"
    }
  } ;;

  str_ "return" ::= "haeta"
.

Compute (SEval (var_s "return") (eval (test_stmt) def_env 100)).