1
(***********************************************************************)
5
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
7
(* Copyright 2001 Institut National de Recherche en Informatique et *)
8
(* en Automatique. All rights reserved. This file is distributed *)
9
(* only by permission. *)
11
(***********************************************************************)
14
let recule d = avance (-. d)
15
and tourne_�_droite a = tourne (-. a)
16
and tourne_�_gauche = tourne;;
18
let baisse_le_crayon () = fixe_crayon false
19
and l�ve_le_crayon () = fixe_crayon true;;
22
for i = 1 to n do l done;;
24
r�p�te 4 [print_int 1; print_char '*'];;
26
let r�p�te n liste_d'ordres =
27
for i = 1 to n do liste_d'ordres () done;;
29
r�p�te 4 (function () -> print_int 1; print_char '*');;
35
let flottant = function
36
| Entier i -> float_of_int i
40
| Av of nombre | Re of nombre
41
| Td of nombre | Tg of nombre
44
| Rep of int * ordre list;;
46
let rec ex�cute_ordre = function
47
| Av n -> avance (flottant n)
48
| Re n -> avance (-. (flottant n))
49
| Tg a -> tourne (flottant a)
50
| Td a -> tourne (-. (flottant a))
51
| Lc -> fixe_crayon true
52
| Bc -> fixe_crayon false
54
| Rep (n, l) -> for i = 1 to n do List.iter ex�cute_ordre l done;;
56
let ex�cute_programme l = List.iter ex�cute_ordre l;;
58
let carr� c = Rep (4, [Av c; Td (Entier 90)]);;
61
[Ve; carr� (Entier 100); carr� (Entier 75);
62
carr� (Entier 50); carr� (Entier 25);
63
carr� (Flottant 12.5); carr� (Flottant 6.25);
64
carr� (Flottant 3.125)];;
69
| Constante_enti�re of int
70
| Constante_flottante of float;;
72
let flux_car = Stream.of_string "Vive Caml!";;
74
let flux_ent = [< '2; '3; '5; '7 >];;
76
stream_next flux_car;;
77
stream_next flux_car;;
79
let rec saute_blancs flux =
80
match flux with parser
81
| [< '' ' >] -> saute_blancs flux (* ' ' est l'espace *)
82
| [< ''\t' >] -> saute_blancs flux (* '\t' est la tabulation *)
83
| [< ''\n' >] -> saute_blancs flux (* '\n' est la fin de ligne *)
86
let rec saute_blancs flux =
87
match flux with parser
88
| [< ' (' ' | '\t' | '\n') >] -> saute_blancs flux
91
let rec lire_entier accumulateur flux =
92
match flux with parser
93
| [< ' ('0' .. '9' as c) >] ->
94
lire_entier (10 * accumulateur + int_of_char c - 48) flux
95
| [< >] -> accumulateur;;
97
let flux_car = Stream.of_string "123/456";;
99
lire_entier 0 flux_car;;
101
stream_next flux_car;;
103
lire_entier 900 flux_car;;
105
let rec lire_d�cimales accumulateur �chelle flux =
106
match flux with parser
107
| [< ' ('0' .. '9' as c) >] ->
110
float_of_int(int_of_char c - 48) *. �chelle)
111
(�chelle /. 10.0) flux
112
| [< >] -> accumulateur;;
114
lire_d�cimales 123.4 0.01 (Stream.of_string "56789");;
116
let tampon = String.make 16 '-';;
118
let rec lire_mot position flux =
119
match flux with parser
120
| [< '( 'A' .. 'Z' | 'a' .. 'z' | '�' | '�' | '_' as c) >] ->
121
if position < string_length tampon then
122
tampon.[position] <- c;
123
lire_mot (position+1) flux
125
String.sub tampon 0 (min position (string_length tampon));;
126
let rec lire_lex�me flux =
128
match flux with parser
129
| [< '( 'A' .. 'Z' | 'a' .. 'z' | '�' | '�' as c) >] ->
132
| [< '( '0' .. '9' as c) >] ->
133
let n = lire_entier (int_of_char c - 48) flux in
134
begin match flux with parser
137
(lire_d�cimales (float_of_int n) 0.1 flux)
138
| [< >] -> Constante_enti�re(n)
140
| [< 'c >] -> Symbole c;;
141
let flux_car = Stream.of_string "123bonjour ! 45.67";;
142
lire_lex�me flux_car;;
143
lire_lex�me flux_car;;
144
lire_lex�me flux_car;;
145
lire_lex�me flux_car;;
146
let rec analyseur_lexical flux =
147
match flux with parser
148
| [< l = lire_lex�me >] -> [< 'l; analyseur_lexical flux >]
151
analyseur_lexical(Stream.of_string "123bonjour ! 45.67");;
152
stream_next flux_lex�mes;;
153
stream_next flux_lex�mes;;
154
stream_next flux_lex�mes;;
155
stream_next flux_lex�mes;;
157
| [< i = Constante_enti�re >] -> Entier i
158
| [< f = Constante_flottante >] -> Flottant f;;
160
analyseur_lexical(Stream.of_string "123 1.05 fini");;
161
nombre flux_lex�mes;;
162
nombre flux_lex�mes;;
163
nombre flux_lex�mes;;
164
let rec ordre = parser
165
| [< 'Mot "baisse_crayon" >] -> Bc
166
| [< 'Mot "bc" >] -> Bc
167
| [< 'Mot "l�ve_crayon" >] -> Lc
168
| [< 'Mot "lc" >] -> Lc
169
| [< 'Mot "vide_�cran" >] -> Ve
170
| [< 'Mot "ve" >] -> Ve
171
| [< 'Mot "avance"; n = nombre >] -> Av n
172
| [< 'Mot "av"; n = nombre >] -> Av n
173
| [< 'Mot "recule"; n = nombre >] -> Re n
174
| [< 'Mot "re"; n = nombre >] -> Re n
175
| [< 'Mot "droite"; n = nombre >] -> Td n
176
| [< 'Mot "td"; n = nombre >] -> Td n
177
| [< 'Mot "gauche"; n = nombre >] -> Tg n
178
| [< 'Mot "tg"; n = nombre >] -> Tg n
179
| [< 'Mot "r�p�te"; n = Constante_enti�re;
180
l = liste_d'ordres >] -> Rep (n,l)
181
| [< 'Mot "rep"; n = Constante_enti�re;
182
l = liste_d'ordres >] -> Rep (n,l)
183
and liste_d'ordres = parser
184
| [< 'Symbole '['; l = suite_d'ordres; 'Symbole ']' >] -> l
185
and suite_d'ordres = parser
186
| [< ord = ordre; l_ord = suite_d'ordres >] -> ord :: l_ord
188
let analyse_programme = parser
189
| [< l = suite_d'ordres; 'Symbole '.' >] -> l;;
190
let lire_code cha�ne =
192
(analyseur_lexical (Stream.of_string cha�ne));;
193
lire_code "r�p�te 4 [avance 100 droite 90].";;
195
ex�cute_programme (lire_code cha�ne);;
197
[td 60 r�p�te 6 [av 15 tg 60] av 15].";;
199
| Constante of nombre
200
| Somme of expression * expression
201
| Produit of expression * expression
202
| Diff�rence of expression * expression
203
| Quotient of expression * expression
204
| Variable of string;;
205
let ajoute_nombres = function
206
| (Entier i, Entier j) -> Entier (i + j)
207
| (n1, n2) -> Flottant (flottant n1 +. flottant n2)
208
and soustrais_nombres = function
209
| (Entier i, Entier j) -> Entier (i - j)
210
| (n1, n2) -> Flottant (flottant n1 -. flottant n2)
211
and multiplie_nombres = function
212
| (Entier i, Entier j) -> Entier (i * j)
213
| (n1, n2) -> Flottant (flottant n1 *. flottant n2)
214
and divise_nombres = function
215
| (Entier i, Entier j) -> Entier (i / j)
216
| (n1, n2) -> Flottant (flottant n1 /. flottant n2)
217
and compare_nombres = function
218
| (Entier i, Entier j) -> i >= j
219
| (n1, n2) -> (flottant n1 >=. flottant n2);;
220
let rec valeur_expr env = function
223
ajoute_nombres (valeur_expr env e1, valeur_expr env e2)
224
| Produit (e1, e2) ->
225
multiplie_nombres (valeur_expr env e1, valeur_expr env e2)
226
| Diff�rence (e1, e2) ->
227
soustrais_nombres (valeur_expr env e1, valeur_expr env e2)
228
| Quotient (e1, e2) ->
229
divise_nombres (valeur_expr env e1, valeur_expr env e2)
230
| Variable s -> assoc s env;;
232
| Av of expression | Re of expression
233
| Td of expression | Tg of expression
236
| Rep of expression * ordre list
238
| Si of expression * expression * ordre list * ordre list
239
| Ex�cute of string * expression list;;
240
type proc�dure = {param�tres : string list; corps : ordre list};;
241
let proc�dures_d�finies = ref ([] : (string * proc�dure) list);;
242
let d�finit_proc�dure (nom, proc as liaison) =
243
proc�dures_d�finies := liaison :: !proc�dures_d�finies
244
and d�finition_de nom_de_proc�dure =
245
assoc nom_de_proc�dure !proc�dures_d�finies;;
246
let valeur_enti�re = function
248
| Flottant f -> failwith "entier attendu";;
249
exception Fin_de_proc�dure;;
250
let rec ex�cute_ordre env = function
251
| Av e -> avance (flottant (valeur_expr env e))
252
| Re e -> avance (-. (flottant (valeur_expr env e)))
253
| Tg a -> tourne (flottant (valeur_expr env a))
254
| Td a -> tourne (-. (flottant (valeur_expr env a)))
255
| Lc -> fixe_crayon true
256
| Bc -> fixe_crayon false
259
for i = 1 to valeur_enti�re (valeur_expr env n)
260
do List.iter (ex�cute_ordre env) l done
261
| Si (e1, e2, alors, sinon) ->
262
if compare_nombres (valeur_expr env e1, valeur_expr env e2)
263
then List.iter (ex�cute_ordre env) alors
264
else List.iter (ex�cute_ordre env) sinon
265
| Stop -> raise Fin_de_proc�dure
266
| Ex�cute (nom_de_proc�dure, args) ->
267
let d�finition = d�finition_de nom_de_proc�dure in
268
let variables = d�finition.param�tres
269
and corps = d�finition.corps in
270
let rec augmente_env = function
272
| variable :: vars, expr :: exprs ->
273
(variable, valeur_expr env expr) ::
274
augmente_env (vars, exprs)
276
failwith ("mauvais nombre d'arguments pour "
277
^ nom_de_proc�dure) in
278
let env_pour_corps = augmente_env (variables, args) in
279
try List.iter (ex�cute_ordre env_pour_corps) corps
280
with Fin_de_proc�dure -> ();;
282
| Pour of string * proc�dure
284
type programme_logo = Programme of phrase_logo list;;
285
let rec ex�cute_phrase = function
286
| Ordre ord -> ex�cute_ordre [] ord
287
| Pour (nom, proc as liaison) -> d�finit_proc�dure liaison
288
and ex�cute_programme = function
289
| Programme phs -> List.iter ex�cute_phrase phs;;
291
List.iter ex�cute_phrase
293
(analyseur_lexical (Stream.of_string cha�ne)));;
295
r�p�te 4 [av :c td 90].
296
pour multi_carr� :c :n
297
r�p�te :n [carr� :c td 10].
298
ve multi_carr� 80 10 .";;
299
logo "pour spirale :d :a :i :n
301
[av :d td :a spirale (:d + :i) :a :i (:n - 1)]
311
(* logo "ve spirale -180.0 79.5 0.5 720 .";; *)
312
logo "pour spirala :d :a :i :n
314
[av :d td :a spirala :d (:a + :i) :i (:n - 1)]
316
(* logo "ve spirala 10 0 2.5 90 .";; *)
320
4 0.5 181.5 1500 .";;
added
removed
examples/minilogo/abstract.ml
