MicroHs:
A Small Haskell Compiler
Lennart Augustsson
Haskell Symposium, September 7, 2024
Demo
Why?
Does the world need another Haskell compiler?
Why?
Does the world need another Haskell compiler?
😀 I don't care. I'm doing this for fun.
Why?
Does the world need another Haskell compiler?
😀 I don't care. I'm doing this for fun.
😐 Maybe. GHC isn't known for being minimal.
Why?
Does the world need another Haskell compiler?
😀 I don't care. I'm doing this for fun.
😐 Maybe. GHC isn't known for being minimal.
🙁 No. GHC is the defacto standard.
Why?
Does the world need another Haskell compiler?
😀 I don't care. I'm doing this for fun.
😐 Maybe. GHC isn't known for being minimal.
🙁 No. GHC is the defacto standard.
Why?
Does the world need another Haskell compiler?
😀 I don't care. I'm doing this for fun.
😐 Maybe. GHC isn't known for being minimal.
🙁 No. GHC is the defacto standard.
Why?
Does the world need another Haskell compiler?
😀 I don't care. I'm doing this for fun.
😐 Maybe. GHC isn't known for being minimal.
🙁 No. GHC is the defacto standard.
Why?
Why the name? Or, some numbers...
An (unfair) comparison. All numbers from an M1 MacBook.
| Binary MB | Compiler kLOC | Runtime kLOC | Compile mhs with libs s | Compile mhs no libs s |
mhs | 0.45 | 10 | 6 | 18.2 | 12.0 |
gmhs | 24.04 | 10 | 6 | 1.5 | |
ghc | 120?? | 515 | 133 | | 11.2 |
Compiler pipeline structure (boring)
Lex
Parse
Type
check
Desugar
Opt
Comb
Input Language
MicroHs compiles Haskell2010, with some always-on extensions:�{-# LANGUAGE �BangPatterns ConstraintKinds DefaultSignatures DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification ExtendedDefaultRules FlexibleContexts FlexibleInstance ForeignFunctionInterface FunctionalDependencies GADTs GADTsyntax ImportQualifiedPost IncoherentInstances KindSignatures MonoLocalBinds MultiParamTypeClasses NamedFieldPuns NegativeLiterals NoMonomorphismRestriction NoStarIsType OverlappingInstances OverloadedRecordDot OverloadedRecordUpdate OverloadedStrings PolyKinds RankNTypes RecordWildCards QualifiedDo ScopedTypeVariables StandaloneKindSignatures TupleSections (only pairs right now) TypeLits TypeSynonymInstances UndecidableInstances UndecidableSuperClasses ViewPatterns�#-}
Input Language
Missing features
Output Language
Combinators, more later
The output contains the combinator graph in textual form.� A B _49 @_50 @:51 @� A C _46 @#0 @:50 @� A B C C S' @B _48 #91 @@_48 #93 @@@@@B B B B _48 #91 @@@@@S' B @C'B @B B Y @@B C'B B P @_48 #93 @@@@B B B B _48 #44 @@@@@C'B @@@@@@:49 @
But it is generated as a C byte array.� static unsigned char data[] = {� 118,55,46,48,10,50,49,55,10,65,32,95,48,32,95,50,52,32,64,95,� 52,49,32,102,114,111,109,85,84,70,56,32,34,83,111,109,101,32,102,97,� 99,116,111,114,105,97,108,115,34,32,64,64,64,95,52,51,32,95,53,50,� ...
This is compiled together with the runtime system to generate the binary.
Parsing layout
Haskell has one annoying lexing feature. This is the specification of how to insert missing '{', ';', and '}'. All easy, except... "parse-error(t)"
Parsing layout
Typical interface to the lexer:� lex :: [Char] -> [Token]
To communicate from the parser to the lexer MicroHs uses:� startLex :: [Char] -> LexState� nextToken :: LexState -> (Token, LexState)� popLayout :: LexState -> LexState
The change to the parser is minimal:� pBraces :: P a -> P a� pBraces p = pSpec '{' *> p <* pSpec '}'� <|> pSpec '{' *> p <* soft� where soft = nextToken >>= \case� TSpec '}' -> pSpec '}'� _ -> mapTokenState popLayout -- magic!
Type checking
Needed "type" checkers:
MicroHs uses the same type checker for all of those (and the same AST).
Based on Practical type inference for arbitrary-rank types� Peyton Jones, Vytiniotis, Weirich, Shields
Desugar
Optimization
A single optimization: remove initial prefix of constant arguments in recursion.�E.g.
map f [] = []�map f (x:xs) = f x : map f xs
turns into
map f = g� where g [] = []� g (x:xs) = f x : g xs
(The importance of this will become clear soon.)
Combinators
Combinator calculus was introduced by Moses Schönfinkel and Haskell Curry.
A typical combinator base:� S f g x = (f x) (g x) -- Haskell: ap� K x y = x -- Haskell: const� I x = x -- Haskell: id
These 3 are enough to encode the λ-calculus.�(Actually, S&K are enough since I=SKK.)
Combinators
Turn λ-calculus into combinators, bracket abstraction
λx. e = [x]e
[x]x = I� [x]y = K y x≠y� [x](e1 e2) = S ([x]e1) ([x]e2)� [x](λy. e) = [x]([y]e)
Graph reduction
David Turner's 1979 seminal paper A New Implementation Technique for Applicative Languages shows how to use combinators for execution.
To get efficient evaluation, we need graph reduction.
Interpret the combinator reduction rules as graph rewrites.
*
@
I
I x = x
*
@
K x y = x
@
K
x
x
y
y
x
x
Graph reduction
@
S f g x = f x (g x)
@
g
x
@
S
f
g
x
f
@
@
@
@
Y
Y f = f (Y f)
@
f
f
Normal order reduction
Getting normal order reduction and lazy evaluation is easy:
Start from the root of the combinator graph, and do the leftmost reduction,�repeat.
@
@
@
@
X
Reduce
here
Normal order reduction
Getting normal order reduction and lazy evaluation is easy:
Start from the root of the combinator graph, and do the leftmost reduction,�repeat.
@
@
@
@
X
.
.
.
To avoid repeatedly finding the leftmost redex the runtime keeps a stack of pointers to the spine.
Combinators in MicroHs
A very ad hoc set� Haskell In D.A.T. paper�S x y z = x z (y z) A (<*>) *�K x y = x * const, False, [] *�I x = x * id *�B x y z = x (y z) A (.) *�C x y z = x z y A flip *�S' x y z w = x (y w) (z w) A *�B' x y z w = x y (z w) A *�C' x y z w = x (y w) z A *�A x y = y * True�U x y = y x uncurry *�Z x y z = x y�P x y z = z x y A (,) *�R x y z = y z x A�O x y z w = w x y A (:)�n@(Y x) = x n fix *�K2 x y z = x *�K3 x y z w = x *�K4 x y z w v = x *
A - allocates, * - uses indirection node
Combinators
Primitive functions
seq not lambda definable
intAdd, intSub, ... arithmetic
intEq, ... comparisons
dblAdd, dblSub, ...
dblEq, ...
returnIO
bindIO
thenIO
performIO i.e., unsafePerformIO
throw
catch
ccall FFI call
malloc, free
Self-optimization
David said:
f x = (2+3) + x
f = intAdd (intAdd 2 3)
The first time f is used the (intAdd 2 3) reduction will happen and the new definition will be�f = intAdd 5
Implementing overloading (self-optimization)
Source
class Num a where
(+) :: a -> a -> a
fromInteger :: Integer -> a
...
instance Num Int where
(+) = primIntAdd
fromInteger = primIToInt
...
inc :: forall a . Num a => a -> a
inc x =
x + 1
incInt :: Int -> Int
incInt = inc
Transformed
data Num a = Num {
(+) :: a -> a -> a,
fromInteger :: Integer -> a
... }
instNumInt :: Num Int
instNumInt = Num {
(+) = primIntAdd,
fromInteger = primIToInt
... }
inc :: forall a . Num a -> a -> a
inc numDict x =
((+) numDict) x
(fromInteger numDict 1)
incInt :: Int -> Int
incInt = inc instNumInt
Implementing overloading (self-optimization)
Transformed
data Num a = Num {
(+) :: a -> a -> a,
fromInteger :: Integer -> a
... }
instNumInt :: Num Int
instNumInt = Num {
(+) = primIntAdd,
fromInteger = primIToInt
... }
inc :: forall a . Num a -> a -> a
inc numDict x =
((+) numDict) x
(fromInteger numDict 1)
incInt :: Int -> Int
incInt = inc instNumInt
Reduction (actually happens with combinators):
incInt →
inc instNumInt →
\x-> ((+) intNumInt) x
(fromInteger instNumInt 1) →
\x-> primIntAdd x (primIToInt 1) →
\x-> primIntAdd x #1 →
\x-> flip primIntAdd #1 x →
flip primIntAdd #1 →
C primIntAdd #1
Compiler structure
Decode args,
read files, etc
Compiler pipeline
Cache
Package
database
Write file
C compiler
C rts
Cache
MicroHs has no separate compilation of modules, only packages.
MicroHs always operates in "make" mode, i.e., it automatically finds and compiles all imported modules.
There is cache during compilation:
A package is just a saved compilation cache.
Demo
inc :: Num a => a -> a�inc x = x + 1��incInt :: Int -> Int�incInt = inc
Demo
inc :: Num a => a -> a�inc x = x + 1��incInt :: Int -> Int�incInt = inc
inc' :: Dict (Num a) -> a -> a�inc' Dict = inc
inc' = (U (((S' C) (U (Z (Z (Z (Z (Z K))))))) ((C (U (K (K4 A)))) ((P K) ((O #1) K)))))
incInt = ((C +) #1)
Easy execution
After conversion to combinators we have this data type (assuming only Int literals):
data Exp = App Exp Exp | Comb String | LitInt Int
How can we convert an expression tree (an Exp) to the value it represent?
Easy execution
After conversion to combinators we have this data type (assuming only Int literals):
data Exp = App Exp Exp | Comb String | LitInt Integer
How can we convert an expression tree (an Exp) to the value it represent?
Ignoring types, it's very easy!
translate :: Exp -> Any
translate (LitInt i) = unsafeCoerce i
translate (Comb s) = lookupComb s
translate (App f a) = (unsafeCoerce (translate f)) (translate a)
lookupComb :: String -> Any
lookupComb "K" = unsafeCoerce const
lookupComb "I" = unsafeCoerce id
lookupComb "S" = unsafeCoerce $ \ f g x -> (f x) (g x)
lookupComb "+" = unsafeCoerce (+)
Combinator evaluation
The runtime system has two evaluators:
eval(), some C code
for(;;) {
tag = GETTAG(n);
switch(tag) {
case T_IND: n = INDIR(n); break;
case T_AP: PUSH(n); n = FUN(n); break;
case T_INT: RET;
case T_S: GCCHECK(2); CHKARG3; GOAP(new_ap(x, z), new_ap(y, z)); /* S x y z = x z (y z) */
case T_SS: GCCHECK(3); CHKARG4; GOAP(new_ap(x, new_ap(y, w)), new_ap(z, w)); /* S' x y z w = x (y w) (z w) */
case T_K: CHKARG2; GOIND(x); /* K x y = *x */
case T_A: CHKARG2; GOIND(y); /* A x y = *y */
case T_U: CHKARG2; GOAP(y, x); /* U x y = y x */
case T_I: CHKARG1; GOIND(x); /* I x = *x */
case T_Y: CHKARG1; GOAP(x, n); /* n@(Y x) = x n */
case T_B: GCCHECK(1); CHKARG3; GOAP(x, new_ap(y, z)); /* B x y z = x (y z) */
case T_BB: GCCHECK(2); CHKARG4; GOAP(new_ap(x, y), new_ap(z, w)); /* B' x y z w = x y (z w) */
case T_Z: CHKARG3; GOAP(x, y); /* Z x y z = x y */
case T_C: GCCHECK(1); CHKARG3; GOAP(new_ap(x, z), y); /* C x y z = x z y */
case T_CC: GCCHECK(2); CHKARG4; GOAP(new_ap(x, new_ap(y, w)), z); /* C' x y z w = x (y w) z */
case T_P: GCCHECK(1); CHKARG3; GOAP(new_ap(z, x), y); /* P x y z = z x y */
case T_R: GCCHECK(1); CHKARG3; GOAP(new_ap(y, z), x); /* R x y z = y z x */
case T_O: GCCHECK(1); CHKARG4; GOAP(new_ap(w, x), y); /* O x y z w = w x y */
case T_ADD: ARITHBIN(+);
case T_SUB: ARITHBIN(-);
...
}
}
execio(), some C code
for(;;) {
eval(n);
tag = GETTAG(n);
switch(tag) {
case T_IND: n = INDIR(n); break;
case T_AP: PUSH(n); n = FUN(n); break;
case T_IO_BIND: CHECKIO(2); x = execio(ARG(TOP(1))); f = ARG(TOP(2)); n = new_ap(f, x); POP(3); break;
case T_IO_THEN: CHECKIO(2); (void)execio(ARG(TOP(1))); n = ARG(TOP(2)); POP(3); break;
case T_IO_RETURN: CHECKIO(1); n = ARG(TOP(1)); RETIO(n);
case T_IO_CCALL: ...
case T_IO_CATCH: ... setjmp(jbuf); ...
...
default: ERR("non-IO encountered");
}
}
Memory management
0
1
T_S
1
T_INT
42
1
T_PTR
C
application
combinator etc
base type
Serialization
The graph in memory has a very simple structure, only 3 kinds of nodes
This means that we can have a generic serializer than can write any (except C pointers) graph to a file
Both of these are easy with a 2 pass serializer, and a deserializer with a sharing table.
MicroHs uses an s-expression textual format. E.g.� 1 + 2 is ((+ #1) #2)�let x = 1+2 in x*x is ((* :83 ((+ #1) #2)) _83)
Runtime system
Demo
module Blink where
import Control.Monad; import ESP32; import Morse
colorCycle = [ RGB 255 0 0, RGB 128 128 0, RGB 0 255 0,
RGB 0 128 128, RGB 0 0 255, RGB 128 0 128 ]
message = "MicroHs "
unit = 100 -- Time in ms for a dot
main = do led <- ledConfigure; blink led
blink led = zipWithM_ (send led) (cycle colorCycle) (cycle message)
send _ _ ' ' = delayMs (5 * unit) -- word gap (8 - 3)
send led rgb c = do
mapM_ (sendOne led rgb) (getMorseChar c)
delayMs (2 * unit) -- character gap (3 - 1)
sendOne led rgb m = do
ledRGB led rgb
delayMs $ unit * if m == '-' then 3 else 1
ledRGB led (RGB 0 0 0)
delayMs unit
Rant
Future work
Whatever I feel like, but a JIT would be cool.
I have a long list.