(* Gestione Ambiente*)
type 't env = (string * 't) list
exception WrongBindlist
let emptyenv(x) = [("", x)]
let rec applyenv(x, y) = match x with
  | [(_, e)] -> e
  | (i1, e1) :: x1 -> if y = i1 then e1
      else applyenv(x1, y)
  | [] -> failwith("wrong env")
let bind(r, l, e) = (l, e) :: r
let rec bindlist(r, il, el) = match (il, el) with
  | ([], []) -> r
  | (i::il1, e::el1) -> bindlist(bind(r, i, e), il1, el1)
  | _ -> raise WrongBindlist
;;


(* Linguaggio Funzionale Didattico*)
type ide = string
type exp =
    | Eint of int
    | Ebool of bool
    | Den of ide
    | Sum of exp * exp
    | Diff of exp * exp
    | Prod of exp * exp
    | Eq of exp * exp
    | Minus of exp
    | Iszero of exp
    | Or of exp * exp
    | And of exp * exp
    | Not of exp
    | Ifthenelse of exp * exp * exp
    | Let of ide * exp * exp(* Dichiarazione di ide: modifica ambiente*)
    | Fun of ide * exp(* Astrazione di funzione*)
    | Apply of exp * exp (* Applicazione di funzione*)
    | Letrec of ide(*nome fun*)*ide(*par.formale*)*exp(*body fun*)*exp(*body let*)
    | Etup of tuple (*Tupla come espressione*)
    | Pipe of tuple (*Concatenazione di funzioni*)
    | ManyTimes of int * exp (*Esecuzione iterata di una funzione*)
and tuple =
    | Nil (*Tupla vuota*)
    | Seq of exp * tuple (*Tupla di espressioni*)
;;


(*Eval*)
type eval=
    | Int of int
    | Bool of bool
    | Unbound
    | RecFunVal of ide * ide * exp * eval env
    | Funval of efun
    | ValTup of evtuple
and efun = ide* exp * eval env
and evtuple =
    | Nil
    | Seq of eval * evtuple
;;



(*Type Checker Dinamico*)
let typecheck(x, y) = match x with
  | "int" ->
      (match y with
        | Int(u) -> true
        | _ -> false)
  | "bool" ->
      (match y with
        |Bool(b) -> true
        |_->false)
  |_->failwith("error");;


let plus(x, y) = if typecheck("int", x) && typecheck("int", y) then
    (match (x, y) with
      |(Int(u), Int(w)) -> Int(u + w)
      |_->failwith("error"))
  else failwith ("error");;


let diff(x,y)=if typecheck("int",x) && typecheck("int", y) then
    (match (x, y) with
      |(Int(u), Int(w)) -> Int(u - w)
      |_->failwith("error"))
  else failwith ("type error");;


let prod(x,y)=if typecheck("int",x) && typecheck("int", y) then
    (match (x, y) with
      |(Int(u), Int(w)) -> Int(u * w)
      |_->failwith("error"))
  else failwith ("type error");;


let iszero(x)=if typecheck("int",x) then
    (match x with
      |Int(u)->if u=0 then Bool(true) else Bool(false)
      |_->failwith("error"))
  else failwith("type error");;


let equ(x,y)=if typecheck("int",x) && typecheck("int", y) then
    (match (x, y) with
      |(Int(u), Int(w)) -> if u=w then Bool(true) else Bool(false)
      |_->failwith("error"))
  else failwith ("type error");;


let minus(x)=if typecheck("int",x) then
    (match x with
      |Int(u)->Int(-u)
      |_->failwith("error"))
  else failwith("type error");;


let et(x,y)=if typecheck("bool",x) && typecheck("bool", y) then
    (match (x, y) with
      |(Bool(u), Bool(w)) -> Bool(u && w)
      |_->failwith("error"))
  else failwith ("type error");;


let vel(x,y)=if typecheck("bool",x) && typecheck("bool", y) then
    (match (x, y) with
      |(Bool(u), Bool(w)) -> Bool(u || w)
      |_->failwith("error"))
  else failwith ("type error");;


let non(x)=if typecheck("bool",x) then
    (match x with
      |Bool(u) -> Bool(not(u))
      |_->failwith("error"))
  else failwith ("type error");;

(*Interprete a scoping statico*)
let rec sem ((e: exp), (r: eval env)) =
  (match e with
    | Eint(n) -> Int(n)
    | Ebool(b) -> Bool(b)
    | Den(i) -> applyenv(r, i)
    | Sum(a, b) ->  plus(sem(a, r), sem(b, r))
    | Diff(a, b)  ->  diff(sem(a, r), sem(b, r))
    | Prod(a,b)->prod(sem(a,r), sem(b,r))
    | Iszero(a) -> iszero(sem(a, r))
    | Eq(a, b) -> equ(sem(a, r),sem(b, r))
    | Minus(a) ->  minus(sem(a, r))
    | And(a, b) ->  et(sem(a, r), sem(b, r))
    | Or(a, b) ->  vel(sem(a, r), sem(b, r))
    | Not(a) -> non(sem(a, r))
    | Ifthenelse(a, b, c) -> let g = sem(a, r) in
          if typecheck("bool", g) then
            (if g = Bool(true) then sem(b, r) else sem(c, r))
          else failwith ("nonboolean guard")
    | Let(i, e1, e2) -> sem(e2, bind (r, i, sem(e1, r)))
    | Fun(i,a) -> Funval(i,a,r)
    | Letrec(f, i, fBody,letBody) ->
        let benv =
          bind(r, f, (RecFunVal(f, i, fBody, r)))
        in sem(letBody, benv)
    | Etup(tup) -> (match tup with
        | Seq(elem, ttup) ->
            let evelem = sem(elem, r) in
            let ValTup(evttup) = sem(Etup(ttup), r) in
                ValTup(Seq(evelem, evttup))
        | Nil -> ValTup(Nil))
    | Apply(Den f, eArg) ->
        (let fclosure= sem(Den f, r) in
           match fclosure with
             | Funval(arg, fbody, fDecEnv) ->
                 sem(fbody, bind(fDecEnv, arg, sem(eArg, r)))
             | RecFunVal(f, arg, fbody, fDecEnv) ->
                 let aVal= sem(eArg, r) in
                 let rEnv= bind(fDecEnv, f, fclosure) in
                 let aEnv= bind(rEnv, arg, aVal) in
                   sem(fbody, aEnv)
             | _ -> failwith("non functional value"))
    | Apply(Pipe tup, eArg) -> unrollPipe tup sem(eArg, r) r
    | Apply(_,_) -> failwith("not function"))

and rec unrollPipe tup evarg r = match tup with
        | Seq(Den f, ttup) ->
            let fclosure= sem(Den f, r) in
            match fclosure with
                | Funval(arg, fbody, fDecEnv) ->
                    let fres = sem(fbody, bind(fDecEnv, arg, evarg)) in
                        unrollPipe Pipe(ttup) fres r
                | RecFunVal(f, arg, fbody, fDecEnv) ->
                    let rEnv= bind(fDecEnv, f, fclosure) in
                    let aEnv= bind(rEnv, arg, evarg) in
                    let fres = sem(fbody, aEnv) in
                        unrollPipe Pipe(ttup) fres r
        | Seq(Pipe(ftup), ttup) ->
            let fres = unrollPipe Pipe(ftup) evarg r in
                unrollPipe Pipe(ttup) fres r
        | Nil -> evarg
        | _ -> failwith("bad Pipe")
;;


(*Prova valutazione tupla*)
sem(
    Etup(
        Seq( Sum(Eint(10), Eint(2)),
        Seq( Eint(29),
            Nil))),
    (emptyenv Unbound));;