[Haskell-cafe] wanted: Function to break circular data dependencies

Joey Adams joeyadams3.14159 at gmail.com
Mon May 5 03:39:12 UTC 2014


On Sun, May 4, 2014 at 3:39 PM, Mathijs Kwik <mathijs at bluescreen303.nl>wrote:

> An expression that demands itself isn't necessarily an infinite loop
> either. So this still boils down to the halting problem.
>
> a :: [Int]
> a = [length a * 2, length a * 3, length a * 4]
>

To be more precise, I believe we're looking to catch an expression where
evaluating it to head-normal form demands itself already evaluated in
head-normal form.  In your example, there is no loop because `length a` can
be evaluated without evaluating any of the items in `a`.  But you get an
infinite loop if you make cons strict in the item:

    {-# LANGUAGE BangPatterns #-}
    import Prelude hiding (length)

    -- | List whose cons is strict in the value.
    data SList a = Nil | Cons !a (SList a)
        deriving Show

    infixr 5 `Cons`

    length :: SList a -> Int
    length xs0 = go 0 xs0
      where
        go !n Nil = n
        go !n (Cons _ xs) = go (n+1) xs

    a :: SList Int
    a = (length a * 2) `Cons` (length a * 3) `Cons` (length a * 4) `Cons`
Nil

    main :: IO ()
    main = print a
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140504/d16e2c6d/attachment.html>


More information about the Haskell-Cafe mailing list