#open "crayon";;

let flottant = function
    Entier i -> float_of_int i
  | Flottant f -> f;;

let ajoute_nombres = function
    (Entier i, Entier j) -> Entier (i + j)
  | (n1, n2) -> Flottant (flottant n1 +. flottant n2)
and soustrais_nombres = function
    (Entier i, Entier j) -> Entier (i - j)
  | (n1, n2) -> Flottant (flottant n1 -. flottant n2)
and multiplie_nombres = function
    (Entier i, Entier j) -> Entier (i * j)
  | (n1, n2) -> Flottant (flottant n1 *. flottant n2)
and divise_nombres = function
    (Entier i, Entier j) -> Entier (i / j)
  | (n1, n2) -> Flottant (flottant n1 /. flottant n2)
and compare_nombres = function
    (Entier i, Entier j) -> i >= j
  | (n1, n2) -> (flottant n1 >=. flottant n2);;

let rec valeur_expr env = function
    Constante n -> n
  | Somme (e1, e2) ->
     ajoute_nombres (valeur_expr env e1, valeur_expr env e2)
  | Produit (e1, e2) ->
     multiplie_nombres (valeur_expr env e1, valeur_expr env e2)
  | Différence (e1, e2) ->
     soustrais_nombres (valeur_expr env e1, valeur_expr env e2)
  | Quotient (e1, e2) ->
     divise_nombres (valeur_expr env e1, valeur_expr env e2)
  | Variable s -> assoc s env;;

let procédures_définies = ref ([] : (string * procédure) list);;
let définit_procédure (nom, proc as liaison) =
    procédures_définies := liaison :: !procédures_définies
and définition_de nom_de_procédure =
    try
      assoc nom_de_procédure !procédures_définies
    with Not_found ->
      failwith ("procédure inconnue: " ^ nom_de_procédure);;
let valeur_entière = function
    Entier i -> i
  | Flottant f -> failwith "entier attendu";;
exception Fin_de_procédure;;
let rec exécute_ordre env = function
    Av e -> avance (flottant (valeur_expr env e))
  | Re e -> avance (-. (flottant (valeur_expr env e)))
  | Tg a -> tourne (flottant (valeur_expr env a))
  | Td a -> tourne (-. (flottant (valeur_expr env a)))
  | Lc -> fixe_crayon true
  | Bc -> fixe_crayon false
  | Ve -> vide_écran()
  | Rep (n, l) ->
     for i = 1 to valeur_entière (valeur_expr env n)
     do do_list (exécute_ordre env) l done
  | Si (e1, e2, alors, sinon) ->
     if compare_nombres (valeur_expr env e1, valeur_expr env e2)
     then do_list (exécute_ordre env) alors
     else do_list (exécute_ordre env) sinon
  | Stop -> raise Fin_de_procédure
  | Exécute (nom_de_procédure, args) ->
     let définition = définition_de nom_de_procédure in
     let variables = définition.Paramètres
     and corps = définition.Corps in
     let rec augmente_env = function
         [],[] -> env
       | variable::vars, expr::exprs ->
          (variable, valeur_expr env expr) ::
          augmente_env (vars, exprs)
       | _ ->
          failwith ("mauvais nombre d'arguments pour "
                    ^ nom_de_procédure) in
     let env_pour_corps = augmente_env (variables, args) in
     try  do_list (exécute_ordre env_pour_corps) corps
     with Fin_de_procédure -> ();;

let rec exécute_phrase = function
    Ordre ord -> exécute_ordre [] ord
  | Pour (nom, proc as liaison) -> définit_procédure liaison
and exécute_programme = function
    Programme phs -> do_list exécute_phrase phs;;
