fork(3) download
copy 
  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
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(#(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
https://ideone.com/GozM0B
language:
Scheme (guile 2.2.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!