Solutionnaire au TP#2

Programme original:

======================================================================
(define compute-checksum
  (lambda (str)
    (let ((n 0))
      (let iter ((i (- (string-length str) 1)))
	(if (>= i 0)
	    (begin
	      (set! n (modulo (+ n (char->integer (string-ref str i)))
			      1024))
	      (iter (- i 1)))
	    n)))))

(define run
  (lambda ()
    (compute-checksum "Ceci est un texte qui sert d'exemple.")))
======================================================================

En premier lieu, on élimine le `let' nommé:

======================================================================
(define compute-checksum
  (lambda (str)
    (let ((n 0))
      (let ((iter #f))
	(set! iter
	      (lambda (i)
		(if (>= i 0)
		    (begin
		      (set! n (modulo (+ n (char->integer (string-ref str i)))
				      1024))
		      (iter (- i 1)))
		    n)))
	(iter (- (string-length str) 1))))))

(define run
  (lambda ()
    (compute-checksum "Ceci est un texte qui sert d'exemple.")))
======================================================================

Ensuite, on élimine les `let' ordinaires:

======================================================================
(define compute-checksum
  (lambda (str)
    ((lambda (n)
       ((lambda (iter)
	 (set! iter
	       (lambda (i)
		 (if (>= i 0)
		     (begin
		       (set! n (modulo (+ n (char->integer (string-ref str i)))
				       1024))
		       (iter (- i 1)))
		     n)))
	 (iter (- (string-length str) 1)))
	#f))
     0)))

(define run
  (lambda ()
    (compute-checksum "Ceci est un texte qui sert d'exemple.")))
======================================================================

Pour effectuer la transformation vers des fermetures chaînées, il faut
premièrement implanter `list-set!'.  Noter que ce doit être une
version destructrice, i.e. qui modifie vraiment le contenu d'une paire
dans la liste.  Ensuite, il faut changer les noms des variables du
niveau usager.  Enfin, il faut ajouter l'ensemble des fonctions
utilitaires nécessaires.

======================================================================
(define env
  '())

(define clos-arity
  (lambda (f)
    (vector-ref f 0)))

(define clos-code
  (lambda (f)
    (vector-ref f 1)))

(define clos-env
  (lambda (f)
    (vector-ref f 2)))

(define clos?
  (lambda (f)
    (and (vector? f)
	 (= (vector-length f) 3))))

(define clos0?
  (lambda (f)
    (and (clos? f)
	 (equal? (clos-arity f) 0))))

(define clos1?
  (lambda (f)
    (and (clos? f)
	 (equal? (clos-arity f) 1))))

(define clos2?
  (lambda (f)
    (and (clos? f)
	 (equal? (clos-arity f) 2))))

(define make-clos0
  (lambda (f env)
    (vector 0 f env)))

(define make-clos1
  (lambda (f env)
    (vector 1 f env)))

(define make-clos2
  (lambda (f env)
    (vector 2 f env)))

(define clos-apply0
  (lambda (f)
    (if (clos0? f)
	((clos-code f)
	 (clos-env f))
	(error "in clos-apply0"))))

(define clos-apply1
  (lambda (f x1)
    (if (clos1? f)
	((clos-code f)
	 (cons x1 (clos-env f)))
	(error "in clos-apply1"))))

(define clos-apply2
  (lambda (f x1 x2)
    (if (clos2? f)
	((clos-code f)
	 (cons x1 (cons x2 (clos-env f))))
	(error "in clos-apply2"))))

(define list-set!
  (lambda (lst i x)
    (if (= i 0)
	(set-car! lst x)
	(list-set! (cdr lst) (- i 1) x))))

(define user-+
  (make-clos2
   (lambda (env)  ; x y
     (+ (list-ref env 0) (list-ref env 1)))
   env))

(define user--
  (make-clos2
   (lambda (env)  ; x y
     (- (list-ref env 0) (list-ref env 1)))
   env))

(define user-modulo
  (make-clos2
   (lambda (env)  ; x y
     (modulo (list-ref env 0) (list-ref env 1)))
   env))

(define user->=
  (make-clos2
   (lambda (env)  ; x y
     (>= (list-ref env 0) (list-ref env 1)))
   env))

(define user-string-length
  (make-clos1
   (lambda (env)  ; str
     (string-length (list-ref env 0)))
   env))

(define user-string-ref
  (make-clos2
   (lambda (env)  ; str i
     (string-ref (list-ref env 0) (list-ref env 1)))
   env))

(define user-char->integer
  (make-clos1
   (lambda (env)  ; c
     (char->integer (list-ref env 0)))
   env))

(define user-compute-checksum
  (make-clos1
   (lambda (env)  ; str
     (clos-apply1
      (make-clos1
       (lambda (env)  ; n str
	 (clos-apply1
	  (make-clos1
	   (lambda (env)  ; iter n str
	     (list-set! env 0
	       (make-clos1
		(lambda (env)  ; i iter n str
		  (if (clos-apply2 user->= (list-ref env 0) 0)
		    (begin
		      (list-set! env 2
			(clos-apply2
			 user-modulo
			 (clos-apply2
			  user-+
			  (list-ref env 2)
			  (clos-apply1
			   user-char->integer
			   (clos-apply2
			    user-string-ref
			    (list-ref env 3)
			    (list-ref env 0))))
			 1024))
		      (clos-apply1
		       (list-ref env 1)
		       (clos-apply2
			user--
			(list-ref env 0)
			1)))
		    (list-ref env 2)))
		env))
	     (clos-apply1
	      (list-ref env 0)
	      (clos-apply2
	       user--
	       (clos-apply1
		user-string-length
		(list-ref env 2))
	       1)))
	   env)
	  #f))
       env)
      0))
   env))

(define user-run
  (make-clos0
   (lambda (env)  ;
     (clos-apply1
      user-compute-checksum
      "Ceci est un texte qui sert d'exemple."))
   env))
======================================================================

Avant d'effectuer la transformation vers des fermetures plates, il
faut éliminer les variables locales mutables.

======================================================================
(define make-box
  (lambda (x)
    (vector x)))

(define box-ref
  (lambda (b)
    (vector-ref b 0)))

(define box-set
  (lambda (b x)
    (vector-set! b 0 x)))

(define compute-checksum
  (lambda (str)
    ((lambda (n)
       ((lambda (n)
	  ((lambda (iter)
	     ((lambda (iter)
		(box-set iter
		  (lambda (i)
		    (if (>= i 0)
		      (begin
			(box-set n (modulo (+ (box-ref n)
					      (char->integer
					       (string-ref str i)))
					   1024))
			((box-ref iter) (- i 1)))
		      (box-ref n))))
		((box-ref iter) (- (string-length str) 1)))
	      (make-box iter)))
	   #f))
	(make-box n)))
     0)))

(define run
  (lambda ()
    (compute-checksum "Ceci est un texte qui sert d'exemple.")))
======================================================================

Ensuite, on peut effectuer la transformation vers les fermetures
plates.  Encore une fois, il faut changer les noms des variables du
niveau usager et ajouter les fonctions utilitaires.  (Note: on
considère que les fonctions reliées à la manipulation des boîtes est
déjà au niveau système.)

======================================================================
(define make-box
  (lambda (x)
    (vector x)))

(define box-ref
  (lambda (b)
    (vector-ref b 0)))

(define box-set
  (lambda (b x)
    (vector-set! b 0 x)))

(define clos-arity
  (lambda (f)
    (vector-ref f 0)))

(define clos-code
  (lambda (f)
    (vector-ref f 1)))

(define clos-var1
  (lambda (f)
    (vector-ref f 2)))

(define clos-var2
  (lambda (f)
    (vector-ref f 3)))

(define clos-var3
  (lambda (f)
    (vector-ref f 4)))

(define clos?
  (lambda (f)
    (and (vector? f) (>= (vector-length f) 2))))

(define clos0?
  (lambda (f)
    (and (clos? f)
	 (= (clos-arity f) 0))))

(define clos1?
  (lambda (f)
    (and (clos? f)
	 (= (clos-arity f) 1))))

(define clos2?
  (lambda (f)
    (and (clos? f)
	 (= (clos-arity f) 2))))

(define make-clos0-0
  (lambda (f)
    (vector 0 f)))

(define make-clos1-0
  (lambda (f)
    (vector 1 f)))

(define make-clos1-1
  (lambda (f x1)
    (vector 1 f x1)))

(define make-clos1-2
  (lambda (f x1 x2)
    (vector 1 f x1 x2)))

(define make-clos1-3
  (lambda (f x1 x2 x3)
    (vector 1 f x1 x2 x3)))

(define make-clos2-0
  (lambda (f)
    (vector 2 f)))

(define clos-apply0
  (lambda (f)
    (if (clos0? f)
	((clos-code f) f)
	(error "in clos-apply0"))))

(define clos-apply1
  (lambda (f x1)
    (if (clos1? f)
	((clos-code f) f x1)
	(error "in clos-apply1"))))

(define clos-apply2
  (lambda (f x1 x2)
    (if (clos2? f)
	((clos-code f) f x1 x2)
	(error "in clos-apply2"))))

(define user-+
  (make-clos2-0
   (lambda (clos x y)
     (+ x y))))

(define user--
  (make-clos2-0
   (lambda (clos x y)
     (- x y))))

(define user->=
  (make-clos2-0
   (lambda (clos x y)
     (>= x y))))

(define user-modulo
  (make-clos2-0
   (lambda (clos x y)
     (modulo x y))))

(define user-string-length
  (make-clos1-0
   (lambda (clos str)
     (string-length str))))

(define user-string-ref
  (make-clos2-0
   (lambda (clos str i)
     (string-ref str i))))

(define user-char->integer
  (make-clos1-0
   (lambda (clos c)
     (char->integer c))))

(define user-compute-checksum
  (make-clos1-0
   (lambda (clos user-str)  ; clos:
     (clos-apply1
      (make-clos1-1
       (lambda (clos user-n)  ; clos: str
	 (clos-apply1
	  (make-clos1-1
	   (lambda (clos user-n)  ; clos: str
	     (clos-apply1
	      (make-clos1-2
	       (lambda (clos user-iter)  ; clos: str n
		 (clos-apply1
		  (make-clos1-2
		   (lambda (clos user-iter)  ; clos: str n
		     (box-set user-iter
		       (make-clos1-3
			(lambda (clos user-i)  ; clos: str n iter
			  (if (clos-apply2
			       user->=
			       user-i
			       0)
			    (begin
			      (box-set (clos-var2 clos)
				(clos-apply2
				 user-modulo
				 (clos-apply2
				  user-+
				  (box-ref (clos-var2 clos))
				  (clos-apply1
				   user-char->integer
				   (clos-apply2
				    user-string-ref
				    (clos-var1 clos)
				    user-i)))
				 1024))
			      (clos-apply1
			       (box-ref (clos-var3 clos))
			       (clos-apply2
				user--
				user-i
				1)))
			    (box-ref (clos-var2 clos))))
			(clos-var1 clos) (clos-var2 clos) user-iter))
		     (clos-apply1
		      (box-ref user-iter)
		      (clos-apply2
		       user--
		       (clos-apply1
			user-string-length
			(clos-var1 clos))
		       1)))
		   (clos-var1 clos) (clos-var2 clos))
		  (make-box user-iter)))
	       (clos-var1 clos) user-n)
	      #f))
	   (clos-var1 clos))
	  (make-box user-n)))
       user-str)
      0))))

(define user-run
  (make-clos0-0
   (lambda (clos)  ; clos:
     (clos-apply1
      user-compute-checksum
      "Ceci est un texte qui sert d'exemple."))))
======================================================================