Definition table (A B : Type) := list (A*B).
Fixpoint table_get {A B}{H: EqDec A} (rho: table A B) (x: A) : option B :=
match rho with
| (y,v)::ys => if eq_dec x y then Some v else table_get ys x
| nil => None
end.
Definition table_set {A B}{H: EqDec A} (x: A) (v: B) (rho: table A B)  : table A B := (x,v)::rho.
Definition var := nat.
Instance EqDec_var: EqDec var := _.
Opaque var.
Definition adr := nat.
Instance EqDec_adr : EqDec adr := _.
Opaque adr.
Definition locals := table var adr.
Definition heap := adr -> option adr.
Inductive expr :=
| Const: adr -> expr
| Var: var -> expr
| Offset: expr -> nat -> expr
| Mem: expr -> expr.
Coercion Var : var >-> expr.
Coercion Const: adr >-> expr.
Notation " a '.+' n " := (Offset a n) (at level 87, no associativity).
Inductive control :=
| Assign: expr -> expr -> control -> control
| IfThenElse: expr -> control -> control -> control
| Go: expr -> list expr -> control.
Definition program := table adr (list var * control).
Definition bind_option (A B: Type) (f: option A) (g: A -> option B) : option B :=
match f with None => None | Some x => g x end.
Implicit Arguments bind_option [A B].
Notation "'do1' X '<-' A ';' B" := (bind_option A (fun X => B))
(at level 200, X ident, A at level 100, B at level 200).
Definition emptyheap : heap := fun _ => None.
Definition heap_get (h: heap) (a: adr) : option adr := h a.
Definition heap_set (a v: adr) (h: heap) :=
fun i => if eq_dec i a then Some v else h i.
Opaque heap.
Fixpoint expr_get (s: locals)(h: heap) (e: expr) : option adr :=
match e with
| Const n => Some n
| Var x => table_get s x
| Offset e n => do1 v <- expr_get s h e; Some (v+n)
| Mem e => do1 v <- expr_get s h e; heap_get h v
end.
Fixpoint get_list s h (xs: list expr) : option (list adr) :=
match xs with
| nil => Some nil
| e :: es => do1 v <- expr_get s h e; do1 vs <- get_list s h es; Some (v::vs)
end.
Definition mk_locals  (xs: list var) (ys: list adr) : locals := combine xs ys.
Definition state := (locals * heap * control)%type.
Definition step (p: program) (sk: state) : option state :=
match sk with
| ((stk,hp), Assign (Var x) y c) =>
do1 v <- expr_get stk hp y;
Some ((table_set x v stk, hp), c)
| ((stk,hp), Assign (Mem x) y c) =>
do1 v <- expr_get stk hp y;
do1 p <- expr_get stk hp x;
Some ((stk, heap_set p v hp), c)
| (_, Assign _ y c) => None
| ((stk,hp), IfThenElse x c1 c2) =>
do1 v <- expr_get stk hp x;
Some (if eq_dec v 0 then ((stk,hp), c2) else ((stk,hp), c1))
| ((stk, hp), Go x ys) =>
do1 v <- expr_get stk hp x;
do1 k <- table_get p v;
do1 vs <- get_list stk hp ys;
Some ((mk_locals (fst k) vs, hp), snd k)
end.
Fixpoint stepN (p: program) (sk: state) (n: nat) : option state :=
match n with O => Some sk
| S n' => match step p sk with Some sk' => stepN p sk' n' | _ => None end
end.
Fixpoint boundary (p: program) : nat :=
match p with (n, _)::p' => Max.max (S n) (boundary p') | nil => 2 end.
Definition initial_locals (p: program) : locals := (0, boundary p)::nil.
Definition initial_heap (p: program) : heap :=
fun i => if lt_dec i (boundary p) then None else Some 0.
Definition run (p: program) (n: nat) : option state :=
stepN p (nil, initial_heap p, Go (Const 0) (Const (boundary p) :: nil)) n.
Notation "'Do' x ':=' v ';' c" := (Assign x v c) (at level 200, x at level 1, v at level 90, c at level 200).
Notation "'If' x 'Then' c1 'Else' c2" := (IfThenElse x c1 c2)  (at level 200, x at level 90, c1 at level 200, c2 at level 200).
Definition safe (p: program) : Prop :=  forall n, exists sk', run p n = Some sk'.
(* LOCAL VARIABLE ENVIRONMENTS *)
Definition env := var -> adr.
Definition env_set (f: env) (x: var) (y: adr) :=
fun i => if eq_dec i x then y else f i.
Definition locals2env (s: locals) : env :=
fun x => match table_get s x with Some a => a | None => 0 end.
Fixpoint eval (e: expr) : env -> adr :=
fun s =>
match e with
| Const n => n
| Var x => s x
| Offset e n => n + eval e s
| Mem e => 0
end.
Definition eval_list (xs: list expr) : env -> (list adr) := fun s => map (fun e => eval e s) xs.
Definition arguments (vars: list var) (vl: list adr) : env :=
locals2env (mk_locals vars vl).
Opaque arguments.
Definition subst{A} (x: var) (v: adr) (P: env -> A) : env -> A :=
fun s => P (env_set s x v).
(* TYPE-CHECKING OF LOCAL VARIABLES *)
Require ListSet.
Definition varset : Type := ListSet.set var.
Definition vs_mem: var -> varset -> bool := ListSet.set_mem EqDec_var.
Definition vs_add: var -> varset -> varset := ListSet.set_add EqDec_var.
Definition varcompat (vars: varset) (s: locals) :=
forall i, vs_mem i vars = true -> table_get s i <> None.
Fixpoint expcheck (vars: varset) (e: expr) :=
match e with
| Const _ => true
| Var v => vs_mem v vars
| Offset e n => expcheck vars e
| Mem _ => false
end.
Fixpoint typecheck (vars: varset) (c: control) : bool :=
match c with
| Assign (Var v) (Mem e) c' => andb (expcheck vars e)
(typecheck (vs_add v vars) c')
| Assign (Var v) e c' => andb (expcheck vars e)
(typecheck (vs_add v vars) c')
| Assign (Mem e1) e2 c' => andb (andb (expcheck vars e1)  (expcheck vars e2))
(typecheck vars c')
| IfThenElse e c1 c2 => andb (expcheck vars e)
(andb (typecheck vars c1) (typecheck vars c2))
| Go e el => andb (expcheck vars e)  (forallb (expcheck vars) el)
| _ => false
end.

Lemma varcompat_mk_locals:
forall xl vl, length xl <= length vl -> varcompat xl (mk_locals xl vl).