[Yhc] Re: Crashing Queens

Neil Mitchell ndmitchell at gmail.com
Thu Aug 16 16:17:18 EDT 2007


Hi

The reason, as Matt discovered, is that it has module Queens where,
not module Main where. Could we perhaps get a better error message on
this one?

Thanks

Neil

On 8/16/07, Neil Mitchell <ndmitchell at gmail.com> wrote:
> Hi,
>
> Using the attached program:
>
> --------------------------------------------------------------------------------
> D:\Temp>yhc Queens.hs
> Compiling Queens           ( Queens.hs )
>
> D:\Temp>yhi Queens.hbc
> Assertion failed: pinfo->info.tag == I_PINFO, file d:\sources\yhc\current\src\ru
> ntime\bckernel\mutins.h, line 295
>
> This application has requested the Runtime to terminate it in an unusual way.
> Please contact the application's support team for more information.
> --------------------------------------------------------------------------------
>
> This also shows we have assertions on in the release "scons yhi" code,
> I guess they can stay in for now, but we really do need an
> optimisation mode.
>
> Program from Matt :-)
>
> Thanks
>
> Neil
>
>
> ----------- Queens.hs --------------
>
> module Queens where
>
> main = nsoln 9
>
> len :: [a] -> Int
> len [] = 0
> len (x:xs) = 1 + len xs
>
> nsoln :: Int -> Int
> nsoln nq = len (gen nq)
>   where
>     gen :: Int -> [[Int]]
>     gen 0 = [[]]
>     gen n = [ (q:b) | b <- gen (n-1), q <- [1,2,3,4,5,6,7,8,9] {-toOne
> nq-}, safe q 1 b]
>
> safe :: Int -> Int -> [Int] -> Bool
> safe x d []    = True
> safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l
>
> toOne :: Int -> [Int]
> toOne n = if n == 1 then [1] else n : toOne (n-1)
>


More information about the Yhc mailing list