std/net/httpd/mux: static mux

adam-7 · Nov 9, 2019 · e297e66 · e297e66
1 parent 6df4b4d
commit e297e66
Showing 1 changed file with 42 additions and 9 deletions.
diff --git a/src/std/net/httpd/mux.ss b/src/std/net/httpd/mux.ss
@@ -13,20 +13,20 @@
 
 ;; default mux implementation -- paths are resolved with an exact match
 (defstruct default-http-mux (t default)
-  constructor: :init!)
+  constructor: :init! unchecked: #t)
 
 (defmethod {:init! default-http-mux}
   (lambda (self (default #f))
     (struct-instance-init! self (make-sync-hash (make-hash-table)) default)))
 
 (defmethod {put-handler! default-http-mux}
   (lambda (self host path handler)
-    (sync-hash-put! (default-http-mux-t self) path handler)))
+    (sync-hash-put! (&default-http-mux-t self) path handler)))
 
 (defmethod {get-handler default-http-mux}
   (lambda (self host path)
-    (sync-hash-ref (default-http-mux-t self) path
-                   (default-http-mux-default self))))
+    (sync-hash-ref (&default-http-mux-t self) path
+                   (&default-http-mux-default self))))
 
 ;; recursive mux -- resolves paths up to their parent
 (defstruct (recursive-http-mux default-http-mux) ())
@@ -40,24 +40,57 @@
       (lambda (ht)
         (let lp ((path path))
           (cond
-           ((hash-get ht path) => values)
+           ((hash-get ht path))
            ((string-rindex path #\/)
             => (lambda (ix) (lp (substring path 0 ix))))
            (else
             (default-http-mux-default self))))))))
 
+;; static mux -- paths are resolved in a static hash table, which elides the need for a mutex
+(defstruct static-http-mux (t default)
+  constructor: :init! unchecked: #t)
+
+(defmethod {:init! static-http-mux}
+  (lambda (self tab (default #f))
+    (struct-instance-init! self tab default)))
+
+(defmethod {put-handler! static-http-mux}
+  (lambda (self host path handler)
+    (error "mux does not support dynamic handler registration")))
+
+(defmethod {get-handler static-http-mux}
+  (lambda (self host path)
+    (hash-ref (&static-http-mux-t self) path
+              (&static-http-mux-default self))))
+
+;; recursive static mux -- resolves paths up to their parent
+(defstruct (recursive-static-http-mux static-http-mux) ())
+
+(defmethod {:init! recursive-static-http-mux}
+  static-http-mux:::init!)
+
+(defmethod {get-handler recursive-static-http-mux}
+  (lambda (self host path)
+    (let (ht (&static-http-mux-t self))
+      (let lp ((path path))
+        (cond
+         ((hash-get ht path))
+         ((string-rindex path #\/)
+          => (lambda (ix) (lp (substring path 0 ix))))
+         (else (&static-http-mux-default self)))))))
+
 ;; custom mux -- it dispatches all resolutions/registrations to user supplied functions
 (defstruct custom-http-mux (get put)
-  constructor: :init! final: #t)
+  constructor: :init! final: #t unchecked: #t)
 
 (defmethod {:init! custom-http-mux}
   (lambda (self get (put void))
     (struct-instance-init! self get put)))
 
 (defmethod {get-handler custom-http-mux}
   (lambda (self host path)
-    ((custom-http-mux-get self) host path)))
+    ((&custom-http-mux-get self) host path)))
 
-(defmethod {put-handler custom-http-mux}
+(defmethod {put-handler! custom-http-mux}
   (lambda (self host path handler)
-    ((custom-http-mux-put self) host path handler)))
+    ((&custom-http-mux-put self) host path handler)))