Prepare for split

experiments/quadratic-choice-evt-fold.rkt

@@ -0,0 +1,25 @@
+(require srfi/1)
+
+(define (c v acc) acc)
+(define (c v acc) (choice-evt never-evt acc))
+(define (c v acc) (choice-evt (handle-evt always-evt void) acc))
+
+(define-values (c1 c2) (values values list))
+(define-values (c1 c2) (values (lambda (i) never-evt) choice-evt))
+(define-values (c1 c2) (values (lambda (i) (handle-evt always-evt void)) choice-evt))
+
+(for-each (lambda (n)
+	    (define limit (* 128 (expt 2 n)))
+	    (write limit)
+	    (newline)
+	    (time (do ((i 0 (+ i 1))
+		       (e never-evt (c i e)))
+		      ((= i limit) e))))
+	  (iota 16))
+
+(for-each (lambda (n)
+	    (define limit (* 128 (expt 2 n)))
+	    (write limit)
+	    (newline)
+	    (time (apply c2 (map c1 (iota limit)))))
+	  (iota 16))

experiments/sfclient.rkt

@@ -0,0 +1,42 @@
+#lang racket/base
+
+(require "os-big-bang.rkt")
+(require "os-udp.rkt")
+(require "os-timer.rkt" racket/match)
+
+(define getter
+  (os-big-bang 'none
+    (send-message `(request create-echo-socket (udp new 0 65536)))
+    (subscribe/fresh sub
+      (message-handlers w
+	[`(reply create-echo-socket ,sname)
+	 (transition w
+	   (unsubscribe sub)
+	   (send-message (udp-packet sname (udp-address "127.0.0.1" 5678) #"get"))
+	   (send-message (set-timer 'timeout 500 #t))
+	   (subscribe 'reply-waiter
+	     (message-handlers w
+	       [(udp-packet source (== sname) reply-bytes)
+		(define counter (integer-bytes->integer reply-bytes #f))
+		(write counter)
+		(newline)
+		(transition w
+		  (send-message 'quit)
+		  (unsubscribe 'reply-waiter))]
+	       [(timer-expired 'timeout _)
+		(write 'timed-out)
+		(newline)
+		(transition w
+		  (send-message 'quit)
+		  (unsubscribe 'reply-waiter))])))]))))
+
+(ground-vm
+ (os-big-bang 'none
+   (spawn (os-big-bang 'none
+	    (subscribe 'quit-waiter
+	      (message-handlers w
+		['quit
+		 (exit)]))))
+   (spawn udp-driver)
+   (spawn (timer-driver))
+   (spawn getter)))

experiments/sfclient2.rkt

@@ -0,0 +1,14 @@
+#lang racket/base
+
+(require racket/match)
+(require racket/udp)
+
+(define s (udp-open-socket #f #f))
+(udp-send-to s "127.0.0.1" 5678 #"get")
+(define buffer (make-bytes 8))
+(sync/timeout 0.5
+	      (wrap-evt (udp-receive!-evt s buffer)
+			(match-lambda
+			 [(list 8 _ _)
+			  (write (integer-bytes->integer buffer #f))
+			  (newline)])))

experiments/sfclient3.rkt

@@ -0,0 +1,24 @@
+#lang racket/base
+
+(require racket/match)
+(require racket/udp)
+
+(define s (udp-open-socket #f #f))
+(define buffer (make-bytes 8))
+(define nrepeats 3500)
+
+(for-each
+ (lambda (x) (write `(,x milliseconds in ,nrepeats repeats =
+			 ,(exact->inexact (/ x nrepeats)))) (newline))
+ (cdr
+  (call-with-values (lambda ()
+		      (time-apply
+		       (lambda ()
+			 (for ([i (in-range nrepeats)])
+			   (udp-send-to s "127.0.0.1" 5678 #"get")
+			   (sync/timeout 0.5
+					 (wrap-evt (udp-receive!-evt s buffer)
+						   (match-lambda
+						    [(list 8 _ _) 'ok])))))
+		       '()))
+    list)))

experiments/sfserver.rkt

@@ -0,0 +1,25 @@
+#lang racket
+
+(require "os-big-bang.rkt")
+(require "os-udp.rkt")
+
+(define counter
+  (os-big-bang 0
+    (send-message `(request create-echo-socket (udp new 5678 65536)))
+    (subscribe/fresh sub
+      (message-handlers current-counter
+	[`(reply create-echo-socket ,sname)
+	 (transition current-counter
+	   (unsubscribe sub)
+	   (subscribe 'packet-handler
+	     (message-handlers current-counter
+	       [(udp-packet source (== sname) #"get")
+		(transition (+ current-counter 1)
+		  (send-message
+		   (udp-packet sname source
+			       (integer->integer-bytes current-counter 8 #f))))])))]))))
+
+(ground-vm
+ (os-big-bang 'none
+   (spawn udp-driver)
+   (spawn counter)))

experiments/sfserver2.rkt

@@ -0,0 +1,29 @@
+#lang racket
+
+(require "os-big-bang.rkt")
+(require "os-udp.rkt")
+
+(define socket-maker
+  (os-big-bang 'no-state
+    (send-message `(request create-echo-socket (udp new 5678 65536)))
+    (subscribe/fresh sub
+      (message-handlers w
+	[`(reply create-echo-socket ,server-socket)
+	 (transition w
+	   (unsubscribe sub)
+	   (spawn (counter server-socket)))]))))
+
+(define (counter server-socket)
+  (os-big-bang 0
+    (subscribe 'packet-handler
+      (message-handlers current-counter
+	[(udp-packet source (== server-socket) #"get")
+	 (transition (+ current-counter 1)
+	   (send-message
+	    (udp-packet server-socket source
+			(integer->integer-bytes current-counter 8 #f))))]))))
+
+(ground-vm
+ (os-big-bang 'none
+   (spawn udp-driver)
+   (spawn socket-maker)))

functional-queue.rkt

@@ -1,75 +0,0 @@
-#lang racket/base
-
-(provide make-queue
-	 queue?
-	 enqueue
-	 enqueue-all
-	 dequeue
-	 list->queue
-	 queue->list
-	 queue-length
-	 queue-empty?
-	 queue-append
-	 queue-extract)
-
-(struct queue (head tail) #:transparent)
-
-(define (make-queue)
-  (queue '() '()))
-
-(define (enqueue q v)
-  (queue (queue-head q)
-	 (cons v (queue-tail q))))
-
-(define (enqueue-all q v)
-  (queue (queue-head q)
-	 (append (reverse v) (queue-tail q))))
-
-(define (shuffle q)
-  (if (null? (queue-head q))
-      (queue (reverse (queue-tail q)) '())
-      q))
-
-(define (dequeue q)
-  (let ((q1 (shuffle q)))
-    (values (car (queue-head q1))
-	    (queue (cdr (queue-head q1)) (queue-tail q1)))))
-
-(define (list->queue xs)
-  (queue xs '()))
-
-(define (queue->list q)
-  (append (queue-head q) (reverse (queue-tail q))))
-
-(define (queue-length q)
-  (+ (length (queue-head q))
-     (length (queue-tail q))))
-
-(define (queue-empty? q)
-  (and (null? (queue-head q))
-       (null? (queue-tail q))))
-
-(define (queue-append q1 q2)
-  (queue (append (queue-head q1)
-		 (reverse (queue-tail q1))
-		 (queue-head q2))
-	 (queue-tail q2)))
-
-(define (queue-extract q predicate [default-value #f])
-  (let search-head ((head (queue-head q))
-		    (rejected-head-rev '()))
-    (cond
-     ((null? head) (let search-tail ((tail (reverse (queue-tail q)))
-				     (rejected-tail-rev '()))
-		     (cond
-		      ((null? tail) (values default-value q))
-		      ((predicate (car tail)) (values (car tail)
-						      (queue (queue-head q)
-							     (append (reverse (cdr tail))
-								     rejected-tail-rev))))
-		      (else (search-tail (cdr tail) (cons (car tail) rejected-tail-rev))))))
-     ((predicate (car head)) (values (car head)
-				     (queue (append (reverse rejected-head-rev)
-						    (cdr head))
-					    (queue-tail q))))
-     (else (search-head (cdr head) (cons (car head) rejected-head-rev))))))

matrix/TODO

@@ -0,0 +1,31 @@
+## DNS
+
+Make RData and RRType the same thing so it becomes impossible to make
+a mistake.
+
+Tests needed:
+ - encode and decode of each kind of RR
+    - so far, have: txt, a, ns, mx, soa, cname, aaaa, srv.
+    - that leaves: md, mf, mb, mg, mr, null, wks, ptr, hinfo, minfo
+    - most of those are obsolete, so finding wild examples will be
+      very difficult
+
+ - encode and decode of several variants of packet, both sensible and not
+    - misleading section length count - short, long
+    - misleading label length - short, long
+    - misleading rdata length - short, long
+    - misleading txt record string length - short, long
+    - looping domain-name (using compressed format)
+    - compressed domain-name pointing into hyperspace
+    - txt record with rdata filled with a list of empty byte-strings
+
+## os.rkt and friends
+
+ - move from quasiquoted to prefab structs
+ - define a prefab struct for every evt? that we want to use
+ - define lowest-level drivers for each prefab struct
+
+It feels like those lowest-level drivers are listening for *demand*
+i.e. they're listening for presence and are then acting to supply such
+demand. Think about the relationships between presence (both positive
+and negative), and interfacing to ad-hoc sources and sinks.