gistfile1.ml

module Interpret = begin

(* e -> term to replace in
x -> identifier string
t -> id replacement *)
let rec subst e x t =   match e with
                        | ID s when s=x -> t
                        | IF (p,v,f) -> IF (subst p x t, subst v x t, subst f x t)
                        | APP (e1,e2) -> APP (subst e1 x t, subst e2 x t)
                        | FUN (id,c) when id=x -> FUN (id,c)
                        | FUN (id,c) -> FUN(id,subst c x t)
                        | _ -> e

let rec interp = function
| ID s -> ID s
| NUM i -> NUM i
| BOOL b -> BOOL b
| SUCC -> SUCC
| PRED -> PRED
| ISZERO -> ISZERO
| IF(pred, vrai, faux) ->
    match interp pred with
    | BOOL true -> interp vrai
    | BOOL false -> interp faux
    | _ -> ERROR "If statement requires a boolean value"
| APP (e1, e2) ->   match (interp e1, interp e2) with
                    | (ERROR s, _) -> ERROR s // ERRORs are propagated
                    | (_, ERROR s) -> ERROR s
                    | (SUCC, NUM n) -> NUM (n+1)
                    | (SUCC, v) -> ERROR (sprintf "'succ' needs int argument, not '%A'" v)
                    | (PRED, NUM n) -> if n=0 then NUM(0) else NUM (n-1)
                    | (PRED, v) -> ERROR (sprintf "'pred' needs int argument, not '%A'" v)
                    | (ISZERO, NUM n) -> if(n=0) then BOOL(true) else BOOL(false)
                    | (ISZERO, v) -> ERROR (sprintf "'iszero' needs int argument, not '%A'" v)
                    | (REC(n,c), tm) -> interp (APP (interp (subst c n (REC(n,c))), tm))
                    | (FUN(n,c), tm) -> interp (subst c n tm)
                    | (ID a, ID b) -> APP(ID a, ID b)
                    | (x,y) -> ERROR(sprintf "Broken on %A :::: %A" x y)
| FUN(name, content) -> FUN(name, content)
| REC(name, content) -> REC(name, content)
| ERROR s -> ERROR s

end