#!/usr//bin/env csi
(use srfi-18)

;; Be a construction worker (at least that's where I learned the
;; phrase).  PURPOSE: make sure some other threads *will* do their
;; jobs.

(define (seem-to-be-busy! income)
  (thread-sleep! (+ (/ income 10000.0)
		    (let ((p0 (/ (random 1000) 1000.0)))
		      (+ p0 (* p0 p0 p0))))))

(define hand 2000.0)			; low income

(define bigfish 10000.0)

(define-syntax hurry-up!
  (syntax-rules ()
    ((_ sentence) (begin sentence sentence sentence))))

;; An artificial version of "map" trying to have some time off during
;; working hours.
;;
;; Returns AS IF the promise had been force just one time BUT returns
;; only the first result, ignoring cost.

(define (map-force lst)
  (hurry-up!
   (for-each
    (lambda (element)
      (let ((t (make-thread (lambda () (force element)))))
	(thread-start! t)))
    lst))
  (seem-to-be-busy! bigfish)
  (map force lst))

;; Citing R7RS section 4.2.5: try to "illustrate the property that
;; only one value is computed for a promise, no matter how many times
;; it is forced illustrate the property that only one value is
;; computed for a promise, no matter how many times it is forced"

(define count 0)

(define workload-mux (make-mutex))
(define workload '())

;; A single promise to test.
(define p
  (delay
    (let ((n (random 1000)))
      (seem-to-be-busy! hand)
      (begin
	(mutex-lock! workload-mux)
	(set! workload (cons n workload))
	(mutex-unlock! workload-mux))
      n)))

(define input (list p p p p p p))

(define output (map-force input))

;; Now we find:

(format #t "\nAs expected - only one (the fastest) result ~a times:\n~a\n"
	(length input) output)

;; However it's

(format #t "\nSuprising what was actually forced:\n from ~a promises we get ~a invocations\n"
	(length input)
	(length workload))
(display workload)

(display "\n\nYou might need to rerun the test to find anything
between 1 and MORE THAN the number of time the promise was forced here.\n")

(exit 0)