fork download
copy 
  1. ; okasaki's physicist's queues
  2.  
  3. (use-modules (srfi srfi-11))
  4.  
  5. (define queue list)
  6.  
  7. (define empty (queue (list) 0 (delay (list)) 0 (list)))
  8. (define (empty? q) (zero? (cadr q)))
  9.  
  10. (define (checkw w lenf f lenr r)
  11.   (if (null? w)
  12.       (queue (force f) lenf f lenr r)
  13.       (queue w lenf f lenr r)))
  14. (define (check w lenf f lenr r)
  15.   (if (< lenr lenf)
  16.       (checkw w lenf f lenr r)
  17.       (let ((fprime (force f)))
  18.         (checkw fprime (+ lenf lenr)
  19.                 (delay (append fprime (reverse r)))
  20.                 0 (list)))))
  21.  
  22. (define (snoc q x)
  23.   (let-values (((w lenf f lenr r) (apply values q)))
  24.     (check w lenf f (+ lenr 1) (cons x r))))
  25.  
  26. (define (head q)
  27.   (if (null? (car q)) (error 'head "empty queue") (caar q)))
  28. (define (tail q)
  29.   (if (null? (car q)) (error 'tail "empty queue")
  30.     (let-values (((w lenf f lenr r) (apply values q)))
  31.       (check (cdr w) (- lenf 1) (delay (cdr (force f))) lenr r))))
  32.  
  33. (define q empty)
  34. (set! q (snoc q 1))
  35. (set! q (snoc q 2))
  36. (display (head q)) (newline)
  37. (set! q (snoc q 3))
  38. (display (head q)) (newline)
  39. (set! q (tail q))
  40. (display (head q)) (newline)
  41. (set! q (tail q))
  42. (display (head q)) (newline)
  43. (set! q (tail q))
  44. (display (empty? q)) (newline)
Success #stdin #stdout 0.02s 50232KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
1
1
2
3
#t
https://ideone.com/b6IN8k
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!