fork download
copy 
  1. ; deletion from a cyclical list
  2.  
  3. (define (last-pair xs)
  4.   (if (null? xs) (error 'last-pair "empty list")
  5.     (if (null? (cdr xs)) xs (last-pair (cdr xs)))))
  6.  
  7. (define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
  8.  
  9. (define (remove-cycle eql? x xs)
  10.   (let loop ((ys (cdr xs)))
  11.     (if (eql? x (car ys)) (remove-head ys)
  12.       (if (eq? xs ys) xs (loop (cdr ys))))))
  13.  
  14. (define (remove-head xs)
  15.   (let loop ((ys (cdr xs)))
  16.     (cond ((eq? xs (cdr ys))
  17.             (set-cdr! ys (cddr ys)) ys)
  18.           (else (loop (cdr ys))))))
  19.  
  20. (define xs (cycle 2 3 5 7 11 13 17 19 23 29))
  21. (set! xs (remove-cycle = 2 xs))
  22. (set! xs (remove-cycle = 11 xs))
  23. (set! xs (remove-cycle = 19 xs))
  24. (set! xs (remove-cycle = 21 xs))
  25. (set! xs (remove-cycle = 23 xs))
  26. (display xs) (newline)
Success #stdin #stdout 0.03s 8112KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(17 29 3 5 7 13 . #-5#)
https://ideone.com/Y1tnVv
language:
Scheme (guile 2.2.4)
created:
6 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!