Interpreter of lambda expression

interpreter.ml

open List;;
open Plf;;
open Plftypes;;

let primitives = ["succ" ; "plus" ; "moins" ; "fois" ; "div" ; "egal"];;

let rec present e l = match l with  
   [] -> false
 | x::r when x=e-> true
 | x::r -> present e r
;;
present "succ" primitives;;
present "egal" primitives;;
present "egale" primitives;;

let rec verif e env = match e with  
   Const(_) -> true
 | Var(x) -> present x env
 | Abs(x,y) -> verif y (x::env)
 | Appl(x,y) -> verif x env && verif y env
 | Cond(x,y,z) -> verif x env && verif y env && verif z env 
 | Let(x,y,z) -> verif y env && verif z (x::env)
;;

(* Test Verif *)
let env1 = "newVar" :: primitives;;
let x = Const(1608);;
verif x env1;;
let y = Var("newVar");;
verif y env1;;
let z1 = parse_top "\\x.x;";;
verif z1 primitives;; 
let z2 = parse_top "\\x.y;";;
verif z2 primitives;;
let z3 = parse_top "\\x.succ x;";;
verif z3 primitives;;
let z4 = parse_top "\\x.suck x;";;
verif z4 primitives;;
let t = Cond(Appl(Appl(Var("egal"), Const(3)), Const(2)),Var("aa"),Var("a"));; (* problème définir avec syntaxe concrète *)
verif t primitives;; 
let t = Cond(Const 1,Var("succ"),Var("moins"));;
verif t primitives;; 
let w = parse_top "let f be \\x.((plus x) 1) in f 2;";;
verif w primitives;;
let w = parse_top "let f be \\x.((plus x) 1) in y 2;";;
verif w primitives;;

type valSem = ValCst of int |
              ValFct of (valSem -> valSem)
;;

exception ErrSemantique;;
let unaryOperator f =  ValFct(function ValCst x -> ValCst (f x) 
                                       | _ -> raise ErrSemantique);;
let binaryOperator f = ValFct(function ValCst x -> ValFct(function ValCst y -> ValCst(f(x,y))
                                                                   | _ -> raise ErrSemantique) 
                                       | _ -> raise ErrSemantique);;

let env_Init = [("succ", unaryOperator(fun x -> x+1));
								("plus", binaryOperator(fun (x,y) -> x+y));
                ("moins", binaryOperator(fun (x,y) -> -x+y));
                ("fois", binaryOperator(fun (x,y) -> x*y));
                ("div", binaryOperator(fun (x,y) -> y/x));
                ("egal", binaryOperator(fun (x,y) -> if x=y then 1 else 0))
]				
;;

let rec getFromEnv e l = match l with
   [] -> raise ErrSemantique
 | (a,b)::r when a=e -> b
 | x::r -> getFromEnv e r  
;;

let applyApp f e = match f with
 | ValFct(func) -> func e
 | ValCst(x) -> ValCst(x)
;;

let rec transformAbs e f env = match f with 
   Const(a) -> ValFct(fun _ -> ValCst(a))
 | Var(b) when b=e -> ValFct(fun x -> x)
 | Var(b) when b!=e -> getFromEnv b env
 | Abs(a,b) -> transformAbs a b (e, ValFct(fun x -> e))::env
 | Appl(x,y) -> applyApp (transformAbs e x env) (transformAbs e y env)
 (*| Cond(x,y,z) -> verif x env && verif y env && verif z env 
 | Let(x,y,z) -> verif y env && verif z (x::env)*)
;;
applyApp (transformAbs "x" (Const 3) env_Init) (ValCst(10));;
applyApp (transformAbs "x" (Var "x") env_Init) (ValCst(10));;
applyApp (transformAbs "x" (Var "succ") env_Init) (ValCst(10));;
applyApp (transformAbs "x" z1 env_Init) (ValCst(10));;
applyApp (transformAbs "x" z2 env_Init) (ValCst(10));;
applyApp (transformAbs "x" z3 env_Init) (ValCst(10));;
applyApp (transformAbs "x" (Abs ("x", Appl (Var "div", Const 3))) env_Init) (ValCst(10));;

let rec eval e env = match e with
   Const x -> ValCst x
 | Var x -> getFromEnv x env
 | Cond(x,y,_) when eval x env = ValCst 1 -> eval y env
 | Cond(_,_,z) -> eval z env  
 | Appl(x,y) -> applyApp (eval x env) (eval y env) 
 | Abs(x,y) -> env := !env
 | Let(x,y,z) -> eval (Appl(Abs(x,y),z)) env
;;

eval x env_Init;;
let x = Var("succ");;
eval x env_Init;;
let t = Cond(Const 1,Var("succ"),Var("yolo"));;
eval t env_Init;;
let t = Cond(Const 0,Var("succ"),Var("yolo"));;
eval t env_Init;;
let app1 = parse_top "succ 0;";;
eval app1 env_Init;;
eval (parse_top "(div 3) 12;") env_Init;;
eval (parse_top "(\\x.(plus x) 4) 12;") env_Init;;