(*Interprète pour un langage basique (sans fonctions) *)

type var=string
type binop = Plus | Moins | Et | Ou | Comp
type unop = Abs | Non 
type mestypes = Booleen | Entier | Chaine 

(*Expressions *)
type term =
        |Int of int
        |Bool of bool
        |String of string
        |Var of var
        |Binop of binop * term * term
        |Unop of unop * term


type instruction =
        |Aff of var * term
        |Print of term
        |Test of term * instruction * instruction
        |While of term * instruction
        |Sequence of instruction list



let rec string_of_term = fun t -> match t with
        |Int(n) -> string_of_int n
        |Bool(b) -> string_of_bool b
        |String(s) -> s
        |Var(v) -> v
        |Binop(op,t,t') -> 
                        let s,s' = string_of_term t, string_of_term t' in
                        (match op with
                        |Plus -> s ^ "+" ^ s'
                        |Moins -> s ^ "-" ^ s'
                        |Et -> s ^ "et" ^ s'
                        |Ou -> s^" ou "^ s'
                        |Comp -> s^" < "^ s'
                        )
        |Unop(op,t) ->
                        let s = string_of_term t in
                        (match op with
                        |Abs -> "|"^s^"|"
                        |Non -> "non "^s
                        )
;;
                                                
type env_type = var * mestypes list

exception Erreur_type

let rec inferer_type = fun term envt ->(*environnement de typage *)
        match term with
        |Int _ -> Entier
        |Bool _ -> Booleen
        |String _ -> Chaine
        |Var v -> envt v
        |Binop(op, t, t') -> 
                let (type1,type2)=(inferer_type t envt, inferer_type t' envt) in
                (match op with
                |Plus -> if type1=Entier && type2=Entier then Entier
                        else raise Erreur_type
                |Moins -> if type1=Entier && type2=Entier then Entier
                        else raise Erreur_type
                |Et -> if type1=Booleen && type2=Booleen then Booleen
                        else raise Erreur_type
                |Ou -> if type1=Booleen && type2=Booleen then Booleen
                        else raise Erreur_type
                |Comp -> if type1=type2 then type1 else raise Erreur_type
                 (*opérateur polymorphe*)
                )
        |Unop(op,t) -> 
                let type1 = inferer_type t envt in
                (match op with
                |Abs -> if type1 = Entier then Entier else raise Erreur_type
                |Non -> if type1 = Booleen then Booleen else raise Erreur_type
                )
;;
      (*Ici on triche un peu, on utilise les opérateurs natifs du langage—outil,
       * car nos valeurs de base utilisent les types de Caml.
       * *)
exception Non_simplifiable


(*Évalue un terme s’il ne comporte pas de variables *)
let simplify_term = function t ->
        match t with
        |Binop(op,t1,t2) ->
                (match (op,t1,t2) with
                |Plus, Int(n),Int(n') -> Int(n+n')
                |Moins,Int(n),Int(n') -> Int(n-n')
                |Et,Bool(b),Bool(b') -> Bool(b && b')
                |Ou,Bool(b),Bool(b') -> Bool(b || b')
                |Comp,Int(n),Int(n') ->Bool(n<n')
                |Comp,Bool(b),Bool(b') -> Bool (not b && b')
                |_ -> raise Erreur_type 
                )
        |Unop(op,t1) ->
                       (match (op,t1) with
                       |Abs,Int(n) -> Int(abs(n))
                       |Non,Bool(b) -> Bool (not b)
                       |_ -> raise Erreur_type
                       )
        |Var s -> raise Non_simplifiable
        |_ -> t
;;
        
type environnement = (string * term) list;;
let rec print_env env =
        match env with
        |[] -> ()
        |(s,t)::tail -> print_string("("^s^" : "^(string_of_term t)^")");
                print_env tail

exception Erreur_environnement of string

(*Retourne le terme associé à un nom dans un environnement
Si le nom a reçu plusieurs affectations, on retourne la dernière,
c’est-à-dire le premier élément correspondant dans le parcours
de l’environnement. *)

let rec apply : environnement -> string -> term =
        fun env s ->
                match env with
                |[] -> raise (Erreur_environnement (s^" non défini"))
                |(v,t) :: tail -> if v = s then t else apply tail s
;;


let rec evaluer_terme = fun term env -> 
        match term with
        |Int _ -> term
        |Bool _ -> term
        |String _ -> term
        |Var v -> apply env v
        |Binop(op,t1,t2) ->
                        ( let r1,r2 = evaluer_terme t1 env, evaluer_terme t2 env in
                        simplify_term (Binop(op,r1,r2))
                        )
        |Unop(op,t1) ->
                        ( let r1 = evaluer_terme t1 env in
                        simplify_term (Unop(op,r1))
                        )
;;
(*REMARQUE : Les expressions ne contiennent jamais d’instructions dans ce langage simple *)

(*Sémantique opérationnelle : *)

let rec step : instruction -> environnement -> environnement = fun inst env ->
        match inst with
        |Aff(var,t) -> (var, (evaluer_terme t env)):: env
        |Print(t) ->
                        print_string ((string_of_term (evaluer_terme t env))^"\n");
                        env
        |Test(t,i1,i2) -> let b = evaluer_terme t env in
                if b=Bool(false) then step i2 env
                else if b = Bool(true) then step i1 env
                else raise Erreur_type
        |While(t,i) -> let b = evaluer_terme t env in
                if b = Bool(false) then 
                        env
                else if b = Bool(true) then
                        step inst (step i env)
                else raise Erreur_type
        |Sequence(l) -> match l with
                |[] -> env
                |h::t -> step (Sequence t) (step h env)
;;


type program = instruction list 



(*TESTS*)


let interp p: unit =
        let env = step (Sequence p) [] in ()


let afx= Aff("x",Int 1)
let afx'= Aff("x",Int 9)
let afy= Aff("y",Int 2)
let printx=Print(Var "x")

let decr_x= Aff ("x", Binop(Moins,Var "x", Int 1));;


let p = [afx;afx';decr_x;printx];;

(*let () =interp p;;*)

let x_gt_z =Binop(Comp, Int 0, Var "x")  ;;

let prog = [
        Aff("x",Int 10);
        While(x_gt_z, Sequence([Print(Var "x");decr_x]  ))
]

let () = interp prog

(*
*)