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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
(***********************************************************************)
(* *)
(* 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;;
open Valeur;;
open Envir;;
let rec valeur_initiale = function
| Integer | Boolean -> Inconnue
| Array(inf, sup, ty) ->
let v = Array.make (sup - inf + 1) Inconnue in
for i = inf to sup do
v.(i - inf) <- valeur_initiale ty
done;
Tableau(inf, v);;
let alloue_variable (nom_var, type_var) env =
ajoute_variable nom_var (ref (valeur_initiale type_var)) env;;
let alloue_variables dcl_var env =
List.fold_right alloue_variable dcl_var env;;
let rec ajoute_arguments paramtres arguments env =
match paramtres, arguments with
| [], [] -> env
| (nom, typ) :: reste_p, v :: reste_a ->
ajoute_arguments reste_p reste_a
(ajoute_variable nom (ref v) env)
| _, _ ->
raise(Erreur_excution "mauvais nombre d'arguments");;
let environnement_global =
ref (environnement_initial [] [] : valeur ref env);;
let rec value_expr env = function
| Constante(Entire n) -> Ent n
| Constante(Boolenne b) -> Bool b
| Variable nom ->
let emplacement = cherche_variable nom env in
!emplacement
| Application(nom_fonc, arguments) ->
let fonc = cherche_fonction nom_fonc env in
applique_fonc nom_fonc fonc (List.map (value_expr env) arguments)
| Op_unaire(op, argument) ->
let v = value_expr env argument in
begin match op with
| "-" -> Ent(- (ent_val v))
| "not" -> Bool(not (bool_val v))
| _ -> failwith "Oprateur unaire inconnu"
end
| Op_binaire(op, argument1, argument2) ->
let v1 = value_expr env argument1 in
let v2 = value_expr env argument2 in
begin match op with
| "*" -> Ent(ent_val v1 * ent_val v2)
| "/" ->
let n2 = ent_val v2 in
if n2 = 0 then raise(Erreur_excution "division par zro")
else Ent(ent_val v1 / n2)
| "+" -> Ent(ent_val v1 + ent_val v2)
| "-" -> Ent(ent_val v1 - ent_val v2)
| "=" -> Bool(v1 = v2)
| "<>" -> Bool(v1 <> v2)
| "<" -> Bool(ent_val v1 < ent_val v2)
| ">" -> Bool(ent_val v1 > ent_val v2)
| "<="-> Bool(ent_val v1 <= ent_val v2)
| ">=" -> Bool(ent_val v1 >= ent_val v2)
| "and" -> Bool(bool_val v1 && bool_val v2)
| "or" -> Bool(bool_val v1 || bool_val v2)
| _ -> failwith "Oprateur binaire inconnu"
end
| Accs_tableau(argument1, argument2) ->
let (inf, tbl) = tableau_val(value_expr env argument1) in
let indice = ent_val(value_expr env argument2) in
if indice >= inf && indice < inf + Array.length tbl
then tbl.(indice - inf)
else raise(Erreur_excution "accs hors bornes")
and excute_instr env = function
| Affectation_var(nom, expr) ->
let emplacement = cherche_variable nom env in
emplacement := value_expr env expr
| Affectation_tableau(expr1, expr2, expr3) ->
let nouvelle_valeur = value_expr env expr3 in
let (inf, tbl) = tableau_val(value_expr env expr1) in
let indice = ent_val(value_expr env expr2) in
if indice >= inf && indice < inf + Array.length tbl
then tbl.(indice - inf) <- nouvelle_valeur
else raise(Erreur_excution "accs hors bornes")
| Appel(nom_proc, arguments) ->
let proc = cherche_procdure nom_proc env in
appelle_proc proc (List.map (value_expr env) arguments)
| If(condition, branche_oui, branche_non) ->
if bool_val(value_expr env condition)
then excute_instr env branche_oui
else excute_instr env branche_non
| While(condition, boucle) ->
while bool_val(value_expr env condition) do
excute_instr env boucle
done
| Write expr ->
affiche_valeur(value_expr env expr)
| Read nom ->
let emplacement = cherche_variable nom env in
emplacement := lire_valeur ()
| Bloc instructions ->
List.iter (excute_instr env) instructions
and appelle_proc proc arguments =
let env =
alloue_variables proc.proc_variables
(ajoute_arguments proc.proc_paramtres arguments
!environnement_global) in
excute_instr env proc.proc_corps
and applique_fonc nom_fonc fonc arguments =
let env =
alloue_variable (nom_fonc, fonc.fonc_type_rsultat)
(alloue_variables fonc.fonc_variables
(ajoute_arguments fonc.fonc_paramtres arguments
!environnement_global)) in
excute_instr env fonc.fonc_corps;
let emplacement_rsultat = cherche_variable nom_fonc env in
!emplacement_rsultat;;
let excute_programme prog =
environnement_global :=
alloue_variables prog.prog_variables
(environnement_initial prog.prog_procdures prog.prog_fonctions);
try
excute_instr !environnement_global prog.prog_corps
with Pas_trouv nom ->
raise(Erreur_excution("identificateur inconnu: " ^ nom));;
|
