(* dynamic.rml *)
module Dynamic:
  with "absyn.rml"
  datatype P1	= P1REF | P1GET | P1NULL | P1HD | P1TL | P1CONS | P1PRINT
  datatype P2	= P2SET | P2FST | P2SND | P2EQ | P2LT | P2LE
		| P2ADD | P2SUB | P2MUL | P2IDIV | P2IMOD | P2RDIV
  datatype Prim	= P1 of P1 | P2 of P2
  type Location	= int
  datatype Val	= INT of int
		| REAL of real
		| STRING of string
		| BOOL of bool
		| REF of Location
		| UNIT
		| PAIR of Val * Val
		| CLO of Closure
		| PRIM of Prim
  and Closure	= CLOSURE of Absyn.Lambda * Env * string option
  withtype Env	= (string * Val) list
  type Store	= (Location * Val) list

  val state0	: Store
  val env0	: Env

  relation evaluate: (Store, Env, Absyn.Dec) => (Store, Env)
end

with "util.rml"

relation bool_string: bool => string =
  axiom bool_string true	=> "true"
  axiom bool_string false	=> "false"
end

relation app_p1 =	(* s,p1,v |- s',v' *)
  rule	tick => loc
	----------------
	app_p1(s, P1REF, x) => ((loc,x)::s, REF loc)

  rule	Util.lookup(s, loc) => x
	----------------
	app_p1(s, P1GET, REF loc) => (s, x)

  axiom app_p1(s, P1NULL, UNIT)		=> (s, BOOL true)
  axiom app_p1(s, P1NULL, PAIR(_,_))	=> (s, BOOL false)
  axiom app_p1(s, P1HD, PAIR(x,_)) => (s, x)
  axiom app_p1(s, P1TL, PAIR(_,y)) => (s, y)
  axiom app_p1(s, P1CONS, xy) => (s, xy)

  rule	int_string x => str & print str & print "\n"
	----------------
	app_p1(s, P1PRINT, INT x) => (s, UNIT)

  rule	real_string x => str & print str & print "\n"
	----------------
	app_p1(s, P1PRINT, REAL x) => (s, UNIT)

  rule	print x & print "\n"
	----------------
	app_p1(s, P1PRINT, STRING x) => (s, UNIT)

  rule	bool_string x => str & print str & print "\n"
	----------------
	app_p1(s, P1PRINT, BOOL x) => (s, UNIT)
end

relation app_p2 =	(* s,p2,v1,v2 |- s',v *)
  axiom app_p2(s, P2SET, REF loc, y) => ((loc,y)::s, UNIT)
  axiom app_p2(s, P2FST, x, _) => (s, x)
  axiom app_p2(s, P2SND, _, y) => (s, y)

  rule	x = y
	----------------
	app_p2(s, P2EQ, x, y) => (s, BOOL true)

  rule	not x = y
	----------------
	app_p2(s, P2EQ, x, y) => (s, BOOL false)

  rule	int_lt(x, y) => flag
	----------------
	app_p2(s, P2LT, INT x, INT y) => (s, BOOL flag)

  rule	real_lt(x, y) => flag
	----------------
	app_p2(s, P2LT, REAL x, REAL y) => (s, BOOL flag)

  rule	int_le(x, y) => flag
	----------------
	app_p2(s, P2LE, INT x, INT y) => (s, BOOL flag)

  rule	real_le(x, y) => flag
	----------------
	app_p2(s, P2LE, REAL x, REAL y) => (s, BOOL flag)

  rule	int_add(x, y) => z
	----------------
	app_p2(s, P2ADD, INT x, INT y) => (s, INT z)

  rule	real_add(x, y) => z
	----------------
	app_p2(s, P2ADD, REAL x, REAL y) => (s, REAL z)

  rule	int_sub(x, y) => z
	----------------
	app_p2(s, P2SUB, INT x, INT y) => (s, INT z)

  rule	real_sub(x, y) => z
	----------------
	app_p2(s, P2SUB, REAL x, REAL y) => (s, REAL z)

  rule	int_mul(x, y) => z
	----------------
	app_p2(s, P2MUL, INT x, INT y) => (s, INT z)

  rule	real_mul(x, y) => z
	----------------
	app_p2(s, P2MUL, REAL x, REAL y) => (s, REAL z)

  rule	int_div(x, y) => z
	----------------
	app_p2(s, P2IDIV, INT x, INT y) => (s, INT z)

  rule	int_mod(x, y) => z
	----------------
	app_p2(s, P2IMOD, INT x, INT y) => (s, INT z)

  rule	real_div(x, y) => z
	----------------
	app_p2(s, P2RDIV, REAL x, REAL y) => (s, REAL z)
end

relation app_prim =	(* s,p,v |- s',v' *)
  rule	app_p1(s, p1, x) => (s', z)
	----------------
	app_prim(s, P1 p1, x) => (s', z)

  rule	app_p2(s, p2, x, y) => (s', z)
	----------------
	app_prim(s, P2 p2, PAIR(x,y)) => (s', z)
end

relation unfold_clo =
  axiom unfold_clo(clo as CLOSURE(_,_,NONE)) => clo
  axiom unfold_clo(clo as CLOSURE(lam,env,SOME id))
	=> CLOSURE(lam, (id,CLO clo)::env, SOME id)
end

relation apply =	(* s,v |- s',v' *)
  rule	unfold_clo clo => CLOSURE(Absyn.LAMBDA(id,exp), env, _) &
	eval(s, (id,x)::env, exp) => (s', v)
	----------------
	apply(s, CLO clo, x) => (s', v)

  rule	app_prim(s, p, x) => (s', y)
	----------------
	apply(s, PRIM p, x) => (s', y)
end

and eval =	(* s,env |- exp => s',v *)
  axiom eval(s, _, Absyn.INT x) => (s, INT x)
  axiom	eval(s, _, Absyn.REAL x) => (s, REAL x)
  axiom eval(s, _, Absyn.STRING x) => (s, STRING x)
  axiom eval(s, _, Absyn.UNIT) => (s, UNIT)

  rule	Util.lookup(env, id) => v
	----------------
	eval(s, env, Absyn.VAR id) => (s, v)

  axiom eval(s, env, Absyn.LAM lam) => (s, CLO(CLOSURE(lam, env, NONE)))

  rule	eval(s0, env, f) => (s1, f') &
	eval(s1, env, x) => (s2, x') &
	apply(s2, f', x') => (s3, v)
	----------------
	eval(s0, env, Absyn.APP(f,x)) => (s3, v)

  rule	eval(s0, env, e1) => (s1, v1) & eval(s1, env, e2) => (s2, v2)
	----------------
	eval(s0, env, Absyn.PAIR(e1,e2)) => (s2, PAIR(v1,v2))

  rule	eval(s0, env, e1) => (s1, BOOL true) & eval(s1, env, e2) => (s2, v2)
	----------------
	eval(s0, env, Absyn.IF(e1, e2, _)) => (s2, v2)

  rule	eval(s0, env, e1) => (s1, BOOL false) & eval(s1, env, e3) => (s2, v2)
	----------------
	eval(s0, env, Absyn.IF(e1, _, e3)) => (s2, v2)

  rule	eval(s0, env, e1) => (s1, v1) & eval(s1, (x,v1)::env, e2) => (s2, v2)
	----------------
	eval(s0, env, Absyn.LET(x,e1,e2)) => (s2, v2)

  rule	eval(s, (id,CLO(CLOSURE(lam,env,SOME id)))::env, exp) => (s', v)
	----------------
	eval(s, env, Absyn.LETREC(id,lam,exp)) => (s', v)
end

val state0 = []
val env0 =
	[("=",		PRIM(P2 P2EQ))
	,("ref",	PRIM(P1 P1REF))
	,("!",		PRIM(P1 P1GET))
	,(":=",		PRIM(P2 P2SET))
	,("fst",	PRIM(P2 P2FST))
	,("snd",	PRIM(P2 P2SND))
	,("true",	BOOL true)
	,("false",	BOOL false)
	,("null",	PRIM(P1 P1NULL))
	,("hd",		PRIM(P1 P1HD))
	,("tl",		PRIM(P1 P1TL))
	,("nil",	UNIT)
	,("::",		PRIM(P1 P1CONS))
	,("+",		PRIM(P2 P2ADD))
	,("-",		PRIM(P2 P2SUB))
	,("*",		PRIM(P2 P2MUL))
	,("idiv",	PRIM(P2 P2IDIV))
	,("imod",	PRIM(P2 P2IMOD))
	,("/",		PRIM(P2 P2RDIV))
	,("<",		PRIM(P2 P2LT))
	,("<=",		PRIM(P2 P2LE))
	,("print",	PRIM(P1 P1PRINT))
	]

relation evaluate =
  rule	eval(s, env, exp) => (s', v)
	----------------
	evaluate(s, env, Absyn.VAL(id,exp)) => (s', (id,v)::env)
end
