Skip to content

Instantly share code, notes, and snippets.

@noughtmare

noughtmare/StreamFuseDupLast.hs

Created May 13, 2026 18:19
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save noughtmare/58a4c014a632c2c76c854cc45a5f6e16 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save noughtmare/58a4c014a632c2c76c854cc45a5f6e16 to your computer and use it in GitHub Desktop.
Download ZIP
Stream fusion for dupLast
Raw
StreamFuseDupLast.hs
{-# LANGUAGE TypeApplications, TypeAbstractions #-}
module T where
import GHC.Base (build)
import Prelude hiding (Maybe)
data Stream a = forall s. MkStream (s -> Step s a) !s
data Step s a = Yield a !s | Done
toStream :: [a] -> Stream a
toStream xs = MkStream step xs where
step [] = Done
step (x:xs) = Yield x xs
fromStream :: Stream a -> [a]
fromStream (MkStream step s0) = go s0 where
go s = case step s of
Yield x s' -> x : go s'
Done -> []
data SMaybe a = SNothing | SJust !a
data T a b = T !a !b
{-# INLINE dupList #-}
dupList :: Stream a -> Stream a
dupList @a (MkStream @_ @s step s0) = MkStream step' $ case step s0 of
Yield x s' -> SJust (T x s')
Done -> SNothing
where
step' :: SMaybe (T a s) -> Step (SMaybe (T a s)) a
step' (SJust (T x s)) =
case step s of
Done -> Yield x SNothing
Yield y s' -> Yield y (SJust (T y s'))
step' SNothing = Done
trupList xs = fromStream (dupList (dupList (toStream xs)))
@noughtmare
Copy link
Copy Markdown
Author

noughtmare commented May 13, 2026 •
edited
Loading

The Core basically boils down to:

trupList :: [a] -> [a]
trupList [] = []
trupList [x] = [x]
trupList [x,y] = [y,y]
trupList (_:_:x:xs) = x : trupList2 (x:x:xs)

But the SMaybe and T types obscure it quite a bit.

@noughtmare
Copy link
Copy Markdown
Author

noughtmare commented May 13, 2026 •
edited
Loading

The equivalent foldr/build fusion code is this:

module T (shiftList2) where

import GHC.Base (build, oneShot)

{-# INLINE shiftList #-}
shiftList :: [a] -> [a]
shiftList xs = build $ \c n ->
  let
    base Nothing = n
    base (Just s) = c s n
    step x go = oneShot $ \s ->
      case s of
        Nothing -> go (Just x)
        _ -> x `c` go (Just x)
  in
  foldr step base xs Nothing

shiftList2 :: [a] -> [a]
shiftList2 xs = shiftList (shiftList xs)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment