Re-unify Un/Typed Racket programs.

MLton/Makefile

@@ -123,9 +123,6 @@ bench_whispers : iter_command = $(hypw3) --parameter-list num_threads "$(call sp
 
 define for_iters =
 	for i in $(ITERATIONS); do\
-		echo $$j = $$j;\
-		echo $$i = $$i;\
-		echo benches_record_name = $(benches_record_name);\
 		$(iter_command);\
 	done
 endef
@@ -136,7 +133,6 @@ bench_all: $(bench_names)
 # at least, it only takes one parameter, meaning that hyperfine
 # can handle everything without resorting to an external for loop.
 bench_commstime: commstime | $(benches_dir)
-	@echo benches_record_name = $(benches_record_name)
 	$(hypw3) --parameter-list num_iters "$(call spaces-to-commas,$(ITERATIONS))" "$(exes_dir)/$< {num_iters}"
 
 # Note that this one is different from most of the others in that it
@@ -161,7 +157,6 @@ bench_spawn: spawn | $(benches_dir)
 
 # This has the same issues as bench_linalg - see the comment there.
 bench_whispers: whispers | $(benches_dir)
-	@echo benches_record_name = $(benches_record_name)
 	for j in $(WHISPERS_OPTS); do\
 		$(for_iters); \
 	done

Racket/src/montecarlopi.rkt

@@ -1,7 +1,6 @@
 #lang racket/base
 
-(require racket/match)
-(require racket/flonum racket/unsafe/ops)
+(require racket/flonum racket/fixnum)
 (require racket/place racket/future)
 
 (define (distribute-extras total base)
@@ -18,33 +17,42 @@
    (begin
      (define (run-thread-in-place randomiser thread-iterations)
        (define (helper accumulator iteration)
-         (match iteration
+         #;(match iteration
            [0 accumulator]
            [iter (let ([x (random randomiser)] [y (random randomiser)]
-                       [next-iter (unsafe-fx- iter 1)])
-                   (let ([in-circle (unsafe-fl+ (unsafe-fl* x x) (unsafe-fl* y y))])
-                     (if (unsafe-fl< in-circle 1.0)
-                         (helper (unsafe-fx+ accumulator 1) next-iter)
-                         (helper accumulator next-iter))))]))
+                       [next-iter (fx- iter 1)])
+                   (let ([in-circle (fl+ (fl* x x) (fl* y y))])
+                     (if (fl< in-circle 1.0)
+                         (helper (fx+ accumulator 1) next-iter)
+         (helper accumulator next-iter))))])
+         (if (zero? iteration)
+             accumulator
+             (let ([x (random randomiser)] [y (random randomiser)]
+                   [next-iter (fx- iteration 1 )])
+               (let ([in-circle (fl+ (fl* x x) (fl* y y))])
+                 (if (fl< in-circle 1.0)
+                     (helper (fx+ accumulator 1) next-iter)
+                     (helper accumulator next-iter))))))
        (place-channel-put return-chan (helper 0 thread-iterations)))
-     (map sync (for/list ([i (distribute-extras iterations num-threads)])
+     (for-each sync (for/list ([i (distribute-extras iterations num-threads)])
                  (thread (λ () (run-thread-in-place (make-pseudo-random-generator) i))))))))
 
-(define (experiment iterations num-threads)
-  (define num-cores (processor-count))
+(define (experiment iterations num-cores num-threads)
+  #;(define num-cores (processor-count))
   (define threads-per-place-vec (distribute-extras num-threads num-cores))
   (define iters-per-place-vec (distribute-extras iterations num-cores))
   (define-values (rx-ch tx-ch) (place-channel))
+
   (define (collect-from-chan count sum)
     (if (< count 1)
         sum
         (collect-from-chan (sub1 count)
-                           (unsafe-fx+ sum (place-channel-get rx-ch)))))
+                           (fx+ sum (place-channel-get rx-ch)))))
   (for ([ts (in-vector threads-per-place-vec)]
         [is (in-vector iters-per-place-vec)])
     (montecarlopi/place is ts tx-ch))
 
-  (displayln (unsafe-fl* 4.0 (unsafe-fl/ ;
+  (displayln (fl* 4.0 (fl/ ;
                               (->fl (collect-from-chan num-threads 0)) ;
                               (->fl iterations))))
   (displayln "Monte Carlo Pi completed successfully"))
@@ -53,4 +61,5 @@
   (define cmd-params (current-command-line-arguments))
   (define iterations (string->number (vector-ref cmd-params 0)))
   (define num-threads (string->number (vector-ref cmd-params 1)))
-  (experiment iterations num-threads))
+  (define num-cores (min num-threads (processor-count)))
+  (experiment iterations num-cores num-threads))

Racket/src/selecttime.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require racket/random racket/match)
+(require racket/random)
 (require racket/place)
 
 (define (create-place-chans length)

Racket/src/spawn.rkt

@@ -20,19 +20,20 @@
    (for ([i (in-range iterations)])
        (let ([threads-list (for/list ([t (in-range num-threads)])
                              (thread (λ () (child i id t))))])
-         (map thread-wait threads-list)))))
+         (for-each thread-wait threads-list)))))
 
-(define (experiment iterations num-threads)
-  (define num-cores (processor-count))
+(define (experiment iterations num-cores num-threads)
+  #;(define num-cores (processor-count))
   (define threads-per-place (distribute-extras num-threads num-cores))
   (let ([places (for/list ([i (in-range num-cores)]
                            [j (in-vector threads-per-place)])
-                  (child/place iterations i ))])
-    (map place-wait places)))
+                  (child/place iterations i j))])
+    (for-each place-wait places)))
 
 (module+ main
   (define cmd-params (current-command-line-arguments))
-  (define iterations (vector-ref cmd-params 0))
-  (define num-threads (vector-ref cmd-params 1))
-  (experiment (string->number iterations) (string->number num-threads))
+  (define iterations (string->number (vector-ref cmd-params 0)))
+  (define num-threads (string->number (vector-ref cmd-params 1)))
+  (define num-cores (min num-threads (processor-count)))
+  (experiment iterations num-cores num-threads)
   (displayln "Spawn completed successfully"))

Racket/src/whispers.rkt

@@ -1,8 +1,8 @@
 #lang racket/base
 
-(require racket/list racket/string racket/function racket/match)
+(require racket/list racket/string racket/function)
 (require racket/place racket/future)
-(require srfi/43)
+#;(require srfi/43)
 
 (define (chans-list size)
   (build-list size (λ (i) (make-channel))))
@@ -93,12 +93,20 @@ ret-vec)
      (thread (λ () (rcv-and-fwd (vector-ref ch-vec (sub1 num-threads)) end-chan)))
      (run-place rx tx (vector-ref ch-vec 0) end-chan))))
 
-(define (interpose rx tx)
+#;(define (interpose rx tx)
   (match (place-channel-get rx)
     [0 (void)]
     [i (begin
          (place-channel-put tx (sub1 i))
-         (interpose rx tx))]))
+(interpose rx tx))]))
+
+(define (interpose rx tx)
+  (let ([i (place-channel-get rx)])
+    (case i
+      [(0) (void)]
+      [else (begin
+              (place-channel-put tx (sub1 i))
+              (interpose rx tx))])))
 
 (define (ring/place iterations size num-places)
   (define threads-per-place (vector->list (distribute-extra-threads size num-places)))
@@ -201,7 +209,7 @@ events2))))))
   (let* ([experiment-selection (string-trim (vector-ref cmd-params 0))]
          [iterations (string->number (vector-ref cmd-params 1))]
          [size-num (string->number (vector-ref cmd-params 2))]
-         [num-places (processor-count)])
+         [num-places (min size-num (processor-count))])
     (if (< size-num num-places)
         (displayln (format "The number of threads called for is too small to test the capabilities of this program.  Please request a larger number.  For this computer, the minimum is ~v." num-places) (current-error-port))
         (begin

TypedRacket/src/montecarlopi.rkt

@@ -1,8 +1,7 @@
 #lang typed/racket/base
 
-(require racket/match racket/fixnum racket/flonum)
+(require racket/fixnum racket/flonum)
 (require racket/place racket/future)
-(require racket/unsafe/ops)
 
 
 (: distribute-extras (-> Nonnegative-Fixnum Nonnegative-Fixnum (Vectorof Nonnegative-Fixnum)))
@@ -31,11 +30,11 @@
                          (helper (fx+ accumulator 1) next-iter)
                          (helper accumulator next-iter))))))
        (place-channel-put return-chan (helper 0 thread-iterations)))
-     (map sync (for/list ([i (distribute-extras iterations num-threads)])
+     (for-each sync (for/list ([i (distribute-extras iterations num-threads)])
                  (thread (λ () (run-thread-in-place (make-pseudo-random-generator) i))))))))
 
 (: experiment (-> Nonnegative-Fixnum Nonnegative-Fixnum Nonnegative-Fixnum Void))
-(define (experiment iterations num-threads num-cores)
+(define (experiment iterations num-cores num-threads)
   (define threads-per-place-vec (distribute-extras num-threads num-cores))
   (define iters-per-place-vec (assert (distribute-extras iterations num-cores) vector?))
   (define-values (rx-ch tx-ch) (place-channel))
@@ -60,4 +59,4 @@
   (define iterations (cast (string->number (vector-ref cmd-params 0)) Nonnegative-Fixnum))
   (define num-threads (cast (string->number (vector-ref cmd-params 1)) Nonnegative-Fixnum))
   (define num-cores (min num-threads (cast (processor-count) Nonnegative-Fixnum)))
-  (experiment iterations num-threads num-cores))
+  (experiment iterations num-cores num-threads))

TypedRacket/src/selecttime.rkt

@@ -1,6 +1,6 @@
 #lang typed/racket/base
 
-(require racket/random racket/match)
+(require racket/random)
 (require racket/place racket/fixnum)
 
 (: create-place-chans (-> Nonnegative-Fixnum (Values (Listof Place-Channel) (Listof Place-Channel))))

TypedRacket/src/spawn.rkt

@@ -1,30 +1,23 @@
 #lang typed/racket/base
 
-(require racket/place racket/future)
+(require racket/place racket/future racket/fixnum)
+
+(: distribute-extras (-> Nonnegative-Fixnum Nonnegative-Fixnum (Vectorof Nonnegative-Fixnum)))
+(define (distribute-extras total-threads base)
+  (: ret-vec (Vectorof Nonnegative-Fixnum))
+  (define ret-vec (make-vector base (quotient total-threads base)))
+  (define leftovers (remainder total-threads base))
+  (for ([i (in-range leftovers)])
+    (let ([curr-val (vector-ref ret-vec i)])
+      (vector-set! ret-vec i (fx+ 1 curr-val))))
+  ret-vec)
 
 (: child (-> Nonnegative-Fixnum Integer Integer Void))
 (define (child iteration place-id thread-id)
   #;(printf "I am child thread ~a of place ~a, during iteration ~a\n" thread-id place-id iteration)
   (void))
 
-;(: child/place (-> Integer Integer Nonnegative-Fixnum Place))
-#;(define (child/place iteration id num-threads)
-  (place/context
-   c
-   (let ([threads-list (for/list ([i (in-range num-threads)])
-                         (thread (λ () (child iteration id i))))])
-     (map thread-wait threads-list))))
-
-;(: experiment (-> Nonnegative-Fixnum Nonnegative-Fixnum Void))
-#;(define (experiment iterations num-threads)
-  (define num-cores (processor-count))
-  (define threads-per-place (max 1 (quotient num-threads num-cores)))
-  (for ([i : Integer (in-range iterations)])
-    (let ([places : (Listof Place) (for/list ([j : Integer (in-range num-cores)])
-                    (child/place i j threads-per-place))])
-(map place-wait places))))
-
-(: child/place (-> Integer Integer Nonnegative-Fixnum Place))
+(: child/place (-> Integer Integer Integer Place))
 (define (child/place iterations id num-threads)
   (place/context
    c
@@ -33,17 +26,20 @@
                              (thread (λ () (child i id t))))])
          (for-each thread-wait threads-list)))))
 
-(: experiment (-> Nonnegative-Fixnum Nonnegative-Fixnum Void))
-(define (experiment iterations num-threads)
-  (define num-cores (processor-count))
-  (define threads-per-place (max 1 (quotient num-threads num-cores)))
-  (let ([places : (Listof Place) (for/list ([j : Integer (in-range num-cores)])
-                                   (child/place iterations j threads-per-place))])
+(: experiment (-> Nonnegative-Fixnum Nonnegative-Fixnum Nonnegative-Fixnum Void))
+(define (experiment iterations num-cores num-threads)
+  #;(define num-cores (processor-count))
+  #;(define threads-per-place (max 1 (quotient num-threads num-cores)))
+  (define threads-per-place (distribute-extras num-threads num-cores))
+  (let ([places : (Listof Place) (for/list ([i : Integer (in-range num-cores)]
+                                            [j : Integer (in-vector threads-per-place)])
+                                   (child/place iterations i j))])
     (for-each place-wait places)))
 
 (module+ main
   (define cmd-params (current-command-line-arguments))
   (define iterations (cast (string->number (vector-ref cmd-params 0)) Nonnegative-Fixnum))
   (define num-threads (cast (string->number (vector-ref cmd-params 1)) Nonnegative-Fixnum))
-  (experiment iterations num-threads)
+  (define num-cores (fxmin num-threads (cast (processor-count) Nonnegative-Fixnum)))
+  (experiment iterations num-cores num-threads)
   (displayln "Spawn completed successfully"))