queens 0 = [[]]
queens (n+1) = [q:bb<queens n;q<[1..11];safe q b]
safe q b = and[~checks q b ii<index b]
checks q b i = q=b!i \/ abs(qb!i)=i+1
main = queens 11
Miranda
Haskell nearly never existed. They originally planned to build on David Turner’s Miranda language rather than invent a new one.
Released in the 1980s, Miranda compiles a Haskelllike language to a certain set of combinators which a C program interprets. This is precisely what we do!
In January 2020, Miranda’s source was released. Its approach to compilation has remained unchanged through the years, yielding an excellent opportunity for an exhibition match.
▶ Download the files from this contest: cmpmira.tar.gz.
These go to eleven
We bump up a Miranda example that solves the eight queens puzzle to 11 queens:
On my laptop, to build mira
, I had to first edit the Makefile
and change
quotehostinfo
to ./quotehostinfo
. Afterwards:
$ mira make q11.m $ time mira exec q11.m > /dev/null real 0m8.132s user 0m8.111s sys 0m0.020s
We translate it for our assembly
compiler. We need much more code as we lack
a standard library:
infixl 9 !!; infixr 9 .; infixl 7 * , / , %; infixl 6 + , ; infixr 5 ++; infixl 4 <*>; infix 4 == , <=; infixl 3 &&; infixl 2 ; infixl 1 >> , >>=; infixr 0 $; foreign import ccall "putchar" putChar :: Int > IO Int; class Eq a where { (==) :: a > a > Bool }; instance Eq Int where { (==) = intEq }; class Ord a where { (<=) :: a > a > Bool }; instance Ord Int where { (<=) = intLE }; class Functor f where { fmap :: (a > b) > f a > f b }; class Applicative f where { pure :: a > f a ; (<*>) :: f (a > b) > f a > f b }; class Monad m where { return :: a > m a ; (>>=) :: m a > (a > m b) > m b }; (>>) f g = f >>= \_ > g; ($) f x = f x; (.) f g x = f (g x); id x = x; flip f x y = f y x;  TOOD: Support signed ints.  abs x = if 0 <= x then x else 0  x; abs x = if x <= 2147483647 then x else 0  x; not a = if a then False else True; () f g = if f then True else g; (&&) f g = if f then g else False; flst xs n c = case xs of { [] > n; h:t > c h t }; foldr c n l = flst l n (\h t > c h(foldr c n t)); (++) = flip (foldr (:)); concat = foldr (++) []; map = flip (foldr . ((:) .)) []; concatMap = (concat .) . map; and = foldr (&&) True; undefined = undefined; xs !! n = flst xs undefined \x xt > if n == 0 then x else xt !! (n  1); checks q b i = q==b!!i  abs(qb!!i)==i+1; index x = let { f n [] = [] ; f n (a:x) = n:f(n+1)x } in f 0 x; safe q b = and $ map (not . checks q b) $ index b; range m n  m <= n = m:range (m+1) n  True = []; queens 0 = [[]]; queens n = concatMap (\b > concatMap (\q > concatMap (\_ > [q:b]) $ if safe q b then [()] else []) $ range 1 11) $ queens $ n  1; instance Applicative IO where { pure = ioPure ; (<*>) f x = ioBind f \g > ioBind x \y > ioPure (g y) }; instance Monad IO where { return = ioPure ; (>>=) = ioBind }; instance Functor IO where { fmap f x = ioPure f <*> x }; mapM_ f = foldr ((>>) . f) (pure ()); putStr = mapM_ $ putChar . ord; class Shows a where { shows :: a > String > String }; showInt' n = if 0 == n then id else (showInt' $ n/10) . ((:) (chr $ 48+n%10)); instance Shows Int where { shows n = if 0 == n then ('0':) else showInt' n }; intersperse x as = flst as [] \a at > a : foldr (\h t > [x, h] ++ t) [] at; instance Shows a => Shows [a] where { shows xs = ('[':) . foldr (.) id (intersperse (',':) $ map shows xs) . (']':) }; main = putStr $ shows (queens 11) "";
On my laptop:
$ (cat rts.c;./assembly < q11.hs) > q11.c $ cc O2 q11.c o q11 $ time ./q11 > /dev/null real 0m6.783s user 0m6.734s sys 0m0.048s
I can’t help feeling proud. Miranda uses Turner’s bracket abstraction algorithm, which pushes SchÃ¶nfinkel’s classic approach about as far as it can go. It has a large set of combinators, including dedicated combinators for map and fold. And surely its runtime system must be expertly tuned.
Our program, on the other hand, compiles to a handful of basic combinators, uses the Scott encoding for all data types except unsigned ints, and the source to its hastily designed virtual machine prizes brevity over efficiency: it began life as an IOCCC entry after all.
But really its performance has little to do with my prowess. The credit goes to Oleg Kiselyov’s bracket abstraction algorithm (with minor tweaks from a few syntactic rewrites).
% = Q %; / = Q /; * = Q *;  = Q ; + = Q +; unsafePerformIO = C (T ?) K; exitSuccess = .; fail# = unsafePerformIO .; ioPure = B C T; ioBind = C; succ = T (1 +); ord = I; chr = I; () = K; if = I; intLE = Q L; intEq = Q =; shows = T I; >>= = T (K I); return = T K; <*> = T (K I); pure = T K; fmap = T I; <= = T I; == = T I; putChar = T FFI_0; , = B C T; , = I; : = B (B K) (B C T); [] = K; []: = I; False = K I; True = K; TrueFalse = I; {Eq Int} = T intEq; {Ord Int} = T intLE; >> = B (R K) (B (B B) (>>=)); $ = I; . = B; id = I; flip = C; abs = S (S (R 2147483647 ((<=) {Ord Int})) I) (() 0); not = R K (T False);  = T K; && = R False; flst = I; foldr = B (S (B C T)) (S (B B (B C (B B))) foldr); ++ = C (foldr (:)); concat = foldr (++) K; map = C (B foldr (B (:))) K; concatMap = B (B concat) map; and = foldr (&&) K; undefined = undefined; !! = R (S (B C (B (B B) (R 0 ((==) {Eq Int})))) (B (C (!!)) (R 1 ()))) (B B (T undefined)); checks = S (B S (B (B S) (B (B (B ())) (R (!!) (B B (B B ((==) {Eq Int}))))))) (B (R (R 1 (+))) (B (B S) (B (B (B ((==) {Eq Int}))) (B (B (B abs)) (R (!!) (B B (B B ()))))))); index = Y (B (B (S (T K))) (B (B (B K)) (B (B (B K)) (B (B (C (T fail#))) (B (B K) (B (S (B B (:))) (R (R 1 (+)) B))))))) 0; safe = B (B and) (R index (B S (B (B map) (B (B (B not)) checks)))); range = B (R K) (S (B S ((<=) {Ord Int})) (S (B B (:)) (B range (R 1 (+))))); queens = S (R ((:) K K) ((==) {Eq Int} 0)) (B (concatMap (R (range 1 11) (B concatMap (S (B S (B (B concatMap) (B (B K) (B (R K) (B (B (:)) (C (:))))))) (B (R K) (B (R ((:) K K)) (C safe))))))) (B queens (R 1 ()))); {Applicative IO} = C (T ioPure) (R (R (B ioPure) (B B C)) (B B C)); {Monad IO} = C (T ioPure) C; {Functor IO} = T (B ((<*>) {Applicative IO}) ioPure); mapM_ = B (C (B C (B (B foldr) (B B (>>))))) (R K pure); putStr = mapM_ {Applicative IO} {Monad IO} putChar; showInt' = S (R I ((==) {Eq Int} 0)) (S (B B (B showInt' (R 10 (/)))) (B (:) (B ((+) 48) (R 10 (%))))); {Shows Int} = T (S (R ((:) 48) ((==) {Eq Int} 0)) showInt'); intersperse = B (C (T K)) (B (C (B B (:))) (R K (B foldr (B (B (++)) (R (R K (:)) (B B (:))))))); {Shows ([] a)} = B T (B (B (B ((:) 91))) (B (R ((:) 93)) (B (B B) (B (B (foldr B I)) (B (B (intersperse ((:) 44))) (B map shows)))))); main = putStr (shows ({Shows ([] a)} ({Shows ([] a)} {Shows Int})) (queens 11) "");
A second opinion
The difference is even more pronounced for another example that computes 'e' to 4096 decimal places:
$ time ./e4096 > /dev/null real 0m6.532s user 0m6.471s sys 0m0.060s $ time mira exec e4096.m > /dev/null real 0m14.350s user 0m14.321s sys 0m0.013s
The Miranda original:
edigits = "2." ++ convert (repeat 1)
convert x = mkdigit (hd x'):convert (tl x')
where x' = norm 2 (0:map (10*) x)
mkdigit n = decode(n + code '0'), if n<10
norm c (d:e:x) = d + e div c: e' mod c : x', if e mod c + 9 < c
= d + e' div c : e' mod c : x', otherwise
where
(e':x') = norm (c+1) (e:x)
main = take 4096 edigits
Our version:
infixl 9 !!; infixr 9 .; infixl 7 * , / , %; infixl 6 + , ; infixr 5 ++; infixl 4 <*>; infix 4 == , <=; infixl 3 &&; infixl 2 ; infixl 1 >> , >>=; infixr 0 $; foreign import ccall "putchar" putChar :: Int > IO Int; class Eq a where { (==) :: a > a > Bool }; instance Eq Int where { (==) = intEq }; class Ord a where { (<=) :: a > a > Bool }; instance Ord Int where { (<=) = intLE }; class Functor f where { fmap :: (a > b) > f a > f b }; class Applicative f where { pure :: a > f a ; (<*>) :: f (a > b) > f a > f b }; class Monad m where { return :: a > m a ; (>>=) :: m a > (a > m b) > m b }; (>>) f g = f >>= \_ > g; ($) f x = f x; (.) f g x = f (g x); flip f x y = f y x; flst xs n c = case xs of { [] > n; h:t > c h t }; foldr c n l = flst l n (\h t > c h(foldr c n t)); (++) = flip (foldr (:)); concat = foldr (++) []; map = flip (foldr . ((:) .)) []; head (h:_) = h; tail (_:t) = t; repeat x = x : repeat x; mkdigit n  n <= 9 = chr (n + ord '0'); norm c (d:(e:x)) = let { e'x' = norm (c+1) (e:x); e' = head e'x'; x' = tail e'x' } in if e % c + 10 <= c then d + e / c: e' % c : x' else d + e' / c : e' % c : x'; convert x = let { x' = norm 2 (0:map (10*) x) } in mkdigit (head x'):convert (tail x'); edigits = "2." ++ convert (repeat 1); instance Applicative IO where { pure = ioPure ; (<*>) f x = ioBind f \g > ioBind x \y > ioPure (g y) }; instance Monad IO where { return = ioPure ; (>>=) = ioBind }; instance Functor IO where { fmap f x = ioPure f <*> x }; mapM_ f = foldr ((>>) . f) (pure ()); putStr = mapM_ $ putChar . ord; take 0 _ = []; take n (h:t) = h:take (n  1) t; main = putStr $ take 4096 edigits;
A rematch?
See David Turner’s talk, Open Sourcing Miranda, especially for tips on updating C code written 30 years ago! I was pleased to hear that:

Miranda’s VM has an ATOMLIMIT that is like our scheme of addressses starting at 128, with lower values representing combinators. (Though unlike Miranda, we box our characters.)

Turner talks about rewriting Miranda’s fragile conservative garbage collector. We began with a robust copying garbage collector.

Turner also talks about rewriting much of the C in Miranda. Been there, done that: we wrote everything but the VM in Haskell from the start.
But most of all, I’m pleased Miranda is alive again, and look forward to rematches with future releases.