(*

    Trabalho Final 2016/2

    Grupo:

    Leonardo Silva Rosa     242292
    Marcelo Haider          220505
    Gabriel Martins         228416

    Avaliador : Big-Step

*)

type Variavel = string

type Operador =
    | Soma
    | Subtracao
    | Mult
    | Div
    | Menor
    | MenorIgual
    | Igual
    | Diferente
    | MaiorIgual
    | Maior

type Expressao =
    | Num           of int
    | Bool          of bool
    | Op            of Expressao * Operador * Expressao
    | If            of Expressao * Expressao * Expressao
    | Var           of Variavel
    | App           of Expressao * Expressao
    | Fn            of Variavel * Expressao
    | Let           of Variavel * Expressao * Expressao
    | LetRec        of Variavel * Variavel * Expressao * Expressao
    | Nil
    | Cons          of Expressao * Expressao
    | IsEmpty       of Expressao
    | Hd            of Expressao
    | Tl            of Expressao
    | Raise
    | TryWith       of Expressao * Expressao

type Valor =
    | VNumerico     of int
    | VBooleano     of bool
    | VClosure      of Variavel * Expressao * Ambiente
    | VClosureRec   of Variavel * Variavel * Expressao * Ambiente
    | VList         of Valor * Valor
    | VNil
    | VRaise
and
    Ambiente = (Variavel * Valor) list

(*-----------------------------------------------------------------------*)

(*--- Excecoes ---*)

exception CantGetValueException
exception CantEvaluateException
exception VariableNotDefinedException

(*-----------------------------------------------------------------------*)

(*--- Operadores ---*)

let soma (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VNumerico(x+y)
    | _ -> raise CantGetValueException

let subt (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VNumerico(x-y)
    | _ -> raise CantGetValueException

let mult (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VNumerico(x*y)
    | _ -> raise CantGetValueException

let div (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VNumerico(x/y)
    | _ -> raise CantGetValueException

let menor (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VBooleano(x<y)
    | _ -> raise CantGetValueException

let menorIgual (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VBooleano(x<=y)
    | _ -> raise CantGetValueException

let maior (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VBooleano(x>y)
    | _ -> raise CantGetValueException

let maiorIgual (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VBooleano(x>=y)
    | _ -> raise CantGetValueException

let igual (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VBooleano(x=y)
    | _ -> raise CantGetValueException

let diferente (a: Valor)(b: Valor) : Valor =
    match (a,b) with
    | (VNumerico(x), VNumerico(y)) -> VBooleano(x<>y)
    | _ -> raise CantGetValueException

(*-----------------------------------------------------------------------*)

(*--- AMBIENTE ---*)

let rec lookupAmbiente (ambiente: Ambiente) (x: Variavel) : Valor =
     match ambiente with
     | [] -> raise VariableNotDefinedException
     | (variavel, valor) :: tl ->
        if variavel = x then
            valor
        else
            lookupAmbiente tl x;;

let adicionaAmbiente (ambiente: Ambiente) (x: Variavel) (v: Valor) : Ambiente =
    (x, v) :: ambiente

(*-----------------------------------------------------------------------*)

(*--- Semântica Big-Step ---*)

let rec avalia (ambiente: Ambiente) (e: Expressao) : Valor =

    match e with

    | Raise -> VRaise

    | Num e -> VNumerico e

    | Bool e -> VBooleano e

    | Var e -> lookupAmbiente ambiente e

    | If (e1, e2, e3) ->
        (match avalia ambiente e1 with
        | VRaise -> VRaise
        | VBooleano true -> avalia ambiente e2
        | VBooleano false -> avalia ambiente e3
        | _ -> raise CantEvaluateException
        )

    | Op (e1, op, e2) ->
        let v1 = avalia ambiente e1 in
        let v2 = avalia ambiente e2 in
        (match (v1, v2) with
        | VRaise, x -> VRaise
        | x, VRaise -> VRaise
        | _ -> (match op with
                | Soma -> soma v1 v2
                | Subtracao -> subt v1 v2
                | Mult -> mult v1 v2
                | Div -> div v1 v2
                | Menor -> menor v1 v2
                | MenorIgual -> menorIgual v1 v2
                | Igual -> igual v1 v2
                | Diferente -> diferente v1 v2
                | MaiorIgual -> maiorIgual v1 v2
                | Maior -> maior v1 v2))

    | Fn (x, e1) ->
        VClosure(x, e1, ambiente)

    | App (e1, e2) ->
        let e1' = avalia ambiente e1 in
            let e2' = avalia ambiente e2 in
                match (e1', e2') with
                //Bs-App
                | (VRaise, x) -> VRaise
                | (x, VRaise) -> VRaise
                | (VClosure(x, e, env), v) ->
                    let env' : Ambiente = (adicionaAmbiente env x v) in
                        avalia env' e
                //Bs-AppRec
                | (VClosureRec(f, x, e, env), v) ->
                    let env' : Ambiente = (adicionaAmbiente (adicionaAmbiente env x v)  f (VClosureRec(f, x, e, env))) in
                        avalia env' e
                | _ -> raise CantEvaluateException

    | Let (x, e1, e2) ->
        let env' : Ambiente = (adicionaAmbiente ambiente x (avalia ambiente e1))
            in avalia env' e2

    | LetRec (f, x, e1, e2) ->
        let closerec = VClosureRec(f, x, e1, ambiente) in
           avalia (adicionaAmbiente ambiente f closerec) e2

    | Nil -> VNil

    | Cons (e1, e2) ->
        let e1' = (avalia ambiente e1) in
            match e1' with
            | VRaise -> VRaise
            | _ ->
            let e2' = (avalia ambiente e2) in
                match e2' with
                | VRaise -> VRaise
                | _ -> VList (e1', e2')

    | IsEmpty e ->
        let e' = (avalia ambiente e) in
            match (e') with
            | VRaise -> VRaise
            | VNil -> VBooleano (true)
            | VList (x, y) -> VBooleano (false)
            | _ -> raise CantEvaluateException

    | Hd e ->
        let e' = (avalia ambiente e) in
            match (e') with
            | VRaise -> VRaise
            | VList (x, y) -> x
            | _ -> raise CantEvaluateException

    | Tl e ->
        let e' = (avalia ambiente e) in
            match (e') with
            | VRaise -> VRaise
            | VList (x, y) -> y
            | _ -> raise CantEvaluateException

    | TryWith (e1, e2) ->
        let e1' = (avalia ambiente e1) in
        	match (e1') with
            | VRaise -> avalia ambiente e2
            | _ -> e1'


(*-----------------------------------------------------------------------*)

(*--- Testes ---*)

let ambiente : Ambiente = [];;

// Teste de fatorial

let numero = 6;;
let igualA1 = Op(Var "x", Igual, Num 1);;
let menos1 = Op(Var "x", Subtracao, Num 1);;
let funcao = If(igualA1, Num 1, Op(Var "x", Mult, App(Var "fat", menos1)));;
let fatorial = LetRec("fat", "x", funcao, App(Var "fat", Num numero));;

avalia ambiente fatorial;;

// Testes listas

let listexp = Cons(Num 1, Cons(Num 2, Cons(Num 3, Nil)));;
let listexp2 = Cons(Num 1, Nil);;
let listexp3 = Cons(Num 0, listexp);;

avalia ambiente listexp;;
avalia ambiente listexp2;;
avalia ambiente listexp3;;

let isempty1 = IsEmpty(listexp);;
let isempty2 = IsEmpty(Nil);;

avalia ambiente isempty1;;
avalia ambiente isempty2;;

let hd1 = Hd(listexp);;
let tl1 = Tl(listexp);;
let hd2 = Hd(listexp2);;
let tl2 = Tl(listexp2);;

avalia ambiente hd1;;
avalia ambiente tl1;;
avalia ambiente hd2;;
avalia ambiente tl2;;

// Testes Try-with

let tw = TryWith(Raise, Num 1);;
let tw2 = TryWith(Num 2, Raise);;
let tw3 = TryWith(Raise, Raise);;

avalia ambiente tw;;
avalia ambiente tw2;;
avalia ambiente tw3;;