[Haskell-cafe] Maybe a compiler bug?
Don Stewart
dons at galois.com
Tue Jan 6 13:49:09 EST 2009
If you believe this is a compiler bug, please report it:
http://hackage.haskell.org/trac/ghc/newticket?type=bug
mgross21:
>
>
> My last note had an error in it, and the code originally sent to the list
> should be ignored. I have attached the current version of the code, and
> here is some further information (the behavior is different, by the way,
> but still apparently wrong).
>
> I have attached the current version of the program, which behaves
> slightly differently from the version originally sent.
>
> I am running ghc 6.6, gcc 4.1.2, g++ 4.1.1, on Debian Linux. The compile
> lines are ghc -threaded solve.hs or ghc -threaded -O2 solve.hs. The
> execution line is ./a.out, which should give me single-threaded execution.
>
> Ignore the output on stdout; it is the same for both versions.
>
> On stderr, the unoptimized version of the attached code gives me both
> "fail" and "goOn" (see lines #150 and #153). The optimized version gives
> me only "goOn." I think that both should give me both "fail" and "goOn."
>
> Were circumstances different, I might suspect that laziness and
> optimization had something to do with this. However, earlier tests showed
> inconsistency between the result of the test in gTst3 and the code where
> the value of gTst3 is used.
>
> A copy of the current version of solve.hs is attached.
>
> Best,
>
> Murray Gross
>
> P.S.: For anyone who has actually looked at the logic, I am aware that the
> test in gTst3 can be sharpened. That will come later. The current version
> is adequate for the time being.
Content-Description: Current version of solve.hs
> -- *********************************************************************
> -- * *
> -- * 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
> (trace "goOn")
> 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+2)||(lr < ll-2)) 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
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list