Implementation of Futures 2

Glenn Takanishi <[email protected]> Tue, 14 Feb 2023 00:53:12 +0000

Newsgroups	gmane.lisp.scheme.gauche
Message-ID	<[email protected]>

2023-2-13

Hi Shiro,

Hope you're doing well.

As I've always say to myself, "This whole thing will start with my own 
laziness".  And this e-mail is no exception :-).  In my last e-mail, you 
gave me the answer to your implementation of futures.   You mentioned 
that I should "collect" the results in "check-trees-of-depth".  Now in 
Common lisp it's kind of easy to do this using the loop construct.

In your implementation of srfi-42, Eager Comprehensions, I think I you 
had written a "collect" verb.  Can you explain to me if or how I could 
use this to ease the pain of writing btree-2.scm which I've attached to 
this e-mail.  (I see you have a module to do collections also in 
Gauche.collection.  Maybe I should look into this.)

Sorry for imposing on you, but ... I have to take my grandson to 
basketball practice now.  How gauche am I?

Thank-you

Glenn

_______________________________________________
Gauche-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/gauche-devel

btree-2.scm (text/plain, 2.9 KB)

;; The Computer Language Benchmarks Game
;; http://shootout.alioth.debian.org/
;; contributed by Sven Hartrumpf


(use scheme.bitwise)
(use control.future)

;; ---------------------------------------------------------------
;;(define nil '())
;;
;;(define-macro  (with-mutex lock . thunk)
;;   `(begin (mutex-lock! ,lock) ,@thunk (mutex-unlock! ,lock)))
;;
;;(define (getf lst key)
;;   (cond ((null? lst) nil)
;;         ((null? (cdr lst)) nil)
;;         ((eq? (car lst) key) (cadr lst))
;;         (else (getf (cddr lst) key))))
;;
;;(define *lock* (make-mutex))
;;(define  *wait* (make-condition-variable))
;;(define  *results*  (make-list 0))
;;(define  *counter*  0)
;; --------------------------------------------------------------

(define TAB (integer->char 9))

(define (make item depth)
   (if (zero? depth) (list item)
       (let ((item2 (* item 2)) (d2 (- depth 1)))
          (cons item  (cons  (make (- item2 1) d2) (make item2 d2))))))

(define (check node)
   (let ((data (car node)) (link (cdr node)))
      (if  (null? link) data
           (- (+ data (check (car link))) (check (cdr link))))))

(define (check-trees-of-depth d max-depth min-depth)
	(let ((iterations (arithmetic-shift 1 (+ (- max-depth d) min-depth)))
			(c 0))
		(do ((i 0 (+ i 1))) ((>= i iterations))
			(set! c (+ c (check (make i d)) (check (make (- i) d)))))
		;;(print (* 2 iterations) TAB " trees of depth " d TAB 
		;;		  " check: " c)
		;; REPLACE above comments by:
		;; ----------------------------------------------------------
		;;(with-mutex *lock*
      ;;            (list-set! *results* (floor (/ (- d min-depth) 2))
      ;;                       (list :iter iterations :depth
      ;;                             d :result chk))
      ;;            (dec! *counter*)
      ;;            (condition-variable-signal! *wait*))
		;; ----------------------------------------------------------
		))

(define (main depth)
	(let* ((min-depth 4)
			 (max-depth (max (+ min-depth 2) depth))
			 (stretch-depth (+ max-depth 1)))
		(print "stretch tree of depth " stretch-depth TAB " check: "
				  (check (make 0 stretch-depth)))
		(let ((long-lived-tree (make 0 max-depth))
				(que nil))
			
			(do ((d 4 (+ d 2))) ((> d max-depth))
				(let* ((fid (future (check-trees-of-depth d max-depth
																		min-depth))))
					;; (push! fid que)))
					(push! que fid)))

			;; the output results are in random order
			(do ((d 4 (+ d 2))) ((> d max-depth))
				(let ((fid (pop! que)))
					(future-get fid)
					;; -----------------------------------------------
					;; (printl (* (getf result :iter) 2)
					;;		  TAB "trees of depth " (getf result :depth)
					;;		  TAB "check: " (getf result :result))
					;; -----------------------------------------------
					))
		
			(print "long lived tree of depth " max-depth TAB " check: "
					  (check long-lived-tree)))))
	
(print (command-line))
(define n (string->number (last (command-line))))
(main n)
(exit)