nothus

Ne trouvant mon bonheur, j'ai testé quelques combinaisons pour me rapprocher des coroutines... Il ne s'agit pas réellement de coroutines, car il n'y a pas suspension de l'exécution d'une fonction. La lambda utilisée ici comme un itérateur (closure), peut recevoir des arguments lors de l'appel (ce n'est pas le cas dans mon exemple). Ainsi vous pouvez facilement émettre et recevoir à chaque appel des valeurs.

Code lisp :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
(define-condition coroutine-terminee (error)
	( (message :initarg :message) )
) 
 
(defmacro coroutiner-simple (corps) 
	`(let 
		( (corps ,corps) (etape nil) ) 
		(lambda () 
			(setf etape (car corps)) 
			(setf corps (cdr corps)) 
			(if (eq etape nil) 
				(error 'coroutine-terminee :message "coroutine terminée") ; inutile de continuer à renvoyer "nil" 
				(eval etape) 
			) 
		) 
	) 
) 
 
;;; Test n°1 
 
(defvar test (coroutiner-simple '( 
	(print "ok") 
	(print "ko")
))) 
 
(funcall test) ; étape 1 / affichera "ok" 
(funcall test) ; étape 2 / affichera "ko" 
(funcall test) ; étape ? / lève une erreur (la coroutine a terminée) 
 
;;; Test n°2 
 
(defvar test2 (coroutiner-simple '(
	( (print "début") (print "0") ) ; évaluation impossible (expression incorrecte) 
	(print "1") 
	(print "2")
))) ; ne fonctionnera pas 
 
;;; Test n°3 
 
(defvar test3 (coroutiner-simple '( 
	(progn (print "début") (print "0")) 
	(print "1") 
	(print "2") 
))) 
 
(funcall test3) ; étape 1 / affichera "début" puis "0" 
(funcall test3) ; étape 2 / affichera "1" 
(funcall test3) ; étape 3 / affichera "2" 
; un appel supplémentaire provoquera une erreur (la coroutine a terminée)

Édition, même jour : la même version, à cette différence que la coroutine est enregistrée dans une variable globale et dont l'avancement se fait via une fonction qui a pour argument le nom de la coroutine voulue. L'intérêt à terme étant d'avoir une boucle unique des coroutines, afin de les gérer collectivement. Attention, une fonction bloquante reste bloquante... pour l'ensemble.

Code lisp :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#!/usr/bin/sbcl --script 
 
(defparameter *coroutines* (make-hash-table :test 'equal)) 
 
(define-condition coroutine-terminee (error)
	( (message :initarg :message) )
) 
 
(defmacro coroutiner-simple (nom corps) 
	`(let 
		( (corps ,corps) (etape nil) (clos nil) ) 
		(setf 
			clos 
			(lambda () 
				(setf etape (car corps)) 
				(setf corps (cdr corps)) 
				(if (eq etape nil) 
					(error 
						'coroutine-terminee 
						:message "coroutine terminée"
					) 
					(progn 
						(eval etape) 
						(force-output) ; évite un arrêt du script avant l'affichage dans notre cas 
					) 
				) 
			) 
		) 
		(setf (gethash ,nom *coroutines*) clos) 
	) 
) 
 
(defun coroutine-avancer (nom) 
	(funcall (gethash nom *coroutines*)) 
) 
 
(coroutiner-simple "test" '( 
	(print "ok") 
	(print "ko")
)) 
 
(coroutine-avancer "test") ; étape 1 / afficher "ok" 
; (coroutine-avancer "test") ; étape 2 / afficher "ko"

Un exemple avec une variable "interne" :

Code lisp :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(coroutiner-simple "test2" '( 
	(print "début") 
	(defvar i 0)
	(print i) 
	(setf i 1) 
	(print i) 
	(print "fin") 
)) 
 
(coroutine-avancer "test2") ; "début"
(coroutine-avancer "test2") ; (rien) 
(coroutine-avancer "test2") ; 0 
(coroutine-avancer "test2") ; (rien) 
(coroutine-avancer "test2") ; "1" 
(coroutine-avancer "test2") ; "fin"

Bon code à tous !