leppie · July 27, 2012 10:29
diff --git a/gistfile1.scm b/gistfile1.scm
 (define (>> n i) (bitwise-arithmetic-shift n (- i)))
 (define << bitwise-arithmetic-shift-left)
 (define & bitwise-and)

 (define (split n p)
  (let* ((bc (bitwise-length n))
         (mid (div bc 2)))
    (define (get-bit-seq s c)
      (let ((rs (- bc s c))
            (m  (- (<< 1 c) 1)))
        (& (>> n rs) m)))
    (and  (<= p mid)
          (let-values (((d m) (div-and-mod bc p)))
            (let f ((i 0)(a '()))
              (if (>= i d)
                  (and (apply = a)
                       (= (>> (car a) (- p m)) (& (- (<< 1 m) 1) n)))
                  (f (+ i 1) 
                     (cons (get-bit-seq (* i p) p) a))))))))

 (define (bit-period n)
  (let ((q (div (bitwise-length n) 2)))
    (let f ((i 1))
      (if (> i q)
          -1
          (let ((r (split n i)))
            (if r 
                i 
                (f (+ i 1))))))))
         
 (map bit-period '(955 102 #b10101010101 #b1111111111111110 #b111011011101101))
	(define (>> n i) (bitwise-arithmetic-shift n (- i)))
	(define << bitwise-arithmetic-shift-left)
	(define & bitwise-and)

	(define (split n p)
	(let* ((bc (bitwise-length n))
	(mid (div bc 2)))
	(define (get-bit-seq s c)
	(let ((rs (- bc s c))
	(m (- (<< 1 c) 1)))
	(& (>> n rs) m)))
	(and (<= p mid)
	(let-values (((d m) (div-and-mod bc p)))
	(let f ((i 0)(a '()))
	(if (>= i d)
	(and (apply = a)
	(= (>> (car a) (- p m)) (& (- (<< 1 m) 1) n)))
	(f (+ i 1)
	(cons (get-bit-seq (* i p) p) a))))))))

	(define (bit-period n)
	(let ((q (div (bitwise-length n) 2)))
	(let f ((i 1))
	(if (> i q)
	-1
	(let ((r (split n i)))
	(if r
	i
	(f (+ i 1))))))))

	(map bit-period '(955 102 #b10101010101 #b1111111111111110 #b111011011101101))