X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Futils.scm;h=5f56f0528703c5ad3d92da0e538d475019e48060;hb=HEAD;hp=f2b339aa18ebbbfe365490ec59037f12dd3bb697;hpb=76eb79c269dde7cc5c0660803bdd37ae3fdd8cb0;p=gacela.git

diff --git a/src/utils.scm b/src/utils.scm
index f2b339a..5f56f05 100644
--- a/src/utils.scm
+++ b/src/utils.scm
@@ -1,5 +1,5 @@
 ;;; Gacela, a GNU Guile extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
 ;;;
 ;;; 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
@@ -16,27 +16,18 @@
 
 
 (define-module (gacela utils)
-  #:use-module (ice-9 session)
-  #:export (use-cache-with
-	    procedure-header))
+  #:export (make-producer))
 
-
-;;; Cache for procedures
-(define (use-cache-with proc)
-  (let ((cache (make-weak-value-hash-table)))
-    (lambda (. param)
-      (let* ((key param)
-	     (res (hash-ref cache key)))
-	(cond (res res)
-	      (else
-	       (set! res (apply proc param))
-	       (hash-set! cache key res)
-	       res))))))
-
-
-;;; Retrive header definition of a procedure
- (define (procedure-header proc)
-   (let* ((args (procedure-arguments proc))
- 	 (name (procedure-name proc))
- 	 (required (cdar args)))
-     (cons name required)))
+(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))))