Name params DONE, FU.

type ide = string;;

type expr =
    | Eint of int
    | Ebool of bool
    | Sum of expr * expr
    | Den of ide
    | Mult of expr * expr
    | Diff of expr * expr
    | Div of expr * expr
    | And of expr * expr
    | Or of expr * expr
    | Equals of expr * expr
    | Let of ide * expr * expr
    | Fun of ide * expr
    | Rec of ide * expr
    | Apply of expr * expr
    | Nameden of ide
    | Name of expr
    | Ifthenelse of expr * expr * expr;;

let typecheck (t, e) = match t with
(*    | "eval" -> (match e with
        | Int _ -> true
        | Bool _ -> true
        | Funval (_, _) -> true
        | Nameval (_, _) -> true
        | Unbound -> true
        | _ -> false)
    | _ -> failwith("you fucking dumb. HA-HA");; *)
    | "eval" -> true
    | _ -> false;;

module type ENV =
    sig
        type 't env
        exception WrongBindlist
        val emptyenv : 't -> 't env
        val applyenv : 't env * ide -> 't
        val bind : 't env * ide * 't -> 't env
        val bindlist : 't env * (ide list) * ('t list) -> 't env
        val envtostr : 't env -> string
    end

module Listenv:ENV =
    struct
        type 't env = (ide * 't) list
        exception WrongBindlist
        let emptyenv(x) = [("", x)]
        let rec applyenv(r, i) = match r with
            | [(_, e)] -> failwith (Printf.sprintf "unbound value %s" i)
            | (i1, e) :: rl -> if i = i1 then e else applyenv(rl, i)
            | _ -> failwith ("wrong env")
        let bind(r, i, e) = (i, e) :: r
        let rec bindlist(r, il, el) = match (il, el) with
            | ([], []) -> r
            | (i::il1, e::el1) -> let r1 = bind(r, i, e) in bindlist(r1, il1, el1)
            | _ -> raise WrongBindlist
        let rec envtostr r = (match r with
            | [(_, e)] -> "\n"
            | (i1, e1) :: rl -> Printf.sprintf "%s -> %s" (i1) (envtostr rl)
            | _ -> failwith ("wrong env"))
        end

type eval =
    | Int of int
    | Bool of bool
    | Funval of efun
    | Nameval of expr * eval Listenv.env
    | Unbound
and efun = expr * eval Listenv.env;;

let rec exprtostr e = (match e with
    | Eint n -> Printf.sprintf "Eint %d" n
    | Ebool b -> if b = true then "Bool true" else "Bool false"
    | Sum(a, b) -> Printf.sprintf "Sum(%s, %s)" (exprtostr a) (exprtostr b)
    | Den x -> Printf.sprintf "Den(%s)" x
    | Mult(a, b) -> Printf.sprintf "Mult(%s, %s)" (exprtostr a) (exprtostr b)
    | Diff(a, b) -> Printf.sprintf "Diff(%s, %s)" (exprtostr a) (exprtostr b)
    | Div(a, b) -> Printf.sprintf "Div(%s, %s)" (exprtostr a) (exprtostr b)
    | And(a, b) -> Printf.sprintf "And(%s, %s)" (exprtostr a) (exprtostr b)
    | Or(a, b) -> Printf.sprintf "Or(%s, %s)" (exprtostr a) (exprtostr b)
    | Equals(a, b) -> Printf.sprintf "Equals(%s, %s)" (exprtostr a) (exprtostr b)
    | Let(i, e1, e2) -> Printf.sprintf "Let(%s, %s, %s)" i (exprtostr e1) (exprtostr e2)
    | Fun(i, e) -> Printf.sprintf "Fun(%s, %s)" i (exprtostr e)
    | Rec(i, e) -> Printf.sprintf "Rec(%s, %s)" i (exprtostr e)
    | Apply(e1, e2) -> Printf.sprintf "Apply(%s, %s)" (exprtostr e1) (exprtostr e2)
    | Nameden i -> Printf.sprintf "Nameden(%s)" i
    | Name e -> Printf.sprintf "Name(%s)" (exprtostr e)
    | Ifthenelse (cond, e1, e2) -> Printf.sprintf "Ifthenelse(%s, %s, %s)" (exprtostr cond) (exprtostr e1) (exprtostr e2))
and evaltostr e = (match e with
    | Int n -> Printf.sprintf "Int %d" n
    | Bool b -> if b = true then "Bool true" else "Bool false"
    | Funval(e, r) -> Printf.sprintf "Funval(%s, %s)" (exprtostr e) (Listenv.envtostr r)
    | Nameval(e, r) -> Printf.sprintf "Nameval(%s, %s)" (exprtostr e) (Listenv.envtostr r)
    | Unbound -> "Unbound");;



let mult = function (x, y) ->
    match (x, y) with
        | (Int(a), Int(b)) -> Int(a * b)
        | _ -> failwith ("wrong type");;

let sum = function (x, y) ->
    match (x, y) with
        | (Int(a), Int(b)) -> Int(a + b)
        | _ -> failwith ("wrong type");;

let diff = function (x, y) ->
    match (x, y) with
        | (Int(a), Int(b)) -> Int(a - b)
        | _ -> failwith ("wrong type");;

let div = function (x, y) ->
    match (x, y) with
        | (Int(a), Int(b)) -> Int(a / b)
        | _ -> failwith ("wrong type");;

let band = function (x, y) ->
    match (x, y) with
        | (Bool(true), Bool(true)) -> Bool(true)
        | (Bool(_), Bool(_)) -> Bool(false)
        | _ -> failwith ("wrong type");;

let bor = function (x, y) ->
    match (x, y) with
        | (Bool(false), Bool(false)) -> Bool(false)
        | (Bool(_), Bool(_)) -> Bool(true)
        | _ -> failwith ("wrong type");;

let rec sem (e, r) =
    match e with
        | Eint(x) -> Int(x)
        | Ebool(x) -> Bool(x)
        | Den(x) -> Listenv.applyenv(r, x)
        | Sum(x, y) -> sum(sem(x, r), sem(y, r))
        | Mult(x, y) -> mult(sem(x, r), sem(y, r))
        | Diff(x, y) -> diff(sem(x, r), sem(y, r))
        | Div(x, y) -> div(sem(x, r), sem(y, r))
        | And(x, y) -> band(sem(x, r), sem(y, r))
        | Or(x, y) -> bor(sem(x, r), sem(y, r))
        | Equals(x, y) -> (match (sem(x, r), sem(y, r)) with
            | Int(a), Int(b) -> if a = b then Bool(true) else Bool(false)
            | _ -> failwith ("Wrong type"))
        | Let(i, e1, e2) -> let r1 = Listenv.bind(r, i, sem(e1, r)) in (Printf.printf "%s" (Listenv.envtostr r1); sem(e2, r1);)
        | Fun(x, y) -> Funval(e, r)
        | Apply(x, y) -> (match sem(x, r) with
            | Funval(Fun(a, b), r1) -> let r2 = Listenv.bind(r1, a, sem(y, r)) in (Printf.printf "%s" (Listenv.envtostr r2); sem(b, r2);)
            | x -> Printf.printf "%s" (evaltostr x); failwith("Not a function!"))
        | Name(x) -> Nameval(x, r)
        | Nameden(x) -> (match sem(Den x, r) with
            | Nameval(e1, r1) -> sem(e1, r1)
            | _ -> failwith ("Expected by-name parameter"))
        | Ifthenelse(cond, x, y) -> match sem(cond, r) with
            | Bool(true) -> sem(x, r)
            | Bool(false) -> sem(y, r)
            | _ -> failwith ("Ifthenelse: wrong condition!");;