module Primes
where

import List

-- 1. version, sieve

primes 
    = sieve [2..] 
       where sieve (x:xs) = x : sieve [ n | n <- xs , n `mod` x > 0 ] 


-- 2. version: keep an "upto-date" list of the non-primes 
--             (a finite list of inifinite lists)
--             and calculate the primes from them.

primes'
    = mkPrimes [] [2..] 
      where
       mkPrimes non_primes (x:xs) 
	   | null withX = x : mkPrimes (mult x : non_primes)        xs
	   | otherwise  =     mkPrimes (map tail withX ++ withoutX) xs
	   where
	   (withX,withoutX) = partition ((==x). head) non_primes
	   mult x           = iterate (+x) (x+x)


-- 3. version: primes and non-primes are mutually recursive.

primes''
    = 2 : diff [3..] non_primes

non_primes 
    = merge (map mult primes'') 
      where 
      mult x   = iterate (+x) (x+x)      

merge ((x:xs):rest)
    = x : merge (rearrange (xs:rest))

rearrange l@(xl@(x:xs):(y:ys):rest) 
    | x <= y     = l
    | otherwise  = (y:xl) : rearrange (ys:rest) 

-- set difference for ordered lists - result is also ordered:
diff :: Ord a => [a] -> [a] -> [a]
diff xl@(x:xs) yl@(y:ys) 
    | x <  y = x : diff xs yl
    | x == y =     diff xs yl
    | x >  y =     diff xl ys


-- 4. version, like 2., but uses a tree to manage non-primse:

primes'''
    = mkPrimes L [2..] 
      where
       mkPrimes non_primes (x:xs) 
	   | null withX = x : mkPrimes (tinsert (mult x) non_primes)             xs
	   | otherwise  =     mkPrimes (foldr tinsert withoutX (map tail withX)) xs
	   where
	   (withX,withoutX) = tpartition [x] non_primes 
	   mult x           = iterate (+x) (x+x)

-- a binary tree:

data Tree = N [Integer] Tree Tree | L deriving Show

-- rules for placing integer lists:

leftof, rightof :: [Integer] -> Tree -> Bool

leftof  (x:xs) (N (y:ys) _ _) = x <= y
rightof (x:xs) (N (y:ys) _ _) = x > y

-- rule for matching integer lists:

matches :: [Integer] -> Tree -> Bool
matches (x:xs) (N (y:ys) _ _) = x == y

-- insertion:

tinsert :: [Integer] -> Tree -> Tree
tinsert xl   L = N xl L L
tinsert xl t@(N yl t1 t2) 
    | xl `leftof`  t = N yl (tinsert xl t1) t2
    | xl `rightof` t = N yl t1 (tinsert xl t2)

-- extraction & removal in one step:

tpartition :: [Integer] -> Tree -> ([[Integer]],Tree)
tpartition xl L = ([],L)
tpartition xl t@(N yl t1 t2) 
    | xl `matches` t  =  let (a,b) = tpartition' xl t1 in (yl:a, remove b t2)
    | xl `leftof`  t  =  let (a,b) = tpartition xl t1 in (a, N yl b t2)
    | xl `rightof` t  =  let (a,b) = tpartition xl t2 in (a, N yl t1 b)

tpartition' xl L = ([],L)      -- check for more matches
tpartition' xl t@(N yl t1 t2) 
    | xl `matches` t  =  let (a,b) = tpartition' xl t1 in (yl:a, remove b t2)
    | otherwise       = ([],t)

remove L  t2  = t2
remove t1 t2 = let (a,b) = rightmost t1 in N a b t2

rightmost (N yl t1  L) = (yl,t1)
rightmost (N yl t1 t2) = let (a,b)=rightmost t2 in (a, N yl t1 b)
  

-- test correctness

pdiff = [ (a,b,c,d) | 
	 (a,b,c,d)<-zip4 primes primes' primes'' primes''', 
	 a /= b || b /= c || c /= d 
	 ]