1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* only by permission. *)
(* *)
(***********************************************************************)
open Syntaxe;;
type valeur =
| Val_nombre of int
| Val_boolenne of bool
| Val_paire of valeur * valeur
| Val_nil
| Val_cons of valeur * valeur
| Val_fermeture of fermeture
| Val_primitive of (valeur -> valeur)
and fermeture =
{ dfinition : (motif * expression) list;
mutable environnement : environnement }
and environnement = (string * valeur) list;;
exception Erreur of string;;
exception chec_filtrage;;
let rec filtrage valeur motif =
match (valeur, motif) with
| (v, Motif_variable id) -> [id, v]
| (Val_boolenne b1, Motif_boolen b2) ->
if b1 = b2 then [] else raise chec_filtrage
| (Val_nombre i1, Motif_nombre i2) ->
if i1 = i2 then [] else raise chec_filtrage
| (Val_paire(v1, v2), Motif_paire(m1, m2)) ->
filtrage v1 m1 @ filtrage v2 m2
| (Val_nil, Motif_nil) -> []
| (Val_cons(v1, v2), Motif_cons(m1, m2)) ->
filtrage v1 m1 @ filtrage v2 m2
| (_, _) -> raise chec_filtrage;;
let rec value env expr =
match expr with
| Variable id ->
begin try
List.assoc id env
with Not_found -> raise(Erreur(id ^ " est inconnu"))
end
| Fonction(liste_de_cas) ->
Val_fermeture {dfinition = liste_de_cas; environnement = env}
| Application(fonction, argument) ->
let val_fonction = value env fonction in
let val_argument = value env argument in
begin match val_fonction with
| Val_primitive fonction_primitive ->
fonction_primitive val_argument
| Val_fermeture fermeture ->
value_application fermeture.environnement
fermeture.dfinition val_argument
| _ ->
raise(Erreur "application d'une valeur non fonctionnelle")
end
| Let(dfinition, corps) ->
value (value_dfinition env dfinition) corps
| Boolen b -> Val_boolenne b
| Nombre n -> Val_nombre n
| Paire(e1, e2) -> Val_paire(value env e1, value env e2)
| Nil -> Val_nil
| Cons(e1, e2) -> Val_cons(value env e1, value env e2)
and value_application env liste_de_cas argument =
match liste_de_cas with
| [] -> raise(Erreur "chec du filtrage")
| (motif, expr) :: autres_cas ->
try
let env_tendu = filtrage argument motif @ env in
value env_tendu expr
with chec_filtrage ->
value_application env autres_cas argument
and value_dfinition env_courant df =
match df.rcursive with
| false -> (df.nom, value env_courant df.expr) :: env_courant
| true ->
match df.expr with
| Fonction liste_de_cas ->
let fermeture =
{ dfinition = liste_de_cas; environnement = [] } in
let env_tendu =
(df.nom, Val_fermeture fermeture) :: env_courant in
fermeture.environnement <- env_tendu;
env_tendu
| _ -> raise(Erreur "let rec non fonctionnel");;
let rec imprime_valeur = function
| Val_nombre n -> print_int n
| Val_boolenne false -> print_string "false"
| Val_boolenne true -> print_string "true"
| Val_paire (v1, v2) ->
print_string "("; imprime_valeur v1;
print_string ", "; imprime_valeur v2;
print_string ")"
| Val_nil ->
print_string "[]"
| Val_cons (v1, v2) ->
imprime_valeur v1;
print_string "::"; imprime_valeur v2
| Val_fermeture _ | Val_primitive _ ->
print_string "<fun>";;
|
