8-2

8-2.ml

type cam_value =
  | CAM_IntVal  of int
  | CAM_BoolVal of bool
  | CAM_ClosVal of cam_code * cam_env
and cam_stack = cam_value list
and cam_env = cam_value list
and cam_instr =
  | CAM_Ldi of int
  | CAM_Ldb of bool
  | CAM_Access of int
  | CAM_Closure of cam_code
  | CAM_Apply
  | CAM_Return
  | CAM_Let
  | CAM_EndLet
  | CAM_Test of cam_code * cam_code
  | CAM_Add | CAM_Sub | CAM_Mul | CAM_Div | CAM_Gt | CAM_Lt
  | CAM_Eq | CAM_Ne
and cam_code = cam_instr list

let intop = (function
  CAM_IntVal(n2)::CAM_IntVal(n1)::s -> (function
     CAM_Add -> (s, CAM_IntVal(n1 + n2))
  |  CAM_Sub -> (s, CAM_IntVal(n1 - n2))
  |  CAM_Mul -> (s, CAM_IntVal(n1 * n2))
  |  CAM_Div -> (s, CAM_IntVal(n1 / n2))
  |  CAM_Gt  -> (s, CAM_BoolVal(n1 > n2))
  |  CAM_Lt  -> (s, CAM_BoolVal(n1 < n2))
  |  _       -> failwith "Int Binop Error")
| _ -> failwith "Binop Error")

let boolop = (function
  v2::v1::s -> (function
      CAM_Eq -> (s, CAM_BoolVal(v1 = v2))
   |  CAM_Ne -> (s, CAM_BoolVal(v1 <> v2))
   |  _       -> failwith "Bool Binop Error")
| _ -> failwith "Binop Error")
 
let tail = (function
   [] -> []
|  hd::tl -> tl)

let rec run env stack = (function
   [] -> (env, stack, [])
|  hd::tl  ->
     let (e, s, c) = 
       (match hd with
          CAM_Ldi(n) -> (env, CAM_IntVal(n)::stack, tl)
       |  CAM_Ldb(b) -> (env, CAM_BoolVal(b)::stack, tl)
       |  CAM_Access(i) -> (env, ((List.nth env i)::stack), tl)
       |  CAM_Closure(c) -> (env, CAM_ClosVal(c, env)::stack, tl)
       |  CAM_Apply ->
            (match stack with
              CAM_ClosVal(c, e)::v::s ->
                (v::CAM_ClosVal(c, e)::e, CAM_ClosVal((tail tl), env)::s, c@tl)
            | _ -> failwith "Apply Error")
       |  CAM_Return -> 
            (match stack with
              v::CAM_ClosVal(c, e)::s -> (e, v::s, c@tl)
            | _ -> failwith "Return Error")
       |  CAM_Let -> 
            (match stack with
              v::s -> (v::env, s, tl)
            | _    -> failwith "Let Error")
       |  CAM_EndLet -> ((tail env), stack, tl)
       |  CAM_Test(c1, c2) ->
            (match stack with
               CAM_BoolVal(true)::s  -> (env, s, c1@tl)
            |  CAM_BoolVal(false)::s -> (env, s, c2@tl)
            |  _ -> failwith "Test Error")
       |  CAM_Add | CAM_Sub | CAM_Mul | CAM_Div | CAM_Gt | CAM_Lt ->
           let (s, v) = intop stack hd in
           (env, v::s, tl)
       |  CAM_Eq | CAM_Ne  ->
           let (s, v) = boolop stack hd in
           (env, v::s, tl))
     in
     run e s c)