X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Futils.scm;h=d63a51148f2a8f590ae1e2a545abc8dc49d5dd16;hb=f02971f747ab2e643e2bc6bd962a068329b0f402;hp=28cc16346524e78c189e7ef194906a37e6c9dad0;hpb=d87136a9ca74b0b145800e362144eeefff803eba;p=gacela.git

diff --git a/src/utils.scm b/src/utils.scm
index 28cc163..d63a511 100644
--- a/src/utils.scm
+++ b/src/utils.scm
@@ -18,7 +18,9 @@
 (define-module (gacela utils)
   #:export (use-cache-with
 	    arguments-calling
-	    arguments-apply))
+	    arguments-apply
+	    bound?
+	    make-producer))
 
 
 ;;; Cache for procedures
@@ -44,7 +46,10 @@
 (define (required-arguments args values)
   "Return an alist with required arguments and their values"
   (define (f vars values)
-    (cond ((or (null? vars) (null? values)) '())
+    (cond ((null? vars) '())
+	  ((null? values) (assoc-set! (f (cdr vars) '())
+				      (car vars)
+				      undefined))
 	  (else (assoc-set! (f (cdr vars) (cdr values))
 			    (car vars)
 			    (car values)))))
@@ -139,3 +144,20 @@
 	    (optional-arguments-apply args values)
 	    (keyword-arguments-apply args values)
 	    (rest-arguments-apply args values))))
+
+
+;;; 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))))