let version = "0.04"

open Num

type reel = float
type naturel = num

let string_of_reel = string_of_float
let string_of_naturel = string_of_num

(* Le type fonct_valeur est une sorte d'«abstraction spéciale»
   utile pour les fonctions spéciales ainsi que pour les applications
   partielles de fonctions spéciales.
   C'est une valeur représentée par le constructeur Valeur_fonct, qui
   porte en outre le terme ayant servi à obtenir cet objet. *)

type fonct_valeur = 
  | Fonct_zero of valeur
  | Fonct_un of (valeur -> fonct_valeur)

and spec = {
  spec_nom : string;
  spec_nom_infixe : string option;
  spec_scope : ty;
  spec_ty : ty;
  spec_fonct : fonct_valeur;
}

and variable =
| Variable_textuelle of string
| Variable_abstraite of int
and ty = 
| Type_fleche of (ty * ty)
| Type_couple of (ty * ty)
| Type_o of ty
| Type_reel
| Type_nat
| Type_bool
and valeur = 
| Valeur_prob of expr
| Valeur_nat of naturel
| Valeur_reelle of reel
| Valeur_bool of bool
| Valeur_lambda of ((variable * ty) * terme)
| Valeur_couple of (valeur * valeur)
| Valeur_fonct of (terme * (valeur -> fonct_valeur))
and terme = 
| Terme_spec of spec
| Terme_valeur of valeur
| Terme_variable of variable
| Terme_application of (terme * terme)
| Terme_couple of (terme * terme)
| Terme_fst of terme
| Terme_snd of terme
| Terme_fix of ((variable * ty) * terme)
| Terme_si of (terme * (terme * terme))
| Terme_egale of (terme * terme)
and expr = 
| Expr_terme of terme
| Expr_sample of ((variable * terme) * expr)
| Expr_s


(* Fonctions spéciales *)

exception Exception_scope_impossible of ty option
exception Exception_spec_abandonne

let spec_nullaire nom ty va =
  {
    spec_nom = nom;
    spec_nom_infixe = None;
    spec_ty = ty;
    spec_scope = ty;
    spec_fonct = Fonct_zero va;
  }

let spec_unaire nom type_valeur type_resultat phi =
  {
    spec_nom = nom;
    spec_nom_infixe = None;
    spec_ty = Type_fleche (type_valeur, type_resultat);
    spec_scope = type_valeur;
    spec_fonct = phi;
  }

let spec_unaire_reelle nom type_resultat phi =
  spec_unaire nom Type_reel type_resultat
    (Fonct_un (fun x1 ->
      match x1 with
        | Valeur_reelle a1 -> Fonct_zero (phi a1)
        | _ -> raise Exception_spec_abandonne
    ))

let spec_unaire_nat nom type_resultat phi =
  spec_unaire nom Type_nat type_resultat 
    (Fonct_un (fun x1 ->
      match x1 with
        | Valeur_nat a1 -> Fonct_zero (phi a1)
        | _ -> raise Exception_spec_abandonne
    ))

let spec_binaire nom_prefixe nom_infixe type_valeurs type_resultat phi =
  {
    spec_nom = nom_prefixe;
    spec_nom_infixe = Some nom_infixe;
    spec_ty = Type_fleche (
      type_valeurs,
      Type_fleche (type_valeurs, type_resultat)
    );
    spec_scope = type_valeurs;
    spec_fonct = phi;
  } 

let spec_binaire_reelle nom_prefixe nom_infixe type_resultat phi =
  spec_binaire nom_prefixe nom_infixe Type_reel type_resultat
    (Fonct_un (fun x1 ->
      Fonct_un (fun x2 ->
        match x1, x2 with
          | Valeur_reelle a1, Valeur_reelle a2 ->
              Fonct_zero (phi a1 a2)
          | _ -> raise Exception_spec_abandonne
      )
    ))

let spec_binaire_nat nom_prefixe nom_infixe type_resultat phi =
  spec_binaire nom_prefixe nom_infixe Type_nat type_resultat 
    (Fonct_un (fun x1 ->
      Fonct_un (fun x2 ->
        match x1, x2 with
      | Valeur_nat a1, Valeur_nat a2 -> Fonct_zero (phi a1 a2)
      | _ -> raise Exception_spec_abandonne
      )
    ))

let specs = [
  
  (* Specs réelles *)

  spec_binaire_reelle "Rplus" "+" Type_reel
  (fun a1 a2 -> Valeur_reelle (a1 +. a2));
  spec_binaire_reelle "Rminus" "-" Type_reel
  (fun a1 a2 -> Valeur_reelle (a1 -. a2));
  spec_binaire_reelle "Rmult" "*" Type_reel
  (fun a1 a2 -> Valeur_reelle (a1 *. a2));
  spec_binaire_reelle "Rdiv" "/" Type_reel
  (fun a1 a2 -> Valeur_reelle (a1 /. a2));

  spec_binaire_reelle "Rle" "<=" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 <= a2));
  spec_binaire_reelle "Rlt" "<" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 < a2));
  spec_binaire_reelle "Rge" ">=" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 >= a2));
  spec_binaire_reelle "Rgt" ">" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 > a2));

  spec_unaire_reelle "Ln" Type_reel
    (fun a1 -> Valeur_reelle (log a1));
  spec_unaire_reelle "Exp" Type_reel
    (fun a1 -> Valeur_reelle (exp a1));

  spec_nullaire "R0" Type_reel (Valeur_reelle 0.);
  spec_nullaire "R1" Type_reel (Valeur_reelle 1.);

(* Specs naturelles *)

  spec_binaire_nat "Plus" "+" Type_nat
  (fun a1 a2 -> Valeur_nat (a1 +/ a2));
  spec_binaire_nat "Minus" "-" Type_nat
  (fun a1 a2 -> Valeur_nat (
    if a1 >/ a2 then a1 -/ a2 else num_of_int 0));
  spec_binaire_nat "Mult" "*" Type_nat
  (fun a1 a2 -> Valeur_nat (a1 */ a2));

  spec_binaire_nat "Le" "<=" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 <=/ a2));
  spec_binaire_nat "Lt" "<" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 </ a2));
  spec_binaire_nat "Ge" ">=" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 >=/ a2));
  spec_binaire_nat "Gt" ">" Type_bool
  (fun a1 a2 -> Valeur_bool (a1 >/ a2));

  spec_unaire_nat "Succ" Type_nat
    (fun a1 -> Valeur_nat (a1 +/ num_of_int 1));

  spec_nullaire "Zero" Type_nat (Valeur_nat (num_of_int 0));

]


exception Exception_spec_introuvable of string
exception Exception_spec2_introuvable of string

let string_of_spec s = s.spec_nom

let spec_of_string s =
  let rec aux = function
    | [] -> raise (Exception_spec_introuvable s)
    | a::_ when a.spec_nom = s -> a
    | _::q -> aux q
  in aux specs

let spec2_of_string s ty =
  let rec aux = function
    | [] -> raise (Exception_spec2_introuvable s)
    | a::_ when a.spec_nom_infixe = Some s && a.spec_scope = ty -> a
    | _::q -> aux q
  in aux specs

exception Exception_egalite_indecidable of (valeur * valeur)

let rec egalite v1 v2 = match (v1, v2) with
  | Valeur_prob _, _
  | _, Valeur_prob _ 
  | Valeur_lambda _, _
  | _, Valeur_lambda _
  | Valeur_fonct _, _
  | _, Valeur_fonct _
      ->
      raise (Exception_egalite_indecidable (v1, v2))
  | Valeur_nat n1, Valeur_nat n2 -> n1 =/ n2
  | Valeur_reelle r1, Valeur_reelle r2 -> r1 = r2
  | Valeur_bool b1, Valeur_bool b2 -> b1 = b2
  | Valeur_couple (a1, b1), Valeur_couple (a2, b2) ->
      egalite a1 b1 && egalite a2 b2
  | _ -> false

(* Typage *)

exception Exception_variable_non_typee of variable

let type_s = Type_reel

let rec rechercher ex a0 = function
| [] -> raise ex
| (a,b) :: _ when a = a0 -> b
| _ :: r -> rechercher ex a0 r

type types_incompatibles = {
 incompat_terme : terme;
 incompat_attendu : ty;
 incompat_obtenu : ty;
}
exception Exception_types_incompatibles of types_incompatibles

exception Exception_type_fleche_attendu of (terme * ty)
exception Exception_type_couple_attendu of (terme * ty)
exception Exception_type_o_attendu of (terme * ty)

let rec typage_terme gamma = function
| Terme_variable x -> rechercher (Exception_variable_non_typee x) x gamma 
| Terme_spec s -> s.spec_ty
| Terme_valeur v -> typage_valeur gamma v
| Terme_application (m1, m2) ->
   begin
    match typage_terme gamma m1 with
    | Type_fleche (a, b) ->
      let a' = typage_terme gamma m2 in
      if a' = a then b else raise (Exception_types_incompatibles {
       incompat_terme = m2;
       incompat_attendu = a;
       incompat_obtenu = a';
      })
    | t -> raise (Exception_type_fleche_attendu (m1, t))
   end
| Terme_couple (m1, m2) ->
   Type_couple ((typage_terme gamma m1), (typage_terme gamma m2))
| Terme_fst m ->
   begin
    match typage_terme gamma m with
    | Type_couple (a1, _) -> a1
    | t -> raise (Exception_type_couple_attendu (m, t))
   end
| Terme_snd m ->
   begin
    match typage_terme gamma m with
    | Type_couple (_, a2) -> a2
    | t -> raise (Exception_type_couple_attendu (m, t))
   end
| Terme_fix ((x, a), m) ->
   let a' = typage_terme ((x, a) :: gamma) m in
   if a' = a then a else raise (Exception_types_incompatibles {
    incompat_terme = m;
    incompat_attendu = a;
    incompat_obtenu = a';
   })

| Terme_si (cond, (vt, vf)) ->
   let t = typage_terme gamma cond in
   if t <> Type_bool then raise (Exception_types_incompatibles {
    incompat_terme = cond;
    incompat_attendu = Type_bool;
    incompat_obtenu = t;
   });
   let a = typage_terme gamma vt and b = typage_terme gamma vf in
   if a = b then a else raise (Exception_types_incompatibles {
    incompat_terme = vf;
    incompat_attendu = a;
    incompat_obtenu = b;
   })

| Terme_egale (a, b) ->
    let t = typage_terme gamma a in
    let u = typage_terme gamma b in
    if t = u
    then Type_bool
    else raise (Exception_types_incompatibles {
      incompat_terme = b;
      incompat_attendu = t;
      incompat_obtenu = u;
    })

and typage_valeur gamma = function
| Valeur_prob e -> Type_o (typage_expr gamma e)
| Valeur_lambda ((x, a), m) ->
   let b = typage_terme ((x, a) :: gamma) m in Type_fleche (a, b)
| Valeur_reelle _ -> Type_reel
| Valeur_bool _ -> Type_bool
| Valeur_nat _ -> Type_nat
| Valeur_couple (v1, v2) ->
    Type_couple (typage_valeur gamma v1, typage_valeur gamma v2)
| Valeur_fonct (t1, _) -> typage_terme gamma t1
   
and typage_expr gamma = function
| Expr_terme m -> typage_terme gamma m
| Expr_sample ((x, m), e) ->
   begin
    match typage_terme gamma m with
    | Type_o a -> typage_expr ((x, a) :: gamma) e
    | t -> raise (Exception_type_o_attendu (m, t))
   end
| Expr_s -> type_s

(* Le renommage et la substitution *)

let nouvelle_variable_abstraite q =
  let q' = q + 1 in q', Variable_abstraite q'
 
let rec subst_naive_fv_terme ancien nouveau = function
| Terme_variable x when x = ancien -> nouveau
| Terme_valeur v -> Terme_valeur (subst_naive_fv_valeur ancien nouveau v)
| Terme_fix ((x, a), m) when x <> ancien ->
   Terme_fix ((x, a), subst_naive_fv_terme ancien nouveau m)
| Terme_application (m1, m2) -> Terme_application (
   subst_naive_fv_terme ancien nouveau m1,
   subst_naive_fv_terme ancien nouveau m2
   )
| Terme_couple (m1, m2) -> Terme_couple (
   subst_naive_fv_terme ancien nouveau m1,
   subst_naive_fv_terme ancien nouveau m2
   )
| Terme_fst m -> Terme_fst (subst_naive_fv_terme ancien nouveau m)
| Terme_snd m -> Terme_snd (subst_naive_fv_terme ancien nouveau m)
| Terme_si (cond, (vt, vf)) -> Terme_si (
    subst_naive_fv_terme ancien nouveau cond, (
     subst_naive_fv_terme ancien nouveau vt,
     subst_naive_fv_terme ancien nouveau vf
    )
   )
| Terme_egale (a, b) -> Terme_egale (
    subst_naive_fv_terme ancien nouveau a,
    subst_naive_fv_terme ancien nouveau b
  )
| t -> t
and subst_naive_fv_valeur ancien nouveau = function
| Valeur_lambda ((x, a), m) when x <> ancien ->
   Valeur_lambda ((x, a), subst_naive_fv_terme ancien nouveau m)
| Valeur_prob e -> Valeur_prob (subst_naive_fv_expr ancien nouveau e)
| Valeur_couple (v1, v2) -> Valeur_couple (
   subst_naive_fv_valeur ancien nouveau v1,
   subst_naive_fv_valeur ancien nouveau v2
  )
| Valeur_fonct (t, f) -> 
    Valeur_fonct (subst_naive_fv_terme ancien nouveau t, f)
| v -> v
and subst_naive_fv_expr ancien nouveau = function
| Expr_terme m -> Expr_terme (subst_naive_fv_terme ancien nouveau m)
| Expr_sample ((x, m), e) when x <> ancien ->
   Expr_sample ((x, subst_naive_fv_terme ancien nouveau m),
    subst_naive_fv_expr ancien nouveau e)
| Expr_sample ((x, m), e) ->
   Expr_sample ((x, subst_naive_fv_terme ancien nouveau m), e)
| t -> t

let rec renommage_bv_terme q = function
| Terme_variable _ as t -> q, t
| Terme_spec _ as t -> q, t
| Terme_valeur v ->
   let (q', v') = renommage_bv_valeur q v in q', Terme_valeur v'
| Terme_fix ((x, a), m) ->
   let q', y = nouvelle_variable_abstraite q in
   let q'', m' = renommage_bv_terme q'
    (subst_naive_fv_terme x (Terme_variable y) m)
   in q'', Terme_fix ((y, a), m')
| Terme_application (m1, m2) -> 
   let q', m1' = renommage_bv_terme q m1 in
   let q'', m2' = renommage_bv_terme q' m2 in
   q'', Terme_application (m1', m2')
| Terme_couple (m1, m2) ->
   let q', m1' = renommage_bv_terme q m1 in
   let q'', m2' = renommage_bv_terme q' m2 in
   q'', Terme_couple (m1', m2')
| Terme_fst m -> let q', m' = renommage_bv_terme q m in
   q', Terme_fst m'
| Terme_snd m -> let q', m' = renommage_bv_terme q m in
   q', Terme_snd m'
| Terme_si (cond, (vt, vf)) -> 
   let q', cond' = renommage_bv_terme q cond in
   let q'', vt' = renommage_bv_terme q' vt in
   let q''', vf' = renommage_bv_terme q'' vf in
   q''', Terme_si (cond', (vt', vf'))
| Terme_egale (a, b) ->
    let q', a'' = renommage_bv_terme q a in
    let q'', b'' = renommage_bv_terme q' b in
    q'', Terme_egale (a'', b'')

and renommage_bv_valeur q = function
| Valeur_lambda ((x, a), m) ->
   let q', y = nouvelle_variable_abstraite q in
   let q'', m' =
    renommage_bv_terme q' (subst_naive_fv_terme x (Terme_variable y) m)
   in
   q'', Valeur_lambda ((y, a), m')
| Valeur_prob e -> 
   let q', e' = renommage_bv_expr q e in q', Valeur_prob e'
| Valeur_couple (v1, v2) ->
   let q', v1' = renommage_bv_valeur q v1 in
   let q'', v2' = renommage_bv_valeur q' v2 in
   q'', Valeur_couple (v1', v2')
| Valeur_fonct (t, f) ->
    let q', t' = renommage_bv_terme q t in 
    q', Valeur_fonct (t', f)
| v -> q, v

and renommage_bv_expr q = function
| Expr_terme m -> let q', m' = renommage_bv_terme q m in q', Expr_terme m'
| Expr_sample ((x, m), e) ->
   let q', y = nouvelle_variable_abstraite q in
   let q'', m' = renommage_bv_terme q' m in
   let q''', e' = renommage_bv_expr q'' e in
   q''', Expr_sample ((y, m'), subst_naive_fv_expr x (Terme_variable y) e')
| Expr_s -> q, Expr_s

let rec maxv_terme q = function
| Terme_variable (Variable_abstraite q') -> max q q'
| Terme_valeur v -> maxv_valeur q v
| Terme_fix ((x, a), m) ->
   let q' =
    match x with Variable_abstraite q1 when q1 > q -> q1 | _ -> q in
   maxv_terme q' m
| Terme_application (m1, m2) -> maxv_terme (maxv_terme q m1) m2
| Terme_couple (m1, m2) -> maxv_terme (maxv_terme q m1) m2
| Terme_fst m -> maxv_terme q m
| Terme_snd m -> maxv_terme q m
| Terme_si (cond, (vt, vf)) -> 
   maxv_terme (maxv_terme (maxv_terme q cond) vt) vf
| Terme_egale (a1, a2) ->
    maxv_terme (maxv_terme q a1) a2
| _ -> q

and maxv_valeur q = function
| Valeur_lambda ((x, a), m) ->
   let q' =
    match x with Variable_abstraite q1 when q1 > q -> q1 | _ -> q in
   maxv_terme q' m
| Valeur_prob e -> maxv_expr q e
| Valeur_couple (v1, v2) -> maxv_valeur (maxv_valeur q v1) v2
| Valeur_fonct (t, _) -> maxv_terme q t
| _ -> q

and maxv_expr q = function
| Expr_terme m -> maxv_terme q m
| Expr_sample ((x, m), e) ->
   let q' =
    match x with Variable_abstraite q1 when q1 > q -> q1 | _ -> q in
   maxv_expr (maxv_terme q' m) e
| _ -> q

let substitution_terme x v m = 
 subst_naive_fv_terme x v (snd (renommage_bv_terme (maxv_terme 0 m) m))
 
let substitution_expr x v e =
 subst_naive_fv_expr x v (snd (renommage_bv_expr (maxv_expr 0 e) e))

 
(* Semantique operationnelle *)

(* Les aspects aleatoires *)

type 'a flot = Flot of (unit -> ('a * 'a flot))

let construire_flot f = 
 let rec sf n () = (f n, Flot (sf (n + 1))) in Flot (sf 0)
 
let deconse_flot (Flot s) = s ()

let alea n = abs_float (cos (1. +. float_of_int n))

let exemple_alea = construire_flot alea

(* On peut aussi utiliser un flot avec lazy
   (effets de bord caches pour que la fonction f de construction du flot
   ne soit executee qu'une fois pour chaque element extrait)
*)

type 'a flot_lazy = Flot_lazy of ('a * 'a flot_lazy) Lazy.t

let construire_flot_lazy f = 
 let rec sf n = (f n, Flot_lazy (lazy (sf (n + 1)))) in
 Flot_lazy (lazy (sf 0))
 
let deconse_flot_lazy (Flot_lazy s) = Lazy.force s

let exemple_alea_lazy = construire_flot_lazy alea

(* On choisit cette dernière approche. *)

type flot_alea = float flot_lazy
let deconse_flot_alea = deconse_flot_lazy
let flot_alea = exemple_alea_lazy

(* Evaluation et calcul naifs sans utilisation des contextes *)

exception Exception_evaluation_ratee of terme
exception Exception_calcul_rate of (flot_alea * expr)

let rec evaluer = function
| Terme_variable _ as t -> raise (Exception_evaluation_ratee t)
| Terme_valeur v -> v

| Terme_spec s -> 
    begin match s.spec_fonct with
      | Fonct_zero v -> v
      | Fonct_un f -> Valeur_fonct (Terme_spec s, f)
    end

| Terme_application (u, v') ->
   begin
    let t = evaluer u in
    match t with
    | Valeur_lambda ((x, a), m) ->
       let v = evaluer v' in
       evaluer (substitution_terme x (Terme_valeur v) m)

    | Valeur_fonct (tf, f) ->
       let v = evaluer v' in
       begin match f v with
         | Fonct_zero y -> y
         | Fonct_un g ->
             Valeur_fonct (Terme_application (tf, Terme_valeur v), g) 
       end

    | v -> raise (
        Exception_evaluation_ratee (Terme_application (Terme_valeur v, v'))
       )
   end

| Terme_fst m ->
   begin
    match evaluer m with
    | Valeur_couple (v1, v2) -> v1
    | v -> raise (
        Exception_evaluation_ratee (Terme_fst (Terme_valeur v))
       )
   end

| Terme_snd m ->
   begin
    match evaluer m with
    | Valeur_couple (v1, v2) -> v2
    | v -> raise (
        Exception_evaluation_ratee (Terme_snd (Terme_valeur v))
       )
   end

| Terme_fix ((x, _), m) as t ->
   let v = substitution_terme x t m in evaluer v

| Terme_couple (m1, m2) ->
   let v1 = evaluer m1 in
   Valeur_couple (v1, evaluer m2)
   
| Terme_si (cond, (vt, vf)) ->
   begin
    match evaluer cond with
    | Valeur_bool true -> evaluer vt
    | Valeur_bool false -> evaluer vf
    | c -> raise (
        Exception_evaluation_ratee (Terme_si (Terme_valeur c, (vt, vf)))
       )
   end

| Terme_egale (a1, a2) ->
    let v1 = evaluer a1 in
    let v2 = evaluer a2 in
    Valeur_bool (egalite v1 v2)

let rec calculer s = function
| Expr_terme t -> s, evaluer t
| Expr_sample ((x, m), e) ->
   begin
    match evaluer m with
    | Valeur_prob e' -> 
       (print_string "Proba"; print_newline ();
       let s', v = calculer s e' in
       calculer s' (substitution_expr x (Terme_valeur v) e) )
    | v -> raise (
        Exception_calcul_rate (s, Expr_sample ((x, Terme_valeur v), e))
       )
   end
| Expr_s -> let (r, s') = deconse_flot_alea s in s', Valeur_reelle r


(* Pour le toplevel *)

exception Exception_fin

type instruction = 
  | Instr_expr of expr
  | Instr_affectations of ((string * ty) * terme) list

 let affectations corps l =
  let rec aux = function
  | [] -> corps, []
  | ((x, a), vx) :: q ->
   let corps2, vals2 = aux q in
    Terme_valeur (Valeur_lambda ((Variable_textuelle x, a), corps2)),
    vx::vals2
  in let corps2, vals2 = aux l in
  let rec construire k = function
  | [] -> k
  | v::q -> construire (Terme_application (k, v)) q
  in construire corps2 vals2

 let transformer_terme_sous_aff aff m0 =
   let rec aux m = function
     | [] -> m
     | l::q -> aux (affectations m l) q
   in (aux m0 aff)

 let rec transformer_expr_sous_aff aff = function
   | Expr_s -> Expr_s
   | Expr_terme m -> Expr_terme (transformer_terme_sous_aff aff m)
   | Expr_sample ((x, m), e) -> Expr_sample ((x, transformer_terme_sous_aff aff m), transformer_expr_sous_aff aff e)
      
 let executer gamma aff s = function
   | Instr_affectations l -> let gamma' = List.map (fun ((x,a),_) -> (Variable_textuelle x, a)) l @ gamma and l' = List.map (fun (v,m) -> (v, Terme_valeur (evaluer (transformer_terme_sous_aff aff m)))) l in ((gamma', l::aff), None)
   | Instr_expr e -> (gamma, aff), Some (calculer s (transformer_expr_sous_aff aff e))



let sortie_erreur = ref (Some stderr)
let sortie_standard = ref (Some stdout)

let fermer_sortie sortie =
 match !sortie with
   | None -> ()
   | Some s when s = stdout || s = stderr -> sortie := None
   | Some s -> (close_out s; sortie := None)

let imprimer_sur_sortie sortie s = match !sortie with
  | Some o -> (output_string o s; flush o)
  | None -> ()

let print_string = imprimer_sur_sortie sortie_standard 
let print_newline () = print_string "\n"

let prerr_string = imprimer_sur_sortie sortie_erreur
let prerr_newline () = prerr_string "\n"