6
and d�code_nombre = function
8
| _ -> raise(Erreur "entier attendu")
11
and d�code_bool�en = function
12
| Val_bool�enne b -> b
13
| _ -> raise(Erreur "bool�en attendu");;
15
(* Pour transformer une fonction Caml en valeur fonctionnelle *)
17
let prim1 codeur calcul d�codeur =
18
Val_primitive (function v -> codeur (calcul (d�codeur v)))
19
and prim2 codeur calcul d�codeur1 d�codeur2 =
20
Val_primitive (function
21
| Val_paire (v1, v2) ->
22
codeur (calcul (d�codeur1 v1) (d�codeur2 v2))
23
| _ -> raise (Erreur "paire attendue"));;
25
(* L'environnement initial *)
28
["+", prim2 code_nombre ( + ) d�code_nombre d�code_nombre;
29
"-", prim2 code_nombre ( - ) d�code_nombre d�code_nombre;
30
"*", prim2 code_nombre ( * ) d�code_nombre d�code_nombre;
31
"/", prim2 code_nombre ( / ) d�code_nombre d�code_nombre;
32
"=", prim2 code_bool�en ( = ) d�code_nombre d�code_nombre;
33
"<>", prim2 code_bool�en ( <> ) d�code_nombre d�code_nombre;
34
"<", prim2 code_bool�en ( < ) d�code_nombre d�code_nombre;
35
">", prim2 code_bool�en ( > ) d�code_nombre d�code_nombre;
36
"<=", prim2 code_bool�en ( <= ) d�code_nombre d�code_nombre;
37
">=", prim2 code_bool�en ( >= ) d�code_nombre d�code_nombre;
38
"not", prim1 code_bool�en ( not ) d�code_bool�en;
39
"read_int", prim1 code_nombre (fun x -> read_int ()) d�code_nombre;
40
"write_int", prim1 code_nombre
41
(fun x -> print_int x; print_newline (); 0)
44
let env_global = ref env_initial in
45
let flux_d'entr�e = Stream.of_channel stdin in
48
print_string "# "; flush stdout;
50
match lire_phrase flux_d'entr�e with
52
let r�s = �value !env_global expr in
53
print_string "- = "; imprime_valeur r�s;
56
let nouvel_env = �value_d�finition !env_global d�f in
57
begin match nouvel_env with
59
print_string nom; print_string " = ";
60
imprime_valeur v; print_newline ()
61
| _ -> failwith "mauvaise gestion des d�finitions"
63
env_global := nouvel_env
66
print_string ("Erreur de syntaxe: " ^ s); print_newline ()
68
print_string "Erreur � l'�valuation: "; print_string msg;
71
with Stream.Failure -> ();;
73
if not !Sys.interactive then boucle ();;