gistfile1.ml

let rec a_sock v vars vals = match (vars, vals) with
  | (x :: xs, y :: ys) -> if v = x then Some y else a_sock v xs ys
  | ([], []) -> None
  | _ -> failwith "malformed environment"

module Eval = struct
    type repr = string list -> int list -> int
    let var v = fun vars vals -> match a_sock v vars vals with
                                 | Some x -> x
                                 | None -> failwith "var not found"
    let num n = fun _ _ -> n
    let add e1 e2 = fun vars vals -> e1 vars vals + e2 vars vals
    let ifz t c a = fun vars vals -> if (t vars vals) = 0 then c vars vals else a vars vals
    let letin x e1 e2 = fun vars vals -> e2 (x :: vars) (e1 vars vals :: vals)
  end ;;

module PEval = struct
    type repr = { st : int option; dy : Eval.repr }

    let to_repr e = (e [] []).dy

    let var v = fun vars vals ->
      match a_sock v vars vals with
      | Some { st = Some x} -> { st = Some x; dy = Eval.num x }
      | Some { dy = x } -> { st = None; dy = x }
      | None -> { st = None; dy = Eval.var v }
    let num n = fun _ _ -> { st = Some n; dy = Eval.num n }
    let add e1 e2 = fun vars vals ->
      match (e1 vars vals, e2 vars vals) with
      |  { st = Some x}, { st = Some y } ->
          { st = Some (x + y); dy = Eval.add (Eval.num x) (Eval.num y) }
      | { st = Some x}, { dy = y } -> { st = None; dy = Eval.add (Eval.num x) y }
      | { dy = x }, { st = Some y} -> { st = None; dy = Eval.add x (Eval.num y) }
      | { dy = x}, { dy = y } -> { st = None; dy = Eval.add x y }
    let ifz t c a = fun vars vals ->
      match t vars vals with
      | { st = Some t' } -> if t' = 0 then c vars vals else a vars vals
      | { dy = t' } ->
         match c vars vals, a vars vals with
         |  { st = Some c''}, { st = Some a''} when c'' = a'' ->
             { st = Some c''; dy = Eval.num c'' }
         | { dy = c'' }, { dy = a'' } -> 
            { st = None; dy = Eval.ifz t' c'' a'' }
    let letin x e1 e2 = fun vars vals ->
      let e1' = e1 vars vals in
      match e2 (x :: vars) (e1' :: vals) with
      | { st = Some x } -> { st = Some x; dy = Eval.num x }
      | { dy = d } -> { st = None; dy = Eval.letin x e1'.dy d }
  end ;;

module TF1 = struct
    open PEval
    let t1 = add (num 3) (num 5)
    let t2 = add (var ("x")) (num 5)
    let t3 = add (var ("x")) (add (num (7)) (num (5)))
    let t4 = letin "x" (num 3) (add (var "x") (var "x"))
    let t5 = letin "x" (var "y") (add (var "x") (var "x"))
    let t6 = ifz (num 1) (num 2) (num 3)
    let t7 = ifz (var "x") (num 2) (num 3)
    let t8 = ifz (var "x") (num 2) (num 2)
  end ;;

print_endline @@ string_of_int @@ (PEval.to_repr TF1.t1) [] [];;
(* 8 *)
print_endline @@ string_of_int @@ (Eval.letin "x" (Eval.num 5) (PEval.to_repr TF1.t2)) [] [];;
(* 10 *)
print_endline @@ string_of_int @@ (Eval.letin "x" (Eval.num 5) (PEval.to_repr TF1.t3)) [] [];;
(* 17 *)
print_endline @@ string_of_int @@ (PEval.to_repr TF1.t4) [] [];;
(* 6 *)
print_endline @@ string_of_int @@ (Eval.letin "y" (Eval.num 5) (PEval.to_repr TF1.t5)) [] [];;
(* 10 *)
print_endline @@ string_of_int @@ (PEval.to_repr TF1.t6) [] [];;
(* 3 *)
print_endline @@ string_of_int @@ (Eval.letin "x" (Eval.num 1) (PEval.to_repr TF1.t7)) [] [];;
(* 3 *)
print_endline @@ string_of_int @@ (PEval.to_repr TF1.t8) [] [];;
(* 2 *)

let print_static e =
  (match e [] [] with
   | { PEval.st = Some x } -> print_int x
   | _ -> print_string "dyn");
  print_newline () ;;
            
List.iter print_static [TF1.t1; TF1.t2; TF1.t3; TF1.t4; TF1.t5; TF1.t6; TF1.t7; TF1.t8] ;;
(*
8
dyn
dyn
6
dyn
3
dyn
2
 *)