How does this piece of obfuscated Haskell code work?

Question

While reading https://en.uncyclopedia.co/wiki/Haskell (and ignoring all the "offensive" stuff), I stumbled upon the following piece of obfuscated code:

fix$(<$>)<$>(:)<*>((<$>((:[{- thor's mother -}])<$>))(=<<)<$>(*)<$>(*2))$1

When I run that piece of code in ghci (after importing Data.Function and Control.Applicative), ghci prints the list of all powers of 2.

How does this piece of code work?

Answer 1

To begin with, we have the lovely definition

x = 1 : map (2*) x

which by itself is a bit mind-bending if you've never seen it before. Anyway it's a fairly standard trick of laziness and recursion. Now, we'll get rid of the explicit recursion using fix, and point-free-ify.

x = fix (\vs -> 1 : map (2*) vs)
x = fix ((1:) . map (2*))

The next thing we're going to do is expand the : section and make the map needlessly complex.

x = fix ((:) 1 . (map . (*) . (*2)) 1)

Well, now we have two copies of that constant 1. That will never do, so we'll use the reader applicative to de-duplicate that. Also, function composition is a bit rubbish, so let's replace that with (<$>) wherever we can.

x = fix (liftA2 (.) (:) (map . (*) . (*2)) 1)
x = fix (((.) <$> (:) <*> (map . (*) . (*2))) 1)
x = fix (((<$>) <$> (:) <*> (map <$> (*) <$> (*2))) 1)

Next up: that call to map is much too readable. But there's nothing to fear: we can use the monad laws to expand it a bit. In particular, fmap f x = x >>= return . f, so

map f x = x >>= return . f
map f x = ((:[]) <$> f) =<< x

We can point-free-ify, replace (.) with (<$>), and then add some spurious sections:

map = (=<<) . ((:[]) <$>)
map = (=<<) <$> ((:[]) <$>)
map = (<$> ((:[]) <$>)) (=<<)

Substituting this equation in our previous step:

x = fix (((<$>) <$> (:) <*> ((<$> ((:[]) <$>)) (=<<) <$> (*) <$> (*2))) 1)

Finally, you break your spacebar and produce the wonderful final equation

x=fix(((<$>)<$>(:)<*>((<$>((:[])<$>))(=<<)<$>(*)<$>(*2)))1)

Answer 2

Was writing a long answer with a full run-through of my IRC logs of the experiments leading up to the final code (this was in early 2008), but I accidentally all the text :) Not that much of a loss though - for the most part Daniel's analysis is spot on.

Here's what I started with:

Jan 25 23:47:23 <olsner>        @pl let q = 2 : map (2*) q in q
Jan 25 23:47:23 <lambdabot>     fix ((2 :) . map (2 *))

The differences mostly come down to the order in which the refactorings happened.

• Instead of x = 1 : map (2*) x I started with 2 : map ..., and I kept that initial 2 right up until the very last version, where I squeezed in a (*2) and changed the $2 at the end into $1. The "make the map needlessly complex" step didn't happen (that early).
• I used liftM2 instead of liftA2
• The obfuscated map function was put in before replacing liftM2 with Applicative combinators. That's also when all the spaces disappeared.
• Even my "final" version had lots of . for function composition left over. Replacing all of those with <$> apparently happened some time in the months between that and uncyclopedia.

BTW, here's an updated version that no longer mentions the number 2:

fix$(<$>)<$>(:)<*>((<$>((:[{- Jörð -}])<$>))(=<<)<$>(*)<$>(>>=)(+)($))$1

Answer 3

Both answers derive the obfuscated code snippet from the short original given out of the blue, but the question actually asks how does the long obfuscated code do its job.

Here's how:

fix$(<$>)<$>(:)<*>((<$>((:[{- thor's mother -}])<$>))(=<<)<$>(*)<$>(*2))$1 
= {- add spaces, remove comment -}
fix $ (<$>) <$> (:) <*> ( (<$> ((:[]) <$>) ) (=<<)  <$>  (*)  <$>  (*2) ) $ 1 
--                      \__\______________/_____________________________/
= {-    A   <$> B   <*> C                          $ 1   =   A (B 1) (C 1) -}
fix $ (<$>) (1 :)     ( ( (<$> ((:[]) <$>) ) (=<<)  <$>  (*)  <$>  (*2) ) 1 )
--                      \__\______________/____________________________/
= {- (<$>) A B = (A <$> B) ; (<$>    B)      A = (A <$> B)  -}
fix $ (1 :) <$>  ( (((=<<) <$> ((:[]) <$>) )        <$>  (*)  <$>  (*2) ) 1 )
--                  \\____________________/____________________________/
= {- <$> is left associative anyway -}
fix $ (1 :) <$>  ( ( (=<<) <$> ((:[]) <$>)          <$>  (*)  <$>  (*2) ) 1 )
--                  \__________________________________________________/
= {-                            A <$> foo = A . foo when foo is a function -}
fix $ (1 :) <$>  ( ( (=<<) <$> ((:[]) <$>)           .   (*)   .   (*2) ) 1 )
--                  \__________________________________________________/
= {-                 ((:[]) <$>) = (<$>) (:[]) = fmap (:[])  is a function -}
fix $ (1 :) <$>  ( ( (=<<)  .  ((:[]) <$>)           .   (*)   .   (*2) ) 1 )
--                  \__________________________________________________/
= {-               (  A     .      B  .  C .  D) 1  =  A  (B  (C  (D  1))) -}
fix $ (1 :) <$>      (=<<)  (  ((:[]) <$>)           (   (*)   (   (*2)   1 )))
= {-                                                    (*2) 1 = (1*2) = 2 -}
fix $ (1 :) <$>      (=<<)  (  ((:[]) <$>)           (   (*)   2             ))
= {-                                                     (*)   2 = (2*)    -}
fix $ (1 :) <$>      (=<<)  (  ((:[]) <$>)              (2*)                  )
= {-                           (  A   <$>)               B  =   A <$> B    -}
fix $ (1 :) <$>      (=<<)  (   (:[]) <$>               (2*)                  )
= {-                     A <$> foo = A . foo   when foo is a function      -}
fix $ (1 :) <$>      (=<<)  (   (:[])  .                (2*)                  )
= {-              (f . g) = (\ x -> f (g x))                               -}
fix $ (1 :) <$>      (=<<)  (\ x -> [2*x]  )
= {-                 (=<<)   A    =   (   A   =<<)                         -}
fix $ (1 :) <$>           ( (\ x -> [2*x]  )  =<<)

Here ( (\ x -> [2*x]) =<<) = (>>= (\ x -> [2*x])) = concatMap (\ x -> [2*x]) = map (2*) is a function, so again, <$> = .:

= 
fix $ (1 :)  .  map (2*)
= {- substitute the definition of fix -}
let xs = (1 :) . map (2*) $ xs in xs
=
let xs = 1 : [ 2*x | x <- xs] in xs
= {- xs = 1 : ys -}
let ys =     [ 2*x | x <- 1:ys] in 1:ys
= {- ys = 2 : zs -}
let zs =     [ 2*x | x <- 2:zs] in 1:2:zs
= {- zs = 4 : ws -}
let ws =     [ 2*x | x <- 4:ws] in 1:2:4:ws
=
iterate (2*) 1
= 
[2^n | n <- [0..]]

are all the powers of 2, in increasing order.

---

This uses

• A <$> B <*> C $ x = liftA2 A B C x and since liftA2 A B C is applied to x it's a function, an as a function it means liftA2 A B C x = A (B x) (C x).

• (f `op` g) = op f g = (f `op`) g = (`op` g) f are the three laws of operator sections

• >>= is monadic bind, and since (`op` g) f = op f g and the types are

   (>>=)                :: Monad m => m a -> (a -> m b ) -> m b
   (\ x -> [2*x])       :: Num t   =>         t -> [ t]
   (>>= (\ x -> [2*x])) :: Num t   => [ t]               -> [ t]
  

by type application and substitution we see that the monad in question is [] for which (>>= g) = concatMap g.

• concatMap (\ x -> [2*x]) xs is simplified as

   concat $ map (\ x -> [2*x]) 
   =
   concat $ [ [2*x] | x <- xs]
   =
            [  2*x  | x <- xs]
   =
            map (\ x ->  2*x )
  

• and by definition,

   (f . g) x  =  f (g x)
  
   fix f  =  let x = f x in x
  
   iterate f x  =  x : iterate f (f x)
                =  x : let y = f x in 
                       y : iterate f (f y)
                =  x : let y = f x in 
                       y : let z = f y in 
                           z : iterate f (f z)
                = ...
                = [ (f^n) x | n <- [0..]]
  

where

            f^n  =  f  .  f  .  ...  . f
            --     \_____n_times _______/

so that

    ((2*)^n) 1  =  ((2*) . (2*) .  ...  . (2*)) 1
                =    2*  (  2*  (  ...  (  2*   1 )...)) 
                =    2^n   ,  for n in [0..]