import .imp_syntax
import .imp_common

namespace imp
namespace interp_nock

/- This is an implementation of an interpreter equivalent to
   the one we defined in `imp_interp.lean`, without the safety
   checks. The goal is to show that the "safe" version of the
   interpreter is equivalent to this "optimized" version of the
   interpreter.
-/

def lookup' (s : store) (x : string) : val :=
  match store.lookup x s with
  | some v := v
  | none := val.int 0
  end

def updates' : store → list string → list val → store
| s (x :: xs') (v :: vs') := updates' (update x v s) xs' vs'
| s _ _ := s

def strget' (v : val) (s : string) : val :=
  match v with
  | val.int i :=
      match s.index i.to_nat with
      | some c := val.str (string.str "" c)
      | none := val.int 0
      end
  | _ := val.int 0
  end

def read' (h : heap) : val → val
| (val.addr a) :=
  match heap.read h a with
  | some v' := v'
  | _ := val.int 0
  end
| _ := val.int 0

def alloc' (h : heap) : val → val → heap
| (val.int i1) v2 := heap.alloc h i1 v2
| _ _ := h

def write' (h : heap) : val → val → heap
| (val.addr i1) v2 :=
  match heap.write h i1 v2 with
  | some h' := h'
  | _ := h
  end
| _ _ := h

def op1 : unary_op → val → val
| unary_op.neg (val.int i) := val.int (-i)
| unary_op.not (val.bool b) := val.bool (bnot b)
| _ _ := val.int 0


section interp_op2

open binary_op
open val

def op2 : binary_op → val → val → val
| add (int i1) (int i2) :=
  val.int (i1 + i2)
| add (str s1) (str s2) :=
  val.str (s1 ++ s2)
| sub (int i1) (int i2) :=
     int (i1 - i2)
| mul (int i1) (int i2) :=
    int (i1 * i2)
| div (int i1) (int i2) :=
    int (int.fdiv i1 i2)
| mod (int i1) (int i2) :=
    int (int.fmod i1 i2)
| eq v1 v2 :=
    bool (v1 = v2)
| lt (int i1) (int i2) :=
    bool (i1 < i2)
| le (int i1) (int i2) :=
    bool (i1 <= i2)
| conj (bool b1) (bool b2) :=
    bool (b1 && b2)
| disj (bool b1) (bool b2) :=
    bool (b1 || b2)
-- hacks
| add (addr i1) (int i2) :=
   addr (1 + i1 + i2)
| _ _ _ := val.int 0

end interp_op2

end interp_nock

section interp_e
open imp.expr val

def interp_nock.expr (s : store) (h : heap) : expr → val
| (expr.val v) := v
| (expr.var x) := interp_nock.lookup' s x
| (expr.unary_op op e1) :=
  interp_nock.op1 op (interp_nock.expr e1)
| (expr.binary_op op e1 e2) :=
  interp_nock.op2 op (interp_nock.expr e1) (interp_nock.expr e2)
| (length e1) :=
  match interp_nock.expr e1 with
  | (addr a) := interp_nock.read' h (addr a)
  | (str cs) := int (cs.length)
  | _ := val.int 0
  end
| (index e1 e2) :=
  match interp_nock.expr e1 with
  | (addr a) := interp_nock.read' h (interp_nock.op2 binary_op.add (addr a) (interp_nock.expr e2))
  | (str cs) := interp_nock.strget' (interp_nock.expr e2) cs
  | _ := int 0
  end

end interp_e

namespace interp_nock

def seq_expr (s : store) (h : heap) : list imp.expr → list val
| [] := []
| (e :: rest) := interp_nock.expr s h e :: seq_expr rest

section interp_s

open stmt
open val

def stmt : store → heap → stmt → (store × heap × stmt)
| s h nop := (s, h, nop)
| s h (set x e) := (update x (expr s h e) s, h, nop)
| s h (alloc x e1 e2) :=
      ( update x (addr $ h.length) s
      , alloc' h (expr s h e1) (expr s h e2)
      , nop
      )
| s h (write x e1 e2) :=
  let h' :=
        write' h (op2 binary_op.add
                    (lookup' s x)
                    (expr s h e1))
                 (expr s h e2)
      in
        (s, h', nop)
| s h (ifelse e p1 p2) :=
      match expr s h e with
      | bool bool.ff := (s, h, p2)
      | _ := (s, h, p1)
      end
| s h (while e p) :=
      match expr s h e with
      | (bool bool.ff) := (s, h, nop)
      | _ := (s, h, seq p (while e p))
      end
| s h (seq p1 p2) :=
  if p1 = imp.stmt.nop
  then (s, h, p2)
  else match stmt s h p1 with
  | (s', h', p1') := (s', h', seq p1' p2)
  end

end interp_s

def program : nat → store → heap → imp.stmt → imp.expr → result
| 0 s h p ret := result.timeout s h p ret
| (n + 1) s h p ret :=
  if p = stmt.nop
  then result.done h (expr s h ret)
  else match stmt s h p with
  | (s', h', p') := program n s' h' p' ret
  end

end interp_nock
end imp