#lang scheme/base (require (prefix-in log: (planet synx/log:1)) scheme/vector) ; This program demonstrates an algorithm for the formation of a hash-tree ; by using it to multiply numbers together ; First I generate the hash-tree in a non-recursive and hopefully efficient manner ; Then I traverse the hash tree (possibly recursively) to examine its structure (define ds (make-immutable-hash null)) ; a vector of levels 0-* ; each element is a vector of size N ; accumulate N in the lowest level, combine to higher level, clear (define hash-per-piece 4) (define-syntax-rule (while test body ...) (let loop () (when test body ... (loop)))) (define (create-tree build) (define hashes (vector)) (define (combine-hashes level level-v) ; very simple hashing algorithm <_< ; normally this would be "save all hashes to file then return the SHA1 of it" (let ((hash (let loop ((i 0)) (if (= i (vector-length level-v)) #f (let ((rest (loop (+ i 1))) (combined (vector-ref level-v i))) (if rest (* rest combined) combined)))))) (log:info "~a: ~a -> ~a" level level-v hash) (set! ds (hash-set ds hash level-v)) hash)) (define (add piece (level 0)) (while (level . > . (- (vector-length hashes) 1)) (set! hashes (vector-append hashes (vector (vector))))) (let ((level-v (vector-ref hashes level))) (when (= hash-per-piece (vector-length level-v)) (let ((carry (combine-hashes level level-v))) (set! level-v (vector)) (add carry (+ level 1)))) (vector-set! hashes level (vector-append level-v (vector piece))))) (build add) (let loop ((level 0) (result #f)) (if (= level (vector-length hashes)) result (let ((level-v (vector-ref hashes level))) (loop (+ level 1) (combine-hashes level (if result (vector-append level-v (vector result)) level-v))))))) (define (main) (set! ds (make-immutable-hash null)) (display "Enter a number: ") (let ((root (create-tree (λ (add) ; hint: don't go above 1000 (for ((i (in-range (read)))) (add (+ 1 i))))))) (log:info "The root hash is ~a" root) (let loop ((cur root) (level 0)) (for ((i (in-range level))) (when (> level 100) (error "too many dashes!")) (display "-")) (display cur)(newline) (for-each (λ (hash) (loop hash (+ level 1))) (vector->list (hash-ref ds cur (λ () (vector))))))))