1 ;;;; $Id: eval4fr.scm,v 1.12 2003/01/16 16:03:52 titou Exp $
2 ;;;; Copyright (C) 2000 by <Titou.Durand@ufr-info-p6.jussieu.fr>
3 ;;;; and <Christian.Queinnec@lip6.fr>
4
5 ;;;; {{{ Grammaire du langage
6 ;;;; Le langage interprété est défini par la grammaire suivante:
7 ;;;; deug-programme := expression
8 ;;;; expression := variable
9 ;;;; | constante | (QUOTE donnée) ; citation
10 ;;;; | (COND clause*) ; conditionnelle
11 ;;;; | (IF condition conséquence [alternant]); alternative
12 ;;;; | (BEGIN expression*) ; séquence
13 ;;;; | (LET (liaison*) corps) ; bloc
14 ;;;; | (fonction argument*) ; application
15 ;;;; condition := expression
16 ;;;; conséquence := expression
17 ;;;; alternant := expression
18 ;;;; clause := (condition expression*)
19 ;;;; | (ELSE expression*)
20 ;;;; fonction := expression
21 ;;;; argument := expression
22 ;;;; constante := nombre | chaîne | booléen | caractère
23 ;;;; donnée := constante
24 ;;;; | symbole
25 ;;;; | (donnée*)
26 ;;;; liaison := (variable expression)
27 ;;;; corps := definition* expression expression*
28 ;;;; définition := (DEFINE (nom-fonction variable*) corps)
29 ;;;; nom-fonction := variable
30 ;;;; variable := tous les symboles de Scheme autres que les mots-clés
31 ;;;; symbole := tous les symboles de Scheme
32 ;;;; }}} Grammaire du langage
33
34 ;;;; {{{ Utilitaires généraux
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 ;;;; Nécessaires pour l'auto-amorçage (on pourrait également les placer
37 ;;;; dans l'environnement initial).
38
39 ;;; Signaler une erreur et abandonner l'évaluation.
40 (define (deug-erreur fn message donnee)
41 (erreur 'deug-eval fn message donnee) )
42
43 ;;; cadr: LISTE[alpha]/au moins deux termes/ -> alpha
44 ;;; (cadr L) rend le second terme de la liste «L».
45 (define (cadr L)
46 (car (cdr L)) )
47
48 ;;; cddr: LISTE[alpha]/au moins deux termes/ -> LISTE[alpha]
49 ;;; (cddr L) rend la liste «L» privée de ses deux premiers termes.
50 (define (cddr L)
51 (cdr (cdr L)) )
52
53 ;;; caddr: LISTE[alpha]/au moins trois termes/ -> alpha
54 ;;; (caddr L) rend le troisième terme de la liste «L».
55 (define (caddr L)
56 (car (cdr (cdr L))) )
57
58 ;;; cdddr: LISTE[alpha]/au moins trois termes/ -> LISTE[alpha]
59 ;;; (cdddr L) rend la liste «L» privée de ses trois premiers termes.
60 (define (cdddr L)
61 (cdr (cdr (cdr L))) )
62
63 ;;; cadddr: LISTE[alpha]/au moins quatre termes/ -> alpha
64 ;;; (cadddr L) rend le quatrième terme de la liste «L».
65 (define (cadddr L)
66 (car (cdr (cdr (cdr L)))) )
67
68 ;;; length: LISTE[alpha] -> nat
69 ;;; (length L) rend la longueur de la liste «L».
70 (define (length L)
71 (if (pair? L)
72 (+ 1 (length (cdr L)))
73 0 ) )
74
75 ;;; deug-map: (alpha -> beta) * LISTE[alpha] -> LISTE[beta]
76 ;;; (deug-map f L) rend la liste des valeurs de «f» appliquée aux termes
77 ;;; de la liste «L».
78 (define (deug-map f L)
79 (if (pair? L)
80 (cons (f (car L)) (deug-map f (cdr L)))
81 '() ) )
82
83 ;;; member: alpha * LISTE[alpha] -> LISTE[alpha] + #f
84 ;;; (member e L) rend le suffixe de «L» débutant par la première
85 ;;; occurrence de «e» ou #f si «e» n'apparaît pas dans «L».
86 (define (member e L)
87 (if (pair? L)
88 (if (equal? e (car L))
89 L
90 (member e (cdr L)) )
91 #f ) )
92
93 ;;; rang: alpha * LISTE[alpha] -> nat
94 ;;; (rang e L) rend le rang de l'élément donné dans la liste «L»
95 ;;; (où on sait que l'élément apparaît). Le premier élément a pour rang un.
96 (define (rang e L)
97 (if (equal? e (car L))
98 1
99 (+ 1 (rang e (cdr L))) ) )
100 ;;;; }}} Utilitaires généraux
101
102 ;;;; {{{ Barrière-syntaxique
103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
104 ;;;; Ces fonctions permettent de manipuler les différentes expressions
105 ;;;; syntaxiques dont Scheme est formé. Pour chacune de ces différentes
106 ;;;; formes syntaxiques, on trouve le reconnaisseur et les accesseurs.
107
108 ;;; variable?: Expression -> bool
109 (define (variable? exp)
110 (if (symbol? exp)
111 (cond ((equal? exp 'cond) #f)
112 ((equal? exp 'else) #f)
113 ((equal? exp 'if) #f)
114 ((equal? exp 'quote) #f)
115 ((equal? exp 'begin) #f)
116 ((equal? exp 'let) #f)
117 ((equal? exp 'let*) #f)
118 ((equal? exp 'define) #f)
119 ((equal? exp 'or) #f)
120 ((equal? exp 'and) #f)
121 (else #t) )
122 #f) )
123
124 ;;; citation?: Expression -> bool
125 (define (citation? exp)
126 (cond ((number? exp) #t)
127 ((string? exp) #t)
128 ((char? exp) #t)
129 ((boolean? exp) #t)
130 ((pair? exp) (equal? (car exp) 'quote))
131 (else #f) ) )
132
133 ;;; conditionnelle?: Expression -> bool
134 (define (conditionnelle? exp)
135 (if (pair? exp) (equal? (car exp) 'cond) #f) )
136
137 ;;; conditionnelle-clauses: Conditionnelle -> LISTE[Clause]
138 (define (conditionnelle-clauses conditionnelle)
139 (cdr conditionnelle) )
140
141 ;;; alternative?: Expression -> bool
142 (define (alternative? exp)
143 (if (pair? exp) (equal? (car exp) 'if) #f) )
144
145 ;;; alternative-condition: Alternative -> Expression
146 (define (alternative-condition alt)
147 (cadr alt) )
148
149 ;;; alternative-consequence: Alternative -> Expression
150 (define (alternative-consequence alt)
151 (caddr alt) )
152
153 ;;; alternative-alternant: Alternative -> Expression
154 (define (alternative-alternant alt)
155 (if (pair? (cdddr alt))
156 (cadddr alt)
157 #f ) )
158
159 ;;; sequence?: Expression -> bool
160 (define (sequence? exp)
161 (if (pair? exp) (equal? (car exp) 'begin) #f) )
162
163 ;;; sequence-exps: Sequence -> LISTE[Expression]
164 (define (sequence-exps seq)
165 (cdr seq) )
166
167 ;;; bloc?: Expression -> bool
168 (define (bloc? exp)
169 (if (pair? exp) (equal? (car exp) 'let) #f) )
170
171 ;;; bloc-liaisons: Bloc -> LISTE[Liaison]
172 (define (bloc-liaisons bloc)
173 (cadr bloc) )
174
175 ;;; bloc-corps: Bloc -> Corps
176 (define (bloc-corps bloc)
177 (cddr bloc) )
178
179 ;;; application?: Expression -> bool
180 (define (application? exp)
181 (pair? exp) )
182
183 ;;; application-fonction: Application -> Expression
184 (define (application-fonction appl)
185 (car appl) )
186
187 ;;; application-arguments: Application -> LISTE[Expression]
188 (define (application-arguments appl)
189 (cdr appl) )
190
191 ;;; clause-condition: Clause -> Expression
192 (define (clause-condition clause)
193 (car clause) )
194
195 ;;; clause-expressions: Clause -> LISTE[Expression]
196 (define (clause-expressions clause)
197 (cdr clause) )
198
199 ;;; liaison-variable: Liaison -> Variable
200 (define (liaison-variable liaison)
201 (car liaison) )
202
203 ;;; liaison-exp: Liaison -> Expression
204 (define (liaison-exp liaison)
205 (cadr liaison) )
206
207 ;;; definition?: Corps -> bool
208 ;;; (definition? corps) rend #t ssi le premier élément du corps
209 ;;; «corps» est une définition
210 (define (definition? corps)
211 (if (pair? corps) (equal? (car corps) 'define) #f) )
212
213 ;;; definition-nom-fonction: Definition -> Variable
214 (define (definition-nom-fonction def)
215 (car (cadr def)) )
216
217 ;;; definition-variables: Definition -> LISTE[Variable]
218 (define (definition-variables def)
219 (cdr (cadr def)) )
220
221 ;;; definition-corps: Definition -> Corps
222 (define (definition-corps def)
223 (cddr def) )
224 ;;;; }}} Barrière-syntaxique
225
226 ;;;; {{{ Evaluateur
227 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
228
229 ;;; deug-eval: Deug-Programme -> Valeur
230 ;;; (deug-eval p) rend la valeur du programme (de Deug-Scheme) «p».
231 (define (deug-eval p)
232 (evaluation p (env-initial) ) )
233
234 ;;; evaluation: Expression * Environnement -> Valeur
235 ;;; (evaluation exp env) rend la valeur de l'expression «exp» dans
236 ;;; l'environnement «env».
237 (define (evaluation exp env)
238 ;; (discrimine l'expression et invoque l'évaluateur spécialisé)
239 (cond
240 ((variable? exp) (variable-val exp env))
241 ((citation? exp) (citation-val exp))
242 ((alternative? exp) (alternative-eval
243 (alternative-condition exp)
244 (alternative-consequence exp)
245 (alternative-alternant exp) env))
246 ((conditionnelle? exp) (conditionnelle-eval
247 (conditionnelle-clauses exp) env))
248 ((sequence? exp) (sequence-eval (sequence-exps exp) env))
249 ((bloc? exp) (bloc-eval (bloc-liaisons exp)
250 (bloc-corps exp) env))
251 ((application? exp) (application-eval
252 (application-fonction exp)
253 (application-arguments exp) env))
254 (else (deug-erreur 'evaluation "pas un programme" exp))) )
255
256 ;;; alternative-eval: Expression3 * Environnement -> Valeur
257 ;;; (alternative-eval condition consequence alternant env) rend la valeur de
258 ;;; l'expression «(if condition consequence alternant)» dans l'environnement «env».
259 (define (alternative-eval condition consequence alternant env)
260 (if (evaluation condition env)
261 (evaluation consequence env)
262 (evaluation alternant env)) )
263
264 ;;; LISTE[Clause] * Environnement -> Valeur
265 ;;; (conditionnelle-eval clauses env) rend la valeur, dans l'environnement «env»,
266 ;;; de l'expression «(cond c1 c2 ... cn)», «c1», «c2»... «cn» étant les éléments
267 ;;; de la liste «clauses».
268 (define (conditionnelle-eval clauses env)
269 (evaluation (conditionnelle-expansion clauses) env) )
270
271 ;;; conditionnelle-expansion: LISTE[Clause] -> Expression
272 ;;; (conditionnelle-expansion clauses) rend l'expression, écrite avec des
273 ;;; alternatives, équivalente à l'expression «(cond c1 c2 ... cn)»,
274 ;;; «c1», «c2»... «cn» étant les éléments de la liste «clauses».
275 (define (conditionnelle-expansion clauses)
276 (if (pair? clauses)
277 (let ((premiere-clause (car clauses)))
278 (if (equal? (clause-condition premiere-clause) 'else)
279 (cons 'begin (clause-expressions premiere-clause))
280 (cons 'if
281 (cons (clause-condition premiere-clause)
282 (cons (cons 'begin (clause-expressions premiere-clause))
283 (let ((seq (conditionnelle-expansion (cdr clauses))))
284 (if (pair? seq)
285 (list seq)
286 seq ) ) ) ) ) ) )
287 '() ) )
288
289 ;;; sequence-eval: LISTE[Expression] * Environnement -> Valeur
290 ;;; (sequence-eval exps env) rend la valeur, dans l'environnement «env», de
291 ;;; l'expression «(begin e1 ... en)», «e1»... «en» étant les éléments de la liste
292 ;;; «exps».
293 ;;; (Il faut évaluer tour à tour les expressions et rendre la valeur de la
294 ;;; dernière d'entre elles.)
295 (define (sequence-eval exps env)
296 ;; sequence-eval+ : LISTE[Expression]/non vide/ -> Valeur
297 ;; même fonction, sachant que la liste «exps» n'est pas vide et en globalisant
298 ;; la variable «env».
299 (define (sequence-eval+ exps)
300 (if (pair? (cdr exps))
301 (begin (evaluation (car exps) env)
302 (sequence-eval+ (cdr exps)) )
303 (evaluation (car exps) env)))
304 ;; expression de (sequence-eval exps env) :
305 (if (pair? exps)
306 (sequence-eval+ exps)
307 #f ) )
308
309 ;;; application-eval: Expression * LISTE[Expression] * Environnement -> Valeur
310 ;;; (application-eval exp-fn arguments env) rend la valeur de l'invocation de
311 ;;; l'expression «exp-fn» aux arguments «arguments» dans l'environnement «env».
312 (define (application-eval exp-fn arguments env)
313 ;; eval-env : Expression -> Valeur
314 ;; (eval-env exp) rend la valeur de «exp» dans l'environnement «env»
315 (define (eval-env exp)
316 (evaluation exp env))
317 ;; expression de (application-eval exp-fn arguments env) :
318 (let ((f (evaluation exp-fn env)))
319 (if (invocable? f)
320 (invocation f (deug-map eval-env arguments))
321 (deug-erreur 'application-eval
322 "pas une fonction" f ) ) ) )
323
324 ;;; bloc-eval: LISTE[Liaison] * Corps * Environnement -> Valeur
325 ;;; (bloc-eval liaisons corps env) rend la valeur, dans l'environnement «env»,
326 ;;; de l'expression «(let liaisons corps)».
327 (define (bloc-eval liaisons corps env)
328 (corps-eval corps (env-add-liaisons liaisons env)) )
329
330 ;;; corps-eval: Corps * Environnement -> Valeur
331 ;;; (corps-eval corps env) rend la valeur de «corps» dans l'environnement «env»
332 (define (corps-eval corps env)
333 (let ((def-exp (corps-separation-defs-exps corps)))
334 (let ((defs (car def-exp))
335 (exp (cadr def-exp)))
336 (evaluation exp (env-enrichissement env defs)) ) ) )
337
338 ;;; corps-separation-defs-exps: Corps -> (LISTE[Definition] * LISTE[Expression])
339 ;;; (corps-separation-defs-exps corps) rend une liste dont le premier élément est
340 ;;; la liste des definitions du corps «corps» et les autres éléments sont les
341 ;;; expressions de ce corps.
342 (define (corps-separation-defs-exps corps)
343 (if (definition? (car corps))
344 (let ((def-exp-cdr
345 (corps-separation-defs-exps (cdr corps))))
346 (cons (cons (car corps)
347 (car def-exp-cdr))
348 (cdr def-exp-cdr)))
349 (cons '() corps) ) )
350 ;;;; }}} Evaluateur
351
352 ;;;; {{{ Barrière-interpretation
353 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
354 ;;;; Un programme Scheme décrit deux sortes d'objets: les valeurs non fonctionnelles
355 ;;;; (les entiers, les booléens... les listes...) et les valeurs fonctionnelles
356
357 ;;;; {{{ Valeurs-non-fonctionnelles
358 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
359
360 ;;; citation-val: Citation -> Valeur/non fonctionelle/
361 ;;; (citation-val cit) rend la valeur de la citation «cit».
362 (define (citation-val cit)
363 (if (pair? cit)
364 (cadr cit)
365 cit ) )
366 ;;;; }}} Valeurs-non-fonctionnelles
367
368 ;;;; {{{ Valeurs-fonctionnelles
369 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
370 ;;;; Il y a deux types de fonctions, les fonctions prédéfinies (reconnues par
371 ;;;; primitive?) et les fonctions du programme en cours d'évaluation (créées par
372 ;;;; fonction-creation).
373
374 ;;; invocable?: Valeur -> bool
375 ;;; (invocable? val) rend vrai ssi «val» est une fonction (primitive ou définie
376 ;;; par le programmeur)
377 (define (invocable? val)
378 (if (primitive? val)
379 #t
380 (fonction? val) ) )
381
382 ;;; invocation: Invocable * LISTE[Valeur] -> Valeur
383 ;;; (invocation f vals) rend la valeur de l'application de «f» aux éléments de
384 ;;; «vals».
385 (define (invocation f vals)
386 (if (primitive? f)
387 (primitive-invocation f vals)
388 (fonction-invocation f vals) ) )
389
390 ;;;; {{{ Primitives
391 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
392 ;;;; Une primitive est implantée par un 4-uplet:
393 ;;;; - le premier élément est le symbole *primitive* (pour les reconnaître),
394 ;;;; - le second élément est la fonction du Scheme sous-jacent qui implante
395 ;;;; la primitive,
396 ;;;; - le troisième élément est un comparateur (= ou >=),
397 ;;;; - le dernier élément est un entier naturel, ces deux derniers éléments
398 ;;;; permettant de spécifier l'arité de la primitive.
399
400 ;;; primitive?: Valeur -> bool
401 ;;; (primitive? val) rend vrai ssi «val» est une fonction primitive.
402 (define (primitive? val)
403 (if (pair? val)
404 (equal? (car val) '*primitive*)
405 #f) )
406
407 ;;; primitive-creation: N-UPLET[(Valeur... -> Valeur) (num * num -> bool) num]
408 ;;; -> Primitive
409 ;;; (primitive-creation f-c-n) rend la primitive implantée par la fonction (du
410 ;;; Scheme sous-jacent) «f», le premier élément de «f-c-n», et dont l'arité est
411 ;;; spécifiée par le comparateur «c», deuxième élément de «f-c-n» et l'entier «n»,
412 ;;; troisième élément de «f-c-n».
413 (define (primitive-creation f-c-n)
414 (cons '*primitive* f-c-n) )
415
416 ;;; primitive-invocation: Primitive * LISTE[Valeur] -> Valeur
417 ;;; (primitive-invocation p vals) rend la valeur de l'application de la
418 ;;; primitive «p» aux éléments de «vals».
419 (define (primitive-invocation primitive vals)
420 (let ((n (length vals))
421 (f (cadr primitive))
422 (compare (caddr primitive))
423 (arite (cadddr primitive)))
424 (if (compare n arite)
425 (cond
426 ((= n 0) (f))
427 ((= n 1) (f (car vals)))
428 ((= n 2) (f (car vals) (cadr vals)))
429 ((= n 3) (f (car vals) (cadr vals) (caddr vals)))
430 ((= n 4) (f (car vals) (cadr vals)
431 (caddr vals) (cadddr vals) ))
432 (else
433 (deug-erreur 'primitive-invocation
434 "limite implantation (arités quelconques < 5)"
435 vals)))
436 (deug-erreur 'primitive-invocation "arité incorrecte" vals) ) ) )
437 ;;;; }}} Primitives
438
439 ;;;; {{{ Fonctions-definies par le programmeur
440 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
441 ;;;; Une fonction définie par le programmeur est implantée par un 4-uplet:
442 ;;;; - le premier élément est le symbole *fonction* (pour les reconnaître),
443 ;;;; - le second élément est la liste des variables de la définition de la
444 ;;;; fonction,
445 ;;;; - le troisième élément est le corps de la définition de la fonction,
446 ;;;; - le quatrième élément est l'environnement où est définie la fonction.
447
448 ;;; fonction?: Valeur -> bool
449 ;;; (fonction? val) rend vrai ssi «val» est une fonction créée par le programmeur.
450 (define (fonction? val)
451 (if (pair? val)
452 (equal? (car val) '*fonction*)
453 #f ) )
454
455 ;;; fonction-invocation: Fonction * LISTE[Valeur] -> Valeur
456 ;;; (fonction-invocation f vals) rend la valeur de l'application de
457 ;;; la fonction définie par le programmeur «f» aux éléments de «vals».
458 (define (fonction-invocation f vals)
459 (let ((variables (cadr f))
460 (corps (caddr f))
461 (env (cadddr f)) )
462 (corps-eval corps (env-extension env variables vals)) ) )
463
464 ;;; fonction-creation: Definition * Environnement -> Fonction
465 ;;; (fonction-creation definition env) rend la fonction définie par
466 ;;; «definition» dans l'environnement «env».
467 (define (fonction-creation definition env)
468 (list '*fonction*
469 (definition-variables definition)
470 (definition-corps definition)
471 env ) )
472
473 ;;;; }}} Fonctions-definies par le programmeur
474 ;;;; }}} Valeurs-fonctionnelles
475 ;;;; }}} Barrière-interpretation
476
477 ;;;; {{{ Environnements-H (barrière de haut niveau)
478 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
479
480 ;;; variable-val: Variable * Environnement -> Valeur
481 ;;; (variable-val var env) rend la valeur de la variable «var» dans
482 ;;; l'environnement «env».
483 (define (variable-val var env)
484 (if (env-non-vide? env)
485 (let ((bloc (env-1er-bloc env)))
486 (let ((variables (blocActivation-variables bloc)))
487 (if (member var variables)
488 (blocActivation-val bloc var)
489 (variable-val var (env-reste env)))))
490 (deug-erreur 'variable-val "variable inconnue" var) ) )
491
492 ;;; env-extension: Environnement * LISTE[Variable] * LISTE[Valeur] -> Environnement
493 ;;; (env-extension env vars vals) rend l'environnement «env» étendu avec
494 ;;; un bloc d'activation liant les variables «vars» aux valeurs «vals».
495 (define (env-extension env vars vals)
496 (if (= (length vars) (length vals))
497 (let ((bloc (blocActivation-creation vars)))
498 (begin
499 (blocActivation-mettre-valeurs! bloc vals)
500 (env-add bloc env) ) )
501 (deug-erreur 'env-extension "arité incorrecte" (list vars vals)) ) )
502
503 ;;; env-add-liaisons: LISTE[Liaison] * Environnement -> Environnement
504 ;;; (env-add-liaisons liaisons env) rend l'environnement obtenu en ajoutant,
505 ;;; à l'environnement «env», les liaisons «liaisons».
506 (define (env-add-liaisons liaisons env)
507 ;; eval-env : Expression -> Valeur
508 ;; (eval-env exp) rend la valeur de «exp» dans l'environnement «env»
509 (define (eval-env exp)
510 (evaluation exp env))
511 ;; expression de (env-add-liaisons liaisons env) :
512 (env-extension env
513 (deug-map liaison-variable liaisons)
514 (deug-map eval-env (deug-map liaison-exp liaisons)) ) )
515
516 ;;; env-enrichissement: Environnement * LISTE[Definition] -> Environnement
517 ;;; (env-enrichissement env defs) rend l'environnement «env» étendu avec un
518 ;;; bloc d'activation pour les définitions fonctionnelles «defs».
519 (define (env-enrichissement env defs)
520 (let ((noms (deug-map definition-nom-fonction defs)))
521 (let ((bloc (blocActivation-creation noms)))
522 (let ((env-plus (env-add bloc env)))
523 (define (fonction-creation-env-plus definition)
524 (fonction-creation definition env-plus))
525 (begin
526 (blocActivation-mettre-valeurs!
527 bloc
528 (deug-map fonction-creation-env-plus defs))
529 env-plus ) ) ) ) )
530
531 ;;;; {{{ Environnements-B (barrière de bas niveau)
532 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
533 ;;;; Les environnements sont représentés par la structure de données
534 ;;;; LISTE[BlocActivation]
535
536 ;;; env-vide: -> Environnement
537 ;;; (env-vide) rend l'environnement vide
538 (define (env-vide) '())
539
540 ;;; env-non-vide?: Environnement -> bool
541 ;;; (env-non-vide? env) rend #t ssi l'environnement «env» n'est pas vide
542 (define (env-non-vide? env)
543 (pair? env) )
544
545 ;;; env-add: Environnement * BlocActivation -> Environnement
546 ;;; (env-add bloc env) rend l'environnement obtenu en ajoutant devant
547 ;;; l'environnement «env» le bloc d'activation «bloc».
548 (define (env-add bloc env)
549 (cons bloc env) )
550
551 ;;; env-1er-bloc: Environnement -> BlocActivation
552 ;;; ERREUR lorsque l'environnement donné est vide
553 ;;; (env-1er-bloc env) rend le premier (i.e. celui qui a été ajouté en
554 ;;; dernier) bloc d'activation de l'environnement «env».
555 (define (env-1er-bloc env)
556 (car env) )
557
558 ;;; env-reste: Environnement -> Environnement
559 ;;; ERREUR lorsque l'environnement donné est vide
560 ;;; (env-reste env) rend l'environnement obtenu en supprimant le premier
561 ;;; bloc d'activation de l'environnement «env».
562 (define (env-reste env)
563 (cdr env) )
564
565 ;;;; {{{ Blocs d'activation
566 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
567 ;;;; Les blocs d'activation sont représentés par la structure de données:
568 ;;;; VECTEUR[LISTE[Variable] Valeur...]
569
570 ;;; blocActivation-variables: BlocActivation -> LISTE[Variable]
571 ;;; (blocActivation-variables bloc) rend la liste des variables définies
572 ;;; dans le bloc d'activation «bloc»
573 (define (blocActivation-variables bloc)
574 (vector-ref bloc 0) )
575
576 ;;; blocActivation-val: BlocActivation * Variable -> Valeur
577 ;;; HYPOTHESE: «var» est une variable définie dans «bloc»
578 ;;; (blocActivation-val bloc var) rend la valeur de la variable «var»
579 ;;; dans le bloc d'activation «bloc».
580 (define (blocActivation-val bloc var)
581 (let ((i (rang var (blocActivation-variables bloc))))
582 (vector-ref bloc i) ) )
583
584 ;;; blocActivation-creation: LISTE[Variable] -> BlocActivation
585 ;;; (blocActivation-creation vars) rend un bloc d'activation contenant
586 ;;; la liste des variables «vars», avec la place qu'il faut pour les valeurs
587 ;;; de ces variables, cette place n'étant pas remplie.
588 (define (blocActivation-creation vars)
589 (let ((bloc (make-vector (+ 1 (length vars)))))
590 (begin
591 (vector-set! bloc 0 vars)
592 bloc ) ) )
593
594 ;;; blocActivation-mettre-valeurs!: BlocActivation * LISTE[Valeur] -> Rien
595 ;;; (blocActivation-mettre-valeurs! bloc vals) affecte les valeurs «vals» (données
596 ;;; sous forme de liste) dans le bloc d'activation «bloc» (qui est un vecteur)
597 (define (blocActivation-mettre-valeurs! bloc vals)
598 ;; remplir!: nat * LISTE[Valeur] -> Rien
599 ;; (remplir! i vals) remplit les cases du vecteur «bloc», à partir de
600 ;; l'indice «i», avec les valeurs de la liste «vals» (et dans le même ordre).
601 (define (remplir! i vals)
602 (if (pair? vals)
603 (begin
604 (vector-set! bloc i (car vals))
605 (remplir! (+ i 1) (cdr vals)) ) ) )
606 (remplir! 1 vals) )
607 ;;;; }}} Blocs d'activation
608 ;;;; }}} Environnements-B (barrière de bas niveau)
609
610 ;;;; {{{ Environnement-initial
611 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
612 ;;;; L'environnement initial est composé des primitives.
613 ;;;; Pour faciliter la description, dans ce logiciel, des différentes
614 ;;;; primitives, nous les écrirons sous la forme d'une liste de
615 ;;;; descriptions de primitive.
616 ;;;; Un élément du type DescriptionPrimitive est une description (presque
617 ;;;; textuelle) d'une primitive. C'est une liste dont
618 ;;;; - le premier élément est la variable représentant, dans Deug-Scheme, la
619 ;;;; primitive considérée,
620 ;;;; - les trois autres éléments sont les trois éléments qui décrivent
621 ;;;; l'implantation de la primitive (la fonction du Scheme sous-jacent,
622 ;;;; le comparateur et l'arité).
623
624 ;;; env-initial: -> Environnement
625 ;;; (env-initial) rend l'environnement initial, i.e. l'environnement qui
626 ;;; contient toutes les primitives.
627 (define (env-initial)
628 (env-extension (env-vide)
629 (deug-map car (descriptions-primitives))
630 (deug-map primitive-creation
631 (deug-map cdr (descriptions-primitives)) ) ) )
632
633 ;;; description-primitive: Variable * (Valeur ... -> Valeur)
634 ;;; * (num * num -> bool) * num -> DescriptionPrimitive
635 ;;; (description-primitive var f comparator arite) rend la description de la
636 ;;; primitive désignée par «var», implantée dans le Scheme sous-jacent par «f» et
637 ;;; dont l'arité est définie par «comparator» «arite».
638 (define (description-primitive var f comparator arite)
639 (list var f comparator arite))
640
641 ;;; descriptions-primitives: -> LISTE[DescriptionPrimitive]
642 ;;; (descriptions-primitives) rend la liste des descriptions de toutes les
643 ;;; primitives
644 (define (descriptions-primitives)
645 (list
646 (description-primitive 'car car = 1)
647 (description-primitive 'cdr cdr = 1)
648 (description-primitive 'cons cons = 2)
649 (description-primitive 'list list >= 0)
650 (description-primitive 'vector-length vector-length = 1)
651 (description-primitive 'vector-ref vector-ref = 2)
652 (description-primitive 'vector-set! vector-set! = 3)
653 (description-primitive 'make-vector make-vector = 1) ; ou 2
654 (description-primitive 'pair? pair? = 1)
655 (description-primitive 'symbol? symbol? = 1)
656 (description-primitive 'number? number? = 1)
657 (description-primitive 'string? string? = 1)
658 (description-primitive 'boolean? boolean? = 1)
659 (description-primitive 'vector? vector? = 1)
660 (description-primitive 'char? char? = 1)
661 (description-primitive 'equal? equal? = 2)
662 (description-primitive '+ + >= 0)
663 (description-primitive '* * >= 0)
664 (description-primitive '- - = 2)
665 (description-primitive '= = = 2)
666 (description-primitive '< < = 2)
667 (description-primitive '> > = 2)
668 (description-primitive '<= <= = 2)
669 (description-primitive '>= >= = 2)
670 (description-primitive 'remainder remainder = 2)
671 (description-primitive 'display display = 1) ; ou 2
672 (description-primitive 'newline newline = 0) ; ou 1
673 (description-primitive 'read read = 0)
674 (description-primitive 'erreur deug-erreur = 3) ))
675
676 ;;;; }}} Environnement-initial
677 ;;;; }}} Environnements-H (barrière de haut niveau)
678
679 ;;;; {{{ Mode d'emploi
680 ;;;; NOTA: sous DrScheme, on doit faire tourner ce code dans un environnement où est
681 ;;;; définie la fonction «erreur», pour faire tourner ce code sous d'autres systèmes
682 ;;;; Scheme, il faut définir une fonction «erreur» d'arité supérieure ou égale à 2.
683
684 ; Mise en oeuvre sous DrScheme:
685 ; ouvrir fichier eval4fr.scm puis évaluer (deug-eval '(+ 2 3))
686 ; puis évaluer
687 ; (deug-eval '(let ((a 5)) (define (f n) (if (= n 0) 1 (* n (f (- n 1)))))
688 ; (f a)))
689 ; Pour auto-interpréter l'évaluateur, il suffit d'écrire (en supposant
690 ; que <DEUGEVAL> est le programme définissant deug-eval:
691 ; (deug-eval '(let () <DEUGEVAL> (deug-eval '(+ 2 3))))
692 ; puis
693 ; (deug-eval '(let ()
694 ; <DEUGEVAL>
695 ; (deug-eval '(let ((a 5)) (define (f n) (if (= n 0) 1 (* n (f (- n 1)))))
696 ; (f a)))))
697 ;;;; }}} Mode d'emploi
698 ;;;; end of eval4fr.scm
