(**************************************)
(*     Solution du TD3                *)
(* interpréteur pour PCF (par valeur) *)
(**************************************)

(* Cet interpréteur pat valeur est le plus malin, celui
   qui represente les fonction récursives par des fermetures 
bouclées. *)
(* Source 
inter.ml *)

(* Conforme à l'interface 
Inter *)

(* open Pcf (* À l'extérieur de la bibliothèque *) *)



open S.Ast (* Documentation de S.Ast *)

type value = Num_v of int | Clo_v of string * t * env
and
 env = (string * value) list

open
 Printf

let
 print_value chan v = match v with
| Num_v i -> fprintf chan "%i" i
| Clo_v (_,_,_) -> fprintf chan "<fun>"


exception Error of string

let
 rec interv env t = match t with
| Num i -> Num_v i
| Var x ->
    begin try List.assoc x env
    with Not_found ->
      raise (Error ("variable: "^x^" undefined")) end
| Op (op,t1,t2) ->
    let n1 = inter_int env t1 in
    let n2 = inter_int env t2 in
    Num_v (Op.to_fun op n1 n2)
| Ifz (t1,t2,t3) ->
    let v1 = inter_int env t1 in
    interv env (if v1 = 0 then t2 else t3)
| Let (x,t1,t2) ->
    let v1 = interv env t1 in
    interv ((x,v1)::env) t2
| App (t1,t2) ->
    let x,t_clo,e_clo = inter_clo env t1 in
    let v2 = interv env t2 in
    interv ((x,v2)::e_clo) t_clo
| Fun (x,t) -> Clo_v (x,t,env)
| Fix (f,Fun (x,t)) ->
    let rec clo = Clo_v (x,t,(f,clo)::env) in
    clo
| Fix _ -> raise (Error "Fix allowed on Fun only")

and inter_int env t = match interv env t with
| Num_v i -> i
| Clo_v _ -> raise (Error "Int expected, got Clo")

and inter_clo env t = match interv env t with
| Clo_v (x,t,e) -> (x,t,e)
| Num_v _ -> raise (Error "Clo expected, got Int")

This document was translated from LATEX by HEVEA.