5.3 Description de l'évaluateur
Un évaluateur ML prend en entrée un environnement E, une expression e et retourne une valeur v. Un environnement est implanté comme une
liste d'association "nom" - "valeur". Les expressions sont représentées
par le type ml_expr suivant :
type ml_expr = Const of ml_const
*
2 Var of string
*
2 Unop of string * ml_expr
*
2 Binop of string * ml_expr * ml_expr
*
2 Pair of ml_expr * ml_expr
*
2 Cons of ml_expr * ml_expr
*
2 Cond of ml_expr * ml_expr * ml_expr
*
2 App of ml_expr * ml_expr
*
2 Abs of string * ml_expr
*
2 Letin of string * ml_expr * ml_expr
*
2 Letrecin of string * ml_expr * ml_expr
*
2 Ref of ml_expr
*
and ml_const = Int of int
*
2 Float of float
*
2 Bool of bool
*
2 String of string
*
2 Emptylist
*
2 Unit
*
;;
*
Type ml_expr defined.
*
Type ml_const defined.
On remarque par rapport au typeur, l'introduction de primitives unaire et binaire dans le type ml_expr. Elles correspondent aux primitives arithmétiques (+,- ...), de comparaisons (=,< ...), d'accès aux paires
et aux listes.
Le type ml_val, correspondant aux valeurs calculées,
est le suivant :
type ml_val =
*
V_const of v_mlconst
*
V_list of ml_val * ml_val
*
V_pair of ml_val * ml_val
*
V_closure of (string * ml_val) list * ml_expr
*
V_ref of ml_val ref
*
and v_mlconst =
*
V_int of int
*
V_float of float
*
V_bool of bool
*
V_string of string
*
V_emptylist
*
V_unit;;
*
Type ml_val defined.
*
Type v_mlconst defined.
L'évaluation d'une expression peut entrainer une erreur de calcul
dans certains cas. Le premier est la construction récursive d'une valeur
non fonctionnelle. Cette erreur pourrait être détectée par le typeur, mais
ce n'est pas le cas. Le deuxième cas provient d'une erreur de calcul d'une
primitive qui n'est pas définie sur l'ensemble des valeurs du type de son argument. Par exemple une division par zéro a quelques difficultés pour
retourner une valeur, de même calculer la tête d'une liste vide.
Pour cela on définit les deux exceptions suivantes :
exception Rec_def;;
*
Exception Rec_def defined.
exception Eval_failure of string;;
*
Exception Eval_failure defined.
qui seront traitées par l'évaluateur.
Voici les principales fonctions d'évaluation. L'évaluation d'une constante
est réalisée par la fonction suivante :
let eval_ml_const c = match c with
*
Int i ® V_int i
*
Float f ® V_float f
*
Bool b ® V_bool b
*
String s ® V_string s
*
Emptylist ® V_emptylist
*
Unit ® V_unit
*
;;
*
eval_ml_const : ml_const ® v_mlconst = áfunñ
Les primitives uniares et binaires sont prédéfinies en dur dans les
fonctions eval_unop et eval_binop suivantes :
let rec eval_unop u v = match (u,v) with
*
(``!'', V_ref v) ® !v
*
(``_ML_hd'', V_list(a,)) ® a
*
(``_ML_hd'', V_const V_emptylist) ® raise (Eval_failure ``hd'')
*
(``_ML_tl'', V_list(,b)) ® b
*
(``_ML_tl'', V_const V_emptylist) ® raise (Eval_failure ``tl'')
*
(``_ML_fst'',V_pair(a,)) ® a
*
(``_ML_snd'',V_pair(,b)) ® b
*
(s,) ® failwith (``primitive unaire inconnue : ''^s)
*
;;
*
eval_unop : string ® ml_val ® ml_val = áfunñ
let eval_binop f a b = match (f,a,b) with
*
(``+'',V_const(V_int a),V_const(V_int b)) ® V_const(V_int(a+b))
*
(``-'',V_const(V_int a),V_const(V_int b)) ® V_const(V_int(a-b))
*
(``*'',V_const(V_int a),V_const(V_int b)) ® V_const(V_int(a*b))
*
(``/'',V_const(V_int a),V_const(V_int b)) ®
*
begin
*
try V_const(V_int(a/b)) with Division_by_zero ® raise (Eval_failure ``Div0'')
*
end
*
(``='',a,b) ® V_const(V_bool(a = b))
*
(``+.'',V_const(V_float a),V_const(V_float b)) ® V_const(V_float(a+.b))
*
(``-.'',V_const(V_float a),V_const(V_float b)) ® V_const(V_float(a-.b))
*
(``*.'',V_const(V_float a),V_const(V_float b)) ® V_const(V_float(a*.b))
*
(``/.'',V_const(V_float a),V_const(V_float b)) ® V_const(V_float(a/.b))
*
(``:='',V_ref v1, v2) ® v1:=v2V_const(V_unit)
*
(s,,) ® failwith (``primitive binaire inconnue : ''^s)
*
;;
*
eval_binop : string ® ml_val ® ml_val ® ml_val = áfunñ
Ces fonctions travaillent sur des données de type ml_val.
Enfin la fonction principale d'évaluation traite les différentes constructions du langage selon les règles vues à la section précédente (qui sont lues de
bas en haut pour écrire le traitement à effectuer).
let rec eval_ml_expr env expr = match expr with
*
Const c ® V_const (eval_ml_const c)
*
Var v ® assoc v env
*
Pair (e1,e2) ® V_pair(eval_ml_expr env e1,eval_ml_expr env e2)
*
Cons (e1,e2) ® V_list(eval_ml_expr env e1,eval_ml_expr env e2)
*
Cond (e1,e2,e3) ®
*
begin
*
match eval_ml_expr env e1 with
*
V_const (V_bool b) ®
*
if b then eval_ml_expr env e2 else eval_ml_expr env e3
*
® failwith ``eval_ml_expr : erreur interne : pas de bool''
*
end
*
Unop (s,e) ® let v = eval_ml_expr env e in eval_unop s v
*
Binop(s,e1,e2) ® let v1 = eval_ml_expr env e1
*
and v2 = eval_ml_expr env e2 in
*
eval_binop s v1 v2
*
App(e1,e2) ®
*
begin
*
match (eval_ml_expr env e1, eval_ml_expr env e2) with
*
(V_closure(clos_env,Abs(x,body)),v) ®
*
eval_ml_expr ((x,v)::clos_env) body
*
® failwith ``eval_ml_expr : erreur interne : pas de fun''
*
end
*
Abs(p,e) ® V_closure(env,expr)
*
Letin(s,e1,e2) ®
*
let v = eval_ml_expr env e1 in
*
eval_ml_expr ((s,v)::env) e2
*
Letrecin(f,e1,e2) ®
*
begin
*
match e1 with
*
Abs ®
*
let rec new_env = (f, V_closure(new_env,e1))::env
*
in
*
eval_ml_expr new_env e2
*
® raise Rec_def
*
end
*
Ref e ® let v = eval_ml_expr env e in V_ref (ref v)
*
;;
*
eval_ml_expr : (string * ml_val) list ® ml_expr ® ml_val = áfunñ
La seule "ruse" est l'introduction d'une déclaration récursive sur une
valeur non fonctionnelle pour la construction de l'environnement d'une
fermeture déclarée dans un let rec. Une autre possibilité serait
d'effectuer un effet de bord à la construction de cet environnement où
la variable f apparaitrait une premi`ere fois de manière factice dans
l'environnement de la fermeture pour ensuite changer de valeur une fois
le nouvel environnement construit. Il faut alors changer le type des environnements et en faire des ref.
On définit un environnement initial cohérent avec l'environnement de typage.
let initial_eval_env =
*
let make_new_unop name = name, V_closure([ ], Abs(``x'', Unop ((``_ML_''^name),Var ``x''))) in
*
let new_unop = map make_new_unop [ ``hd''``tl''``fst''``snd'' ]
*
and s_env =
*
[
*
``true'', V_const(V_bool true)
*
``false'', V_const(V_bool false)
*
]
*
in ref (new_unop@s_env);;
*
initial_eval_env
*
: (string * ml_val) list ref
*
= ref [ ``hd'', V_closure ([ ], Abs (``x'', Unop (``_ML_hd'', Var ``x'')))
*
``tl'', V_closure ([ ], Abs (``x'', Unop (``_ML_tl'', Var ``x'')))
*
``fst'', V_closure ([ ], Abs (``x'', Unop (``_ML_fst'', Var ``x'')))
*
``snd'', V_closure ([ ], Abs (``x'', Unop (``_ML_snd'', Var ``x'')))
*
``true'', V_const (V_bool true) ``false'', V_const (V_bool false) ]
Il reste juste ensuite à embaler l'ensemble pour commencer à calculer...
let type_check_and_eval e =
let t = typing_handler type_expr !initial_typing_env e
in
let v = eval_ml_expr !initial_eval_env e
in
let qt = snd(hd(generalize_types !initial_typing_env ["it",t]))
in
v,qt
;;