677 lines
24 KiB
Scheme
677 lines
24 KiB
Scheme
#lang scheme
|
|
;; {{{ Grammaire du langage
|
|
;; Le langage interprete est defini par la grammaire suivante :
|
|
;; meval-scheme := expression
|
|
;; expression := variable
|
|
;; | constante | (QUOTE donnee) ; citation
|
|
;; | (COND clause *) ; conditionnelle
|
|
;; | (IF condition consequence [alternant]) ; alternative
|
|
;; | (BEGIN expression*) ; sequence
|
|
;; | (LET (liaison*) corps) ; bloc
|
|
;; | (fonction argument*) ; application
|
|
;; condition := expression
|
|
;; consequence := expression
|
|
;; alternant := expression
|
|
;; clause := (condition expressin*)
|
|
;; | (ELSE expression*)
|
|
;; fonction := expression
|
|
;; argument := expression
|
|
;; constante := nombre | chaine | booleen | caractere
|
|
;; donnee := constante
|
|
;; | symbole
|
|
;; | (donnee*)
|
|
;; liaison := (variable expression)
|
|
;; corps := definition* expression expression*
|
|
;; definition := (DEFINE (nom-fonction variable*) corps)
|
|
;; nom-fonction := variable
|
|
;; variable := tous les symboles de Scheme autres que les mots-cles
|
|
;; symbole := tous les symboles de Scheme
|
|
;; }}} Grammaire du langage
|
|
|
|
;; {{{ Utilitaire generaux
|
|
;;
|
|
;; Necessaires pour l'auto-amorcage (on pourrait egalement les placer
|
|
;; dans l'environnement initial)
|
|
|
|
;; Signaler une erreur et abandonner l'evaluation
|
|
(define (scheme-erreur fn message donnee)
|
|
(error "meval-scheme" fn message donnee))
|
|
|
|
;; cadr: LISTE[alpha]/au moins 2 termes/ -> alpha
|
|
;; (cadr L) rend le second terme de la liste "L"
|
|
(define (cadr L)
|
|
(car (cdr L)))
|
|
|
|
;; cddr: LISTE[alpha]/au moins 2 termes/ ->LISTE[alpha]
|
|
;; (cddr L) rend la liste "L" privee de ses deux premiers termes
|
|
(define (cddr L)
|
|
(cdr (cdr L)))
|
|
|
|
;; caddr: LISTE[alpha]/au moins 3 termes/ -> alpha
|
|
;; (caddr L) rend le troisieme terme de la liste "L"
|
|
(define (caddr L)
|
|
(car (cdr (cdr L))))
|
|
|
|
;; cdddr: LISTE[alpha]/au moins 3 termes/ -> LISTE[alpha]
|
|
;; (cdddr L) rend la liste "L" privee de ses trois premiers termes
|
|
(define (cdddr L)
|
|
(cdr (cdr (cdr L))))
|
|
|
|
;; cadddr: LISTE[alpha]/au moins 4 termes/ -> alpha
|
|
;; (cadddr L) rend le quatrieme terme de la liste "L"
|
|
(define (cadddr L)
|
|
(car (cdr (cdr (cdr L)))))
|
|
|
|
;; length: LISTE[alpha] -> entier
|
|
;; (length L) rend la longueur de la liste "L"
|
|
(define (length L)
|
|
(if (pair? L)
|
|
(+ 1 (length (cdr L)))
|
|
0))
|
|
|
|
;; meval-scheme-map: (alpha -> beta) * LISTE[alpha] -> LISTE[beta]
|
|
;; (meval-scheme-map f L) rend la liste des valeurs de "f" appliquee
|
|
;; aux termes de la liste "L"
|
|
(define (meval-scheme-map f L)
|
|
(if (pair? L)
|
|
(cons (f (car L)) (meval-scheme-map f (cdr L)))
|
|
'()))
|
|
|
|
;; member: alpha * LISTE[alpha] -> LISTE[alpha] + #f
|
|
;; (member e L) rend le suffixe de "L" debutant par la premiere
|
|
;; occurence de "e" ou #f si "e" n'apparait pas dans "L"
|
|
(define (member e L)
|
|
(if (pair? L)
|
|
(if (equal? e (car L))
|
|
L
|
|
(member e (cdr L)))
|
|
#f))
|
|
|
|
;; rang: alpha * LISTE[alpha] -> entier
|
|
;; (rang e L) rend le rang de l'element donne dans la liste "L"
|
|
;; (ou on sait que l'element apparait). Le premier element a pour rang 1.
|
|
(define (rang e L)
|
|
(if (equal? e (car L))
|
|
1
|
|
(+ 1 (rang e (cdr L)))))
|
|
|
|
;; }}} Utilitaire generaux
|
|
|
|
;; {{{ Barriere-syntaxique
|
|
;;
|
|
;; Ces fonctions permettent de manipuler les differentes expression syntaxiques
|
|
;; dont Scheme est forme. Pour chacune de ces differentes formes syntaxiques, on
|
|
;; trouve le reconnaisseur et les accesseurs.
|
|
|
|
;; variable?: Expression -> bool
|
|
(define (variable? expr)
|
|
(if (symbol? expr)
|
|
(cond ((equal? expr 'cond) #f)
|
|
((equal? expr 'else) #f)
|
|
((equal? expr 'if) #f)
|
|
((equal? expr 'quote) #f)
|
|
((equal? expr 'begin) #f)
|
|
((equal? expr 'let) #f)
|
|
((equal? expr 'let*) #f)
|
|
((equal? expr 'define) #f)
|
|
((equal? expr 'or) #f)
|
|
((equal? expr 'and) #f)
|
|
(else #t))
|
|
#f))
|
|
|
|
;; citation?: Expression -> bool
|
|
(define (citation? expr)
|
|
(cond ((number? expr) #t)
|
|
((char? expr) #t)
|
|
((string? expr) #t)
|
|
((boolean? expr) #t)
|
|
((pair? expr) (equal? (car expr) 'quote))
|
|
(else #f)))
|
|
|
|
;; conditionnelle?: Expression -> bool
|
|
(define (conditionnelle? expr)
|
|
(if (pair? expr)
|
|
(equal? (car expr) 'cond)
|
|
#f))
|
|
|
|
;; conditionnelle-clauses: Conditionnelle -> LISTE[Clause]
|
|
(define (conditionnelle-clauses cond)
|
|
(cdr cond))
|
|
|
|
;; alternative?: Expression -> bool
|
|
(define (alternative? expr)
|
|
(if (pair? expr)
|
|
(equal? (car expr) 'if)
|
|
#f))
|
|
|
|
;; alternative-condition: Alternative -> Expression
|
|
(define (alternative-condition alt)
|
|
(cadr alt))
|
|
|
|
;; alternative-consequence: Alternative -> Expression
|
|
(define (alternative-consequence alt)
|
|
(caddr alt))
|
|
|
|
;; alternative-alternant: Alternative -> Expression
|
|
(define (alternative-alternant alt)
|
|
(if (pair? (cdddr alt))
|
|
(cadddr alt)
|
|
#f))
|
|
|
|
;; sequence?: Expression -> bool
|
|
(define (sequence? expr)
|
|
(if (pair? expr)
|
|
(equal? (car expr) 'begin)
|
|
#f))
|
|
|
|
;; sequence-exprs: Expression -> LISTE[Expression]
|
|
(define (sequence-exprs expr)
|
|
(cdr expr))
|
|
|
|
;; bloc?: Expression -> bool
|
|
(define (bloc? expr)
|
|
(if (pair? expr)
|
|
(equal? (car expr) 'let)
|
|
#f))
|
|
|
|
;; bloc-liaisons: Bloc -> LISTE[Liaison]
|
|
(define (bloc-liaisons bloc)
|
|
(cadr bloc))
|
|
|
|
;; bloc-corps: Bloc -> Corps
|
|
(define (bloc-corps bloc)
|
|
(cddr bloc))
|
|
|
|
;; application?: Expression -> bool
|
|
(define (application? expr)
|
|
(pair? expr))
|
|
|
|
;; application-fonction: Application -> Expression
|
|
(define (application-fonction app)
|
|
(car app))
|
|
|
|
;; application-arguments: Application -> LISTE[Expression]
|
|
(define (application-arguments app)
|
|
(cdr app))
|
|
|
|
;; clause-condition: Clause -> Expression
|
|
(define (clause-condition clause)
|
|
(car clause))
|
|
|
|
;; clause-expressions: Clause -> LISTE[Expression]
|
|
(define (clause-expressions clause)
|
|
(cdr clause))
|
|
|
|
;; liaison-variable: Liaison -> Variable
|
|
(define (liaison-variable liaison)
|
|
(car liaison))
|
|
|
|
;; liaison-expr: Liaison -> Expression
|
|
(define (liaison-expr liaison)
|
|
(cadr liaison))
|
|
|
|
;; definition?: Corps -> bool
|
|
;; (definition? corps) rend #t ssi le premier elements de "corps" est une definition
|
|
(define (definition? corps)
|
|
(if (pair? corps)
|
|
(equal? (car corps) 'define)
|
|
#f))
|
|
|
|
;; definition-nom-fonction: Definition -> Variable
|
|
(define (definition-nom-fonction def)
|
|
(car (cadr def)))
|
|
|
|
;; definition-variables: Definition -> LISTE[Variable]
|
|
(define (definition-variables def)
|
|
(cdr (cadr def)))
|
|
|
|
;; definition-corps: Definition -> Corps
|
|
(define (definition-corps def)
|
|
(cddr def))
|
|
|
|
;; }}} 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))
|
|
((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 env)
|
|
(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
|
|
|
|
;; {{{ Barriere-interpretation
|
|
|
|
;; Un programme Scheme comme LISP decrit deux sortes d'objets: les valeurs non fonctionnelles
|
|
;; (entier, bool, liste...) et les valeurs fonctionnelles
|
|
|
|
;; {{{ Valeurs-non-fonctionnelles
|
|
|
|
;; citation-val: Citation -> Valeur/non fonctionnelle/
|
|
;; (citation-val cit) rend la valeur de la citation "cit"
|
|
(define (citation-val cit)
|
|
(if (pair? cit)
|
|
(cadr cit)
|
|
cit))
|
|
|
|
;; }}} Valeur-non-fonctionnelles
|
|
|
|
;; {{{ Valeur-fonctionnelles
|
|
|
|
;; Il y a deux type de fonctions, les fonctions predefinies (reconnues par primitive? en Scheme
|
|
;; et special-form-p en LISP) et les fonctions du programme en cours d'evaluation (creer par
|
|
;; fonction-creation)
|
|
|
|
;; invocable?: Valeur -> bool
|
|
;; (invocable? val) rend vrai ssi "val" est un fonction (primitive ou definie)
|
|
(define (invocable? val)
|
|
(if (primitive? val)
|
|
#t
|
|
(fonction? val)))
|
|
|
|
;; invocation: Invocable * LISTE[Valeur] -> Valeur
|
|
;; (invocation f args) rend la valeur de l'application de "f" aux elements de "vals"
|
|
(define (invocation f args)
|
|
(if (primitive? f)
|
|
(primitive-invocation f args)
|
|
(fonction-invocation f args)))
|
|
|
|
;; {{{ Primitives
|
|
|
|
;; Une primitive est implantee par un 4-uplet :
|
|
;; - le premier element est le symbole *primitive* (pour les reconnaitre)
|
|
;; - le second element est la fonction du Scheme sous-jacent qui implante la primitive,
|
|
;; - le troisieme element est un comparateur (= ou >=)
|
|
;; - le quatrieme element est un entier naturel, ces deux derniers elements permettant
|
|
;; de specifier l'arite de la primitive.
|
|
|
|
;; primitive?: Valeur -> bool
|
|
;; (primitive? val) rend vrai ssi "val" est une fonction primitive
|
|
(define (primitive? val)
|
|
(if (pair? val)
|
|
(equal? (car val) '*primitive*)
|
|
#f))
|
|
|
|
;; primitive-creation: N-UPLET[(Valeur... -> Valeur)(num * num -> bool) num] -> Primitive
|
|
;; (primitive-creation f-c-n) rend la primitive implantee par la fonction (du Scheme sous-jacent)
|
|
;; "f", le premier element de "f-c-n", et dont l'arite est specifier par le
|
|
;; comparateur "c", deuxieme element de "f-c-n" et l'entier "n", le troisieme element
|
|
(define (primitive-creation f-c-n)
|
|
(cons '*primitive* f-c-n))
|
|
|
|
;; primitive-invocation: Primitive * LISTE[Valeur] -> Valeur
|
|
;; (primitive-invocation p args) rend la valeur de l'application de la primitive "p" aux element
|
|
;; de args
|
|
(define (primitive-invocation p args)
|
|
(let ((n (length args))
|
|
(f (cadr p))
|
|
(compare (caddr p))
|
|
(arite (cadddr p)))
|
|
(if (compare n arite)
|
|
(cond
|
|
((= n 0) (f))
|
|
((= n 1) (f (car args)))
|
|
((= n 2) (f (car args) (cadr args)))
|
|
((= n 3) (f (car args) (cadr args) (caddr args)))
|
|
((= n 4) (f (car args) (cadr args) (caddr args) (cadddr args)))
|
|
(else
|
|
(scheme-erreur 'primitive-invocation
|
|
"limite implantation (arite quelconque < 5)" args)))
|
|
(scheme-erreur 'primitive-invocation
|
|
"arite incorrecte" args))))
|
|
|
|
;; }}} Primitives
|
|
|
|
;; {{{ Fonction-meta-definies
|
|
|
|
;; Une fonction definie est implantee par un 4-uplet:
|
|
;; - le premier element est le symbole *fonction* (pour les reconnaitre)
|
|
;; - le second element est la liste des variables de la definition de la fonction
|
|
;; - le troisieme element est le corps de la definition de la fonction
|
|
;; - le dernier element est l'environnement ou est definie la fonction
|
|
|
|
;; fonction?: Valeur -> bool
|
|
;; (fonction? val) rend vrai ssi "val" est une fonction meta-definie
|
|
(define (fonction? val)
|
|
(if (pair? val)
|
|
(equal? (car val) '*fonction*)
|
|
#f))
|
|
|
|
;; fonction-invocation: Fonction * LISTE[Valeur] -> Valeur
|
|
;; (fonction-invocation f args) rend la valeur de l'application de la fonction
|
|
;; meta-definie "f" aux element de "args"
|
|
(define (fonction-invocation f args)
|
|
(let ((variables (cadr f))
|
|
(corps (caddr f))
|
|
(env (cadddr f)))
|
|
(corps-eval corps (env-extension env variables args))))
|
|
|
|
;; fonction-creation: Definition * Environnement -> Fonction
|
|
;; (fonction-creation definition env) rend la fonction definie par "definition" dans
|
|
;; l'environnement "env"
|
|
(define (fonction-creation definition env)
|
|
(list '*fonction*
|
|
(definition-variables definition)
|
|
(definition-corps definition)
|
|
env))
|
|
|
|
;; }}} Fonctions-meta-definies
|
|
;; }}} Valeurs-fonctionnelles
|
|
;; }}} Barriere-interpretation
|
|
|
|
;; {{{ Environnement-H (barriere de haut niveau)
|
|
|
|
;; variable-val: Variable * Environnement -> Valeur
|
|
;; (variable-val var env) rend la valeur de la variable "var" dans l'environnement "env"
|
|
(define (variable-val var env)
|
|
(if (env-non-vide? env)
|
|
(let ((bloc (env-1er-bloc env)))
|
|
(let ((variables (blocActivation-variables bloc)))
|
|
(if (member var variables)
|
|
(blocActivation-val bloc var)
|
|
(variable-val var (env-reste env)))))
|
|
(scheme-erreur 'variable-val "variable inconnue" var)))
|
|
|
|
;; env-extension: Environnement * LISTE[Variable] * LISTE[Valeur] -> Environnement
|
|
;; (env-extension env vars vals) rend l'environnement "env" etendu avec un bloc
|
|
;; d'activation liant les variables "vars" aux valeurs "vals"
|
|
(define (env-extension env vars vals)
|
|
(if (= (length vars) (length vals))
|
|
(let ((bloc (blocActivation-creation vars)))
|
|
(begin
|
|
(blocActivation-mettre-valeurs! bloc vals)
|
|
(env-add bloc env)))
|
|
(scheme-erreur 'env-extension
|
|
"arite incorrecte" (list vars vals))))
|
|
|
|
;; env-add-liaisons: LISTE[Liaison] * Environnement -> Environnement
|
|
;; (env-add-liaisons liaisons env) rend l'environnement obtenu en ajoutant a l'environnement
|
|
;; "env", les liaisons "liaisons"
|
|
(define (env-add-liaisons liaisons env)
|
|
;; eval-env: Expression -> Valeur
|
|
;; (eval-env exp) rend la valeur de "exp" dans l'environnement "env"
|
|
(define (eval-env exp)
|
|
(evaluation exp env))
|
|
;; expression de (env-add-liaisons env) :
|
|
(env-extension
|
|
env
|
|
(meval-scheme-map liaison-variable liaisons)
|
|
(meval-scheme-map eval-env
|
|
(meval-scheme-map liaison-expr liaisons))))
|
|
|
|
;; env-enrichissement: Environnement * LISTE[Definition] -> Environnement
|
|
;; (env-enrichissement env defs) rend l'environnement "env" etendu avec un bloc
|
|
;; d'activation pour les definitions fonctionnelles "defs"
|
|
(define (env-enrichissement env defs)
|
|
(let ((noms (meval-scheme-map definition-nom-fonction defs)))
|
|
(let ((bloc (blocActivation-creation noms)))
|
|
(let ((env-plus (env-add bloc env)))
|
|
(define (fonction-creation-env-plus definition)
|
|
(fonction-creation definition env-plus))
|
|
(begin
|
|
(blocActivation-mettre-valeurs!
|
|
bloc
|
|
(meval-scheme-map fonction-creation-env-plus defs))
|
|
env-plus)))))
|
|
|
|
;; {{ Environnement-B (barriere de bas niveau)
|
|
|
|
;; Les environnement sont representes par la structure de donnees
|
|
;; LISTE[BlocActivation]
|
|
|
|
;; env-vide: -> Environnement
|
|
;; (env-vide) rend l'environnement vide
|
|
(define (env-vide) '())
|
|
|
|
;; env-non-vide?: Environnement -> bool
|
|
;; (env-non-vide? env) rend #t ssi l'environnement "env" n'est pas vide
|
|
(define (env-non-vide? env)
|
|
(pair? env))
|
|
|
|
;; env-add: Environnement * BlocActivation -> Environnement
|
|
;; (env-add bloc env) rend l'environnement obtenu en ajoutant devant
|
|
;; l'environnement "env" le bloc d'activation "bloc"
|
|
(define (env-add bloc env)
|
|
(cons bloc env))
|
|
|
|
;; env-1er-bloc: Environnement -> BlocActivation
|
|
;; (env-1er-bloc env) rend le premier bloc (le dernier dans la liste) d'activation
|
|
;; de l'environnement "env"
|
|
;; ERREUR lorsque l'environnement donnee est vide
|
|
(define (env-1er-bloc env)
|
|
(car env))
|
|
|
|
;; env-reste: Environnement -> Environnement
|
|
;; (env-reste env) rend l'environnement obtenu en supprimant le premier bloc d'activation
|
|
;; de l'environnement "env"
|
|
;; ERREUR lorsque l'environnement donnee est vide
|
|
(define (env-reste env)
|
|
(cdr env))
|
|
|
|
;; {{{ Bloc d'activation
|
|
|
|
;; Les blocs d'activation sont representes par la structure de donnees:
|
|
;; VECTEUR[LISTE[Variables] Valeur ...]
|
|
|
|
;; blocActivation-variables: BlocActivation -> LISTE[Variable]
|
|
;; (blocActivation-variables bloc) rend la liste des variables definies
|
|
;; dans le bloc d'activation "bloc"
|
|
(define (blocActivation-variables bloc)
|
|
(vector-ref bloc 0))
|
|
|
|
;; blocActivation-val: BlocActivation * Variable -> Valeur
|
|
;; (blocActivation-val bloc var) rend la valeur de la variable "var" dans le bloc
|
|
;; d'activation "bloc"
|
|
;; HYPOTHESE: "var" est une variable definie dans le "bloc"
|
|
(define (blocActivation-val bloc var)
|
|
(let ((i (rang var (blocActivation-variables bloc))))
|
|
(vector-ref bloc i)))
|
|
|
|
;; blocActivation-creation: LISTE[Variable] -> BlocActivation
|
|
;; (blocActivation-creation vars) rend un bloc d'activation contenant la liste des variables
|
|
;; "vars" avec la place qu'il faut pour les valeurs de ces variables, cette place n'etant pas
|
|
;; remplie
|
|
(define (blocActivation-creation vars)
|
|
(let ((bloc (make-vector (+ 1 (length vars)))))
|
|
(begin
|
|
(vector-set! bloc 0 vars)
|
|
bloc)))
|
|
|
|
;; blocActivation-mettre-valeurs!: BlocActivation * LISTE[Valeur] -> Rien
|
|
;; (blocActivation-mettre-valeurs! bloc vals) affecte les valeurs "vals" (donnees sous forme de
|
|
;; liste) dans le bloc d'activation "bloc".
|
|
(define (blocActivation-mettre-valeurs! bloc vals)
|
|
;; remplir!: entier * LISTE[Valeur] -> Rien
|
|
;; (remplir! i vals) remplit les cases du vecteur "bloc" a partir de l'indice "i", avec les valeurs
|
|
;; de la liste "vals" (et dans le meme ordre)
|
|
(define (remplir! i vals)
|
|
(if (pair? vals)
|
|
(begin
|
|
(vector-set! bloc i (car vals))
|
|
(remplir! (+ i 1) (cdr vals)))
|
|
null))
|
|
(remplir! 1 vals))
|
|
|
|
;; }}} Bloc d'activation
|
|
;; }}} Environnement-B (barriere de bas niveau
|
|
|
|
;; {{{ Environnement-initial
|
|
|
|
;; L'environnement initial est compose des primitives.
|
|
;; Pour faciliter la description des differentes primitives (et par manque de temps :D)
|
|
;; on les ecrira sous forme d'une liste de description de primitive.
|
|
;; Une element du type DescriptionPrimitive est une description d'une primitive. C'est
|
|
;; une liste dont :
|
|
;; - le premier element est la variable representant la primitive consideree
|
|
;; - les trois autres elements sont les trois elements qui decrivent
|
|
;; l'implantation de la primitive (la fonction Scheme, le comparateur, et l'arite)
|
|
|
|
;; env-initial -> Environnement
|
|
;; (env-initial) rend l'environnement initial (l'environnement qui contient toutes les primitives.
|
|
(define (env-initial)
|
|
(env-extension
|
|
(env-vide)
|
|
(meval-scheme-map car (descriptions-primitives))
|
|
(meval-scheme-map primitive-creation
|
|
(meval-scheme-map cdr
|
|
(descriptions-primitives)))))
|
|
|
|
;; description-primitive: Variable * (Valeur ... -> Valeur) * (num * num -> bool) * num -> DescriptionPrimitive
|
|
;; (description-primitive var f comparator arite) rend la description de la primitive designee par "var" implantee
|
|
;; dans Scheme par "f" et dont l'arite est definie par "comparator" et "arite"
|
|
(define (description-primitive var f comparator arite)
|
|
(list var f comparator arite))
|
|
|
|
;; descriptions-primitives: -> LISTE[DescriptionPrimitive]
|
|
;; (descriptions-primitives) rend la liste des descriptions de toutes les primitives
|
|
(define (descriptions-primitives)
|
|
(cons (description-primitive 'car car = 1)
|
|
(cons (description-primitive 'cdr cdr = 1)
|
|
(cons (description-primitive 'cons cons = 2)
|
|
(cons (description-primitive 'list list >= 0)
|
|
(cons (description-primitive 'vector-length vector-length = 1)
|
|
(cons (description-primitive 'vector-ref vector-ref = 2)
|
|
(cons (description-primitive 'vector-set! vector-set! = 3)
|
|
(cons (description-primitive 'make-vector make-vector = 1)
|
|
(cons (description-primitive 'pair? pair? = 1)
|
|
(cons (description-primitive 'symbol? symbol? = 1)
|
|
(cons (description-primitive 'number? number? = 1)
|
|
(cons (description-primitive 'string? string? = 1)
|
|
(cons (description-primitive 'boolean? boolean? = 1)
|
|
(cons (description-primitive 'vector? vector? = 1)
|
|
(cons (description-primitive 'char? char? = 1)
|
|
(cons (description-primitive 'equal? equal? = 2)
|
|
(cons (description-primitive '+ + >= 0)
|
|
(cons (description-primitive '- - = 2)
|
|
(cons (description-primitive '* * >= 0)
|
|
(cons (description-primitive '/ / = 2)
|
|
(cons (description-primitive '= = = 2)
|
|
(cons (description-primitive '< < = 2)
|
|
(cons (description-primitive '> > = 2)
|
|
(cons (description-primitive '<= <= = 2)
|
|
(cons (description-primitive '>= >= = 2)
|
|
(cons (description-primitive 'remainder remainder = 2)
|
|
(cons (description-primitive 'display display = 1)
|
|
(cons (description-primitive 'newline newline = 0)
|
|
(cons (description-primitive 'read read = 0)
|
|
(cons (description-primitive 'error error >= 2)
|
|
(list))))))))))))))))))))))))))))))))
|
|
|
|
;; }}} Environnement-initial
|
|
;; }}} Environnement-H (barriere de haut niveau)
|