Evening all... I appear to have broken hat-trans... Stephan Kahrs sent me this program to try hat-delta on, but it appears that hat barfs before I even get that far... lappybob:~/Documents/Work/Hat test cases/Hell Sort tatd2$ hmake -hat hellSort hat-trans hellSort.hs Creating directories Hat Wrote Hat/hellSort.hs ghc -c -package hat -o Hat/hellSort.o Hat/hellSort.hs ghc -package hat -o hellSort Hat/hellSort.o lappybob:~/Documents/Work/Hat test cases/Hell Sort tatd2$ ./hellSort [6,4,2,9,10,9,3]

[2,3,4,6,9,10,9] ^CKilled lappybob:~/Documents/Work/Hat test cases/Hell Sort tatd2$ hat-detect hellSort hat-detect (error): file hellSort.hat is too short lappybob:~/Documents/Work/Hat test cases/Hell Sort tatd2$ hat-check hellSort hat-check (error): file hellSort.hat is too short

Begin forwarded message:

From: "S.M.Kahrs" Date: 16 September 2005 15:34:07 BDT To: tatd2@kent.ac.uk Cc: S.M.Kahrs@kent.ac.uk Subject: buggy sorting function

The sorting function is called 'treesort'.

module Main where {- Ulrich Furbach, Lothar Schmitz -}

treesort :: Ord a => [a] -> [a] treesort = sort . establish

establish f = eaux (length f) ((0,[1]),f)

eaux n a@((u,ss),f) = let sm = head ss sm1 = ss !! 1 sm2 = ss !! 2 in if u==n-1 then ((u,ss),siftav a) else if u>=sm && sm == pre sm1 then eaux n ((u+1,((sm+sm1 +1):drop 2 ss)),siftbin((u,sm),f)) else if n-u>=pre sm then eaux n((u+1,1:ss),siftbin((u,sm),f)) else eaux n((u+1,1:ss), siftav((u,ss),f))

sort ((u,ss),f) = if u==0 then take 1 f else sort (rearrange((u,ss),f)) ++ [f !! u]

rearrange((u,sm:ss),f) = if sm==1 then ((u-1,ss),f) else ((u-1,tt),siftsp((u-1,tt),siftsp((u-1-tlast,tt0),f))) where tt0 = t1: ss tt = tlast: tt0 (tlast,t1)=preaux sm 0 1 1 sm1 = ss !! 0 sm2 = ss !! 1

siftsp ((u,ss),f) = let sm = head ss sm1 = ss !! 1 sm2 = ss !! 2 m = length ss in if m==1 || (f !! (u-sm)) <= (f !! u) then f else siftav ((u-sm,tail ss),swap f (u-sm)u)

siftav((u,ss),f) = if u

siftbin ((u,s),f) = if s==1 || (f !! g)<=(f!! u) then f else siftbin((g,sg),swap f g u) where (p2,p1)=preaux s 0 1 1 (g,sg)= if (f !! (u-1))<= (f !!(u-1-p2)) then (u-1-p2,p1) else (u-1,p2)

swap :: [a] -> Int -> Int -> [a] swap xs i j = if i>j then swap' xs j i else swap' xs i j swap' :: [a] -> Int -> Int -> [a] swap' xs i j = {- i

pre n = snd (preaux n 0 1 1)

preaux n a b c = if n<=c then (a,b) else preaux n b c (b+c+1)

tsort :: [Int] -> [Int] tsort = treesort

main = do putStr "> " xs <- getLine if null xs then return () else ( print (tsort (read xs))) >> main