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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
(***********************************************************************)
(* *)
(* 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 Lexuniv;;
type constante =
| Entire of int
| Boolenne of bool;;
type expr_type =
| Integer (* le type des entiers *)
| Boolean (* le type des boolens *)
| Array of int * int * expr_type;; (* le type des tableaux *)
(* (les deux "int" sont les bornes) *)
type expression =
| Constante of constante
| Variable of string
| Application of string * expression list
| Op_unaire of string * expression
| Op_binaire of string * expression * expression
| Accs_tableau of expression * expression;;
type instruction =
| Affectation_var of string * expression
| Affectation_tableau of expression * expression * expression
| Appel of string * expression list (* appel de procdure *)
| If of expression * instruction * instruction
| While of expression * instruction
| Write of expression
| Read of string
| Bloc of instruction list;; (* bloc begin ... end *)
type dcl_proc =
{ proc_paramtres: (string * expr_type) list;
proc_variables: (string * expr_type) list;
proc_corps: instruction }
and dcl_fonc =
{ fonc_paramtres: (string * expr_type) list;
fonc_type_rsultat: expr_type;
fonc_variables: (string * expr_type) list;
fonc_corps: instruction };;
type programme =
{ prog_variables: (string * expr_type) list;
prog_procdures: (string * dcl_proc) list;
prog_fonctions: (string * dcl_fonc) list;
prog_corps: instruction };;
let analyseur_lexical = construire_analyseur
["false";"true";"("; ","; ")"; "["; "]"; "not"; "*"; "/"; "-"; "+";
"="; "<>"; "<"; ">"; "<="; ">="; "and"; "or"; "if"; "then"; "else";
"while"; "do"; "write"; "read"; "begin"; ";"; "end"; ":=";
"integer"; "boolean"; "array"; "of"; ".."; "var"; ":";
"procedure"; "function"; "program"];;
let lire_liste lire_lment sparateur =
let rec lire_reste = parser
| [< 'MC s when s = sparateur;
elt = lire_lment;
reste = lire_reste >] -> elt :: reste
| [< >] -> [] in
parser
| [< elt = lire_lment; reste = lire_reste >] -> elt :: reste
| [< >] -> [];;
let lire_oprateur oprateurs = parser
[< 'MC op when List.mem op oprateurs >] -> op;;
let lire_opration lire_base oprateurs =
let rec lire_reste e1 = parser
| [< op = lire_oprateur oprateurs;
e2 = lire_base;
e = lire_reste (Op_binaire(op, e1, e2)) >] -> e
| [< >] -> e1 in
parser [< e1 = lire_base; e = lire_reste e1 >] -> e;;
let rec lire_expr0 flux =
match flux with parser
| [< 'Entier n >] -> Constante(Entire n)
| [< 'MC "false" >] -> Constante(Boolenne false)
| [< 'MC "true" >] -> Constante(Boolenne true)
| [< 'Ident nom >] ->
begin match flux with parser
| [< 'MC "("; el = lire_liste lire_expr ","; 'MC ")">] ->
Application(nom, el)
| [< >] -> Variable nom
end
| [< 'MC "("; e = lire_expr; 'MC ")" >] -> e
and lire_expr1 flux =
match flux with parser
| [< e1 = lire_expr0 >] ->
match flux with parser
| [< 'MC "["; e2 = lire_expr; 'MC "]" >] -> Accs_tableau(e1,e2)
| [< >] -> e1
and lire_expr2 = parser
| [< 'MC "-"; e = lire_expr1 >] -> Op_unaire("-", e)
| [< 'MC "not"; e = lire_expr1 >] -> Op_unaire("not", e)
| [< e = lire_expr1 >] -> e
and lire_expr3 flux =
lire_opration lire_expr2 ["*"; "/"] flux
and lire_expr4 flux =
lire_opration lire_expr3 ["+"; "-"] flux
and lire_expr5 flux =
lire_opration lire_expr4 ["="; "<>"; "<"; ">"; "<="; ">="] flux
and lire_expr6 flux =
lire_opration lire_expr5 ["and"] flux
and lire_expr flux =
lire_opration lire_expr6 ["or"] flux;;
let rec lire_instr flux =
match flux with parser
| [< 'MC "if"; e1 = lire_expr; 'MC "then"; i2 = lire_instr >] ->
begin match flux with parser
| [< 'MC "else"; i3 = lire_instr >] -> If(e1, i2, i3)
| [< >] -> If(e1, i2, Bloc [])
end
| [< 'MC "while"; e1 = lire_expr; 'MC "do"; i2 = lire_instr >] ->
While(e1, i2)
| [< 'MC "write"; 'MC "("; e = lire_expr; 'MC ")" >] ->
Write e
| [< 'MC "read"; 'MC "("; 'Ident nom; 'MC ")" >] ->
Read nom
| [< 'MC "begin"; il = lire_liste lire_instr ";"; 'MC "end" >] ->
Bloc il
| [< e = lire_expr >] ->
match e with
| Application(nom, el) ->
Appel(nom, el)
| Variable nom ->
begin match flux with parser
| [< 'MC ":="; e = lire_expr >] ->
Affectation_var(nom, e)
end
| Accs_tableau(e1, e2) ->
begin match flux with parser
[< 'MC ":="; e3 = lire_expr >] ->
Affectation_tableau(e1, e2, e3)
end
| _ -> raise (Stream.Error "Illegal instruction");;
let rec lire_type = parser
| [< 'MC "integer" >] -> Integer
| [< 'MC "boolean" >] -> Boolean
| [< 'MC "array"; 'MC "["; 'Entier bas; 'MC ".."; 'Entier haut;
'MC "]"; 'MC "of"; ty = lire_type >] -> Array(bas, haut, ty);;
let rec lire_variables = parser
| [< 'MC "var"; 'Ident nom; 'MC ":"; ty = lire_type; 'MC ";";
reste = lire_variables >] -> (nom,ty)::reste
| [< >] -> [];;
let lire_un_paramtre = parser
[< 'Ident nom; 'MC ":"; ty = lire_type >] -> (nom,ty);;
let lire_paramtres = parser
[< 'MC "(";
paramtres = lire_liste lire_un_paramtre ",";
'MC ")" >] -> paramtres;;
let lire_procdure = parser
[< 'MC "procedure"; 'Ident nom; p = lire_paramtres; 'MC ";";
v = lire_variables; i = lire_instr; 'MC ";" >] ->
(nom, {proc_paramtres = p; proc_variables = v; proc_corps = i});;
let lire_fonction = parser
[< 'MC "function"; 'Ident nom; p = lire_paramtres; 'MC ":";
ty = lire_type; 'MC ";"; v = lire_variables;
i = lire_instr; 'MC ";" >] ->
(nom, {fonc_paramtres = p; fonc_type_rsultat = ty;
fonc_variables = v; fonc_corps = i});;
let rec lire_proc_fonc = parser
| [< proc = lire_procdure; (procs, foncs) = lire_proc_fonc >] ->
(proc :: procs, foncs)
| [< fonc = lire_fonction; (procs, foncs) = lire_proc_fonc >] ->
(procs, fonc :: foncs)
| [< >] -> ([], []);;
let lire_prog = parser
[< 'MC "program"; 'Ident nom_du_programme; 'MC ";";
v = lire_variables; (p, f) = lire_proc_fonc; i = lire_instr >] ->
{ prog_variables = v; prog_procdures = p;
prog_fonctions = f; prog_corps = i };;
let lire_programme flux = lire_prog (analyseur_lexical flux);;
|
