//
// STRAIGHT-LINE PROGRAM INTERPRETER (pages 10, 11, 12) 
//

// Implemented in ATS by Hongwei Xi (hwxi AT cs DOT bu DOT edu)
// The feature of call-by-reference is used

//
// How to compile:
//   atscc -o calc calc-2009-01-29.dats
//

(* ****** ****** *)

abstype id_t

extern fun id_make (name: string): id_t
extern fun eq_id_id (_: id_t, _: id_t): bool
overload = with eq_id_id

extern fun print_id (_: id_t): void
overload print with print_id

local

assume id_t = string

in

implement id_make (name) = name
implement eq_id_id (x, y) = eq_string_string (x, y)
implement print_id (x) = print_string x

end // end of [local]

(* ****** ****** *)

datatype binop = Plus | Minus | Times | Div

datatype stm = CompoundStm of (stm, stm)
             | AssignStm of (id_t, exp)
             | PrintStm of explst

     and exp = IdExp of id_t
             | NumExp of int
             | OpExp of (exp, binop, exp)
             | EseqExp of (stm, exp)

where explst = List exp

(* ****** ****** *)

abstype table_t

extern fun table_make (): table_t
extern fun lookup (tbl: table_t, x: id_t): int
extern fun update (tbl: table_t, x: id_t, v: int): table_t

local

assume table_t = List @(id_t, int)

in

implement table_make () = list_nil ()

implement lookup (tbl, x0) = case+ tbl of
  | list_cons (xv, tbl) => if (x0 = xv.0) then xv.1 else lookup (tbl, x0)
  | list_nil () => begin
      0 // if a variable is not defined; this is convenient but not such a good style
    end // end of [list_nil]
// end of [lookup]

implement update (tbl, x0, v_new) = case+ tbl of
  | list_cons (xv, tbl) => begin
      if x0 = xv.0 then
        list_cons (@(x0, v_new), tbl)
      else
        list_cons (xv, update (tbl, x0, v_new))
      // end of [if]
    end // end of [list_cons]
  | list_nil () => list_cons (@(x0, v_new), list_nil ())
// end of [update]

end // end of [local]

(* ****** ****** *)

extern fun interpExp (tbl: &table_t, _: exp): int
extern fun interpStm (tbl: &table_t, _: stm): void

(* ****** ****** *)

implement interpExp (tbl, exp) = case+ exp of
  | IdExp id => let val v = lookup (tbl, id) in v end
  | NumExp v => v
  | OpExp (exp1, binop, exp2) => let
      val v1 = interpExp (tbl, exp1)
      val v2 = interpExp (tbl, exp2)
    in
      case+ binop of
      | Plus () => v1 + v2 | Minus () => v1 - v2 | Times () => v1 * v2 | Div () => v1 / v2
    end // end of [OpExp]
  | EseqExp (stm, exp) => let
      val () = interpStm (tbl, stm) in interpExp (tbl, exp)
    end // end of [EseqExp]
// end of [interpExp]

implement interpStm (tbl, stm) = case+ stm of
  | CompoundStm (stm1, stm2) => let
      val () = interpStm (tbl, stm1) in interpStm (tbl, stm2)
    end // end of [CompoundStm]
  | AssignStm (id, exp) => let
      val v = interpExp (tbl, exp)
      val tbl_new = update (tbl, id, v)
    in
      tbl := tbl_new
    end // end of [AssignStm]
  | PrintStm (exps) => loop (tbl, exps, 0) where {
      fun loop (tbl: &table_t, exps: explst, i: int): void =
        case+ exps of
        | list_cons (exp, exps) => let
            val v = interpExp (tbl, exp)
          in
            if i > 0 then print ' '; print v; loop (tbl, exps, i+1)
          end // end of [list_cons]
        | list_nil () => print_newline ()
    } // end of [PrintStm]
// end of [interpStm]
    
(* ****** ****** *)

extern fun interp (_: stm): void

implement interp (stm) = let
  var tbl0 = table_make (); val () = interpStm (tbl0, stm)
in
  // empty
end // end of [interp]

(* ****** ****** *)

implement main () = let
  val a_id = id_make "a"
  val b_id = id_make "b"
  val a_exp = IdExp a_id
  val b_exp = IdExp b_id
  val stm1 = AssignStm (a_id, OpExp (NumExp 5, Plus, NumExp 3))
  val stm2 = PrintStm $lst (a_exp, OpExp (a_exp, Minus, NumExp 1))
  val stm3 = AssignStm (b_id, EseqExp (stm2, OpExp (NumExp 10, Times, a_exp)))
  val stm4 = CompoundStm (stm1, stm3)
  val stm5 = CompoundStm (stm4, PrintStm $lst (b_exp))
in
  interp (stm5)
end // end of [main]

(* ****** ****** *)

(* end of [calc-2009-01-29.dats] *)