[Haskell-cafe] Function hanging in infinite input

[martin]

Hello all,

I was trying to implement >>= (tBind) on my "Temporal" data type and found that it hangs on an operation like

	takeInitialPart $ infiniteTemporal >>= (\x -> finiteTemporal)

I am pretty sure the result is well defined and by no means infinite. Also the code works on finite Temporals. How does
one address such problems?



I attach the relevant pieces of code, in case someone would be so kind and inspect or run it. Feel free to point out any
flaws as I might be completely off-track.

If you call ex10 in GHCI, you get no result. The line marked with "< here" is executed over and over, but apparently
without contributing to the result. The debugger shows, that "hd" does have a correct, finite value each time and that
"tpr" is consumed as expected.

-- -- -- -- -- -- -- -- -- examples -- -- -- -- -- -- --

ex1   = Temporal [(DPast, 1), (T 3,3), (T 7, 7)] :: Temporal Int
ex10 = tUntil (T 5) $ outer `tBind` \_ -> ex1 :: Temporal Int
        where
            outer = Temporal $ (DPast,0):[(T (fromIntegral t), t)| t <- [5,10 ..]]

-- -- -- -- -- -- -- -- -- tBind -- -- -- -- -- -- -- --

-- Changed (Temporal a) to (Temporal Int) for debugging
tBind :: (Temporal Int) -> (Int -> Temporal Int) -> Temporal Int
tBind tpr f
-- tpr is infinite in this example, let's forget these cases
--        | tNull tpr         = error "empty Temporal"
--        | tNull (tTail tpr) = laties
        | otherwise         = let hd = (tUntil (tTt tpr) laties)
                              in hd `tAppend` (tTail tpr `tBind` f) --           < here

        where
            laties = switchAt (tTh tpr) ( f (tVh tpr))
            tTail (Temporal xs) = Temporal (tail xs)
            tAppend (Temporal as) (Temporal bs) = Temporal (as ++ bs)
            switchAt t tpx
                    | tNull (tTail tpx)             = Temporal (tot tpx)
                    | between t (tTh tpx) (tTt tpx) = Temporal (tot tpx)
                    | otherwise                     = switchAt t (tTail tpx)
                    where
                        tot (Temporal ((ty,vy):xs)) = ((max t ty, vy):xs)
                        between t x y               = t >= x && t < y

-- -- -- -- -- -- -- -- -- helpers -- -- -- -- -- -- -- --

data Time = DPast | T Integer deriving (Eq, Show) -- DPast is "distant past"

instance Ord Time
        where
            compare DPast DPast = EQ
            compare DPast _     = LT
            compare _     DPast = GT
            compare (T t1) (T t2)  = compare t1 t2

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

data Temporal a = Temporal [(Time, a)] deriving (Eq, Show)

tVh :: Temporal a -> a
tVh = snd . head . toList        -- value head

tTt, tTh :: Temporal a -> Time
tTt = fst . head . tail . toList -- time tail
tTh = fst . head . toList        -- time head

tNull = null . toList

tUntil :: Time -> Temporal a -> Temporal a
tUntil t (Temporal xs) = Temporal $ (takeWhile (\(tx, vx) -> tx > t)) xs

toList :: Temporal a -> [(Time, a)]
toList (Temporal xs) = xs