The Process

I use OpenCode and its free tier models, mostly DeepSeek V4. The prompt is simple:

Rewrite the interpreter in Haskell. Make sure that every test is rewritten and passed. ghcup is installed on this machine.

The rewriting session lasted for a few hours. The agent get stuck occasionally:

1. It had a hard time writing the parser. This is understandable since there is no reference implementation of the parser.
2. The interpreter went into infinite loop when running tests. The agent solved it in about an hour without intervention.
3. The agent couldn’t implement the step-by-step evaluation, and it decided to implement a simplified evaluation process without asking me.

When all tests are passed, I asked the agent to fuzz the new interpreter: write a Python script to generate random Lam expression and check whether the Rust version and the Haskell version produce the same output. It generated and tested 20k random Lam programs on both versions, fixing some bugs along the way. All tests passed, so we are confident that the two versions should have the same behavior.

The Result

The generated code is beautiful. It doesn’t have the messiness feature of AI-generated code. I think the reason is that the Rust interpreter is clean enough, and Haskell is less noisy than C-like languages.

I’ll paste a couple of excerpts from the Rust and Haskell versions here. The code snippet are supposed to do the same job so you can compare them.

You have to write bizarre parser DSL in both versions. In my opinion parsec is better because it’s at least part of the Haskell language and the compile error is more informative than “there is something wrong at line 2145 of the generated Rust code”:

LetRec: Box<Expr> = {
    <e:Let> => e,
    "letrec" <x:Variable> "=" <evar:LetRec> "in" <ebody:LetRec> => {
        let xclone = x.clone();
        let lam = Box::new(Expr::Lam { x: xclone, e: ebody });
        let arg = Box::new(Expr::Fix { x, e: evar });
        Box::new(Expr::App { lam, arg })
    }
};

Let: Box<Expr> = {
    <e:Func> => e,
    "let" <x:Variable> "=" <e_x:Let> "in" <e_in:Let> => Box::new(Expr::Let { x, e_x, e_in }),
};

letrecExpr :: P Expr
letrecExpr =
    try (do
        kw "letrec"
        x <- var
        op "="
        e1 <- letrecExpr
        kw "in"
        e2 <- letrecExpr
        return (EApp (ELam x e2) (EFix x e1)))
    <|> letExpr

letExpr :: P Expr
letExpr =
    try (do
        kw "let"
        x <- var
        op "="
        e1 <- letExpr
        kw "in"
        ELet x e1 <$> letExpr)
    <|> funExpr

The Haskell version uses recursion to iterate over the constraint, a common trick in pure functional programming:

fn unification(
    constraints: Vec<Constraint>,
) -> Result<(UnionFind<Variable>, HashMap<Variable, Type>), String> {
    let variables: Vec<Variable> = constraints
        .iter()
        .flat_map(|c| vec![&c.type_l, &c.type_r])
        .flat_map(|t| t.get_all_vars())
        .collect();
    let mut uf = UnionFind::new(variables);
    let mut map: HashMap<Variable, Type> = HashMap::new();
    let mut constraints = VecDeque::from(constraints);
    while !constraints.is_empty() {
        let constraint = constraints.pop_front().unwrap();
        match (constraint.type_l, constraint.type_r) {
            (Type::Bool, Type::Bool) | (Type::Num, Type::Num) | (Type::Unit, Type::Unit) => (),
            (Type::Var(l), Type::Var(r)) => {
                let l_root = uf.find(&l)?.clone();
                let r_root = uf.find(&r)?.clone();
                let root = uf.union(&l, &r).unwrap();
                match (map.remove(&l_root), map.remove(&r_root)) {
                    (Some(lval), Some(rval)) => {
                        constraints.push_back(Constraint {
                            type_l: lval.clone(),
                            type_r: rval,
                            expr_l: format!("val({})", l),
                            expr_r: format!("val({})", r),
                        });
                        Some(lval)
                    }
                    (Some(val), None) | (None, Some(val)) => Some(val),
                    (None, None) => None,
                }
                .and_then(|v| map.insert(root.clone(), v));
            }

unification' :: UnionFind Variable -> Map Variable Type -> [Constraint]
    -> Either String (UnionFind Variable, Map Variable Type)
unification' uf mp [] = return (uf, mp)
unification' uf mp (c:cs) = case (typeL c, typeR c) of
    (TNum, TNum) -> unification' uf mp cs
    (TBool, TBool) -> unification' uf mp cs
    (TUnit, TUnit) -> unification' uf mp cs
    (TVar l, TVar r) -> do
        let lRootBefore = case find uf l of Right x -> x; Left _ -> l
        let rRootBefore = case find uf r of Right x -> x; Left _ -> r
        let lVal = Map.lookup lRootBefore mp
        let rVal = Map.lookup rRootBefore mp
        (uf', root) <- union uf l r
        case (lVal, rVal) of
            (Nothing, Nothing) -> unification' uf' mp cs
            (Just lv, Nothing) -> do
                let mp' = Map.insert root lv mp
                unification' uf' mp' cs
            (Nothing, Just rv) -> do
                let mp' = Map.insert root rv mp
                unification' uf' mp' cs
            (Just lv, Just rv) ->
                let newC = Constraint lv rv (show lv) (show rv)
                in unification' uf' mp (newC : cs)

Another example of loop to recursion. I’m glad that my weird logic to reduce nested if-else doesn’t get into the Haskell version:

fn get_type(mut tau: Type, mut uf: UnionFind<Variable>, mut map: HashMap<Variable, Type>) -> Type {
    loop {
        let vars = tau.get_free_vars();
        if vars.is_empty() {
            return tau;
        }
        let x = vars.first().unwrap();
        let r_opt = uf.find(x);
        if let Ok(r) = r_opt
            && x != r
        {
            tau = tau.substitute(x.clone(), Type::Var(r.clone()));
            continue;
        }
        match r_opt.ok().and_then(|r| map.remove(r)) {
            Some(t_x) => tau = tau.substitute(x.clone(), t_x),
            None => tau = tau.add_one_quantifier(x.clone()),
        }
    }
}

getType :: Type -> UnionFind Variable -> Map Variable Type -> Type
getType tau uf mp =
    let fvs = getFreeVars tau in
    if null fvs
        then substituteVars tau
        else let x = head fvs in
            case find uf x of
                Left _ -> getType (addOneQuantifier tau x) uf mp
                Right r -> if r /= x
                    then getType (substituteVar x (TVar r) tau) uf mp
                    else case Map.lookup r mp of
                        Just t -> getType (substituteVar x t tau) uf mp
                        Nothing -> getType (addOneQuantifier tau x) uf mp
  where
    substituteVars t = case t of
        TVar v -> maybe t substituteVars (Map.lookup v mp)
        TFn a r -> TFn (substituteVars a) (substituteVars r)
        TProduct l r -> TProduct (substituteVars l) (substituteVars r)
        TSum l r -> TSum (substituteVars l) (substituteVars r)
        TForall a tau' -> TForall a (substituteVars tau')
        _ -> t

The “pseudo do-notation” implemented using Rust macro looks exactly the same as Haskell’s do-notation:

impl ToGraph for Expr {
    fn to_graph(&self, parent: NodeIndex) -> Writer<()> {
        match self {
            Expr::Var(_)
            | Expr::DeBruijn(_)
            | Expr::Num(_)
            | Expr::True
            | Expr::False
            | Expr::Unit => {
                do_!(new_node(self, parent, "red"), Writer::ret(()))
            }
            Expr::Addop { binop, left, right } => do_!(
                new_node(binop, parent, "red") => cur,
                left.to_graph(cur.clone()),
                right.to_graph(cur)
            ),
            Expr::Mulop { binop, left, right } => do_!(
                new_node(binop, parent, "red") => cur,
                left.to_graph(cur.clone()),
                right.to_graph(cur)
            ),

instance ToGraph Expr where
    toGraph e parent counter = case e of
        EVar _ -> do
            (_, next) <- newNode (show e) parent counter "red"
            return next
        EDeBruijn _ -> do
            (_, next) <- newNode (show e) parent counter "red"
            return next
        ENum _ -> do
            (_, next) <- newNode (show e) parent counter "red"
            return next
        ETrue -> do
            (_, next) <- newNode (show e) parent counter "red"
            return next
        EFalse -> do
            (_, next) <- newNode (show e) parent counter "red"
            return next
        EUnit -> do
            (_, next) <- newNode (show e) parent counter "red"
            return next

        EAddop op left right -> do
            (cur, next1) <- newNode (show op) parent counter "red"
            next2 <- toGraph left cur next1
            toGraph right cur next2

        EMulop op left right -> do
            (cur, next1) <- newNode (show op) parent counter "red"
            next2 <- toGraph left cur next1
            toGraph right cur next2

Conclusion

AI have lowered the barrier to learn and use Haskell. Before the AI agent era, I thought I’ll never be able to write anything non-trivial in Haskell because of its weird Monadic syntax and incomprehensible error message. These are no longer the problem now as AI agents can analyze and fix complex compile error for me.

Haskell will probably be my go-to language when the dependencies are simple and the performance doesn’t matter, such as writing indie compilers and interpreters.

The implementation is based on chapter 10.6 of Cornell CS3110 textbook. I’ll recommend you to read that chapter first since:

• It explains HM algorithm in detail, with step-by-step examples.
• You don’t need to read other chapters of the book to understand everything (if you are familiar with OCaml).
• I may not explain things that are already described in the book.

I’ll also assume that you have took the CS242 course and have done the assignment.

Type Inference Rules

The CS3110 book introduces some symbols to represent the constraints. I’ll translate them in a style that is more consistent with CS242’s type checking rules. For example, the “if” part of the rule is written below the “then” part in CS3110 while in CS242 we prefer to write “if” above the “then”.

The basic idea of HM algorithm is: instead of checking every type in an expression eagerly, we generate a set of type constraint which is similar to a set of equations, and solve them for the unknown types (in a process called unification).

A constraint is just a claim that two types are equal: $$\begin{aligned} \mathsf{Constraint}\ c ::=\ & \tau = \tau \\ \mathsf{Type}\ \tau ::=\ & \mathsf{num} \\ |\ & \mathsf{bool} \\ |\ & \dots \\ \end{aligned}$$

The following are some example of rules with the format type checking rules => type inference rules. I’ll leave other rules as exercises for readers.

Basic Types

Constants, variables and lambdas add nothing to the constraints: $$\frac{}{\varnothing\vdash n:\mathsf{num}}\Rightarrow\frac{}{\varnothing\vdash n:\mathsf{num}\dashv\varnothing},\tag{T-Num}$$ $$\frac{x:\tau\in\Gamma}{\Gamma\vdash x:\tau}\Rightarrow\frac{x:\tau\in\Gamma}{\Gamma\vdash x:\tau\dashv\varnothing}\tag{T-Var}$$ $$\frac{\Gamma, x : \tau_{\mathsf{arg}} \vdash e : \tau_{\mathsf{ret}}}{\Gamma \vdash (\lambda\,(x : \tau_{\mathsf{arg}})\, .\, e) : \tau_{\mathsf{arg}} \to \tau_{\mathsf{ret}}}\Rightarrow\frac{\text{fresh}\ \tau\quad\Gamma, x : \tau \vdash e : \tau_{\mathsf{ret}}\dashv C}{\Gamma \vdash (\lambda\,x\, .\, e) : \tau \to \tau_{\mathsf{ret}}\dashv C},\tag{T-Lam}$$ where $\text{fresh}\ \tau$ means $\tau$ is a fresh new type variable that haven’t been used. ¹

Binary operations add a constraint that the both sides of the operation and the result should be num. $$\begin{aligned} & \frac{\Gamma\vdash e_L:\mathsf{num}\quad\Gamma\vdash e_R:\mathsf{num}}{\Gamma\vdash e_L\oplus e_R:\mathsf{num}} \\ \Rightarrow\ & \frac{\quad\Gamma\vdash e_L:\tau_L\dashv C_L\quad\Gamma\vdash e_R:\tau_R\dashv C_R}{\Gamma\vdash e_L\oplus e_R:\mathsf{num}\dashv C_L,C_R,\tau_L=\mathsf{num},\tau_R=\mathsf{num}} \end{aligned}\tag{T-Binom}$$

Fixpoints requires that the type of $x,e$ and the entire expression are the same: $$\frac{\Gamma, x : \tau \vdash e : \tau}{\Gamma \vdash \mathsf{fix}\ (x : \tau)\, .\, e : \tau}\Rightarrow\frac{\text{fresh}\ \tau'\quad\Gamma, x : \tau' \vdash e : \tau\dashv C}{\Gamma \vdash \mathsf{fix}\ x\, .\, e : \tau'\dashv C,\tau'=\tau},\tag{T-Fix}$$

If-statements add two constraints: the condition must be bool and both arm must have the same type. $$\begin{aligned} & \frac{\Gamma\vdash e_{\mathsf{cond}}:\mathsf{bool}\quad\Gamma\vdash e_{\mathsf{then}}:\tau\quad\Gamma\vdash e_{\mathsf{else}}:\tau}{\Gamma\vdash\mathsf{if}\ e_{\mathsf{cond}}\ \mathsf{then}\ e_{\mathsf{then}}\ \mathsf{else}\ e_{\mathsf{else}}:\tau} \\ \Rightarrow\ & \frac{\Gamma\vdash e_{\mathsf{cond}}:\tau_1\dashv C_1\quad\Gamma\vdash e_{\mathsf{then}}:\tau_2\dashv C_2\quad\Gamma\vdash e_{\mathsf{else}}:\tau_3\dashv C_3}{\Gamma\vdash\mathsf{if}\ e_{\mathsf{cond}}\ \mathsf{then}\ e_{\mathsf{then}}\ \mathsf{else}\ e_{\mathsf{else}}:\tau_2\dashv C_1,C_2,C_3,\tau_1=\mathsf{bool},\tau_2=\tau_3} \end{aligned}\tag{T-If}$$

For function applications, we define a new type $\tau$ for the entire expression and add a constraint that the function must have type $\tau_2 \to \tau$: $$\begin{aligned} & \frac{\Gamma \vdash e_{\mathsf{lam}} : \tau_2 \to \tau\quad \Gamma \vdash e_{\mathsf{arg}} : \tau_2}{\Gamma \vdash (e_{\mathsf{lam}}\ e_{\mathsf{arg}}) : \tau} \\ \Rightarrow\ & \frac{\text{fresh}\ \tau\quad\Gamma \vdash e_{\mathsf{lam}} : \tau_1\dashv C_1\quad \Gamma \vdash e_{\mathsf{arg}} : \tau_2\dashv C_2}{\Gamma \vdash (e_{\mathsf{lam}}\ e_{\mathsf{arg}}) : \tau\dashv C_1, C_2, \tau_1 = \tau_2 \to \tau} \end{aligned}\tag{T-App}$$

De Bruijn Indices

These rules work well until you decided to use the same variable in different expressions:

let f = fun x -> fun y -> ((fun x -> x == y) 2) || x
in f true 1

If we use a set to represent the context $\Gamma$, then the type of the inner x (which is num) will overwrite the outer x (which is bool). This isn’t a problem when we can check the user-annotated type without moving out of the scope, but now we have to infer the type of the inner and outer x after visiting the whole expression.

If you have done the interpreter assignment, you should know that the solution is to convert the expression to nameless form using de Bruijn indices:

let f = fun _ -> fun _ -> ((fun _ -> <0> == <1>) 2) || <0>
in f true 1

We also need to change the rules to represent the context as a stack. The type of the variable with index n is the n-th last element of the stack: $$\frac{}{\Gamma,\tau\vdash \left<0\right>:\tau\dashv\varnothing}\ (\text{T-Var-Term}),\quad\frac{\Gamma=\tau^*,\tau\quad\tau^*\vdash \left<n\right>:\tau'\dashv C}{\Gamma\vdash \left<n+1\right>:\tau'\dashv\varnothing}\ (\text{T-Var-Next}),$$ $$\frac{\text{fresh}\ \tau\quad\Gamma,\tau \vdash e : \tau_{\mathsf{ret}}\dashv C}{\Gamma \vdash (\lambda\,\_\, .\, e) : \tau \to \tau_{\mathsf{ret}}\dashv C}\ (\text{T-Lam}),\quad\frac{\text{fresh}\ \tau'\quad\Gamma,\tau' \vdash e : \tau\dashv C}{\Gamma \vdash \mathsf{fix}\ \_\, .\, e : \tau'\dashv C,\tau'=\tau},(\text{T-Fix})$$

ADT

Product type constructors are similar to binary operations: $$\begin{aligned} & \frac{\Gamma \vdash e_{L} : \tau_{L} \quad \Gamma \vdash e_{R} : \tau_{R}}{\Gamma \vdash (e_{L}, e_{R}) : \tau_{L} \times \tau_{R}} \\ \Rightarrow\ & \frac{\Gamma\vdash e_L:\tau_L\dashv C_L\quad\Gamma\vdash e_R:\tau_R\dashv C_R}{\Gamma \vdash (e_{L}, e_{R}) : \tau_{L} \times \tau_{R}\dashv C_L,C_R}, \end{aligned}$$

We can use the same trick as function applications in product type destructors: $$\frac{\Gamma \vdash e : \tau_{L} \times \tau_{R}}{\Gamma \vdash e.L : \tau_{L}}\Rightarrow\frac{\text{fresh}\ \tau_L,\tau_R\quad\Gamma \vdash e : \tau\dashv C}{\Gamma \vdash e.L : \tau_{L} \dashv C,\tau=\tau_{L} \times \tau_{R}}$$

The type annotation of sum types can also be omitted. The type will be known the time user uses it: $$\frac{\Gamma \vdash e : \tau_{L}}{\Gamma \vdash \mathsf{inj}\ e = L\ \mathsf{as}\ \tau_{L} + \tau_{R} : \tau_{L} + \tau_{R}}\Rightarrow\frac{\text{fresh}\ \tau_R\quad\Gamma \vdash e : \tau_{L}\dashv C}{\Gamma \vdash \mathsf{inj}\ e = L : \tau_{L} + \tau_{R}\dashv C},\tag{T-Inject-L}$$ $$\begin{aligned} & \frac{\Gamma \vdash e : \tau_{L} + \tau_{R} \quad \Gamma, x_{L} : \tau_{L} \vdash e_{L} : \tau \quad \Gamma, x_{R} : \tau_{R} \vdash e_{R} : \tau}{\Gamma \vdash \mathsf{case}\ e\,\{L(x_{L}) \to e_{L} \mid R(x_{R}) \to e_{R}\} : \tau} \\ \Rightarrow &\ \frac{\text{fresh}\ \tau_L,\tau_R,\quad\Gamma \vdash e : \tau_{\mathsf{sum}} \dashv C_{\mathsf{sum}} \quad \Gamma,\tau_{L} \vdash e_{L} : \tau_L'\dashv C_L \quad \Gamma,\tau_{R} \vdash e_{R} : \tau_R'\dashv C_R}{\Gamma \vdash \mathsf{case}\ e\,\{L(\_) \to e_{L} \mid R(\_) \to e_{R}\} : \tau_L'\dashv C_{\mathsf{sum}},C_L,C_R,\tau_{\mathsf{sum}}=\tau_{L} + \tau_{R},\tau_L'=\tau_R'}. \end{aligned}\tag{T-Case}$$

How to Use the Rules

We should know how these rules are used before learning polymorphism.

Collecting Constraints and Type

Remember how we used the type checking rule: for an expression $e$, first we find a rule whose “then” part matches $e$, check whether the conditions in its “if” part are satisfied (which are also type checks), then we know that $\Gamma\vdash e:\tau$.

fn type_check_expr(ast: &Expr, ctx: HashMap<Variable, Type>) -> Result<Type, String> {
    match ast {
        Expr::Num(_) => Ok(Type::Num),
        Expr::Addop { binop, left, right } => {
            let tau_left = type_check_expr(left, ctx.clone())?;
            let tau_right = type_check_expr(right, ctx.clone())?;
            match (tau_left.clone(), tau_right.clone()) {
                (Type::Num, Type::Num) => Ok(Type::Num),
                _ => type_mismatch!(tau_left, tau_right, binop),
            }
        }
        // and other rules
    }
}

The first part of type inference works essentially the same, except that we don’t really check the type, only maintain the set of constraints and a type:

pub fn get_constraints(&self, ctx: &mut Vec<Type>) -> Result<(Type, Vec<Constraint>), String> {
    let (tau_result, c_result) = match self {
        Expr::Num(_) => Ok((Type::Num, vec![])),
        Expr::Addop { left, right, .. } | Expr::Mulop { left, right, .. } => {
            let (tau_left, c_left) = left.get_constraints(ctx)?;
            let (tau_right, c_right) = right.get_constraints(ctx)?;
            let constraints = flat!(vec![
                c_left,
                c_right,
                vec![
                    Constraint {
                        type_l: tau_left,
                        type_r: Type::Num,
                    },
                    Constraint {
                        type_l: tau_right,
                        type_r: Type::Num,
                    },
                ]
            ]);
            Ok((Type::Num, constraints))
        }
        // and other rules
    }
}

Unification

Now we got a set of constraints that looks like $C=\{\tau_1=\mathsf{num},\tau_2\times\tau_1=(\mathsf{num}\to\mathsf{bool})\times\tau_3,\dots\}$ and a type that probabily has some unknown variables, like $\forall\alpha.\tau_1\to(\alpha\times\mathsf{bool})$. The next step is to unify these constraints to know what the types $\tau_1,\tau_2,\dots$ are.

The unification algorithm is straightforward since the constraint and types has a simple, tree-like structure. Unsurprisingly, a union-find set is involved in the algorithm:

1. For every “forall” types $\forall\alpha.\tau$ in $C$, introduce a fresh variable $\tau'$ and remove the quantifier so it becomes $[\alpha\to\tau']\tau$.
2. Initialize the union-find set $S$ with every variable in $C$.
3. Initialize a map $T=\{\}$. $T$ stores the type of variables we have already known. Its keys are the roots in $S$ and its values are types.
4. While $C\neq\varnothing$:
   1. Pop the first constraint $\tau_1=\tau_2$ from $C$.
   2. If both $\tau_1$ and $\tau_2$ are the same atom types like bool and num, then continue.
   3. If $\tau_1$ or $\tau_2$ are variables:
      1. If the variable is not the root in $S$, find and use its root in $S$.
      2. If both $\tau_1$ and $\tau_2$ are variables, we union these two variables in $S$. If $(\tau_1,\tau_1')\in T$ or $(\tau_2,\tau_2')\in T$, we change the key of the items and add $\tau_1'=\tau_2'$ to $C$ (if both items exists in $T$).
      3. If $\tau_1$ is variable and $\tau_2$ does not contain $\tau_1$, we add $(\tau_1,\tau_2)$ to the map $T$.
      4. If $\tau_2$ is variable and $\tau_1$ does not contain $\tau_2$, we add $(\tau_2,\tau_1)$ to the map $T$.
   4. If $\tau_1$ is $\tau_{11}\to\tau_{12}$ and $\tau_2$ is $\tau_{21}\to\tau_{22}$, then add $\tau_{11}=\tau_{21}$ and $\tau_{12}=\tau_{22}$ to $C$.
   5. Similar to 7, if $\tau_1$ and $\tau_2$ falls in the same category of the type’s BNF, then we decompose them into smaller types and add constraints to $C$.
   6. Otherwise, the expression doesn’t type check.

Get the Type

You don’t need to know the type of the expression in general: if the unification succeeded, then the program is type checked. In some cases (like the polymorphism below), we still need to get the type.

We can’t directly use the type $\tau$ generated in the first step because it may contain free type variables (the variable without a quantifier) and whether these variables can be reduced is not known. For example, every fun x -> x in the expressions below generates type a -> a, but their types are different:

(fun x -> x) 1 (* int -> int *)
fun x -> x (* forall a . a -> a *)

The following algorithm removes every free variables in $\tau$:

1. While there is free type variable:
   1. Get the first free variable $x$.
   2. If $S$ doesn’t contain $x$, then $\tau\gets\forall x.\tau$ and continue. Otherwise, let $r$ be the root of $x$.
   3. If $r\neq x$, then $\tau\gets[x\to r]\tau$ and continue.
   4. If $T$ doesn’t contain $r$, then $\tau\gets\forall x.\tau$ and continue. Otherwise, Let $\tau_r$ be the value of $r$.
   5. $\tau\gets[x\to\tau_r]\tau$.
2. Return $\tau$.

Polymorphism

In previous versions of Lam, the user had to explicitly say that there is polymorphism using the $\Lambda\alpha.e$ syntax, and annotate the type of $\alpha$. It’s impossible to keep this syntax: we won’t know what the type indicated by the $\alpha$ in $\Lambda\alpha.e$ means if the user doesn’t use $\alpha$ in their program.

In OCaml, polymorphism is obtained by let expression: when binding a name to an expression with forall type, the variable should be able to instantiate to different types in different contexts. For example, the id in the following expression will have type bool -> bool in (id false) and num -> num in (id 1):

let id = fun x -> x
in if (id false) then (id 1) else 1

As a result, let is no longer a syntax sugar of function application (when inferencing types. You can still treat it as function application when evaluating it). If you “desugar” the expression above, you will get num = bool and the unification will fail.

The inferencing rule of let is a bit involved: $$\frac{\Gamma\vdash e_{\mathsf{var}}:\tau_{\mathsf{var}}\dashv C_{\mathsf{var}}\quad\Gamma,\mathrm{generalize}(\tau_{\mathsf{var}},C_{\mathsf{var}})\vdash e_{\mathsf{in}}:\tau_{\mathsf{in}}\dashv C_{\mathsf{in}}}{\Gamma\vdash\mathsf{let}\ \_=e_{\mathsf{var}}\ \mathsf{in}\ e_{\mathsf{in}}:\tau_{\mathsf{in}}\dashv C_{\mathsf{in}},C_{\mathsf{var}}},\tag{T-Let}$$ where $\mathrm{generalize}(\tau,C)$ unifies $C$ and remove free variables in $\tau$ using the algorithm in the previous section.

The instantiation type annotations and the T-Poly-App rule are replaced by instantiating arguments in forall types as fresh variables: $$\frac{\text{fresh}\ \tau_1',\dots,\tau_n'}{\Gamma,\forall\,\alpha_1\dots\forall\,\alpha_n\, .\, \tau\vdash\left<0\right> : [\alpha_1\to\tau_1',\dots\alpha_n\to\tau_n']\tau\dashv\varnothing}.\tag{T-Poly-Inst}$$

For example, let’s get the type of <0> (fun _ -> <0>) in the program

let _ = fun _ -> fun _ -> <1> <0> in
  let _ = <0> (fun _ -> <0>) in <0> 1  

The context is $\forall\alpha.\forall\beta.(\alpha\to\beta)\to\alpha\to\beta$ (which is the type of fun _ -> fun _ -> <1> <0>) and the expression is <0> (fun _ -> <0>). We can use the rules to get the type $\tau$ and constraints $C$: $$\frac{\text{fresh}\ \tau\quad\dfrac{\text{fresh}\ \alpha',\text{fresh}\ \beta'}{\forall\alpha.\forall\beta.(\alpha\to\beta)\to\alpha\to\beta\vdash\left<0\right> : (\alpha'\to\beta')\to\alpha'\to\beta'\dashv\varnothing}\ (\text{T-Poly-Inst})\quad\dfrac{\text{fresh}\ \gamma\quad\dfrac{}{\gamma \vdash\left<0\right> : \gamma\dashv\varnothing}\ (\text{T-Var-Term})}{\varnothing \vdash (\lambda\,\_\, .\, \left<0\right>) : \gamma \to \gamma\dashv\varnothing}\ (\text{T-Lam})}{\forall\alpha.\forall\beta.(\alpha\to\beta)\to\alpha\to\beta \vdash (\left<0\right>\ (\lambda\,\_\to\left<0\right>)) : \tau\dashv (\alpha'\to\beta')\to\alpha'\to\beta' = (\gamma\to\gamma) \to \tau}\ (\text{T-App})$$

We can get $\{\alpha=\beta=\gamma,\tau=\alpha\to\alpha\}$ from the constraint $(\alpha'\to\beta')\to\alpha'\to\beta' = (\gamma\to\gamma) \to \tau$ (try to simulate the unification algorithm yourself by hand!), so $\mathrm{generalize}(\tau,\{(\alpha'\to\beta')\to\alpha'\to\beta' = (\gamma\to\gamma) \to \tau\})=\forall\tau'.\tau'\to\tau'$.

Let’s go through the whole process of another example (in de Bruijn form):

let _ = fun _ -> <0>
in if (<0> false) then (<0> 1) else 1

We know that fun _ -> <0> has type $\tau\to\tau$ where $\tau$ is a free variable: $$\dfrac{\dfrac{\text{fresh}\ \tau\quad\dfrac{}{\tau \vdash\left<0\right> : \tau\dashv\varnothing}\ (\text{T-Var-Term})}{\varnothing \vdash (\lambda\,\_\, .\, \left<0\right>) : \tau \to \tau\dashv\varnothing}\ (\text{T-Lam})}{\varnothing\vdash\mathsf{let}\ \_=\lambda\,\_\, .\, \left<0\right>\ \mathsf{in}\ e_{\mathsf{in}}}\ (\text{T-Let})$$ so we generalize it to $\forall\tau.\tau\to\tau$ and add it to the context when working on the if expression. Here’s the inference process for the predicate (<0> false): $$\dfrac{\text{fresh}\ \tau_1\quad\dfrac{\text{fresh}\ \tau_1'}{\forall\tau.\tau\to\tau \vdash \left<0\right> : \tau_1'\to\tau_1'\dashv \varnothing}\ (\text{T-Poly-Inst})\quad \dfrac{}{\forall\tau.\tau\to\tau \vdash \mathsf{false} : \mathsf{bool}\dashv\varnothing}\ (\text{T-Bool})}{\forall\tau.\tau\to\tau \vdash (\left<0\right>\ \mathsf{false}) : \tau_1\dashv\tau_1'\to\tau_1' = \mathsf{bool} \to \tau_1}\ (\text{T-App})$$

The constraint and the type of (<0> 1) can be got using a similar process. Let’s complete the inference: $$\dfrac{\dfrac{\dfrac{\dots}{\forall\tau.\tau\to\tau \vdash (\left<0\right>\mathsf{false}) : \tau_1\dashv\tau_1'\to\tau_1' = \mathsf{bool} \to \tau_1}\quad\dfrac{\dots}{\forall\tau.\tau\to\tau \vdash (\left<0\right>1) : \tau_2\dashv\tau_2'\to\tau_2' = \mathsf{num} \to \tau_2}\quad\dfrac{}{\forall\tau.\tau\to\tau\vdash 1:\mathsf{num}\dashv\varnothing}}{\forall\tau.\tau\to\tau\vdash\mathsf{if}\ (\left<0\right>\mathsf{false})\ \mathsf{then}\ (\left<0\right>1)\ \mathsf{else}\ 1:\tau_2\dashv \tau_1'\to\tau_1' = \mathsf{bool} \to \tau_1,\tau_2'\to\tau_2' = \mathsf{num} \to \tau_2,\tau_1=\mathsf{bool},\tau_2=\mathsf{num}}\ (\text{T-If})}{\varnothing\vdash\mathsf{let}\ \_=\lambda\,\_\, .\, \left<0\right>\ \mathsf{in}\ \mathsf{if}\ (\left<0\right>\mathsf{false})\ \mathsf{then}\ (\left<0\right>1)\ \mathsf{else}\ 1:\tau_2\dashv\tau_1'\to\tau_1' = \mathsf{bool} \to \tau_1,\tau_2'\to\tau_2' = \mathsf{num} \to \tau_2,\tau_1=\mathsf{bool},\tau_2=\mathsf{num}}\ (\text{T-Let})$$

Therefore the entire expression has type $\tau_2$. The unification algorithm (again, try to simulate it by hand!) will generate a map $T$ where the root of $\tau_2$ corresponds to num.

Type Safety Proofs

We need to proof the progress and preservation theorem of our type inference system:

• Progress: if $\varnothing\vdash e:\tau$ then either $e\ \mathsf{val}$ or there exists $e'$ such that $e\mapsto e'$.
• Preservation: if $\varnothing\vdash e:\tau$ and $e\mapsto e'$, then $\varnothing\vdash e':\tau$.

By saying $\Gamma\vdash e:\tau$, we mean that $\Gamma\vdash e:\tau'\dashv C$, and $\tau=\mathrm{generalize}(\tau',C)$.

I’ll try to proof the theorems in later posts. This means that I didn’t have the proof yet, and everything presented in this blog post may be wrong. But I’m already exhausted after spending every weekend of the past month trying to make an interpreter that works ².

Update: I did some research, found the game’s Wikipedia page and a similar solution, so I won’t take the credit of the solution even though I came up with it independently.

The Racket programming language has a dozen of simple bundled games, one of which is the “Lights Out” puzzles. Here is the screenshot of the game and its instructions:

It’s supposed to be a hard game if you are using your human heuristics or logic (or luck?), but this game can actually be solved using a dumb polynomial algorithm, and you probably have learned it in your linear algebra class.

The Problem

Let’s consider a generalized problem: we are playing “Lights out” on an undirected simple graph (i.e. there is at most one edge between two nodes), and clicking a node also toggles lights of its neighbors. Our goal is to turn off all the lights in the graph.

Here’s an example of 6 nodes $a,b,c,d,e,f$:

If you want to play the generalized game and gain some intuition, here’s an app written specifically for this blog post. Roughly 90% of the code and every line of the document is written by a coding agent. See Appendix A for its technical details.

The Solution

Suppose that we have known the solution to the above example. Let $a'$ be the number of clicks on node $a$, $b'$ be the number of clicks on node $b'$, etc. Then we can have a set of equations by examine each node and its neighbors: $$\begin{cases} (a'+d')\mathrm{mod}\ 2=0, \\ (b'+d'+e'+f')\mathrm{mod}\ 2=1, \\ (c'+f')\mathrm{mod}\ 2=0, \\ (d'+a'+b')\mathrm{mod}\ 2=1, \\ (e'+b'+f')\mathrm{mod}\ 2=0, \\ (f'+b'+c'+e')\mathrm{mod}\ 2=1. \\ \end{cases}\tag{1}$$

The first equation can be obtained by looking at the node $a$. It should remain off, so it should be toggled by even number of times. Its neighbors are node $d$, and any click to itself and its neighbors will toggle it once, so it will be toggled $a'+d'$ times. The same is true for the node $b$, except that it should be turned off by toggling odd number of times, this gives us the $1$ in the right-hand side of the second equation.

Note that all the parameters are in $\mathbb{Z}_2$ (because of the simple graph constraint), therefore we can get rid of the annoying $\text{mod}\ 2$ by solving the equations (1) in the field $(\mathbb{Z}_2,+,\cdot)$: $$\begin{cases} a'+d'=0, \\ b'+d'+e'+f'=1, \\ c'+f'=0, \\ d'+a'+b'=1, \\ e'+b'+f'=0, \\ f'+b'+c'+e'=1. \\ \end{cases}(a',b',c',d',e',f'\in\mathbb{Z}_2)\tag{2}$$

In fact, (as shown in Appendix B) we won’t miss any solution by limiting the scope: if there is no solution on $\mathbb{Z}_2$, neither will there be a solution on $\mathbb{Z}$.

So it’s just a set of linear equations which can be solved by Gaussian elimination. It’s even simpler since we are doing Gaussian elimination on $\mathbb{Z}_2$.

Here’s the algorithm that can solves any light-out puzzle:

1. Get the adjacent matrix $A$ and the vector $Y=(y_1,\dots,y_m)$, where $y_i=1$ if the i-th node is on, otherwise $y_i=0$.
2. Solve the set of equations $(A+I)X=Y$ on $\mathbb{Z}_2$. If it’s unsolvable, then the puzzle is not solvable.

I implemented the algorithm in the app so that the app can show you the solution if there is any. The algorithm is boring, so I won’t paste it here to waste your time (although it’s written by hand, and it’s about 80 lines of code).

Conclusion

Perhaps the game is too simple to write a blog post to solve it, but it’s a interesting game anyway. I thought that a puzzle game must be NP-hard to be hard enough for humans, but a game that has a simple but unintuitive solution can also be hard.

Appendix A: Implementation Details of the App

The app is written in Rust using raylib’s Rust binding. I chose raylib because I can really understand the code and fix it when something went wrong.

At the time this post is written, opencode is still providing free models, so I’m using them for this app.

The project is more challenging than expected as

1. It’s a GUI app and is hard to test.
2. I decided to start with something small and gradually adding features to it.
3. The agent tends to patch things up instead of refactor the code when the old design is not suitable for a new feature.
4. As a result, technical debt accumulates, and you will get an unmaintainable, buggy app.
5. This gets worse when the agent has to compress the context and most of its experience are lost.

Maybe I should add something like “Refactor the code when it smells” to the agent’s skills, but I doubt that it has the correct judgment. I’ll try that in later projects.

Appendix B: Why Solving in $\mathbb{Z}_2$

Let’s proof its converse: let $A=(a_{ij})$ be an $m\times n$ matrix on $\mathbb{Z}_2$ and $Y$ be a vector in $(\mathbb{Z}_2)^m$, then if $(AX)\text{mod}\ 2=Y$ has solution $X'\in\mathbb{Z}^n$, the equation $AX=Y$ has solution in $(\mathbb{Z}_2)^n$.

Let $f:\mathbb{Z}\to\mathbb{Z},f(x)=x\ \mathrm{mod}\ 2$. Because for every $x,y\in\mathbb{Z}$, $f(x+y)=f(x)+f(y)$, $f(xy)=f(x)f(y)$ and $f(0)=0$, therefore $f$ is a homomorphism between the ring $\mathbb{Z}$ and $\mathbb{Z}_2$.

Let $X'=(x_1,\dots,x_n)$, $Y=(y_1,\dots,y_m)$, then $AX\text{mod}\ 2=Y$ can be expanded as: $$\begin{cases} f(a_{11}x_1+a_{12}x_2+\cdots+a_{1n}x_n)=y_1, \\ \cdots, \\ f(a_{m1}x_1+a_{m2}x_2+\cdots+a_{mn}x_n)=y_m. \\ \end{cases}$$

Because $f$ is homomorphism, we have $$\begin{cases} f(a_{11})f(x_1)+f(a_{12})f(x_2)+\cdots+f(a_{1n})f(x_n)=y_1, \\ \cdots, \\ f(a_{m1})f(x_1)+f(a_{m2})f(x_2)+\cdots+f(a_{mn})f(x_n)=y_m. \\ \end{cases}$$

Since $a_{ij}\in\mathbb{Z_2}$, therefore $f(a_{ij})=a_{ij}$. So $(f(x_1),\dots,f(x_n))\in(\mathbb{Z}_2)^n$ is a solution to $AX=Y$. $\Box$

Here’s an interpretation of this proposition: you don’t need to click a node more than once, since clicking a node twice does nothing.

If you calculate a running sum of the sorted frequency of every word in a long book ¹, the result looks like the following curve:

You can try this J program with your favorite book (as long as cutopen supports the language), where count is defined in my previous post: ²

NB. Plot the word count. Your text should only have one newline at the end of
NB. the file, otherwise `freadr` and `cutopen` won't work. J is definitely not
NB. an ideal language for string processing.
plot +/\ (% +/) \:~ (count"_ 0 ~.) cutopen , freadr 'your/book.txt'
NB.                            ~.   finds the unique word
NB.                 (count"_ 0 ~.)  is a monadic hook that gets the word count
NB.             \:~                 sort the word count
NB.      (% +/)                     normalizes it
NB.  +/\                            calculate partial sum

There are 18000 kinds of words used in total, but only 20% of them is used in 80% of the scenarios. This phenomenon is known as the Pareto principle or the 80:20 rule. In this post, we will have some understanding about why this pattern appears, by designing two languages that follows the principle.

A Language With Equal Word Length

The first language is a boring one: every word has the same length.

The syntax of the first language:

1. There is a finite set $\Omega$ called alphabet.
2. A word is an element of $\Omega^n$ where $n$ is a fixed number.
3. Characters in a word are iid samples of some random variable $X$ over $\Omega$.

For example, let $\Omega=\{a,b,c\}$, $n=5$ and the value of $X$ over $a,b,c$ is $0.5,0.4,0.1$ respectively, then a sentence of our language looks like:

aabaa bbbaa aabaa baaba abaca bbbba abaac ...

This can be generated using the following J sentence:

20 5 $ ((roulette"1) 100 3 $ 0.5 0.4 0.1) (({ >)"0) 100 $ < 'abc'

Typical Set and the Asymptotic Equipartition Principle

We will focus on one seemingly arbitrary property of the language: the information content of a word. Let $I$ be the random variable that represents the information content. Given a character $x$, we have $$I(x)=-\log_2\mathrm{Pr}(X=x).$$

Since the characters are iid samples, according to the law of large numbers, for every $\varepsilon>0$: $$\lim_{n\to\infty}\mathrm{Pr}\left(\left|\frac{1}{n}\sum_{i=1}^nI(x_i)-H(X)\right|<\varepsilon\right)=1,\tag{1}$$ where $H(X)=\mathbb{E}[I(X)]$ is the entropy of $X$.

Let $\mathcal{A}=\{x^n\in\Omega^n:|\frac{1}{n}\sum_{i=1}^nI(x_i)-H(X)|<\varepsilon\}$ be the set of words where the average information content is close to the entropy (it’s called the (weak) typical set in information theory). We know from the equation above that you will almost surely get an element of $\mathcal{A}$ when sampling a word, despite that $|\mathcal{A}|$ is relatively small as we will see.

To estimate $|\mathcal{A}|$, let’s consider an element $x^n=(x_1,x_2,\dots,x_n)\in\mathcal{A}$ and try to answer: What’s the probability of getting the word $x^n$?

Here we can make use of the iid assumption again: $$\mathrm{Pr}(X^n=x^n)=\prod_{i=1}^n\mathrm{Pr}(X=x_i)=2^{\sum_{i=1}^n\log_2\mathrm{Pr}(X=x_i)}=2^{-\sum_{i=1}^nI(x_i)}.$$

By definition of $\mathcal{A}$, $$(1-\varepsilon)H(X)<\frac{1}{n}\sum_{i=1}^nI(x_i)<(1+\varepsilon)H(X).$$

Therefore, $$2^{-n(1+\varepsilon)H(X)}<\mathrm{Pr}(X^n=x^n)<2^{-n(1-\varepsilon)H(X)}.$$

We know this is true for every $x^n\in\mathcal{A}$, so the probability of $X^n\in\mathcal{A}$ is lower-bounded: $$2^{-n(1+\varepsilon)H(X)}|\mathcal{A}|<\mathrm{Pr}(X^n\in\mathcal{A}).$$

$\mathrm{Pr}(X^n\in\mathcal{A})$ is a probability, therefore it can’t be greater than 1: $$2^{-n(1+\varepsilon)H(X)}|\mathcal{A}|<\mathrm{Pr}(X^n\in\mathcal{A})\leq1.$$

Then we have this nice upper bound of $|\mathcal{A}|$: $$|\mathcal{A}|<2^{n(1+\varepsilon)H(X)}.$$

The result is a part of the asymptotic equipartition principle in information theory.

Making The Language 80:20

Let go back to our simple language, and find a set of parameters to make it satisfies the 80:20 rule.

The typical set will have less than 20% of the element if $$\frac{2^{n(1+\varepsilon)H(X)}}{|\Omega|^n}<\frac{1}{5}.$$

We can use the probability distribution $(\frac{1}{2},\frac{1}{4},\dots,\frac{1}{2^{|\Omega|-1}},\frac{1}{2^{|\Omega|-1}})$ to ensure that the entropy is always less than 2 for every $\Omega$ that has more than 1 element (see appendix A for the proof).

Setting $m=|\Omega|=8$ and using the result $H(X)<2$, we got the first constraint $$\frac{2^{2n(1+\varepsilon)}}{8^n}<\frac{1}{5}\Rightarrow \varepsilon<1-\frac{1}{2n}\log_2 5.$$

Unfortunately, weak LLN (1) doesn’t tell us how the probability converges as $n\to\infty$, and the simplest way I came up with is to sample a lot of words.

n =: 6
m =: 8
sample =: 100000
NB. We use the constraint above to get a valid epsilon.
eps =: (1 - (2 ^. 5) % 2 * n) - 0.01

NB. The probability distribution
p =: (2 ^ _1 - i. m - 1) , 2 ^ - m - 1

NB. The entropy
e =: entropy p

NB. Sample the words
words =: roulette"1 (sample, n, m) $ p

NB. Take the y-th element of the probability
NB. The `"0` at the end specifies that its rank is 0
take =: 3 : '{: 1 {. y }. p'"0

NB. Calculate their average information content
i =: (+/ % #)"1 - 2 ^. take words
NB.  (+/ % #)   is a fork that calculates the averave

NB. Get the result
(+/ % #) (i < e + eps) *. (i > e - eps)