;#lang racket ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Programme support du MOOC programmation récursive ;;; Copyright (C) 2013-2015 Christian.Queinnec@paracamplus.com ;;; ;;; This program is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation, either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; MOOC Programmation récursive http://programmation-recursive.net/ ;;; Ce code est écrit en Racket http://racket-lang.org/ ;;; il procure quelques fonctions et macros correspondant au dialecte ;;; Scheme enseigné dans le MOOC Programmation récursive et permettant ;;; de travailler les exercices en Racket plutôt que dans son navigateur ;;; avec MrScheme (dû à Frédéric Peschanski frederic.peschanski@lip6.fr) ;;; L'apport principal de ce fichier est de procurer une implantation ;;; de la forme (verifier ...) qui permet d'écrire des tests et une ;;; implantation des barrières d'abstraction des arbres binaires ou ;;; généraux. ;;; Ce fichier doit être évalué avant de commencer à travailler les ;;; exercices. Lorsque votre solution à un exercice est au point, vous ;;; pourrez alors la copier dans MrScheme afin d'obtenir un rapport de ;;; correction. ;;; Pour l'utiliser, indiquez simplement en première ligne ;;; (include "./li101.rkt") ;;; en adaptant le chemin vers ce fichier si d'aventure il n'est ;;; pas dans le répertoire courant, celui où vous avez lancé DrRacket. ;;; Une implantation simpliste de la forme verifier. ;;; Elle n'indique pas le test defaillant, etc. (define-syntax verifier (syntax-rules (=> -> ERREUR) ((verifier f) "OK") ((verifier f exp => ERREUR rest ...) (begin (display (list 'checking 'exp)) (newline) (if (with-handlers (((lambda (v) #t) (lambda (v) #t))) (begin exp #f) ) (verifier f rest ...) (li101-error "L'erreur attendue n'est pas survenue!?") ) ) ) ((verifier f exp -> ERREUR rest ...) (begin (display (list 'checking 'exp)) (newline) (if (with-handlers (((lambda (v) #t) (lambda (v) #t))) (begin exp #f) ) (verifier f rest ...) (li101-error "L'erreur attendue n'est pas survenue!?") ) ) ) ((verifier f exp => value rest ...) (begin (display (list 'checking 'exp)) (newline) (let ((v (with-handlers (((lambda (v) #t) (lambda (v) v))) exp ))) (if (exn? v) (li101-error "Erreur inattendue:" v) (if (equal? v 'value) (verifier f rest ...) (li101-error "Pas la valeur attendue" v) ) ) ) ) ) ((verifier f exp -> value rest ...) (begin (display (list 'checking 'exp)) (newline) (let ((v (with-handlers (((lambda (v) #t) (lambda (v) v))) exp ))) (if (exn? v) (li101-error "Erreur inattendue:" v) (if (equal? v 'value) (verifier f rest ...) (li101-error "Pas la valeur attendue" v) ) ) ) ) ) ) ) ;;; Adaptation a DrRacket (define (li101-error . msgs) (raise msgs) ) (define erreur li101-error) (define pp pretty-print) ;;; Une implantation des arbres (define (ab-vide) (vector '**EmptyBinTree**) ) (define (ab? ab) (and (vector? ab) (let ((vl (vector-length ab))) (or (= 1 vl) (= 4 vl)) ) (memq (vector-ref ab 0) '(**BinTree** **EmptyBinTree**) ) ) ) (define (ab-noeud tag left right) (if (ab? left) (if (ab? right) (vector '**BinTree** tag left right) (li101-error 1150 'ab-noeud "Fils droit non arbre binaire!") ) (li101-error 1151 'ab-noeud "Fils gauche non arbre binaire!") ) ) (define (ab-noeud? ab) (if (ab? ab) (= 4 (vector-length ab)) (li101-error 1152 'ab-noeud? "Pas un arbre binaire" ab) ) ) (define (ab-etiquette ab) (and (ab-noeud? ab) (vector-ref ab 1) ) ) (define (ab-gauche ab) (and (ab-noeud? ab) (vector-ref ab 2) ) ) (define (ab-droit ab) (and (ab-noeud? ab) (vector-ref ab 3) ) ) (define (ab-affiche ab) (if (ab? ab) (begin (pp ab) #t) ; pour ne pas rendre #unspecified (li101-error 1153 'ab-affiche "Pas un arbre binaire" ab) ) ) ;;; bibliotheque arbres generaux (define (ag-noeud tag forest) (if (andmap ag? forest) (vector '**GeneralTree** tag forest) (li101-error 1154 'ag-noeud "Un terme de la forêt n'est pas un arbre général") ) ) (define (ag? ag) (and (vector? ag) (= 3 (vector-length ag)) (eq? (vector-ref ag 0) '**GeneralTree**) ) ) (define (ag-etiquette ag) (if (ag? ag) (vector-ref ag 1) (li101-error 1155 'ag-etiquette "Pas un arbre général" ag) ) ) (define (ag-foret ag) (if (ag? ag) (vector-ref ag 2) (li101-error 1156 'ag-etiquette "Pas un arbre général" ag) ) ) (define (ag-affiche ag) (if (ag? ag) (begin (pp ag) #t) ; pour ne pas rendre #unspecified (li101-error 1157 'ag-affiche "Pas un arbre général" ag) ) ) ;;; end of li101.rkt