diff --git a/s48/hawk-dns-server/db.scm b/s48/hawk-dns-server/db.scm index df7393d..1a5b493 100644 --- a/s48/hawk-dns-server/db.scm +++ b/s48/hawk-dns-server/db.scm @@ -15,11 +15,17 @@ (define (make-db) - (let ((*db '())) + (let ((*db '()) + ((*prime 1))) (define (add key value) - (set! *db (append *db (list (list key value)))) - ) + (let ((*hash (list (list key value)))) + (nextprime) + (do ((i 0 (+ i 1))) + ((eq? i *prime) + (set! *db (append *db *hash))) + (set! *db (append *db '(0 0)))) + )) (define (lookup key) (let ((*result #f)) @@ -30,6 +36,23 @@ (set! *result (cadr (list-ref *db i)))) ))) + (define (key->hash key) + (let ((*hash 0)) + (do ((i 0 (+ i 1))) + ((= i (string-length key)) + *hash) + (set! *hash (+ *hash (char->ascii (string-ref key i))))) + )) + + (define (nextprime) + (set! *prime (getprime-rec *prime))) + + (define (getprime-rec prime) + (if (or (/ prime 2) (/ prime 3) (/ prime 5) (/ prime 7) (/ prime 10)) + (getpreime-rec (+ prime 1)))) + + (define (integer->ascii + (define (dispatch msg) (cond ((eq? msg 'add) add) ((eq? msg 'lookup) lookup) diff --git a/s48/hawk-dns-server/init.scm b/s48/hawk-dns-server/init.scm index 088e43b..34d70d9 100644 --- a/s48/hawk-dns-server/init.scm +++ b/s48/hawk-dns-server/init.scm @@ -1,2 +1,3 @@ ,load big-scheme ,open byte-vectors +,open ascii diff --git a/s48/hawk-dns-server/packages.scm b/s48/hawk-dns-server/packages.scm index 6c2b7c5..a3c45d9 100644 --- a/s48/hawk-dns-server/packages.scm +++ b/s48/hawk-dns-server/packages.scm @@ -1,9 +1,9 @@ -(define-interface cavespider-interface +(define-interface hawk-dns-server-interface (export make-server make-server-dns)) -(define-structure cavespider - cavespider-interface +(define-structure + hawk-dns-server-interface (open scheme) - (files load file-util hash-util html-util string-util util client)) + (files load util server db server-dns))