----------------------------------------------------------------
-- Daan Leijen (c) 2001
--
-- $Revision$
-- $Author$
-- $Date$
----------------------------------------------------------------
module QueensStrict where

instruction primAdd "addint" :: Int -> Int -> Int
instruction primSub "subint" :: Int -> Int -> Int
instruction primNeq "neint"  :: Int -> Int -> Bool

data List a = Nil
            | Cons a (List a)

data Bool   = False
            | True

add x y  = case y of y -> case x of x-> primAdd x y
sub x y  = case y of y -> case x of x-> primSub x y
neq x y  = case y of y -> case x of x-> primNeq x y

and x y  = case x of
             False -> False
             True  -> y

length xs
  = let len n xs  = case xs of
                       Nil -> n
                       Cons x xx -> case primAdd n 1 of
                                      m -> len m xx
    in len 0 xs


{-
safe x d []     = True
safe x d (y:ys) = x /= y && x+d /= y && x-d /= y && safe x (d+1) ys
-}

safe x d ys
  = case ys of
      Nil        -> True
      Cons y yy  -> case y of
                    y -> case primNeq x y of
                            False -> False
                            _ -> case primAdd x d of
                                 a -> case primNeq a y of
                                         False -> False
                                         _ -> case primSub x d of
                                              b -> case primNeq b y of
                                                      False -> False
                                                      _ -> case primAdd d 1 of
                                                           d -> safe x d yy

{-
queens k 0  = [[]]
queens k n  = [ (x:xs) | xs <- queens k (n-1), x <- [1..k], safe x 1 xs ]

==
queens k n  = let xss = queens k (n-1)
                  walk []       = []
                  walk (xs:xss) = let walkx 0  = walk xss
                                      walkx x  | safe x 1 xs  = (x:xs):walkx (x-1)
                                               | otherwise    = walkx (x-1)
                                  in  walkx k
              in  walk xss
-}

queens k n
  = case n of
      0  -> Cons Nil Nil  -- [[]]
      n  -> let xss  = case primSub n 1 of m -> queens k m
                walk xss  = case xss of
                             Nil -> Nil
                             Cons xs xss ->
                                let walkx x   = case x of
                                                 0  -> walk xss
                                                 x  -> case safe x 1 xs of
                                                         False -> case primSub x 1 of x1 -> walkx x1
                                                         True  -> let ys = case primSub x 1 of x1 -> walkx x1
                                                                  in  Cons (Cons x xs) ys
                                in walkx k
            in walk xss;

main  = length (queens 9 9)