(* file eval.rml *)


module Eval:

with "absyn.rml"

(* Values, bindings and environment *)
datatype Value       =  INTval  of  int 
                     |  REALval of  real

type VarBnd      =  Absyn.Ident * Value
type Env         =  VarBnd list

(* Initial environment is an empty list of (Ident,Value) pairs *)
val init_env : VarBnd list

relation eval: (Env,Absyn.Exp) => (Env,Value)

end (* of interface section *)

val init_env = []

(* Ty2 is an auxiliary datatype used to handle types during evaluation *)
datatype Ty2     =  INT2   of  int * int
                 |  REAL2  of  real * real


(*************** Auxiliary relations ***************)

relation lookup: (Env,Absyn.Ident) => Value  =
(* lookup returns the value associated with an identifier.
 * If no association is present, lookup will fail. 
 *)

  (* Identifier id is found in the first pair of the list, and value
   * is returned. 
   *)
  rule  id = id2
        ------------------------------
        lookup((id2,value) :: _, id) => value

  (* id is not found in the first pair of the list, and lookup will
   * recursively search the rest of the list. If found, value is returned.
   *)
  rule  not id=id2  &  lookup(rest, id) => value
        -------------------------------------
        lookup((id2,_) :: rest, id)  => value

end (* lookup *)

relation lookupextend: (Env,Absyn.Ident) => (Env,Value)  =
(* Return value of id in env. If id not present, add id and return 0 *)

  rule  not lookup(env,id) => v &
        let value = INTval(0)
        -----------------------------
        lookupextend(env, id) => ((id, value)::env,value)

  rule  lookup(env,id) => value
        --------------------------------
        lookupextend(env, id)  => (env,value)
end (* lookupextend *)

relation update: (Env,Absyn.Ident,Value) => Env  =
(* Store binding of id to value at front of environment env *)

  axiom update(env,id,value) => ((id,value) :: env)

end (* update *)


relation type_lub: (Value,Value) => Ty2  =
(* Least upper bound (lub) type for combinations of argument types *)

 axiom  type_lub(INTval(x), INTval(y))   =>  INT2(x,y)

 rule   int_real(x) => x2
        ----------------
        type_lub(INTval(x), REALval(y))  =>  REAL2(x2,y)

 rule   int_real(y) => y2
        -----------------
        type_lub(REALval(x),INTval(y))   =>  REAL2(x,y2)

 axiom  type_lub(REALval(x),REALval(y))  =>  REAL2(x,y)

end (* type_lub *)


(*************** Binary and unary operators ***************)


relation apply_int_binop:(Absyn.BinOp,int,int) => int =

 rule   int_add(x,y) => z
        ------------------------                              (* x+y *)
        apply_int_binop(Absyn.ADD,x,y) => z

 rule   int_sub(x,y) => z
        ------------------------                              (* x-y *)
        apply_int_binop(Absyn.SUB,x,y) => z

 rule   int_mul(x,y) => z
        ------------------------                              (* x*y *)
        apply_int_binop(Absyn.MUL,x,y) => z

 rule   int_div(x,y) => z
        ------------------------                              (* x/y *)
        apply_int_binop(Absyn.DIV,x,y) => z
end

relation apply_real_binop:(Absyn.BinOp,real,real) => real =

 rule   real_add(x,y) => z
        -------------------------                             (* x+y *)
        apply_real_binop(Absyn.ADD,x,y) => z

 rule   real_sub(x,y) => z
        -------------------------                             (* x-y *)
        apply_real_binop(Absyn.SUB,x,y) => z

 rule   real_mul(x,y) => z
        -------------------------                             (* x*y *)
        apply_real_binop(Absyn.MUL,x,y) => z

 rule   real_div(x,y) => z
        ------------------------                              (* x/y *)
        apply_real_binop(Absyn.DIV,x,y) => z

end (* apply_real_binop *)


relation apply_int_unop: (Absyn.UnOp,int) => int =

 rule   int_neg(x) => y
        ------------------------                              (* -x *)
        apply_int_unop(Absyn.NEG,x) => y

end (* apply_int_unop *)


relation apply_real_unop: (Absyn.UnOp,real) => real =

 rule   real_neg(x) => y
        ------------------------                              (* -x *)
        apply_real_unop(Absyn.NEG,x) => y

end (* apply_real_unop *)


(*************** Expression evaluation ***************)

relation eval:  (Env,Absyn.Exp) => (Env,Value)  =
(* Evaluation of expression exp in current environment env, returning
 * a possibly updated environment, and a value which can be either an
 * integer- or real-typed constant value, tagged with constructors
 * INTval or REALval, respectively *)

  axiom eval(env,Absyn.INT(ival)) => (env,INTval(ival))  (* int const *)

  axiom eval(env,Absyn.REAL(rval)) => (env,REALval(rval)) (* real const *)

  rule  lookupextend(env,id) => (env2,value)
        -----------------------------------            (* variable id *)
        eval(env,Absyn.IDENT(id)) => (env2,value)

 rule   eval(env,e1)    => (env1,v1) & 
        eval(env,e2)    => (env2,v2) &
        type_lub(v1,v2) => INT2(x,y) &
        apply_int_binop(binop,x,y) => z
        --------------------------------             (* int binop int *)
        eval(env, Absyn.BINARY(e1,binop,e2)) => (env2,INTval(z))

 rule   eval(env,e1)    => (env1,v1) & 
        eval(env,e2)    => (env2,v2) &
        type_lub(v1,v2) => REAL2(x,y) &
        apply_real_binop(binop,x,y) => z
        --------------------------------   (* int/real binop int/real *)
        eval(env, Absyn.BINARY(e1,binop,e2)) => (env2,REALval(z))

  rule  eval(env,e) => (env1,INTval(x))  &
        apply_int_unop(unop,x) => y
        -----------------------------------             (* int unop exp *)
        eval(env, Absyn.UNARY(unop,e) ) => (env1,INTval(y))

  rule  eval(env,e) => (env1,REALval(x))  &
        apply_real_unop(unop,x) => y
        ------------------------------------            (* real unop exp *)
        eval(env, Absyn.UNARY(unop,e) ) => (env1,REALval(y))

  (* eval of an assignment node returns the updated environment and
   * the assigned value *)
  rule  eval(env,exp) => (env1,value)  &
        update(env1,id,value) => env2
        ----------------------------------------         (* id := exp *)
        eval(env, Absyn.ASSIGN(id,exp)) => (env2,value)

  (* Note: there will be no type error if a real value is assigned to an
   * existing integer-typed variable, since the variable will change
   * type when it is updated. 
   *)

end (* eval *)


(* End of module Eval *)
