fork download
  1. ; blockchain
  2.  
  3. (define (fold-left op base xs)
  4. (if (null? xs)
  5. base
  6. (fold-left op (op base (car xs)) (cdr xs))))
  7.  
  8. (define (range . args)
  9. (case (length args)
  10. ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  11. ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  12. ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  13. (let loop ((x(car args)) (xs '()))
  14. (if (le? (cadr args) x)
  15. (reverse xs)
  16. (loop (+ x (caddr args)) (cons x xs))))))
  17. (else (error 'range "unrecognized arguments"))))
  18.  
  19. (define seed 20180525)
  20. (define (random) (set! seed (modulo (* 16807 seed) 2147483647)) seed)
  21. (define (randint n) (floor (* n (random) (/ 2147483647))))
  22.  
  23. (define (shuffle x)
  24. (do ((v (list->vector x)) (n (length x) (- n 1)))
  25. ((zero? n) (vector->list v))
  26. (let* ((r (randint n)) (t (vector-ref v r)))
  27. (vector-set! v r (vector-ref v (- n 1)))
  28. (vector-set! v (- n 1) t))))
  29.  
  30. (define t (list->vector (shuffle (range 256))))
  31.  
  32. (define (pearson8 str)
  33. (fold-left (lambda (n h) (vector-ref t (modulo (+ n h) 256)))
  34. 0 (map char->integer (string->list str))))
  35.  
  36. (define (index block) (vector-ref block 0))
  37. (define (datum block) (vector-ref block 1))
  38. (define (phash block) (vector-ref block 2))
  39. (define (chash block) (vector-ref block 3))
  40.  
  41. (define (hash index datum phash)
  42. (pearson8 (string-append (number->string index) datum (number->string phash))))
  43.  
  44. (define genesis (vector 0 "Genesis Block" 0 (hash 0 "Genesis Block" 0)))
  45.  
  46. (define (adjoin chain datum)
  47. (let ((index (+ (index (car chain)) 1)) (phash (chash (car chain))))
  48. (cons (vector index datum phash (hash index datum phash)) chain)))
  49.  
  50. (define (validate? chain)
  51. (define (valid? curr prev)
  52. (and (= (index curr) (+ (index prev) 1))
  53. (= (phash curr) (chash prev))
  54. (= (hash (index curr) (datum curr) (phash curr)) (chash curr))))
  55. (if (null? (cdr chain)) (equal? (car chain) genesis)
  56. (and (valid? (car chain) (cadr chain)) (validate? (cdr chain)))))
  57.  
  58. (define b (list genesis))
  59. (set! b (adjoin b "Pearson Hashing"))
  60. (set! b (adjoin b "Floyd's Triangle"))
  61. (set! b (adjoin b "Billing Period"))
  62. (set! b (adjoin b "Sum Embedded Numbers"))
  63. (set! b (adjoin b "Help Wanted: Report Generator"))
  64.  
  65. (display b) (newline)
  66. (display (validate? b)) (newline)
Success #stdin #stdout 0.04s 8344KB
stdin
Standard input is empty
stdout
(#(5 Help Wanted: Report Generator 68 158) #(4 Sum Embedded Numbers 15 68) #(3 Billing Period 43 15) #(2 Floyd's Triangle 198 43) #(1 Pearson Hashing 110 198) #(0 Genesis Block 0 110))
#t