Sorry. Here is my Program. module Main(main) where import IOExtras type Var = Int type Val = Int data Assignment = Var := Val deriving (Eq,Show) data Assgn = Tree Assignment [Assgn] deriving (Eq,Show) main = do putStrLn $ "Solutions = " ++ (show $ length $ results (bb [1..9] 9) 9) c <- readIORef counter putStrLn $ "Checks = " ++ show c cc :: [[Assignment]->Bool] -> Assgn -> [Assgn] cc cons t = fun [] 0 t where fun part var (Tree t cs) = let new_ass = part++[t] new_chi = concatMap (fun new_ass (var+1)) cs in if (cons!!var) new_ass then [Tree t new_chi] else [] bb :: [Var] -> Int -> [Assgn] bb vars n = let cons = take n $ (true : [ f a | a <- [2..]]) f a = foldl1 (&) [check a m | m <- [1..a-1]] in concatMap (cc cons) (fun vars) where fun (v:vs) = [Tree (v:=x) (fun vs) | x <- [1..n]] fun [] = [] check :: Int -> Int -> [Assignment] -> Bool check m n ass = safe (ass!!(m-1)) (ass!!(n-1)) true :: [Assignment] -> Bool true _ = True (&) :: ([Assignment]->Bool) -> ([Assignment]->Bool) -> ([Assignment]->Bool) f1 & f2 = \ints -> f1 ints && f2 ints safe :: Assignment -> Assignment -> Bool safe (i:=j) (m:=n) = unsafePerformIO $ do c <- readIORef counter writeIORef counter $! (c+1) return $ not (j==n || i+j==m+n || i-j==m-n) results :: [Assgn] -> Int -> [[Assignment]] results t no= concatMap ((filter (\l->length l == no)).flatten) t where flatten (Tree t []) = [[t]] flatten (Tree t cs) = map (t:) (concatMap flatten cs) counter :: IORef Integer counter = unsafePerformIO $ newIORef (0::Integer)