theory Lec05b
imports Main
begin



(* monad *)
abbreviation
  mbind :: "'a option => ('a => 'b option) => 'b option"  ("_ >>= _" [65,65] 65) 
where  
  "c >>= f \<equiv> case c of None => None | (Some v) => f v"

(* source language *)
datatype aexp = 
    V string
  | C nat 
  | Diff aexp aexp  ("_ -- _")

(* the environments are association lists *)
types
  env = "(string\<times>nat) list"

fun
  lookup :: "string \<Rightarrow> env \<Rightarrow> nat option"
where
  "lookup x [] = None"
| "lookup x ((y,n)#tail) = (if x=y then Some n else lookup x tail)"

fun
  eval :: "aexp \<Rightarrow> env \<Rightarrow> nat option"
where
  "eval (C n) env = Some n"
| "eval (V x) env = lookup x env"
| "eval (e1 -- e2) env = 
     (eval e1 env) >>= (\<lambda>n1. (eval e2 env) >>= (\<lambda>n2. Some (n1 - n2)))"

(* now the target machine *)
datatype inst = 
    PushV string
  | PushC nat 
  | Sub

types
 stack = "nat list"

fun (sequential)
  exec_instruc :: "inst \<Rightarrow> env \<Rightarrow> stack \<Rightarrow> stack option"
where
  "exec_instruc (PushC n) env s = Some (n#s)"
| "exec_instruc (PushV x) env s = (lookup x env) >>= (\<lambda>n. Some (n#s))"
| "exec_instruc Sub env (n1#n2#s) = Some ((n2 - n1)#s)"
| "exec_instruc Sub env _ = None"

fun
  exec :: "inst list \<Rightarrow> env \<Rightarrow> stack \<Rightarrow> stack option"
where
  "exec [] env s = Some s"  (* halt *)
| "exec (inst#insts) env s = (exec_instruc inst env s) >>= (exec insts env)"

(* the compiler *)

fun
  compile :: "aexp \<Rightarrow> inst list"
where
  "compile (V n) = [PushV n]"
| "compile (C n) = [PushC n]"
| "compile (e1 -- e2) = (compile e1) @ (compile e2) @ [Sub]"

lemma test2:
  shows "compile ((C 2) -- (V x)) = [PushC 2,PushV x,Sub]"
  by simp

(* and now the theorem: *)
declare option.split[split]

theorem exec_assoc: 
  "(exec (insts1 @ insts2) env s) = (exec insts1 env s) >>= (\<lambda>s1. (exec insts2 env s1))"
by (induct insts1 arbitrary: s) (simp_all)
      
theorem compiler_lemma: 
  "exec (compile exp) env s = (eval exp env) >>= (\<lambda>n.(Some(n#s)))"
by (induct exp arbitrary: s) 
   (simp_all add: exec_assoc)


end