import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Maybe
 
data Primality
	= Prime
	| OneFactor Integer
	| TwoFactor Integer Integer
	| ManyFactor
	deriving (Eq, Ord, Read, Show)
 
addFactor :: Integer -> Primality -> Primality
addFactor f Prime = OneFactor f
addFactor f (OneFactor f') = TwoFactor f f'
addFactor _ _ = ManyFactor
 
isSemiprime :: Integer -> Primality -> Bool
isSemiprime n (OneFactor f   ) = f * f  == n
isSemiprime n (TwoFactor f f') = f * f' == n
isSemiprime _ _ = False
 
nextSemiprime :: Integer -> Integer
nextSemiprime n = runST $ do
	arr <- newSTArray (2,2*n) Prime
	forM_ [2..n] $ \p -> do
		primality <- readArray arr p
		when (primality == Prime) $
			forM_ [2*p,3*p..2*n] $ \i ->
				modifyArray arr i (addFactor p)
	-- going up to 2*n is big enough by Bertrand's postulate
	fromJust <$> findM (\i -> isSemiprime i <$> readArray arr i) [n+1..2*n]
 
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM f [] = return Nothing
findM f (x:xs) = do
	done <- f x
	if done then return (Just x) else findM f xs
 
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = readArray arr ix >>= writeArray arr ix . f
 
-- just to fix the type
newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
newSTArray = newArray
 
main = print . take 100 . iterate nextSemiprime $ 4

aW1wb3J0IENvbnRyb2wuTW9uYWQKaW1wb3J0IENvbnRyb2wuTW9uYWQuU1QKaW1wb3J0IERhdGEuQXJyYXkuU1QKaW1wb3J0IERhdGEuTWF5YmUKCmRhdGEgUHJpbWFsaXR5Cgk9IFByaW1lCgl8IE9uZUZhY3RvciBJbnRlZ2VyCgl8IFR3b0ZhY3RvciBJbnRlZ2VyIEludGVnZXIKCXwgTWFueUZhY3RvcgoJZGVyaXZpbmcgKEVxLCBPcmQsIFJlYWQsIFNob3cpCgphZGRGYWN0b3IgOjogSW50ZWdlciAtPiBQcmltYWxpdHkgLT4gUHJpbWFsaXR5CmFkZEZhY3RvciBmIFByaW1lID0gT25lRmFjdG9yIGYKYWRkRmFjdG9yIGYgKE9uZUZhY3RvciBmJykgPSBUd29GYWN0b3IgZiBmJwphZGRGYWN0b3IgXyBfID0gTWFueUZhY3RvcgoKaXNTZW1pcHJpbWUgOjogSW50ZWdlciAtPiBQcmltYWxpdHkgLT4gQm9vbAppc1NlbWlwcmltZSBuIChPbmVGYWN0b3IgZiAgICkgPSBmICogZiAgPT0gbgppc1NlbWlwcmltZSBuIChUd29GYWN0b3IgZiBmJykgPSBmICogZicgPT0gbgppc1NlbWlwcmltZSBfIF8gPSBGYWxzZQoKbmV4dFNlbWlwcmltZSA6OiBJbnRlZ2VyIC0+IEludGVnZXIKbmV4dFNlbWlwcmltZSBuID0gcnVuU1QgJCBkbwoJYXJyIDwtIG5ld1NUQXJyYXkgKDIsMipuKSBQcmltZQoJZm9yTV8gWzIuLm5dICQgXHAgLT4gZG8KCQlwcmltYWxpdHkgPC0gcmVhZEFycmF5IGFyciBwCgkJd2hlbiAocHJpbWFsaXR5ID09IFByaW1lKSAkCgkJCWZvck1fIFsyKnAsMypwLi4yKm5dICQgXGkgLT4KCQkJCW1vZGlmeUFycmF5IGFyciBpIChhZGRGYWN0b3IgcCkKCS0tIGdvaW5nIHVwIHRvIDIqbiBpcyBiaWcgZW5vdWdoIGJ5IEJlcnRyYW5kJ3MgcG9zdHVsYXRlCglmcm9tSnVzdCA8JD4gZmluZE0gKFxpIC0+IGlzU2VtaXByaW1lIGkgPCQ+IHJlYWRBcnJheSBhcnIgaSkgW24rMS4uMipuXQoKZmluZE0gOjogTW9uYWQgbSA9PiAoYSAtPiBtIEJvb2wpIC0+IFthXSAtPiBtIChNYXliZSBhKQpmaW5kTSBmIFtdID0gcmV0dXJuIE5vdGhpbmcKZmluZE0gZiAoeDp4cykgPSBkbwoJZG9uZSA8LSBmIHgKCWlmIGRvbmUgdGhlbiByZXR1cm4gKEp1c3QgeCkgZWxzZSBmaW5kTSBmIHhzCgptb2RpZnlBcnJheSA6OiAoTUFycmF5IGEgZSBtLCBJeCBpKSA9PiBhIGkgZSAtPiBpIC0+IChlIC0+IGUpIC0+IG0gKCkKbW9kaWZ5QXJyYXkgYXJyIGl4IGYgPSByZWFkQXJyYXkgYXJyIGl4ID4+PSB3cml0ZUFycmF5IGFyciBpeCAuIGYKCi0tIGp1c3QgdG8gZml4IHRoZSB0eXBlCm5ld1NUQXJyYXkgOjogSXggaSA9PiAoaSxpKSAtPiBlIC0+IFNUIHMgKFNUQXJyYXkgcyBpIGUpCm5ld1NUQXJyYXkgPSBuZXdBcnJheQoKbWFpbiA9IHByaW50IC4gdGFrZSAxMDAgLiBpdGVyYXRlIG5leHRTZW1pcHJpbWUgJCA0