diff --git a/experiments/EDLS.png b/experiments/EDLS.png new file mode 100644 index 0000000..e9601e2 Binary files /dev/null and b/experiments/EDLS.png differ diff --git a/edls.rkt b/experiments/edls.rkt similarity index 100% rename from edls.rkt rename to experiments/edls.rkt diff --git a/experiments/quadratic-choice-evt-fold.rkt b/experiments/quadratic-choice-evt-fold.rkt new file mode 100644 index 0000000..2c8450c --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/experiments/sfclient.rkt b/experiments/sfclient.rkt new file mode 100644 index 0000000..ff19c63 --- /dev/null +++ b/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))) diff --git a/experiments/sfclient2.rkt b/experiments/sfclient2.rkt new file mode 100644 index 0000000..c0bd55f --- /dev/null +++ b/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)]))) diff --git a/experiments/sfclient3.rkt b/experiments/sfclient3.rkt new file mode 100644 index 0000000..f496a75 --- /dev/null +++ b/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))) diff --git a/experiments/sfserver.rkt b/experiments/sfserver.rkt new file mode 100644 index 0000000..0f028ea --- /dev/null +++ b/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))) diff --git a/experiments/sfserver2.rkt b/experiments/sfserver2.rkt new file mode 100644 index 0000000..a8d3ca5 --- /dev/null +++ b/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))) diff --git a/functional-queue.rkt b/functional-queue.rkt deleted file mode 100644 index 14334e1..0000000 --- a/functional-queue.rkt +++ /dev/null @@ -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)))))) diff --git a/matrix/TODO b/matrix/TODO new file mode 100644 index 0000000..d7b0afc --- /dev/null +++ b/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. diff --git a/dump-bytes.rkt b/matrix/dump-bytes.rkt similarity index 100% rename from dump-bytes.rkt rename to matrix/dump-bytes.rkt diff --git a/indenting.el b/matrix/indenting.el similarity index 100% rename from indenting.el rename to matrix/indenting.el diff --git a/os-big-bang-example.rkt b/matrix/os-big-bang-example.rkt similarity index 100% rename from os-big-bang-example.rkt rename to matrix/os-big-bang-example.rkt diff --git a/os-big-bang-testing.rkt b/matrix/os-big-bang-testing.rkt similarity index 100% rename from os-big-bang-testing.rkt rename to matrix/os-big-bang-testing.rkt diff --git a/os-big-bang.rkt b/matrix/os-big-bang.rkt similarity index 100% rename from os-big-bang.rkt rename to matrix/os-big-bang.rkt diff --git a/os-example.rkt b/matrix/os-example.rkt similarity index 100% rename from os-example.rkt rename to matrix/os-example.rkt diff --git a/os-timer.rkt b/matrix/os-timer.rkt similarity index 100% rename from os-timer.rkt rename to matrix/os-timer.rkt diff --git a/os-udp-test-big-bang.rkt b/matrix/os-udp-test-big-bang.rkt similarity index 100% rename from os-udp-test-big-bang.rkt rename to matrix/os-udp-test-big-bang.rkt diff --git a/os-udp-test-userland.rkt b/matrix/os-udp-test-userland.rkt similarity index 100% rename from os-udp-test-userland.rkt rename to matrix/os-udp-test-userland.rkt diff --git a/os-udp.rkt b/matrix/os-udp.rkt similarity index 100% rename from os-udp.rkt rename to matrix/os-udp.rkt diff --git a/os-userland-example.rkt b/matrix/os-userland-example.rkt similarity index 100% rename from os-userland-example.rkt rename to matrix/os-userland-example.rkt diff --git a/os-userland-stdlib.rkt b/matrix/os-userland-stdlib.rkt similarity index 100% rename from os-userland-stdlib.rkt rename to matrix/os-userland-stdlib.rkt diff --git a/os-userland.rkt b/matrix/os-userland.rkt similarity index 100% rename from os-userland.rkt rename to matrix/os-userland.rkt diff --git a/os.hs b/matrix/os.hs similarity index 100% rename from os.hs rename to matrix/os.hs diff --git a/os.rkt b/matrix/os.rkt similarity index 100% rename from os.rkt rename to matrix/os.rkt diff --git a/universe.rkt b/matrix/universe.rkt similarity index 100% rename from universe.rkt rename to matrix/universe.rkt