(* Source iInter.ml *)


open IAst (* À changer en open Pcf.I.Ast à l'extérieur de la bibliothèque *)

type value =
  | Num_v of int | Clo of string *  t * env (* comme pour Pcf pur, entiers et fermetures *)
  | Void_v (* Constante 'Unit' *)
  | Ref_v of value ref
(* Référence Pcf, tout simplement encodée par une référence de Caml *)

and env = (string * value) list


(*************************)
(* Afficheur des valeurs *)
(*************************)

let rec print_value chan v = match v with
  | Num_v i -> Printf.fprintf chan "%i" i
  | Ref_v r -> Printf.fprintf chan "{%a}" print_value !r
  | Void_v -> Printf.fprintf chan "()"
  | Clo (_,_,_) -> Printf.fprintf chan "<fun>"

exception Error of string

(*******************************)
(* Interpréteur proprement dit *)
(*******************************)
let fun_of_op op = match op with
  | Add -> (+)
  | Mul -> ( * )
  | Sub -> fun x y -> if y>x then 0 else x-y
  | Div -> (/)

let rec inter env t = match t with
| Unit -> Void_v
| Num i -> Num_v i
| Ref v -> Ref_v (ref (inter env v))
| Var x ->
    begin try
      List.assoc x env
    with Not_found ->
      raise (Error (Printf.sprintf "undefined variable %S" x))
    end
| Op (op,t1,t2) ->
    let n1 = inter_int env t1 in
    let n2 = inter_int env t2 in
    Num_v (fun_of_op op n1 n2)
| Ifz (t1,t2,t3) ->
    let v1 = inter_int env t1 in
    inter env (if v1 = 0 then t2 else t3)
| Let (x,t1,t2) ->
    let v1 = inter env t1 in
    inter ((x,v1)::env) t2
| App (t1,t2) ->
    let x,t_clo,e_clo = inter_clo env t1 in
    let v2 = inter env t2 in
    inter ((x,v2)::e_clo) t_clo
| Fun (x,t) -> Clo (x,t,env)
| Fix (f,Fun (x,t)) ->
    let rec clo = Clo (x,t,(f,clo)::env) in
    clo
| Fix _ -> raise (Error "Fix allowed on Fun only")
| Set (t,v) ->
    let r = inter_ref env t in
    let v = inter env v in
    r := v ;
(* La valeur est 'void' *)
    Void_v
| Get t -> !(inter_ref env t)
| Seq (a,b) ->
    let va = inter env a in
    let vb = inter env b in
    if va <> Void_v then begin
      (* Diagnostic sur la sortie d'erreur *)
      Printf.eprintf "Warning: sequence ignores its first value!\n" ;
      flush stderr
    end ;
    vb

and inter_int env t = match inter env t with
| Num_v i -> i
| Clo _ -> raise (Error "Num_v expected, got Clo")
| Ref_v _ -> raise (Error "Num_v expected, got Ref_v")
| Void_v -> raise (Error "Num_v expected, got Void_v")

and inter_clo env t = match inter env t with
| Clo (x,t,e) -> (x,t,e)
| Num_v _ -> raise (Error "Clo expected, got Num_v")
| Ref_v _ -> raise (Error "Clo expected, got Ref_v")
| Void_v -> raise (Error "Clo expected, got Void_v")

and inter_ref env t = match inter env t with
| Ref_v r -> r
| Clo _ -> raise (Error "Ref expected, got Clo")
| Num_v _ -> raise (Error "Ref expected, got Num_v")
| Void_v -> raise (Error "Ref expected, got Void_v")