Exercice 1. Supposez qu'une implantation de Scheme utilise le type suivant pour représenter les symboles : (define-type symbol name ; chaîne correspondant au symbole, i.e. "foo" pour le symbole foo ) Implantez les fonctions (string->symbol str) et (symbol->string sym) à l'aide de tables. Souvenez-vous que (eq? (string->symbol "a") (string->symbol "a")) doit être #t. Quel genre de table doit-on utiliser? Implantez aussi une fonction (gensym) qui retourne un nouveau symbole et dont le nom est tiré de la séquence g1, g2, g3, ... Solution : (define-type symbol name) ;; Utilise une table str2sym avec weak-values=#t pour que les ;; symboles ne soient gardés par le garbage-collector que si le ;; symbole est toujours utilisé par le programme. (define str2sym (make-table test: string=? weak-values: #t)) (define (string->symbol str) (or (table-ref str2sym str #f) (let ((sym (make-symbol str))) (table-set! str2sym str sym) sym))) (define (symbol->string sym) (symbol-name sym)) ;; Note: gensym n'entre pas le symbole dans la table ;; de symbole. (define gensym (let ((count 0)) (lambda () (set! count (+ count 1)) (make-symbol (string-append "g" (number->string count)))))) Exercice 2. En classe nous avons vu comment implanter avec une table la fonction (object->serial-number obj) qui associe un numéro de série à tout objet, et qui permet au garbage collector de récupérer la mémoire occupée par cet objet lorsqu'il n'est plus accessible. Comment peut-on supporter simultanément la fonction (object->serial-number obj) et (serial-number->object obj) tout en permettant au garbage collector de récupérer la mémoire occupée par cet objet lorsqu'il n'est plus accessible? Qu'arrive-t'il si on entre le numéro de série d'un objet qui a été récupéré? Implantez votre solution et faites des tests pour montrer qu'elle fonctionne. Solution : (define ns 0) (define (++ns) (set! ns (+ ns 1)) ns) (define o2ns (make-table test: eq? weak-keys: #t)) (define ns2o (make-table test: = weak-values: #t)) (define (obj->ns o) (or (table-ref o2ns o #f) (let ((n (++ns))) (table-set! o2ns o n) (table-set! ns2o n o) n))) (define (ns->obj n) (table-ref ns2o n)) ;; erreur si n n'est plus dans la table Exercice 3. La fonction de hachage pour les tables "eq?" est la fonction eq?-hash. Donnez le pseudo-code d'une implantation de eq?-hash dans le contexte d'un récupérateur mémoire non-copiant (c'est-à-dire qui ne déplace pas les objets en mémoire). Solution : (define (eq?-hash obj) (object-address obj)) ;; obtient l'adresse mémoire de l'objet obj Exercice 4. Écrivez une macro for qui permet de faire des boucles sur un intervalle d'entiers. Voici un exemple d'utilisation de la macro for : > (for i 1 10 (write i) (display " ") (write (* i i)) (newline)) 1 1 2 4 3 9 4 16 5 25 6 36 7 49 8 64 9 81 10 100 Construisez le code généré avec list et cons. Ensuite faites une nouvelle implantation de cette macro avec quasiquote. Est-ce que votre macro évite les problèmes de conflits de nom? Solution : (define-macro (for var lo hi . body) (list 'let 'loop (list (list var lo)) (list 'if (list '<= var hi) (append '(begin) body (list (list 'loop (list '+ var 1))))))) (define-macro (for var lo hi . body) `(let loop ((,var ,lo)) (if (<= ,var ,hi) (begin ,@body (loop (+ ,var 1)))))) ;; Ces définitions ont un problème de conflit de nom. Il y a un ;; problème lorsque le corps de la boucle réfère à l'identificateur ;; "loop" : ;; ;; (let ((loop 10)) (for i 1 10 (write (* loop i)))) ;; ;; et aussi si la variable d'itération se nomme "loop" : ;; ;; (for loop 1 10 (write loop)) ;; ;; Un autre problème, non-relié aux conflits de nom, c'est que ;; "hi" est évalué autant de fois que la boucle (il serait mieux ;; de calculer la borne supérieure au début de la boucle et la ;; stocker dans une variable... mais cela créerait un autre ;; problème de conflit de nom!). ;; ;; Voici une solution qui n'a pas ces problèmes. (define-macro (for var lo hi . body) (let ((loopvar (gensym)) (hivar (gensym))) `(let ((,hivar ,hi)) (let ,loopvar ((,var ,lo)) (if (<= ,var ,hivar) (begin ,@body (,loopvar (+ ,var 1)))))))) Exercice 5. Implantez la forme spéciale define-type dans sa forme la plus simple (aucun héritage, aucun attributs de champs et aucun prédicat pour tester le type). Utilisez les vecteurs pour représenter les enregistrements. Par exemple la définition de type (define-type point x y) devrait être expansée en (begin (define make-point vector) (define point-x (lambda (obj) (vector-ref obj 0))) (define point-x-set! (lambda (obj val) (vector-set! obj 0 val))) (define point-y (lambda (obj) (vector-ref obj 1))) (define point-y-set! (lambda (obj val) (vector-set! obj 1 val)))) Solution : (define-macro (define-type type-name . fields) (define (intervalle lo hi) (if (< lo hi) (cons lo (intervalle (+ lo 1) hi)) '())) (define type-name-str (symbol->string type-name)) (define gen-accessors (lambda (n i) (let* ((prefix (string-append type-name-str "-" (symbol->string n))) (setter (string->symbol (string-append prefix "-set!"))) (getter (string->symbol prefix))) `((define ,getter (lambda (obj) (vector-ref obj ,i))) (define ,setter (lambda (obj val) (vector-set! obj ,i val))))))) `(begin (define ,(string->symbol (string-append "make-" (symbol->string type-name))) vector) ,@(apply append (map gen-accessors fields (intervalle 0 (length fields))))))