Précédent Index Suivant

6   Scheme en Scheme



Où lectrices et lecteurs découvriront, abasourdis, l'interprète Scheme écrit en Scheme lui-même et ce qui s'ensuivra.

Voici la définition d'un interprète Scheme en Scheme:
(define (evaluate e env)
  (if (atom? e)  ; i.e.,(not (pair? e))
      (cond ((symbol? e) (lookup e env))
            ((or (number? e) (string? e) (char? e) (boolean? e)) 
             e )
            (else (wrong "Cannot evaluate" e)) )
      (case (car e)
        ;; pas de vérification syntaxique
        ((quote) (cadr e))
        ((if) (if (evaluate (cadr e) env)
                  (evaluate (caddr e) env)
                  (evaluate (cadddr e) env) ))
        ;; begin n'est pas une vraie forme spéciale
        ((begin) (eprogn (cdr e) env))
        ((set!) (update! (cadr e) env (evaluate (caddr e) env)))
        ((lambda) (make-function (cadr e) (cddr e) env))
        (else (invoke (evaluate (car e) env)
                      (evlis (cdr e) env) )) ) ) )
Deux itérateurs évaluant leur premier argument:
;;; Two specialized evaluators.
(define (evlis exps env)
  (if (pair? exps)
      (cons (evaluate (car exps) env)
            (evlis (cdr exps) env) )
      '() ) ) 
(define (eprogn exps env)
  (if (pair? exps)
      (if (pair? (cdr exps))
          (begin (evaluate (car exps) env)
                 (eprogn (cdr exps) env) )
          (evaluate (car exps) env) )
      '() ) )
La représentation des fonctions:
;;; Functions are represented as functions
(define (make-function variables body env)
  (lambda (values)
     (eprogn body (extend env variables values)) ) ) 
(define (invoke fn args)
  (if (procedure? fn) 
      (fn args)
      (wrong "Not a function" fn) ) )
La représentation des environnements:
;;; Environments are Alists handled by lookup and update!.
;;; The global environment is not exensible (see definitial below).
(define (lookup id env)
  (if (pair? env)
      (if (eq? (caar env) id)
          (cdar env)
          (lookup id (cdr env)) )
      (wrong "No such binding" id) ) ) 
(define (update! id env value)
  (if (pair? env)
      (if (eq? (caar env) id)
          (set-cdr! (car env) value)
          (update! id (cdr env) value) )
      (wrong "No such binding" id) ) ) 
(define (extend env names values)
  (cond ((pair? names)
         (if (pair? values)
             (cons (cons (car names) (car values))
                   (extend env (cdr names) (cdr values)) )
             (wrong "Too less values") ) )
        ((null? names)
             (if (null? values)
                 env 
                 (wrong "Too much values") ) )
        ((symbol? names) (cons (cons names values) env)) ) )
L'environnement initial:
(define env.init '()) 
;;; Three macros to define the initial global environment
(define env.global env.init)
Les définisseurs de liaisons prédéfinies:
(define-macro (definitial name value)
  `(begin (set! env.global (cons (cons ',name ,value) env.global))
          ',name ) ) 
(define-macro (defprimitive name value arity)
  `(definitial ,name 
     (lambda (values) 
       (if (= (length values) ,arity)
           (apply ,value values)
           (wrong "Incorrect arity"
                  (list ',name values) ) ) ) ) ) 
(define the-false-value #f) 
(define-macro (defpredicate name value arity)
  `(definitial ,name
     (lambda (values) 
       (if (= ,arity (length values))
           (or (apply ,value values) the-false-value)
           (wrong "Incorrect arity"
                  (list ',name values) ) ) ) ) )
Quelques fonctions prédéfinies:
(defprimitive car car 1) 
(defprimitive cons cons 2)
Lancement de l'interprète:
;;; Starting the interpreter.
(define (toplevel)
  (display (evaluate (read) env.global))
  (toplevel) )

Exercice 51 : Modifier le lancement de l'interprète pour ajouter une bannière, une invite et détecter la fin de fichier.

Solution de l'exercice 51 :
(define (scheme)
  (display "Bienvenue !")
  (newline)
  (let toplevel ()
    (display "?? ")
    (let ((e (read)))
      (if (eof-object? e)
          (begin (display ";;; end")
                 (newline) )
          (let ((r (evaluate e env.global)))
            (display "== ")
            (display r)
            (newline)
            (toplevel) ) ) ) ) )

Exercice 52 : Définir les fonctions list et apply pour cet interprète. On pourra se limitera à un apply binaire.

Solution de l'exercice 52 : Voici un apply n-aire. Comme list est aussi une fonction n-aire, on définira auparavant un définisseur de fonctions n-aires.
(defnaryprimitive list
   (lambda values values)
   0 ) 
(define-macro (defnaryprimitive name value arity)
  `(definitial ,name 
     (lambda (values) 
       (if (>= (length values) ,arity)
           (apply ,value values)
           (wrong "Incorrect arity"
                  (list ',name values) ) ) ) ) ) 
(defnaryprimitive apply 
  (lambda values
    (define (listify arguments)
      (if (pair? (cdr arguments))
          (cons (car arguments) (listify (cdr arguments)))
          (car arguments) ) )
    (invoke (car values) (listify (cdr values))) )
  2 )

Exercice 53 : Changer la représentation des fonctions afin que la valeur de cons dans le Scheme interprété soit la valeur de cons dans le Scheme sous-jacent. Réécrire alors list et apply.

Solution de l'exercice 53 :
;;; representation differente des fonctions.
(define (make-function variables body env)
  (lambda values
    (eprogn body (extend env variables values)) ) ) 
(define (invoke fn args)
  (if (procedure? fn)
      (apply fn args)
      (wrong "Not a function" fn) ) ) 
;;; Ici la verification d'arite est laissee a l'implantation.
(define-macro (defprimitive name value arity)
  `(definitial ,name ,value) ) 
(defnaryprimitive list list 0) 
(defnaryprimitive apply apply 2)

Exercice 54 : Modifier l'affectation afin qu'elle crée les variables si inexistantes.

Solution de l'exercice 54 : Les variables sont créées ici au niveau global. Il suffira de remplacer update! par update!!.
;;; Une variante qui cree les variables inexistantes au niveau global.
(define (update!! id env value)
  (if (pair? env)
      (if (eq? (caar env) id)
          (begin (set-cdr! (car env) value)
                 value )
          (update!! id (cdr env) value) )
      (begin (set-cdr! (last-pair env.global)
                       (list (cons id value)) )
             value ) ) )

Exercice 55 : Compte-tenu de l'interprète donné ci-avant, ajouter le code nécessaire permettant de tracer l'évaluation des expressions qui lui sont soumises.

Solution de l'exercice 55 : On ajoutera par exemple en tête de la fonction evaluate, la verrue suivante:
(define (evaluate e env)
  (display `(evaluation de ,e))(newline)
  (let ((resultat code original))
     (display `(le resultat est ,resultat))(newline)
     resultat ) ) 

Exercice 56 : Au lieu d'imprimer bestialement, procurer à l'utilisateur la possibilité d'indiquer les seuls appels qu'il souhaite voir (cf. trace) ou bien lui offrir une nouvelle boucle d'interaction locale lui permettant d'inspecter l'environnement.

Solution de l'exercice 56 : On écrira par exemple:
(define (evaluate e env)
  (display `(ATTENTION je vais evaluer ,e))(newline)
  (toplevel env)      ; une boucle d'interactions
  (let* ((resultat code original)
         (nom 'resultat)
         (env (extend env (list nom) (list resultat))) )
     (display `(ATTENTION le ,nom est ,resultat))(newline)
     (toplevel env)   ; une autre boucle d'interactions
     (lookup nom) ) ) 

Exercice 57 : Modifier l'interprète précédent pour qu'un nombre en position fonctionnelle soit analogue à un sélecteur de liste. Un nombre positif correspondra à cadnr tandis qu'un nombre négatif correspondra à cd-nr. Par exemple
? (NOUVEL-EVAL '(2 '(A B C D)))
= C 
? (NOUVEL-EVAL '(-2 '(A B C D)))
= (C D)  

Solution de l'exercice 57 : On raffinera la fonction invoke pour accepter les nombres.
;;; Id: natScheme3.scm,v 1.1 1996/09/19 13:06:45 queinnec Exp
(define (invoke fn args)
  (cond ((procedure? fn)
         (apply fn args) )
        ((integer? fn) 
         (if (>= fn 0) (list-ref (car args) fn)
                      (list-tail (car args) (- fn)) ) )
        (else (wrong "Cannot invoke" fn)) ) )

Exercice 58 : Modifier l'interprète précédent afin d'autoriser une écriture infixe des fonctions. Par exemple:
? (AUTRE-EVAL '(1 + (3 * 4)))
= 13  

Solution de l'exercice 58 : On raffinera encore invoke pour accepter cette syntaxe.
;;; Id: natScheme4.scm,v 1.1 1996/09/19 13:06:26 queinnec Exp
(define (invoke fn args)
  (cond ((procedure? fn)
         (apply fn args) )
        ((and (pair? args) (procedure? (car args)))
         (invoke (car args) (cons fn (cdr args))) )
        (else (wrong "Cannot invoke" fn)) ) )

Macro-expansion

Exercice 59 : Ajouter une phase de macroexpansion à l'interprète. On commencera par écrire une fonction prenant une expression, l'arpentant et remplaçant toute expression, dont le car est un symbole connu, par le résultat de l'expanseur associé à ce symbole. Ensuite on insérera ce macro-expanseur dans la boucle d'interaction et on créera une macro prédéfinie de définition de macros. Voici un exemple:
? (define-macro (foo x) 
    (list 'quote (list x x)) )
= foo
? (foo 3)
= (3 3) 

Solution de l'exercice 59 : Le modèle qui suit ne permet pas de macro locales. Il ne procure qu'un unique définisseur de macro define-macro. Celui-ci communique avec le macro-expanseur à l'aide d'une variable partagée. On notera l'usage d'evaluate pour convertir, à la volée, le texte de l'expanseur en une fonction invoquable. On notera aussi la reconnaissance de la citation pour éviter d'expanser son paramètre. Voici tout d'abord l'expanseur:
(define (expand-expression e)
  (if (pair? e)
      (case (car e)
        ((quote) e)
        ((lambda) `(lambda ,(cadr e) . ,(expand-expressions (cddr e))))
        (else 
         (let ((expander (assoc (car e) macro-env)))
           (if (pair? expander)
               ;; Utiliser le protocole d'appel du Scheme interprété.
               (let ((ee (invoke (cdr expander) (list e))))
                 (expand ee) )
               (expand-expressions e) ) ) ) )
      e ) ) 
(define (expand-expressions e*)
  (if (pair? e*)
      (cons (expand-expression (car e*))
            (expand-expressions (cdr e*)) )
      e* ) ) 
(define macro-env 
  (list (cons 'define-macro macro-definer)) )
Voici la macro prédéfinie de création de macros. La variable macro-env est une variable interne a l'implantation. On pourrait aussi la rendre visible du Scheme interprété.
(define (macro-definer e)
  (let* ((call (cadr e))
         (body (cddr e))
         (name (car call))
         (vars (cdr call)) )
    ;; macro-env est partagé avec expand-expression.
    (set! macro-env
          ;; Il faut évaluer l'expanseur pour qu'il puisse être invoqué
          (cons (cons name (evaluate `(lambda (e) 
                                        (apply (lambda ,vars . ,body) 
                                               (cdr e) ) )
                                     env.predefined ) )
                macro-env ) )
    `(quote ,name) ) )
Puis une façon d'intégrer le macro-expanseur à la boucle d'évaluation. On utilisera une variable du Scheme interprété pour contenir l'expanseur courant.
(define (scheme2)
  (display "Bienvenue !")
  (newline)
  (let toplevel ()
    (display "?? ")
    (let ((e (expand-program (read))))
      (if (eof-object? e)
          (begin (display ";;; end")
                 (newline) )
          (let ((r (evaluate e env.global)))
            (display "== ")
            (display r)
            (newline)
            (toplevel) ) ) ) ) ) 
(set! env.predefined
      (cons (cons 'expand expand-expression)
            ;; copie l'environnement global afin d'être indépendant.
            (append env.global '()) ) ) 
(define (expand-program e)
  (evaluate `(expand ',e) env.predefined) )

Précédent Index Suivant