2.n

(* * SNU 4190.310 Programming Languages (Fall 2006) * * K- Interpreter I *) (* Memory *) signature MEM = sig    (* The type of address *)    type address    (* The type of memory from type address to type 'a *)    type 'a t    exception Not_allocated    exception Not_initialized    (* The empty memory *)    val empty : 'a t    (*     * allocate m returns an address to a fresh (uninitialized) buffer and a     * memory containing the same bindings as m, plus a binding of the address     * to the allocated buffer.     *)    val allocate : 'a t -> address * 'a t    (*     * store addr v m returns a memory containing the same bindings as m, with     * addr bounded to v, or raises Not_allocated if m doesn't contain a     * binding for addr.     *)    val store : address -> 'a -> 'a t -> 'a t    (*     * fetch addr m returns the current binding of addr in m, raises     * Not_initialized if the binding is not initialized yet or raises     * Not_found if no such binding exists.     *)    val fetch : address -> 'a t -> 'a    (*     * is_allocated addr m returns true if m contains a binding for addr, and     * false otherwise.     *)    val is_allocated : address -> 'a t -> bool end structure Mem : MEM = struct    type address = int    type 'a t = address * ((address, 'a option) Map.t)    exception Not_allocated    exception Not_initialized    val empty = (0, Map.empty)    fun allocate (n, m) = (n, (n + 1, Map.add n None m))    fun store a v (n, m)  =        if Map.mem a m then (n, Map.add a (Some v) m) else raise Not_allocated    fun fetch a (_, m) = (          case (Map.find a m) of Some v => v | None => raise Not_initialized        ) handle Not_found => raise Not_allocated    fun is_allocated a (_, m) = Map.mem a m end (* Environment *) signature ENV = sig    (* The type of environment from 'a to 'b *)    type ('a, 'b) t    exception Not_bound    (* The empty environment *)    val empty : ('a, 'b) t    (*     * bind x addr e returns an environment containing the same bindings as     * e, plus a binding of x to addr. If x was already bound in e, its     * previous binding disappears.     *)    val bind : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t    (*     * lookup x e returns the current binding of x in e, or raises Not_bound if     * no such binding exists.     *)    val lookup : 'a -> ('a, 'b) t -> 'b    (*     * is_bound x e returns true if e contains a binding for x, and false     * otherwise.     *)    val is_bound : 'a -> ('a, 'b) t -> bool end structure Env : ENV = struct    type ('a, 'b) t = ('a, 'b) Map.t    exception Not_bound    val empty = Map.empty    fun bind x a e = Map.add x a e    fun lookup x e = (Map.find x e) handle Not_found => raise Not_bound    fun is_bound x e = Map.mem x e end (* K- Interpreter *) signature KEVAL = sig    exception Error of string    type id = string    type exp =        NUM of int      | TRUE      | FALSE      | UNIT      | VAR of id      | ADD of exp * exp      | SUB of exp * exp      | MUL of exp * exp      | DIV of exp * exp      | EQUAL of exp * exp      | LESS of exp * exp      | NOT of exp      | ASSIGN of id * exp      | SEQ of exp * exp      | IF2 of exp * exp * exp      | IF1 of exp * exp      | WHILE of exp * exp      | FOR of id * exp * exp * exp      | LET of id * exp * exp      | READ of id      | WRITE of exp    type program = exp    type memory    type env    type value        val v2s : value -> string    val emptyMem : memory    val emptyEnv : env    val run : memory * env * program -> value end structure Keval : KEVAL = struct    exception Error of string    type id = string    type exp =        NUM of int      | TRUE      | FALSE      | UNIT      | VAR of id      | ADD of exp * exp      | SUB of exp * exp      | MUL of exp * exp      | DIV of exp * exp      | EQUAL of exp * exp      | LESS of exp * exp      | NOT of exp      | ASSIGN of id * exp      | SEQ of exp * exp      | IF2 of exp * exp * exp      | IF1 of exp * exp      | WHILE of exp * exp      | FOR of id * exp * exp * exp      | LET of id * exp * exp      | READ of id      | WRITE of exp    type program = exp    type value = int    type memory = value Mem.t    type env = (id, value) Env.t    val emptyMem = Mem.empty    val emptyEnv = Env.empty        val v2s = fn x => (string_of_int x)^"\n"    val run =          fn (memory, env, program) => (*                  (case program of                        NUM (i) => i              | TRUE => 1              | FALSE => 0              | UNIT => 0              | VAR (id) => val _ = print_string(id);              | ADD (exp1, exp2) => fn(memory, env, exp1)              | SUB (exp1, exp2) => fn(memory, env, exp1)              | MUL (exp1, exp2) => fn(memory, env, exp1)              | DIV (exp1, exp2) => fn(memory, env, exp1)              | EQUAL (exp1, exp2) => fn(memory, env, exp1)              | LESS (exp1, exp2) => fn(memory, env, exp1)              | NOT (exp) => fn(memory, env, exp)              | ASSIGN (id, exp) => memory.allocate id              | SEQ (exp1, exp2) => fn(memory, env, exp1)              | IF2 (exp1, exp2, exp3) => fn(memory, env, exp1)              | IF (exp1, exp2) => fn(memory, env, exp1)              | WHILE (exp1, exp2) => fn(memory, env, exp1)              | FOR (id, exp1, exp2, exp3) => fn(memory, env, exp1)              | LET (id, exp1, exp2) => fn(memory, env, exp1)              | READ (id) =>                  | WRITE (exp) => fn(memory, env, exp1)        )*) end