-- --------------------------------------------------------------------
--
-- Crash.hs: Bugs in hugs and ghc
--
--  Author:  Till Dörges  <till@doerges.net>
--
-- --------------------------------------------------------------------
-- For hugs see:
--  http://www.cse.ogi.edu/PacSoft/projects/Hugs/pages/bugsandfeatures.htm
-- --------------------------------------------------------------------

module Crash where

import List
import Trace

-- Put elems at specified positions in 2nd list.
-- Non-existant positions will be ignored.
-- The order of the input list won't be altered.
select :: [a] -> [Integer] -> ([a],[a])
select xs poss = sAcc xs (sort poss) 0 ([],[])
    where sAcc :: [a] -> [Integer] -> Integer -> ([a],[a]) -> ([a],[a])
	  sAcc []     _          _      (ys,zs) = (ys,zs)
	  sAcc xs     []         _      (ys,zs) = (ys++xs, zs)
	  sAcc (x:xs) (pos:poss) curpos (ys,zs) =
	      if (pos == curpos)
	      then sAcc xs poss       (curpos+1) (ys, zs++[x])
	      else sAcc xs (pos:poss) (curpos+1) (ys++[x], zs)



-- Crashes hugs. Possibly due to exhausted C-Stack.

-- Tested against: hugs Version: February 2000
-- Case 1: Linux atlan 2.4.7-int-ac3 #1 Wed Aug 1 01:54:15 CEST 2001 i686 unknown
--         HUGSFLAGS="+s +h2M -P<pretty-3.0>:<parsec-0.2>:<x11>:"
-- Case 2: SunOS userv1 5.8 Generic_108528-09 sun4u sparc SUNW,Ultra-80
--         HUGSFLAGS="-98 -o +s +h10M -P<pretty-3.0>:<parsec-0.2>: 

-- Crash> :t select
-- select :: [a] -> [Integer] -> ([a],[a])
-- Crash> :t crash1
-- crash1 :: ([Integer],[Integer])
-- Crash> crash1
-- Segmentation fault (core dumped)

crash1=select [0..500000] [0,1,2,20,418,451596,451616]


-- Hopefully better implementation of select.
select' :: [a] -> [Integer] -> ([a],[a])
select' xs poss = sAcc xs (sort poss) 0 ([],[])
    where sAcc :: [a] -> [Integer] -> Integer -> (([a],[a]) -> ([a],[a]))
	  sAcc [] _  _ = trace "hi1" $ id
	  sAcc xs [] _ = trace "hi2" $ (\ (ys,zs) -> (ys++xs,zs))
	  sAcc (x:xs) (pos:poss) curpos =
	      if (pos == curpos)
		 then (\ (ys,zs) -> (  ys,x:zs)) . (sAcc xs poss       (curpos+1))
 		 else (\ (ys,zs) -> (x:ys,  zs)) . (sAcc xs (pos:poss) (curpos+1))