commit 218ab7a0f328169149fce57241ea8d3833e35298
parent f9d7dded59606558ce2c9f88e41cdc49c1a0f578
Author: Bertrand BRUN <bertrand0brun@gmail.com>
Date: Sun, 21 Nov 2010 18:47:29 +0100
Fin de la parti Evaluateur
Diffstat:
1 file changed, 124 insertions(+), 0 deletions(-)
diff --git a/scheme/meval-scheme.scm b/scheme/meval-scheme.scm
@@ -230,3 +230,127 @@
;; }}} Barriere-syntaxique
+;; {{{ Evaluateur
+
+;; meval-scheme: Expression -> Valeur
+;; (meval-scheme e) rend la valeur de l'expression "e"
+(define (meval-scheme e)
+ (evaluation e (env-initial)))
+
+;; evaluation: Expression * Environnement -> Valeur
+;; (evaluation expr env) rend la valeur de l'expression "expr" dans l'environnement "env"
+(define (evaluation expr env)
+ ;; (discrimine l'expression et invoque l'evaluateur specialise)
+ (cond
+ ((variable? expr) (variable-val expr env))
+ ((citation? expr) (citation-val expr env))
+ ((alternative? expr) (alternative-eval
+ (alternative-condition expr)
+ (alternative-consequence expr)
+ (alternative-alternant expr) env))
+ ((conditionnelle? expr) (conditionnelle-eval
+ (conditionnelle-clauses expr) env))
+ ((sequence? expr) (sequence-eval (sequence-exprs expr) env))
+ ((bloc? expr) (bloc-eval (bloc-liaisons expr)
+ (bloc-corps expr) env))
+ ((application? expr) (application-eval
+ (application-fonction expr)
+ (application-arguments expr) env))
+ (else
+ (scheme-erreur 'evaluation "pas un programme" expr))))
+
+;; alternative-eval: Expression3 * Environnement -> Valeur
+;; (alternative-eval condition consequence alternant env) rend la valeur de
+;; l'expression "(if condition consequence alternant)" dans l'environnement "env"
+(define (alternative-eval condition consequence alternant)
+ (if (evaluation condition env)
+ (evaluation consequence env)
+ (evaluation alternant env)))
+
+;; conditionnelle-eval: LISTE[Clause] -> Expression
+;; (conditionnelle-eval clauses env) rend la valeur, dans l'environnement "env",
+;; de l'expression "(cond c1 c2 ... cn)".
+(define (conditionnelle-eval clauses env)
+ (evaluation (cond-expansion clauses) env))
+
+;; cond-expansion: LISTE[Clause] -> Expression
+;; (cond-expansion clauses) rend l'expression, ecrite avec des alternatives,
+;; equivalente a l'expression "(cond c1 c2 .. cn)".
+(define (cond-expansion clauses)
+ (if (pair? clauses)
+ (let ((first-clause (cadr clauses)))
+ (if (equal? (clause-condition first-clause) 'else)
+ (cons 'begin (clause-expressions first-clause))
+ (cons 'if
+ (cons
+ (clause-condition first-clause)
+ (cons
+ (cons 'begin (clause-expressions first-clause))
+ (let ((seq (cond-expansion (cdr clauses))))
+ (if (pair? seq)
+ (list seq)
+ seq)))))))
+ '()))
+
+;; sequence-eval: LISTE[Expression] * Environnement -> Valeur
+;; (sequence-eval exprs env) rend la valeur, dans l'environnement "env",
+;; de l'expression "(begin e1 ... en)". (Il faut evaluer tour a tour les
+;; expressions et rendre la valeur de la derniere expression.)
+(define (sequence-eval exprs env)
+ ;; sequence-eval+: LISTE[Expression]/non vide/ -> Valeur
+ ;; meme fonction, sachant que la liste "exprs" n'est pas vide et en globalisant
+ ;; la variable "env"
+ (define (sequence-eval+ exprs)
+ (if (pair? (cdr exprs))
+ (begin (evaluation (car exprs) env)
+ (sequence-eval+ (cdr exprs)))
+ (evaluation (car exprs) env)))
+ ;; expression de (sequence-eval exprs env):
+ (if (pair? exprs)
+ (sequence-eval+ exprs)
+ #f))
+
+;; application-eval: Expression * LISTE[Expression] * Environnement -> Valeur
+;; (application-eval exp-fn args env) rend la valeur de l'invocation de
+;; l'expression "exp-fn" aux arguments "args" dans l'environnement "env"
+(define (application-eval exp-fn args env)
+ ;; eval-env : Expression -> Valeur
+ ;; (eval-env expr) rend la valeur de "expr" dans l'environnement "env"
+ (define (eval-env expr)
+ (evaluation expr env))
+ ;;expression de (application-eval exp-fn args env) :
+ (let ((f (evaluation exp-fn env)))
+ (if (invocable? f)
+ (invocation f (meval-scheme-map eval-env args))
+ (scheme-erreur 'application-eval
+ "pas une fonction" f))))
+
+;; bloc-eval: LISTE[Liaison] * Corps * Environnement -> Valeur
+;; (bloc-eval liaisons corps env) rend la valeur, dans l'environnement "env"
+;; de l'expression "(let liaisons corps)"
+(define (bloc-eval liaisons corps env)
+ (corps-eval corps (env-add-liaisons liaisons env)))
+
+;; corps-eval: Corps * Environnement -> Valeur
+;; (corps-eval corps env) rend la valeur de "corps" dans l'environnement "env"
+(define (corps-eval corps env)
+ (let ((def-exp (corps-separation-defs-exps corps)))
+ (let ((defs (car def-exp))
+ (exps (cadr def-exp)))
+ (sequence-eval exps (env-enrichissement env defs)))))
+
+;; corps-separation-defs-exps: Corps -> COUPLE[LISTE[Definition] LISTE[Expression]]
+;; (corps-separation-defs-exps corps) rend un couple dont le premier elements est
+;; la liste des definitions du corps "corps" et le second element est la liste des
+;; expressions de ce corps
+(define (corps-separation-defs-exps corps)
+ (if (definition? (car corps))
+ (let ((def-exp-cdr
+ (corps-separation-defs-exps (cdr corps))))
+ (cons (cons (car corps)
+ (car def-exp-cdr))
+ (cdr def-exp-cdr)))
+ (list '() corps)))
+
+;; }}} Evaluateur
+
