“Seven Trees in One” by Andreas Blass

blass.hs

import Test.QuickCheck

data Tree = L | N Tree Tree deriving (Eq, Show)

data Herp
  = H0
  | H1 Tree
  | H2 Tree Tree
  | H3 Tree Tree Tree
  | H4 Tree Tree Tree Tree
  | H5 Tree Tree Tree Tree Tree
  | H6 Tree Tree Tree Tree Tree Tree
  | H8 Tree Tree Tree Tree Tree Tree Tree Tree

data Derp
  = D0
  | D2 Tree Tree
  | D3 Tree Tree Tree
  | D4 Tree Tree Tree Tree
  | D5 Tree Tree Tree Tree Tree
  | D6 Tree Tree Tree Tree Tree Tree
  | D7 Tree Tree Tree Tree Tree Tree Tree
  | D8 Tree Tree Tree Tree Tree Tree Tree Tree

foo L = H0
foo (N a L) = H1 a
foo (N a (N b L)) = H2 a b
foo (N a (N b (N c L))) = H3 a b c
foo (N a (N b (N c (N d L)))) = H4 a b c d
foo (N a (N b (N c (N d (N e L))))) = H5 a b c d e
foo (N a (N b (N c (N d (N e (N f L)))))) = H6 a b c d e f
foo (N a (N b (N c (N d (N e (N f (N g h))))))) = H8 a b c d e f g h

foo' H0 = L
foo' (H1 a) = N a L
foo' (H2 a b) = N a (N b L)
foo' (H3 a b c) = N a (N b (N c L))
foo' (H4 a b c d) = N a (N b (N c (N d L)))
foo' (H5 a b c d e) = N a (N b (N c (N d (N e L))))
foo' (H6 a b c d e f) = N a (N b (N c (N d (N e (N f L)))))
foo' (H8 a b c d e f g h) = N a (N b (N c (N d (N e (N f (N g h))))))

bar H0 = D0
bar (H1 a) = D2 L a
bar (H2 a b) = D2 (N L a) b
bar (H3 a b c) = D3 a b c
bar (H4 a b c d) = D4 a b c d
bar (H5 a b c d e) = D5 a b c d e
bar (H6 L L a b c d) = D2 (N (N a b) c) d
bar (H6 L (N a b) c d e f) = D6 a b c d e f
bar (H6 (N a b) c d e f g) = D7 a b c d e f g
bar (H8 a b c d e f g h) = D8 a b c d e f g h

bar' D0 = H0
bar' (D2 L a) = H1 a
bar' (D2 (N L a) b) = H2 a b
bar' (D2 (N (N a b) c) d) = H6 L L a b c d
bar' (D3 a b c) = H3 a b c
bar' (D4 a b c d) = H4 a b c d
bar' (D5 a b c d e) = H5 a b c d e
bar' (D6 a b c d e f) = H6 L (N a b) c d e f
bar' (D7 a b c d e f g) = H6 (N a b) c d e f g
bar' (D8 a b c d e f g h) = H8 a b c d e f g h

qux D0 = (L,L,L,L,L,L,L)
qux (D2 a b) = (L,L,L,L,L,L,N a b)
qux (D3 a b c) = (L,L,L,L,L,N a b,c)
qux (D4 a b c d) = (L,L,L,L,N a b,c,d)
qux (D5 a b c d e) = (L,L,L,N a b,c,d,e)
qux (D6 a b c d e f) = (L,L,N a b,c,d,e,f)
qux (D7 a b c d e f g) = (L,N a b,c,d,e,f,g)
qux (D8 a b c d e f g h) = (N a b,c,d,e,f,g,h)

qux' (L,L,L,L,L,L,L) = D0
qux' (L,L,L,L,L,L,N a b) = D2 a b
qux' (L,L,L,L,L,N a b,c) = D3 a b c
qux' (L,L,L,L,N a b,c,d) = D4 a b c d
qux' (L,L,L,N a b,c,d,e) = D5 a b c d e
qux' (L,L,N a b,c,d,e,f) = D6 a b c d e f
qux' (L,N a b,c,d,e,f,g) = D7 a b c d e f g
qux' (N a b,c,d,e,f,g,h) = D8 a b c d e f g h

fwd = qux . bar . foo
bwd = foo' . bar' . qux'

gen n = frequency [(1, pure L), (n, N <$> next <*> next)]
  where
    next = gen (n - 1)

instance Arbitrary Tree where
  arbitrary = gen 15

main = do
  quickCheck $ (==) <$> id <*> bwd . fwd
  quickCheck $ (==) <$> id <*> fwd . bwd

blass.sml

datatype tree = L | N of tree * tree

datatype herp
  = H0
  | H1 of tree
  | H2 of tree * tree
  | H3 of tree * tree * tree
  | H4 of tree * tree * tree * tree
  | H5 of tree * tree * tree * tree * tree
  | H6 of tree * tree * tree * tree * tree * tree
  | H8 of tree * tree * tree * tree * tree * tree * tree * tree

datatype derp
  = D0
  | D2 of tree * tree
  | D3 of tree * tree * tree
  | D4 of tree * tree * tree * tree
  | D5 of tree * tree * tree * tree * tree
  | D6 of tree * tree * tree * tree * tree * tree
  | D7 of tree * tree * tree * tree * tree * tree * tree
  | D8 of tree * tree * tree * tree * tree * tree * tree * tree

fun foo L = H0
  | foo (N (a,L)) = H1 a
  | foo (N (a,N (b,L))) = H2 (a,b)
  | foo (N (a,N (b,N (c,L)))) = H3 (a,b,c)
  | foo (N (a,N (b,N (c,N (d,L))))) = H4 (a,b,c,d)
  | foo (N (a,N (b,N (c,N (d,N (e,L)))))) = H5 (a,b,c,d,e)
  | foo (N (a,N (b,N (c,N (d,N (e,N (f,L))))))) = H6 (a,b,c,d,e,f)
  | foo (N (a,N (b,N (c,N (d,N (e,N (f,N (g,h)))))))) = H8 (a,b,c,d,e,f,g,h)

fun foo' H0 = L
  | foo' (H1 a) = N (a,L)
  | foo' (H2 (a,b)) = N (a,N (b,L))
  | foo' (H3 (a,b,c)) = N (a,N (b,N (c,L)))
  | foo' (H4 (a,b,c,d)) = N (a,N (b,N (c,N (d,L))))
  | foo' (H5 (a,b,c,d,e)) = N (a,N (b,N (c,N (d,N (e,L)))))
  | foo' (H6 (a,b,c,d,e,f)) = N (a,N (b,N (c,N (d,N (e,N (f,L))))))
  | foo' (H8 (a,b,c,d,e,f,g,h)) = N (a,N (b,N (c,N (d,N (e,N (f,N (g,h)))))))

fun bar H0 = D0
  | bar (H1 a) = D2 (L,a)
  | bar (H2 (a,b)) = D2 (N (L,a),b)
  | bar (H3 xs) = D3 xs
  | bar (H4 xs) = D4 xs
  | bar (H5 xs) = D5 xs
  | bar (H6 (L,L,a,b,c,d)) = D2 (N (N (a,b),c),d)
  | bar (H6 (L,N(a,b),c,d,e,f)) = D6 (a,b,c,d,e,f)
  | bar (H6 (N(a,b),c,d,e,f,g)) = D7 (a,b,c,d,e,f,g)
  | bar (H8 xs) = D8 xs

fun bar' D0 = H0
  | bar' (D2 (L,a)) = H1 a
  | bar' (D2 (N (L,a),b)) = H2 (a,b)
  | bar' (D2 (N (N (a,b),c),d)) = H6 (L,L,a,b,c,d)
  | bar' (D3 xs) = H3 xs
  | bar' (D4 xs) = H4 xs
  | bar' (D5 xs) = H5 xs
  | bar' (D6 (a,b,c,d,e,f)) = H6 (L,N(a,b),c,d,e,f)
  | bar' (D7 (a,b,c,d,e,f,g)) = H6 (N(a,b),c,d,e,f,g)
  | bar' (D8 xs) = H8 xs

fun qux D0 = (L,L,L,L,L,L,L)
  | qux (D2 (a,b)) = (L,L,L,L,L,L,N(a,b))
  | qux (D3 (a,b,c)) = (L,L,L,L,L,N(a,b),c)
  | qux (D4 (a,b,c,d)) = (L,L,L,L,N(a,b),c,d)
  | qux (D5 (a,b,c,d,e)) = (L,L,L,N(a,b),c,d,e)
  | qux (D6 (a,b,c,d,e,f)) = (L,L,N(a,b),c,d,e,f)
  | qux (D7 (a,b,c,d,e,f,g)) = (L,N(a,b),c,d,e,f,g)
  | qux (D8 (a,b,c,d,e,f,g,h)) = (N(a,b),c,d,e,f,g,h)

fun qux' (L,L,L,L,L,L,L) = D0
  | qux' (L,L,L,L,L,L,N(a,b)) = D2 (a,b)
  | qux' (L,L,L,L,L,N(a,b),c) = D3 (a,b,c)
  | qux' (L,L,L,L,N(a,b),c,d) = D4 (a,b,c,d)
  | qux' (L,L,L,N(a,b),c,d,e) = D5 (a,b,c,d,e)
  | qux' (L,L,N(a,b),c,d,e,f) = D6 (a,b,c,d,e,f)
  | qux' (L,N(a,b),c,d,e,f,g) = D7 (a,b,c,d,e,f,g)
  | qux' (N(a,b),c,d,e,f,g,h) = D8 (a,b,c,d,e,f,g,h)

val fwd = qux o bar o foo
val bwd = foo' o bar' o qux'