X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Futils.scm;h=ed09712d9a990531d9e9daecdc81e1131596aed1;hb=bdc03bcc2da4d01745fb542d7a7d642b888b691e;hp=33b245ff153c300affe7f2819d5968a9135a690f;hpb=938de63713779c6777d54cd962ec82ee64744abc;p=gacela.git

diff --git a/src/utils.scm b/src/utils.scm
index 33b245f..ed09712 100644
--- a/src/utils.scm
+++ b/src/utils.scm
@@ -18,7 +18,10 @@
 (define-module (gacela utils)
   #:export (use-cache-with
 	    arguments-calling
-	    arguments-apply))
+	    arguments-apply
+	    bound?
+	    names-arguments
+	    make-producer))
 
 
 ;;; Cache for procedures
@@ -142,3 +145,33 @@
 	    (optional-arguments-apply args values)
 	    (keyword-arguments-apply args values)
 	    (rest-arguments-apply args values))))
+
+(define (names-arguments args)
+  (map (lambda (x) (if (list? x) (car x) x))
+       (filter (lambda (x) (not (keyword? x)))
+	       (pair-to-list args))))
+
+
+;;; Continuations and coroutines
+
+(define (make-producer body)
+  (define resume #f)
+  (lambda (real-send)
+    (define send-to real-send)
+    (define (send value-to-send)
+      (set! send-to
+	    (call/cc
+	     (lambda (k)
+	       (set! resume k)
+	       (send-to value-to-send)))))
+    (if resume
+        (resume real-send)
+        (body send))))
+
+
+;;; Miscellaneous
+
+(define (pair-to-list pair)
+  (cond ((null? pair) '())
+	((not (pair? pair)) (list pair))
+	(else (cons (car pair) (pair-to-list (cdr pair))))))