paire.ml
type prim = {name : string; arity : int}
let succ = {name ="succ"; arity = 1}
let plus = {name = "plus"; arity = 2}

type constr = Int of int | Constr of string
type const = {constr : constr; carity : int}
type exp =
  | Const of const * exp list
  | Prim of prim * exp list
  | Var of var
  | App of exp * exp 
  | Fonction of var * exp
  | Liaison of var * exp * exp
and var = string;;
    
type valeur =
  | Vconst of const * valeur list
  | Vfonction of var * exp * env
and env = (var * valeur) list;;
    
type error =
  | Libre of string
  | Delta of prim * valeur list
  | Beta of exp
exception Error of error
let error e = raise (Error e);;

let pair = {constr = Constr "paire"; carity = 2};;
let int n = {constr = Int n; carity = 0};;
let fst = {name= "fst"; arity = 1; }
let snd = {name= "snd"; arity = 1; };;

let delta_plus
    [ Vconst ({constr = Int x}, []); Vconst ({constr = Int y},[])] =
  Vconst (int (x + y), [])
let delta_succ [ Vconst ({constr = Int x}, [])] = Vconst (int (x+1), [])
let delta_fst  [Vconst ({constr = Constr "paire"}, [x; y])] = x
let delta_snd  [Vconst ({constr = Constr "paire"}, [x; y])] = y
let delta =
  [ "succ", delta_succ; "plus", delta_plus;
    "fst", delta_fst; "snd", delta_snd ] ;;

let find x env =
  try List.assoc x env with Not_found -> error (Libre x);;

let rec eval env = function
  | Const (c, args) -> Vconst (c, List.map (eval env) args)
  | Var x -> find x env
  | Fonction (x, a) as f -> Vfonction (x, a, env)
  | App (a1, a2) as e ->
      let f = eval env a1 in
      let v = eval env a2 in
      begin match f with
      | Vfonction (x, a, env0) ->
          eval ((x, v) :: env0) a
      | Vconst _ -> error (Beta e)
      end
  | Prim (f, args) ->
      let vargs = List.map (eval env) args in
      begin try  (List.assoc f.name delta) vargs
      with x -> error (Delta (f, vargs))
      end
  | Liaison (x, e1, e2) ->
      eval env (App (Fonction (x, e2), e1)) ;;


let e =
  Liaison
    ("f",
     Fonction
       ("xy", Const (pair,
                     [ Prim (snd, [ Var "xy"]);
                       Prim (fst, [Var "xy"]);])),
     App
      (Var "f",
       Const (pair, [Const (int 1, []); Const (int 2, [])])));;

eval [] e;;