Sys.command "ocaml -version";;
print_endline Sys.ocaml_version;;

type operateur = Plus | Moins | MoinsDroite | Mul | Div | DivDroite | Modulo | Expo ;;
(* On utilisera MoinsDroite et DivDroite pour la compilation avec la méthode d'Ershov *)

type ('a, 'b) arbre_binaire = N of (('a,'b) arbre_binaire) * 'b * (('a,'b) arbre_binaire) | F of 'a

(* exp1 = (x - y*z) *)
let exp1 =
N(
    F("x"),
    Moins,
    N(
        F("y"),
        Mul,
        F("z")
    )
)
;;

(* exp2 = (u - v*w) *)
let exp2 =
N(
    F("u"),
    Moins,
    N(
        F("v"),
        Mul,
        F("w")
    )
)
;;

(* exp3 = (x - y*z)/(u - v*w) *)
let exp3 =
N(
    exp1,
    Div,
    exp2
)

let rec nombre_rho (expr : ('a, 'b) arbre_binaire) : int =
    match expr with
    | F _ -> 0
    | N(t1, _, t2) ->
        let d1, d2 = nombre_rho t1, nombre_rho t2 in
        if d1 = d2 then
            d1 + 1
        else
            max d1 d2
;;

let rec hauteur (expr : ('a, 'b) arbre_binaire) : int =
    match expr with
    | F _ -> 0
    | N(t1, _, t2) ->
        let d1, d2 = hauteur t1, hauteur t2 in
        1 + (max d1 d2)
;;

let _ = hauteur exp1;;
let _ = nombre_rho exp1;;

let _ = hauteur exp2;;
let _ = nombre_rho exp2;;

let _ = hauteur exp3;;
let _ = nombre_rho exp3;;

type ('a, 'b, 'c) arbre_binaire_decore = N2 of ('c * (('a, 'b, 'c) arbre_binaire_decore) * 'b * (('a, 'b, 'c) arbre_binaire_decore)) | F2 of 'a

type decoration = {
    rho : int;
    premier_gauche : bool;
};;

let rec decore (expr : (('a, 'b) arbre_binaire)) : (('a, 'b, decoration) arbre_binaire_decore) =
    match expr with
    | F v -> F2 v
    | N (t1, o, t2) ->
        let d1, d2 = nombre_rho t1, nombre_rho t2 in
        let d = if d1 = d2 then d1 + 1 else max d1 d2 in
        N2({rho = d; premier_gauche = (d2<= d1)}, (decore t1), o, (decore t2))
;;

decore exp1;;

decore exp2;;

decore exp3;;

type ('a, 'b) contexte = ('a * 'b) list;;
let valeur (ctx : ('a, 'b) contexte) (var : 'a) = List.assoc var ctx;;
(* une Hashtbl peut etre utilisee si besoin de bonnes performances *)

let contexte1 : (string, int) contexte = [
    ("x", 1); ("y", 2); ("z", 3);
    ("u", 4); ("v", 5); ("w", 6)
];;

let intop_of_op (op : operateur) : (int -> int -> int) =
    match op with
    | Plus -> ( + )
    | Moins -> ( - )
    | MoinsDroite -> (fun v1 -> fun v2 -> v2 - v1)
    | Mul -> ( * )
    | Div -> ( / )
    | DivDroite -> (fun v1 -> fun v2 -> v2 / v1)
    | Modulo -> ( mod )
    | Expo ->
        (fun v1 -> fun v2 -> int_of_float ((float_of_int v1) ** (float_of_int v2)))
;;

let rec eval_int (ctx : (string, int) contexte) (expr : (string, operateur) arbre_binaire) : int =
    match expr with
    | F(s) -> valeur ctx s
    | N(t1, op, t2) ->
        let v1, v2 = eval_int ctx t1, eval_int ctx t2 in
        (intop_of_op op) v1 v2
;;

let _ = eval_int contexte1 (F("x"));;

let _ = eval_int contexte1 (N(F("x"), Plus, F("y")));;

let _ = eval_int contexte1 exp1;;

let _ = eval_int contexte1 exp2;;

let _ = eval_int contexte1 exp3;;

let contexte2 : (string, float) contexte = [
    ("x", 1.); ("y", 2.); ("z", 3.);
    ("u", 4.); ("v", 5.); ("w", 6.)
];;

let floatop_of_op (op : operateur) : (float -> float -> float) =
    match op with
    | Plus -> ( +. )
    | Moins -> ( -. )
    | MoinsDroite -> (fun v1 -> fun v2 -> v2 -. v1)
    | Mul -> ( *. )
    | Div -> ( /. )
    | DivDroite -> (fun v1 -> fun v2 -> v2 /. v1)
    | Modulo ->
        (fun v1 -> fun v2 -> float_of_int ((int_of_float v1) mod (int_of_float v2)))
    | Expo -> ( ** )
;;

let rec eval_float (ctx : (string, float) contexte) (expr : (string, operateur) arbre_binaire) : float =
    match expr with
    | F(s) -> valeur ctx s
    | N(t1, op, t2) ->
        let v1, v2 = eval_float ctx t1, eval_float ctx t2 in
        (floatop_of_op op) v1 v2
;;

let _ = eval_float contexte2 (F("x"));;

let _ = eval_float contexte2 (N(F("x"), Plus, F("y")));;

let _ = eval_float contexte2 exp1;;

let _ = eval_float contexte2 exp2;;

let _ = eval_float contexte2 exp3;;

type ('a, 'b) lexem = O of 'b | V of 'a;;
type ('a, 'b) parcours = (('a, 'b) lexem) list;;

let parcours_postfix (expr : ('a, 'b) arbre_binaire) : (('a, 'b) parcours) =
    let rec parcours vus expr =
        match expr with
        | F(s) -> V(s) :: vus
        | N(t1, op, t2) -> O(op) :: (parcours (parcours vus t1) t2)
    in
    List.rev (parcours [] expr)
;;

parcours_postfix exp1;;

parcours_postfix exp3;;

let eval_int_2 (ctx : (string, int) contexte) (expr : (string, operateur) arbre_binaire) : int =
    let vus = parcours_postfix expr in
    let pile = Stack.create () in
    let aux lex =
        match lex with
        | V(s) -> Stack.push (valeur ctx s) pile;
        | O(op) ->
            let v1, v2 = Stack.pop pile, Stack.pop pile in
            Stack.push ((intop_of_op op) v1 v2) pile;
    in
    List.iter aux vus;
    Stack.pop pile
;;

let _ = exp1 ;;
let _ = eval_int_2 contexte1 exp1;;

let _ = exp2;;
let _ = eval_int_2 contexte1 exp2;;

let print f =
    let r = Printf.printf f in
    flush_all();
    r
;;

let print_pile pile =
    print "\nPile : ";
    Stack.iter (print "%i; ") pile;
    print "."
;;

let eval_int_3 (ctx : (string, int) contexte) (expr : (string, operateur) arbre_binaire) : int =
    let vus = parcours_postfix expr in
    let pile = Stack.create () in
    let aux lex =
        print_pile pile;
        match lex with
        | V(s) -> Stack.push (valeur ctx s) pile;
        | O(op) ->
            let v1, v2 = Stack.pop pile, Stack.pop pile in
            Stack.push ((intop_of_op op) v1 v2) pile;
    in
    List.iter aux vus;
    Stack.pop pile
;;

let _ = exp1 ;;
let _ = eval_int_3 contexte1 exp1;;

let _ = exp3;;
let _ = eval_int_3 contexte1 exp3;;

let print_aff (line : int) (i : int) (s : string) : unit =
    print "\n%02i: R[%d] := %s ;" line i s;
;;

let string_of_op (op : operateur) : string =
    match op with
    | Plus -> "+"
    | Moins | MoinsDroite -> "-"
    | Mul -> "*"
    | Div | DivDroite -> "/"
    | Modulo -> "%"
    | Expo -> "^"
;;

let print_op (line : int) (i : int) (j : int) (k : int) (op : operateur) : unit =
    match op with
    | MoinsDroite | DivDroite -> (* on gère ici les opérateurs "inverses" *)
        print "\n%02i: R[%d] := R[%d] %s R[%d] ;" line i k (string_of_op op) j;
    | _ ->
        print "\n%02i: R[%d] := R[%d] %s R[%d] ;" line i j (string_of_op op) k;
;;

let eval_int_4 (ctx : (string, int) contexte) (expr : (string, operateur) arbre_binaire) : int =
    let vus = parcours_postfix expr in
    let pile = Stack.create () in
    let ligne = ref 0 in
    let aux lex =
        incr ligne;
        match lex with
        | V(s) ->
            Stack.push (valeur ctx s) pile;
            print_aff !ligne ((Stack.length pile) - 1) s;
        | O(op) ->
            let v1, v2 = Stack.pop pile, Stack.pop pile in
            Stack.push ((intop_of_op op) v1 v2) pile;
            print_op !ligne ((Stack.length pile) - 1) ((Stack.length pile) - 1) (Stack.length pile) op;
    in
    List.iter aux vus;
    Stack.pop pile
;;

let _ = exp1 ;;
let _ = eval_int_4 contexte1 exp1;;

let _ = exp3;;
let _ = eval_int_4 contexte1 exp3;;

decore exp1;;

let parcours_postfix_decore (expr : ('a, 'b, decoration) arbre_binaire_decore) : (('a, 'b) parcours) =
    let rec parcours vus expr =
        match expr with
        | F2(s) -> V(s) :: vus
        | N2(dec, t1, Moins, t2) when dec.premier_gauche = false ->
            O(MoinsDroite) :: (parcours (parcours vus t2) t1)
        | N2(dec, t1, MoinsDroite, t2) when dec.premier_gauche = false ->
            O(Moins) :: (parcours (parcours vus t2) t1)
        | N2(dec, t1, Div, t2) when dec.premier_gauche = false ->
            O(DivDroite) :: (parcours (parcours vus t2) t1)
        | N2(dec, t1, DivDroite, t2) when dec.premier_gauche = false ->
            O(Div) :: (parcours (parcours vus t2) t1)
        | N2(dec, t1, op, t2) when dec.premier_gauche = false ->
            O(op) :: (parcours (parcours vus t2) t1)
        | N2(_, t1, op, t2) ->
            O(op) :: (parcours (parcours vus t1) t2)
    in
    List.rev (parcours [] expr)
;;

let eval_int_ershov (ctx : (string, int) contexte) (expr : (string, operateur) arbre_binaire) : int =
    let vus = parcours_postfix_decore (decore expr) in
    let pile = Stack.create () in
    let ligne = ref 0 in
    let aux lex =
        incr ligne;
        match lex with
        | V(s) ->
            Stack.push (valeur ctx s) pile;
            print_aff !ligne ((Stack.length pile) - 1) s;
        | O(op) ->
            let v1, v2 = Stack.pop pile, Stack.pop pile in
            Stack.push ((intop_of_op op) v1 v2) pile;
            print_op !ligne ((Stack.length pile) - 1) ((Stack.length pile) - 1) (Stack.length pile) op;
    in
    List.iter aux vus;
    Stack.pop pile
;;

let _ = exp1 ;;
let _ = eval_int_ershov contexte1 exp1;;

let _ = exp3;;
let _ = eval_int_ershov contexte1 exp3;;