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 Haskell-like 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:

queens 0 = [[]]
queens (n+1) = [q:b|b<-queens n;q<-[1..11];safe q b]
safe q b = and[~checks q b i|i<-index b]
checks q b i = q=b!i \/ abs(q-b!i)=i+1
main = queens 11

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(q-b!!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;
|True|False = 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.

Ben Lynn blynn@cs.stanford.edu 💡

Miranda

These go to eleven

A second opinion

A rematch?

Contents