Mylang

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;;

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
    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)] -> e
            | (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
    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 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 evaltostr e =
    match e with
        | Int(a) -> let s = Printf.sprintf "Int(%d) " a in s
        | Bool(a) -> if a = true then "Bool(true) " else "Bool(false) "
        | Funval(a, r) -> "Funzione :O "
        | _ -> "Cazzo fai?!";;

let rec envtostr r =
    match r with
        | [] -> ""
        | [(a, b)]::xs -> Printf.sprintf "%s%s%s" (a) (evaltostr(b)) (envtostr(xs));;

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 sem(e2, r1)
        | Fun(x, y) -> Funval(e, r)
        | Apply(x, y) -> (match sem(x, r) with
            | Funval(Fun(a, b), r) -> let r1 = Listenv.bind(r, a, sem(y, r)) in sem(b, r1)
            | 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); Printf.printf "%s" (envtostr(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!");;

let r = Listenv.bind(Listenv.emptyenv(Int 0), "q", Int 4) in Listenv.applyenv(r, "q");;