[Haskell-cafe] Maybe a compiler bug?
Murray Gross
mgross21 at verizon.net
Mon Jan 5 20:51:04 EST 2009
No unsafe perform (except what may be hidden in trace), nothing, fancy, no
gimmicks (very pedestrian, even heavy-handed) code. Complete code is
attached (I don't have smaller snippets, because I just discovered the
problem).
Best,
Murray Gross
On Mon, 5 Jan 2009, Luke Palmer wrote:
> On Mon, Jan 5, 2009 at 4:34 PM, Murray Gross <mgross21 at verizon.net> wrote:
>
>>
>> When using any of -O, -O1, -O2 with the Debian binary build of GHC 6.6,
>> trace shows that the expression
>>
>> if (lr > ll) then False else True
>>
>> is (at least partially) evaluated, but the value returned is always True,
>> even though trace reports that (lr > ll) is True. When I use only the native
>> code generator (without optimization), the correct value (False) is
>> returned.
>>
>> Further detail and complete code on request.
>
>
> Of course! This is obviously incorrect behavior. Are you doing any
> unsafePerformIO? Please, complete code (minimal test case if possible, but
> don't let that stop you).
>
> Luke
>
>
>
>
>>
>>
>> Best,
>>
>> Murray Gross
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
-------------- next part --------------
-- *********************************************************************
-- * *
-- * Eternity II puzzle. Each puzzle piece is represented by a *
-- * 5-tuple, in which the first 4 entries represent the four *
-- * edge colors in the order left, top, right, bottom, and the *
-- * fifth member is the (numerical) identifier for the piece. *
-- * *
-- *********************************************************************
-- module Solve where
import Data.Array.IArray
import Control.Parallel
import Control.Parallel.Strategies
import List
import Debug.Trace
main = putStrLn (show corns) >>
putStrLn (corpic) >>
putStrLn "Left sides\n">>
putStrLn (pArrayPic (pArray pSides)) >>
putStrLn "Right sides\n">>
putStrLn (pArrayPic (rightArray ))>>
putStrLn (show (length (perims (pArray pSides) corTemp))) >>
putStrLn (show (perims (pArray pSides) corTemp))>>
putStrLn "done"
-- *********************************************************************
-- * *
-- * Make a list of all possible perimeters. Run the operation in *
-- * parallel over the list of possible corner configurations. *
-- * *
-- *********************************************************************
perims:: Array (Int) [Int]->
[(Int,Int,Int,Int)]->[[Int]]
perims pArray corTemp = concat $ parMap rwhnf (\oneCor->makPerim
oneCor pArray
)
corTemp
-- *********************************************************************
-- * *
-- * We build a list of perimeters by constructing each backward *
-- * from position 59. However, position 59 needs special handling *
-- * because it must match position 0 as well as 58. Each of the *
-- * other corners will also need special handling, which is done *
-- * by a case statement. *
-- * *
-- * Note that pArray is organized by the left sides of the pieces, *
-- * while in makePerim we need to check the right side of a *
-- * against the bottom of the first corner. This results in the *
-- * need for rightArray, and some tricky indexing. *
-- * *
-- *********************************************************************
makPerim :: (Int,Int,Int,Int) -> Array (Int) [Int] -> [[Int]]
makPerim oneCor
pArray = [a:b | a <- ((rightArray) ! startCol), b <-
(restPerim a
(pArray // [(left(refPerim!a),
(pArray!(left(refPerim!a)))\\[a])])
(rightArray //[(startCol,
(rightArray ! startCol) \\ [a])])
oneCor
58),
trace (show b)
b /=[]
]
where startCol = bot (corns !! (fst4 oneCor))
-- *********************************************************************
-- * *
-- * Once past the first piece in a perimeter, move to next. *
-- * Check for a corner piece, which needs special handling. *
-- * If there are no candidates left to match last, terminate *
-- * the recursion, indicating there is no way to continue. *
-- * Otherwise, construct the list of possible continuations of *
-- * the perimeter. *
-- * *
-- *********************************************************************
--
restPerim last
leftRay
rightRay
oneCor
iAm | -- trace ((show iAm)++" "++ (show last))
elem iAm [0,15,30,45] = corner last
leftRay
rightRay
oneCor
iAm
| useRow /= [] = extend
| otherwise = []
where useRow = rightRay ! (left (refPerim ! last))
extend = [b:c | b <- (rightRay ! (left
(refPerim ! last))),
c <- restPerim
b
(newLeft b)
(newRight b)
oneCor
(iAm - 1),
--trace (show c)
c/=[]]
newLeft b = leftRay //
[((left (refPerim ! b)),
(leftRay ! (left (refPerim ! b)))
\\ [b])]
newRight b = rightRay //
[((right (refPerim ! b)),
(rightRay ! (right (refPerim ! b)))
\\ [b])]
-- *********************************************************************
-- * *
-- * Corners get special handling. The corner in the upper left is *
-- * always piece 1, because of rotational symmetry. *
-- * *
-- *********************************************************************
--
corner last
leftRay
rightRay
oneCor
iAm
| -- trace ((show last)++" "++(show iAm))
iAm == 15 = if (gTst3 leftRay rightRay) then
goOn (snd4 oneCor)
else trace "fail" []
| -- trace "goo"
iAm == 30 = goOn (thd4 oneCor)
| -- trace "gah"
iAm == 45 = goOn (fth4 oneCor)
| -- trace "gii"
iAm == 0 = if (lastLeft == rightCor 1) then [[1]]
else []
| otherwise = error ("\n\n *** You can't get here"++
" *** \n\n")
where lastLeft = left (refPerim ! last)
rightCor b = right (refPerim ! b)
botCor b = bot (refPerim ! b)
nLeft b = left (refPerim ! b)
goOn q = if (lastLeft /= rightCor q) then
[]
else [q:c:d | c <- (leftRay !
(botCor q)),
d <-
-- trace ((show q)++" "++
-- (show c)++"xx ")
restPerim c
(newleft c)
(newright c)
oneCor
(iAm - 2)
]
newleft c = leftRay //
[((nLeft c),
leftRay!(nLeft c)\\[c])]
newright c = rightRay //
[((rightCor c),
rightRay!(rightCor c)\\
[c])]
-- *********************************************************************
-- * *
-- * agTst is a simple heuristic test to determine whether it is *
-- * possible for a perimeter to be built with the remaining *
-- * pieces: it tests to find out whether there are an equal no. of *
-- * pieces whose right side matches the left sides of available *
-- * pieces, except, perhaps for 1, which will fit a corner piece. *
-- * *
-- * And it doesn't work, at least at the beginning of the solution.*
-- * In the first 10,000,000 passages through corner 15, there is *
-- * only 1 fail. *
-- * *
-- *********************************************************************
gTst :: Array Int [Int] -> Array Int [Int] -> Bool
gTst right left = and $ map tryme (indices right)
where iList = indices right
tryme x | (length (right ! x)) ==
(length (left ! x)) = True
| abs ((length (right ! x))-
(length (left ! x))) ==
1 = True
| otherwise = False
gTst1:: Array Int [Int] -> Array Int [Int] -> Bool
gTst1 right left = if (sum $ map tryme (indices right)) > 2 then False
else True
where tryme x = abs ((length (right ! x)) -
(length (left ! x)))
gTst2 right left = if (length (left ! 2)) > 0 then True else False
gTst3 right left = if (lr > ll) then False else True
where lr = length (right ! 2)
ll = length (left ! 2)
-- *********************************************************************
-- * *
-- * Here we make up a list of the 6 possible corner configurations *
-- * There are only 6 such because the remaining permutations of *
-- * corner pieces are merely rotations of the six used here. *
-- * *
-- *********************************************************************
corTemp :: [(Int,Int,Int,Int)]
corTemp = [(1,2,3,4),(1,2,4,3),(1,3,2,4),(1,3,4,2),(1,4,2,3),(1,4,3,2)]
corns = [(0,0,0,0,0), (0,0,2,1,1),(0,0,2,3,2),(0,0,4,1,3),(0,0,1,4,4)]
-- *********************************************************************
-- * *
-- * Construct an array in which each entry is a list of pieces *
-- * that have the same color on the left side. This array will be *
-- * used to construct the perimeters of the puzzle. *
-- * *
-- * We use pArray as an array of available pieces, and refPerim *
-- * in order to find the matching colors; since it changes a lot, *
-- * the reduced item count will reduce overhead from building new *
-- * pArray's. *
-- * *
-- *********************************************************************
pSides:: [(Int,Int,Int,Int,Int)]
pSides = [(2,0,2,5,5),(4,0,2,6,6),(2,0,2,7,7),(8,0,2,7,8),(1,0,2,9,9),
(3,0,2,10,10),(4,0,2,11,11),(3,0,2,12,12),(8,0,2,12,13),
(3,0,2,13,14),(2,0,4,6,15),(1,0,4,14,16),(8,0,4,15,17),
(8,0,4,16,18),(4,0,4,10,19),(4,0,4,11,20),(3,0,4,17,21),
(2,0,4,18,22),(8,0,4,18,23),(2,0,4,19,24),(2,0,4,13,25),
(4,0,1,5,26),(1,0,1,5,27),(1,0,1,6,28),(1,0,1,14,29),
(8,0,1,10,30),(4,0,1,11,31),(1,0,1,19,32),(4,0,1,12,33),
(3,0,1,12,34),(8,0,1,20,35),(3,0,1,21,36),(2,0,3,14,37),
(8,0,3,22,38),(8,0,3,9,39),(4,0,3,16,40),(1,0,3,16,41),
(2,0,3,11,42),(4,0,3,11,43),(1,0,3,11,44),(2,0,3,17,45),
(3,0,3,19,46),(3,0,3,12,47),(3,0,3,20,48),(8,0,8,5,49),
(2,0,8,6,50),(4,0,8,6,51),(2,0,8,7,52),(3,0,8,10,53),
(3,0,8,17,54),(8,0,8,17,55),(1,0,8,12,56),(2,0,8,20,57),
(8,0,8,20,58),(4,0,8,13,59),(1,0,8,21,60)]
pArray:: [(Int,Int,Int,Int,Int)] -> Array (Int)
[Int]
pArray pSides = accumArray (++) [] (1,8) accumPlist
rightArray:: Array (Int) [Int]
rightArray = accumArray (++) [] (1,8) rightAccum
rightAccum = map (\item ->((right item),[piece item])) pSides
accumPlist = map (\item ->((left item),[piece item])) pSides
refPerim:: Array (Int) (Int,Int,Int,Int,Int)
refPerim = listArray (1,60) (trace "don't get here"(drop 1 corns)++pSides)
-- *********************************************************************
-- * *
-- * Pretty-printer for corner configurations. *
-- * *
-- * *
-- *********************************************************************
corpic = concat $ map oneSq corTemp
oneSq (a,b,c,d) = show (corns !! a) ++ " " ++ show (corns !! b) ++
"\n\n" ++
show (corns !! c)++" "++show (corns !! d) ++ "\n\n\n"
-- *********************************************************************
-- * *
-- * Ugly-printer for pArray, the array of pieces for the *
-- * perimeter. *
-- * *
-- * *
-- *********************************************************************
pArrayPic myray = concatMap (\x-> (show x)++"\n\n") (elems myray)
-- *********************************************************************
-- * *
-- * Convenience functions. *
-- * *
-- *********************************************************************
left:: (Int,Int,Int,Int,Int) -> Int
left (a,b,c,d,e) = a
fst4 (a,b,c,d) = a
top (a,b,c,d,e) = b
snd4 (a,b,c,d) =b
right (a,b,c,d,e) = c
thd4 (a,b,c,d) = c
bot (a,b,c,d,e) = d
fth4 (a,b,c,d) = d
piece (a,b,c,d,e) = e
More information about the Haskell-Cafe
mailing list