Start rewrite using query system.queries

14 files changed, 741 insertions, 89 deletions

diff --git a/src/chomp/ast/error.rs b/src/chomp/ast-old/error.rs
index 9057ec3..9057ec3 100644
--- a/src/chomp/ast/error.rs
+++ b/src/chomp/ast-old/error.rs
diff --git a/src/chomp/ast/mod.rs b/src/chomp/ast-old/mod.rs
index 232381a..232381a 100644
--- a/src/chomp/ast/mod.rs
+++ b/src/chomp/ast-old/mod.rs
diff --git a/src/chomp/ast/substitute.rs b/src/chomp/ast-old/substitute.rs
index 80df588..80df588 100644
--- a/src/chomp/ast/substitute.rs
+++ b/src/chomp/ast-old/substitute.rs
diff --git a/src/chomp/ast.rs b/src/chomp/ast.rs
new file mode 100644
index 0000000..dbbcb5d
--- /dev/null
+++ b/src/chomp/ast.rs
@@ -0,0 +1,146 @@
+use std::rc::Rc;
+
+use super::Context;
+
+#[derive(Debug)]
+pub struct Lambda(pub Rc<Tree>, pub Rc<Tree>);
+
+#[derive(Debug)]
+pub enum Tree {
+    Epsilon,
+    Bottom,
+    Identity,
+    Literal(String),
+    Variable,
+    Cat(Rc<Tree>, Rc<Tree>),
+    Alt(Rc<Tree>, Rc<Tree>),
+    Fix(Rc<Tree>),
+    Call(Rc<Tree>, Rc<Tree>),
+    Lambda(Lambda),
+    Let(Rc<Tree>, Rc<Tree>, Rc<Tree>),
+}
+
+impl Tree {
+    pub fn try_as_lambda(&self) -> Option<&Lambda> {
+        if let Self::Lambda(v) = self {
+            Some(v)
+        } else {
+            None
+        }
+    }
+}
+
+#[derive(Clone, Debug)]
+pub enum TranslateError {
+    CallFunNotLambda(Rc<Tree>),
+}
+
+pub(crate) fn substitute(
+    ctx: &mut Context,
+    tree: &Rc<Tree>,
+    from: &Rc<Tree>,
+    into: &Rc<Tree>,
+) -> Option<Rc<Tree>> {
+    if Rc::ptr_eq(tree, from) {
+        return Some(into.clone());
+    }
+
+    match tree.as_ref() {
+        Tree::Epsilon | Tree::Bottom | Tree::Identity | Tree::Literal(_) | Tree::Variable => None,
+        Tree::Cat(front, back) => {
+            let new_front = ctx.substitute(front, from, into);
+            let new_back = ctx.substitute(back, from, into);
+            let (front, back) = match (new_front, new_back) {
+                (None, None) => return None,
+                (None, Some(back)) => (front.clone(), back),
+                (Some(front), None) => (front, back.clone()),
+                (Some(front), Some(back)) => (front, back),
+            };
+            Some(ctx.tree_interner.cat(front, back))
+        }
+        Tree::Alt(left, right) => {
+            let new_left = ctx.substitute(left, from, into);
+            let new_right = ctx.substitute(right, from, into);
+            let (left, right) = match (new_left, new_right) {
+                (None, None) => return None,
+                (None, Some(right)) => (left.clone(), right),
+                (Some(left), None) => (left, right.clone()),
+                (Some(left), Some(right)) => (left, right),
+            };
+            Some(ctx.tree_interner.alt(left, right))
+        }
+        Tree::Fix(inner) => {
+            let inner = ctx.substitute(inner, from, into)?;
+            Some(ctx.tree_interner.fix(inner))
+        }
+        Tree::Call(fun, arg) => {
+            let new_fun = ctx.substitute(fun, from, into);
+            let new_arg = ctx.substitute(arg, from, into);
+            let (fun, arg) = match (new_fun, new_arg) {
+                (None, None) => return None,
+                (None, Some(arg)) => (fun.clone(), arg),
+                (Some(fun), None) => (fun, arg.clone()),
+                (Some(fun), Some(arg)) => (fun, arg),
+            };
+            Some(ctx.tree_interner.call(fun, arg))
+        }
+        Tree::Lambda(Lambda(arg, inner)) => {
+            let inner = ctx.substitute(inner, from, into)?;
+            Some(Rc::new(Tree::Lambda(Lambda(arg.clone(), inner))))
+        }
+        Tree::Let(bind, arg, inner) => {
+            let new_bind = ctx.substitute(bind, from, into);
+            let new_inner = ctx.substitute(inner, from, into);
+            let (bind, inner) = match (new_bind, new_inner) {
+                (None, None) => return None,
+                (None, Some(inner)) => (bind.clone(), inner),
+                (Some(bind), None) => (bind, inner.clone()),
+                (Some(bind), Some(inner)) => (bind, inner),
+            };
+            Some(Rc::new(Tree::Let(bind, arg.clone(), inner)))
+        }
+    }
+}
+
+pub(crate) fn translate(
+    ctx: &mut Context,
+    tree: &Rc<Tree>,
+) -> Result<Option<Rc<Tree>>, TranslateError> {
+    match tree.as_ref() {
+        Tree::Epsilon
+        | Tree::Bottom
+        | Tree::Identity
+        | Tree::Literal(_)
+        | Tree::Variable
+        | Tree::Cat(_, _)
+        | Tree::Alt(_, _)
+        | Tree::Fix(_)
+        | Tree::Lambda(_) => Ok(None),
+        Tree::Call(fun, arg) => {
+            let fun = ctx.translate(fun)?.unwrap_or_else(|| fun.clone());
+            let lambda = fun
+                .try_as_lambda()
+                .ok_or_else(|| TranslateError::CallFunNotLambda(fun.clone()))?;
+            let mut out = ctx
+                .substitute(&lambda.1, &lambda.0, arg)
+                .unwrap_or_else(|| lambda.1.clone());
+            loop {
+                match ctx.translate(&out)? {
+                    Some(tree) => out = tree,
+                    None => return Ok(Some(out)),
+                }
+            }
+        }
+        Tree::Let(bind, arg, inner) => {
+            let mut out = ctx
+                .substitute(inner, arg, bind)
+                .unwrap_or_else(|| inner.clone());
+            loop {
+                match ctx.translate(&out)? {
+                    Some(tree) => out = tree,
+                    None => return Ok(Some(out)),
+                }
+            }
+        }
+    }
+}
diff --git a/src/chomp/cst.rs b/src/chomp/cst.rs
new file mode 100644
index 0000000..8e3163b
--- /dev/null
+++ b/src/chomp/cst.rs
@@ -0,0 +1,65 @@
+use std::rc::Rc;
+
+use super::Context;
+
+#[derive(Debug)]
+pub struct Name;
+
+#[derive(Debug)]
+pub enum Shape {
+    Epsilon,
+    Literal(String),
+    Variable(usize),
+    Cat(Vec<Rc<Shape>>),
+    Alt(Vec<Rc<Shape>>),
+    Fix(Rc<Shape>),
+    Call(Vec<Rc<Shape>>),
+    Lambda(Vec<Name>, Rc<Shape>),
+    Let(Name, Rc<Shape>, Rc<Shape>),
+}
+
+pub(crate) fn as_tree(ctx: &mut Context, shape: &Rc<Shape>) -> Rc<super::ast::Tree> {
+    fn lambda_as_tree(ctx: &mut Context, count: usize, inner: &Rc<Shape>) -> Rc<super::ast::Tree> {
+        if count == 0 {
+            ctx.as_tree(inner)
+        } else {
+            ctx.new_lambda(|ctx| lambda_as_tree(ctx, count - 1, inner))
+        }
+    }
+
+    match shape.as_ref() {
+        Shape::Epsilon => ctx.tree_interner.epsilon(),
+        Shape::Literal(l) => ctx.tree_interner.literal(l.to_owned()),
+        Shape::Variable(idx) => ctx.lookup_tree_variable(*idx),
+        Shape::Cat(v) => {
+            let epsilon = ctx.tree_interner.epsilon();
+            v.into_iter().fold(epsilon, |front, back| {
+                let back = ctx.as_tree(back);
+                ctx.tree_interner.cat(front, back)
+            })
+        }
+        Shape::Alt(v) => {
+            let bottom = ctx.tree_interner.bottom();
+            v.into_iter().fold(bottom, |left, right| {
+                let right = ctx.as_tree(right);
+                ctx.tree_interner.alt(left, right)
+            })
+        }
+        Shape::Fix(inner) => {
+            let inner = ctx.as_tree(inner);
+            ctx.tree_interner.fix(inner)
+        }
+        Shape::Call(v) => {
+            let identity = ctx.tree_interner.identity();
+            v.into_iter().fold(identity, |fun, arg| {
+                let arg = ctx.as_tree(arg);
+                ctx.tree_interner.call(fun, arg)
+            })
+        }
+        Shape::Lambda(names, inner) => lambda_as_tree(ctx, names.len(), inner),
+        Shape::Let(_, bind, inner) => {
+            let bind = ctx.as_tree(bind);
+            ctx.new_let(bind, |ctx| ctx.as_tree(inner))
+        }
+    }
+}
diff --git a/src/chomp/intern.rs b/src/chomp/intern.rs
new file mode 100644
index 0000000..b224e53
--- /dev/null
+++ b/src/chomp/intern.rs
@@ -0,0 +1,151 @@
+use std::{cell::RefCell, collections::HashMap, hash::Hash, rc::Rc};
+
+use super::{
+    ast::Tree,
+    typed::{GroundType, Type},
+};
+
+#[derive(Debug)]
+pub struct Intern<T>(Rc<T>);
+
+impl<T> PartialEq for Intern<T> {
+    fn eq(&self, other: &Self) -> bool {
+        Rc::ptr_eq(&self.0, &other.0)
+    }
+}
+
+impl<T> Eq for Intern<T> {}
+
+impl<T> Hash for Intern<T> {
+    fn hash<H: std::hash::Hasher>(&self, state: &mut H) {
+        Rc::as_ptr(&self.0).hash(state)
+    }
+}
+
+impl<T> From<Rc<T>> for Intern<T> {
+    fn from(inner: Rc<T>) -> Self {
+        Self(inner)
+    }
+}
+
+#[derive(Debug)]
+pub struct TreeInterner {
+    epsilon: Option<Rc<Tree>>,
+    bottom: Option<Rc<Tree>>,
+    identity: Option<Rc<Tree>>,
+    literal: HashMap<String, Rc<Tree>>,
+    cat: HashMap<(Intern<Tree>, Intern<Tree>), Rc<Tree>>,
+    alt: HashMap<(Intern<Tree>, Intern<Tree>), Rc<Tree>>,
+    fix: HashMap<Intern<Tree>, Rc<Tree>>,
+    call: HashMap<(Intern<Tree>, Intern<Tree>), Rc<Tree>>,
+}
+
+impl TreeInterner {
+    pub fn epsilon(&mut self) -> Rc<Tree> {
+        self.epsilon
+            .get_or_insert_with(|| Rc::new(Tree::Epsilon))
+            .clone()
+    }
+
+    pub fn bottom(&mut self) -> Rc<Tree> {
+        self.bottom
+            .get_or_insert_with(|| Rc::new(Tree::Bottom))
+            .clone()
+    }
+
+    pub fn identity(&mut self) -> Rc<Tree> {
+        self.identity
+            .get_or_insert_with(|| Rc::new(Tree::Identity))
+            .clone()
+    }
+
+    pub fn literal(&mut self, lit: String) -> Rc<Tree> {
+        self.literal
+            .entry(lit)
+            .or_insert_with_key(|lit| Rc::new(Tree::Literal(lit.clone())))
+            .clone()
+    }
+
+    pub fn cat(&mut self, front: Rc<Tree>, back: Rc<Tree>) -> Rc<Tree> {
+        self.cat
+            .entry((Intern(front), Intern(back)))
+            .or_insert_with_key(|(front, back)| Rc::new(Tree::Cat(front.0.clone(), back.0.clone())))
+            .clone()
+    }
+
+    pub fn alt(&mut self, left: Rc<Tree>, right: Rc<Tree>) -> Rc<Tree> {
+        self.alt
+            .entry((Intern(left), Intern(right)))
+            .or_insert_with_key(|(left, right)| Rc::new(Tree::Alt(left.0.clone(), right.0.clone())))
+            .clone()
+    }
+
+    pub fn fix(&mut self, inner: Rc<Tree>) -> Rc<Tree> {
+        self.fix
+            .entry(Intern(inner))
+            .or_insert_with_key(|inner| Rc::new(Tree::Fix(inner.0.clone())))
+            .clone()
+    }
+
+    pub fn call(&mut self, fun: Rc<Tree>, arg: Rc<Tree>) -> Rc<Tree> {
+        self.call
+            .entry((Intern(fun), Intern(arg)))
+            .or_insert_with_key(|(fun, arg)| Rc::new(Tree::Call(fun.0.clone(), arg.0.clone())))
+            .clone()
+    }
+}
+
+#[derive(Debug)]
+pub struct TypeInterner {
+    epsilon: Option<Rc<Type>>,
+    bottom: Option<Rc<Type>>,
+    character: HashMap<char, Rc<Type>>,
+    cat: HashMap<(Intern<GroundType>, Intern<GroundType>), Rc<Type>>,
+    alt: HashMap<(Intern<GroundType>, Intern<GroundType>), Rc<Type>>,
+    fix: HashMap<Intern<GroundType>, Rc<Type>>,
+}
+
+impl TypeInterner {
+    pub fn epsilon(&mut self) -> Rc<Type> {
+        self.epsilon
+            .get_or_insert_with(|| Rc::new(GroundType::Epsilon.into()))
+            .clone()
+    }
+
+    pub fn bottom(&mut self) -> Rc<Type> {
+        self.bottom
+            .get_or_insert_with(|| Rc::new(GroundType::Bottom.into()))
+            .clone()
+    }
+
+    pub fn character(&mut self, c: char) -> Rc<Type> {
+        self.character
+            .entry(c)
+            .or_insert_with(|| Rc::new(GroundType::Character(c).into()))
+            .clone()
+    }
+
+    pub fn cat(&mut self, front: Rc<GroundType>, back: Rc<GroundType>) -> Rc<Type> {
+        self.cat
+            .entry((Intern(front), Intern(back)))
+            .or_insert_with_key(|(front, back)| {
+                Rc::new(
+                    GroundType::Cat(RefCell::new(front.0.clone()), RefCell::new(back.0.clone()))
+                        .into(),
+                )
+            })
+            .clone()
+    }
+
+    pub fn alt(&mut self, left: Rc<GroundType>, right: Rc<GroundType>) -> Rc<Type> {
+        self.alt
+            .entry((Intern(left), Intern(right)))
+            .or_insert_with_key(|(left, right)| {
+                Rc::new(
+                    GroundType::Alt(RefCell::new(left.0.clone()), RefCell::new(right.0.clone()))
+                        .into(),
+                )
+            })
+            .clone()
+    }
+}
diff --git a/src/chomp/mod.rs b/src/chomp/mod.rs
index 79b4fac..c8c82ae 100644
--- a/src/chomp/mod.rs
+++ b/src/chomp/mod.rs
@@ -1,114 +1,128 @@
-use std::{fmt, hash};
+use std::{collections::HashMap, rc::Rc};
 
-use heck::{CamelCase, SnakeCase};
-use proc_macro2::{Ident, Span};
-use syn::ext::IdentExt;
+use intern::Intern;
 
-pub mod ast;
-pub mod set;
-pub mod typed;
-pub mod visit;
+use self::ast::Lambda;
 
-#[derive(Clone, Debug)]
-pub enum Name {
-    Spanned(Ident),
-    Spanless(String),
+mod ast;
+mod cst;
+mod intern;
+mod typed;
+
+type SubstTriple = (Intern<ast::Tree>, Intern<ast::Tree>, Intern<ast::Tree>);
+
+#[derive(Debug)]
+pub struct Context {
+    // Abstract tree interning
+    var_stack: Vec<Rc<ast::Tree>>,
+    pub tree_interner: intern::TreeInterner,
+    pub type_interner: intern::TypeInterner,
+
+    // Caches
+    as_tree: HashMap<Intern<cst::Shape>, Rc<ast::Tree>>,
+    substitute: HashMap<SubstTriple, Option<Rc<ast::Tree>>>,
+    translate: HashMap<Intern<ast::Tree>, Result<Option<Rc<ast::Tree>>, ast::TranslateError>>,
+    type_of: HashMap<
+        Intern<ast::Tree>,
+        Result<typed::ConstrainedType, typed::TypeError>,
+    >,
 }
 
-impl Name {
-    pub fn span(&self) -> Option<Span> {
-        match self {
-            Self::Spanned(i) => Some(i.span()),
-            Self::Spanless(_) => None,
+impl Context {
+    /// Converts a concrete syntax tree into an abstract one.
+    pub fn as_tree(&mut self, shape: &Rc<cst::Shape>) -> Rc<ast::Tree> {
+        if let Some(tree) = self.as_tree.get(&shape.clone().into()) {
+            return tree.clone();
         }
+        let tree = cst::as_tree(self, shape);
+        self.as_tree.insert(shape.clone().into(), tree.clone());
+        tree
     }
 
-    pub fn into_ident(self, span: Span) -> Ident {
-        match self {
-            Self::Spanned(i) => i,
-            Self::Spanless(s) => Ident::new(&s, span),
+    /// Creates a copy of `tree` that replaces variables pointing to `from` with `into`.
+    pub fn substitute(
+        &mut self,
+        tree: &Rc<ast::Tree>,
+        from: &Rc<ast::Tree>,
+        into: &Rc<ast::Tree>,
+    ) -> Option<Rc<ast::Tree>> {
+        if let Some(tree) = self.substitute.get(&(
+            tree.clone().into(),
+            from.clone().into(),
+            into.clone().into(),
+        )) {
+            return tree.clone();
         }
+        let out = ast::substitute(self, tree, from, into);
+        self.substitute.insert(
+            (
+                tree.clone().into(),
+                from.clone().into(),
+                into.clone().into(),
+            ),
+            out.clone(),
+        );
+        out
     }
-}
 
-impl CamelCase for Name {
-    fn to_camel_case(&self) -> Self::Owned {
-        match self {
-            Self::Spanned(ident) => {
-                let span = ident.span();
-                let name = ident.unraw().to_string();
-                Ident::new(&name.to_camel_case(), span).into()
-            }
-            Name::Spanless(name) => {
-                name.to_camel_case().into()
-            }
+    /// Expands let bindings and function calls until the top level construct is a base term.
+    pub fn translate(
+        &mut self,
+        tree: &Rc<ast::Tree>,
+    ) -> Result<Option<Rc<ast::Tree>>, ast::TranslateError> {
+        if let Some(tree) = self.translate.get(&tree.clone().into()) {
+            return tree.clone();
         }
+        let out = ast::translate(self, tree);
+        self.translate.insert(tree.clone().into(), out.clone());
+        out
     }
-}
 
-impl SnakeCase for Name {
-    fn to_snake_case(&self) -> Self::Owned {
-        match self {
-            Self::Spanned(ident) => {
-                let span = ident.span();
-                let name = ident.unraw().to_string();
-                Ident::new(&name.to_snake_case(), span).into()
-            }
-            Name::Spanless(name) => {
-                name.to_snake_case().into()
-            }
+    /// Computes set of unsolvable type constraints for a term. Returns an error
+    /// if a solvable constraint is unsatisfiable, or the constraints cannot be inferred.
+    pub fn type_of(
+        &mut self,
+        tree: &Rc<ast::Tree>,
+    ) -> Result<typed::ConstrainedType, typed::TypeError> {
+        if let Some(ty) = self.type_of.get(&tree.clone().into()) {
+            return ty.clone();
         }
+        let ty = typed::type_of(self, tree);
+        self.type_of.insert(tree.clone().into(), ty.clone());
+        ty
     }
-}
 
-impl PartialEq for Name {
-    fn eq(&self, other: &Self) -> bool {
-        match (self, other) {
-            (Self::Spanned(me), Self::Spanned(them)) => me == them,
-            (Self::Spanned(me), Self::Spanless(them)) => me.unraw() == them,
-            (Self::Spanless(me), Self::Spanned(them)) => them.unraw() == me,
-            (Self::Spanless(me), Self::Spanless(them)) => me == them,
-        }
+    fn lookup_tree_variable(&self, idx: usize) -> Rc<ast::Tree> {
+        self.var_stack[idx].clone()
     }
-}
 
-impl<T: AsRef<str>> PartialEq<T> for Name {
-    fn eq(&self, other: &T) -> bool {
-        match self {
-            Name::Spanned(me) => me.unraw() == other,
-            Name::Spanless(me) => me == other.as_ref(),
-        }
-    }
-}
+    fn new_lambda<F: FnOnce(&mut Self) -> Rc<ast::Tree>>(&mut self, f: F) -> Rc<ast::Tree> {
+        // Create variable node
+        let arg = Rc::new(ast::Tree::Variable);
 
-impl Eq for Name {}
+        // Apply inner with the variable
+        self.var_stack.push(arg.clone());
+        let inner = f(self);
+        self.var_stack.pop();
 
-impl hash::Hash for Name {
-    fn hash<H: hash::Hasher>(&self, state: &mut H) {
-        match self {
-            Self::Spanned(i) => i.unraw().to_string().hash(state),
-            Self::Spanless(s) => s.hash(state),
-        }
+        // Create the lambda
+        Rc::new(ast::Tree::Lambda(Lambda(arg, inner)))
     }
-}
 
-impl fmt::Display for Name {
-    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
-        match self {
-            Name::Spanned(i) => i.fmt(f),
-            Name::Spanless(s) => s.fmt(f),
-        }
-    }
-}
+    fn new_let<F: FnOnce(&mut Self) -> Rc<ast::Tree>>(
+        &mut self,
+        bind: Rc<ast::Tree>,
+        inner: F,
+    ) -> Rc<ast::Tree> {
+        // Create variable node
+        let arg = Rc::new(ast::Tree::Variable);
 
-impl From<Ident> for Name {
-    fn from(ident: Ident) -> Self {
-        Self::Spanned(ident)
-    }
-}
+        // Apply inner with the variable
+        self.var_stack.push(arg.clone());
+        let inner = inner(self);
+        self.var_stack.pop();
 
-impl From<String> for Name {
-    fn from(string: String) -> Self {
-        Self::Spanless(string)
+        // Create the let
+        Rc::new(ast::Tree::Let(bind, arg, inner))
     }
 }
diff --git a/src/chomp/typed/context.rs b/src/chomp/typed-old/context.rs
index f3263ce..f3263ce 100644
--- a/src/chomp/typed/context.rs
+++ b/src/chomp/typed-old/context.rs
diff --git a/src/chomp/typed/error.rs b/src/chomp/typed-old/error.rs
index 5c1e21e..5c1e21e 100644
--- a/src/chomp/typed/error.rs
+++ b/src/chomp/typed-old/error.rs
diff --git a/src/chomp/typed/infer.rs b/src/chomp/typed-old/infer.rs
index e2c2198..e2c2198 100644
--- a/src/chomp/typed/infer.rs
+++ b/src/chomp/typed-old/infer.rs
diff --git a/src/chomp/typed/lower.rs b/src/chomp/typed-old/lower.rs
index 37589a1..37589a1 100644
--- a/src/chomp/typed/lower.rs
+++ b/src/chomp/typed-old/lower.rs
diff --git a/src/chomp/typed/mod.rs b/src/chomp/typed-old/mod.rs
index cddb05a..cddb05a 100644
--- a/src/chomp/typed/mod.rs
+++ b/src/chomp/typed-old/mod.rs
diff --git a/src/chomp/typed.rs b/src/chomp/typed.rs
new file mode 100644
index 0000000..50d8155
--- /dev/null
+++ b/src/chomp/typed.rs
@@ -0,0 +1,274 @@
+use std::{borrow::BorrowMut, cell::RefCell, rc::Rc};
+
+use super::{
+    ast::{Lambda, Tree},
+    Context,
+};
+
+#[derive(Clone, Debug)]
+pub enum Constraint {}
+
+#[derive(Clone, Debug)]
+pub enum CatCheckError {}
+
+#[derive(Clone, Debug)]
+pub enum TypeError {
+    NeedGroundType(Rc<Type>),
+    CatCheck(CatCheckError),
+}
+
+#[derive(Debug)]
+pub struct AlgebraicType {}
+
+#[derive(Debug)]
+pub enum GroundType {
+    Epsilon,
+    Bottom,
+    Character(char),
+    Variable,
+    Cat(RefCell<Rc<GroundType>>, RefCell<Rc<GroundType>>),
+    Alt(RefCell<Rc<GroundType>>, RefCell<Rc<GroundType>>),
+    Fix(RefCell<Rc<GroundType>>, RefCell<Rc<GroundType>>),
+}
+
+#[derive(Clone, Debug)]
+pub struct UnificationError(pub Rc<Type>, pub Rc<Type>);
+
+impl GroundType {
+    pub fn is_variable(&self) -> bool {
+        matches!(self, Self::Variable)
+    }
+
+    pub fn substitute(self: &mut Rc<Self>, from: &Rc<Self>, into: &Rc<Self>) {
+        if Rc::ptr_eq(self, from) {
+            *self = into.clone();
+            return;
+        }
+
+        match self.as_ref() {
+            GroundType::Epsilon => {}
+            GroundType::Bottom => {}
+            GroundType::Character(_) => {}
+            GroundType::Variable => {}
+            GroundType::Cat(front, back) => {
+                front.borrow_mut().substitute(from, into);
+                back.borrow_mut().substitute(from, into);
+            }
+            GroundType::Alt(left, right) => {
+                left.borrow_mut().substitute(from, into);
+                right.borrow_mut().substitute(from, into);
+            }
+            GroundType::Fix(_, inner) => {
+                inner.borrow_mut().substitute(from, into);
+            }
+        }
+    }
+
+    pub fn occurs_in(self: &Rc<Self>, other: &Rc<Self>) -> bool {
+        if Rc::ptr_eq(self, other) {
+            return true;
+        }
+
+        match other.as_ref() {
+            GroundType::Epsilon => false,
+            GroundType::Bottom => false,
+            GroundType::Character(_) => false,
+            GroundType::Variable => false,
+            GroundType::Cat(front, back) => {
+                self.occurs_in(&front.borrow()) || self.occurs_in(&back.borrow())
+            }
+            GroundType::Alt(left, right) => {
+                self.occurs_in(&left.borrow()) || self.occurs_in(&right.borrow())
+            }
+            GroundType::Fix(arg, out) => {
+                self.occurs_in(&arg.borrow()) || self.occurs_in(&out.borrow())
+            }
+        }
+    }
+
+    pub fn unify<'a>(
+        self: &'a mut Rc<Self>,
+        other: &'a mut Rc<Self>,
+    ) -> Result<(), UnificationError> {
+        if Rc::ptr_eq(self, other) {
+            return Ok(());
+        }
+
+        match (self.as_ref(), other.as_ref()) {
+            (GroundType::Epsilon, GroundType::Epsilon) => Ok(()),
+            (GroundType::Bottom, GroundType::Bottom) => Ok(()),
+            (GroundType::Character(c), GroundType::Character(d)) if c == d => Ok(()),
+            (GroundType::Cat(front1, back1), GroundType::Cat(front2, back2)) => {
+                front1.borrow_mut().unify(&mut front2.borrow_mut())?;
+                back1.borrow_mut().unify(&mut back2.borrow_mut())
+            }
+            (GroundType::Alt(left1, right1), GroundType::Alt(left2, right2)) => {
+                left1.borrow_mut().unify(&mut left2.borrow_mut())?;
+                right1.borrow_mut().unify(&mut right2.borrow_mut())
+            }
+            (GroundType::Fix(arg1, out1), GroundType::Fix(arg2, out2)) => {
+                let new_arg = Rc::new(GroundType::Variable);
+                out1.borrow_mut().substitute(&arg1.borrow(), &new_arg);
+                out2.borrow_mut().substitute(&arg2.borrow(), &new_arg);
+                arg1.replace(new_arg.clone());
+                arg2.replace(new_arg.clone());
+                out1.borrow_mut().unify(&mut out2.borrow_mut())
+            }
+            (GroundType::Variable, GroundType::Variable) => {
+                self = other;
+                Ok(())
+            }
+            (GroundType::Variable, _) if !self.occurs_in(other) => {
+                self = other;
+                Ok(())
+            }
+            (_, GroundType::Variable) if !other.occurs_in(self) => {
+                other = self;
+                Ok(())
+            }
+            _ => Err(UnificationError(
+                Rc::new(self.clone().into()),
+                Rc::new(other.clone().into()),
+            )),
+        }
+    }
+}
+
+/// Function type where the formal parameter is guarded in the body.
+/// The actual parameter is checked in an unguarded context.
+#[derive(Debug)]
+pub struct GuardedFunction(pub RefCell<Rc<GroundType>>, pub RefCell<Rc<Type>>);
+
+#[derive(Debug)]
+pub enum Type {
+    Ground(RefCell<Rc<GroundType>>),
+    /// Function type where the formal parameter is unguarded in the body.
+    /// The actual parameter is checked in a guarded context.
+    UnguardedFunction(RefCell<Rc<GroundType>>, RefCell<Rc<Type>>),
+    GuardedFunction(GuardedFunction),
+    Variable,
+}
+
+impl Type {
+    pub fn try_as_ground<'a>(
+        self: &'a Rc<Self>,
+    ) -> Result<&'a RefCell<Rc<GroundType>>, &'a Rc<Self>> {
+        if let Type::Ground(g) = self.as_ref() {
+            Ok(g)
+        } else {
+            Err(self)
+        }
+    }
+    pub fn unify<'a>(
+        self: &'a mut Rc<Self>,
+        other: &'a mut Rc<Self>,
+    ) -> Result<(), UnificationError> {
+        if Rc::ptr_eq(self, other) {
+            return Ok(());
+        }
+
+        match self.as_ref() {
+            Type::Ground(g) => {
+                if let Type::Ground(o) = other.as_ref() {
+                    g.borrow_mut().unify(&mut o.borrow_mut())
+                } else {
+                    Err(UnificationError(self.clone(), other.clone()))
+                }
+            }
+            Type::UnguardedFunction(arg, out) => {
+                if let Type::UnguardedFunction(o_arg, o_out) = other.as_ref() {
+                    arg.borrow_mut().unify(&mut o_arg.borrow_mut())?;
+                    out.borrow_mut().unify(&mut o_out.borrow_mut())
+                } else {
+                    Err(UnificationError(self.clone(), other.clone()))
+                }
+            }
+            Type::GuardedFunction(GuardedFunction(arg, out)) => {
+                if let Type::GuardedFunction(GuardedFunction(o_arg, o_out)) = other.as_ref() {
+                    arg.borrow_mut().unify(&mut o_arg.borrow_mut())?;
+                    out.borrow_mut().unify(&mut o_out.borrow_mut())
+                } else {
+                    Err(UnificationError(self.clone(), other.clone()))
+                }
+            }
+            Type::Variable => {
+                self = other;
+                Ok(())
+            }
+        }
+    }
+}
+
+impl From<GroundType> for Type {
+    fn from(ty: GroundType) -> Self {
+        Rc::new(ty).into()
+    }
+}
+
+impl From<Rc<GroundType>> for Type {
+    fn from(ty: Rc<GroundType>) -> Self {
+        Self::Ground(RefCell::new(ty))
+    }
+}
+
+pub fn type_of(ctx: &mut Context, tree: &Rc<Tree>) -> Result<Rc<Type>, TypeError> {
+    match tree.as_ref() {
+        Tree::Epsilon => Ok(ctx.type_interner.epsilon()),
+        Tree::Bottom => Ok(ctx.type_interner.bottom()),
+        Tree::Identity => {
+            let arg = Rc::new(GroundType::Variable);
+            Ok(Rc::new(Type::UnguardedFunction(
+                RefCell::new(arg),
+                RefCell::new(Rc::new(arg.into())),
+            )))
+        }
+        Tree::Literal(l) => {
+            if let Some(c) = l.chars().next() {
+                Ok(ctx.type_interner.character(c))
+            } else {
+                Ok(ctx.type_interner.epsilon())
+            }
+        }
+        Tree::Variable => todo!(), // ctx.lookup_type_variable(tree),
+        Tree::Cat(front, back) => {
+            let mut front_ty: Rc<Type> = Rc::new(GroundType::Variable.into());
+            let mut back_ty: Rc<Type> = Rc::new(GroundType::Variable.into());
+            ctx.type_of(front)?
+                .unify(&mut front_ty)
+                .map_err(|_| todo!())?;
+            ctx.type_of(back)?
+                .unify(&mut back_ty)
+                .map_err(|_| todo!())?;
+            let front_ty = front_ty.try_as_ground().unwrap();
+            let back_ty = back_ty.try_as_ground().unwrap();
+            Ok(ctx
+                .type_interner
+                .cat(front_ty.borrow().clone(), back_ty.borrow().clone()))
+        }
+        Tree::Alt(left, right) => {
+            let mut left_ty: Rc<Type> = Rc::new(GroundType::Variable.into());
+            let mut right_ty: Rc<Type> = Rc::new(GroundType::Variable.into());
+            ctx.type_of(left)?
+                .unify(&mut left_ty)
+                .map_err(|_| todo!())?;
+            ctx.type_of(right)?
+                .unify(&mut right_ty)
+                .map_err(|_| todo!())?;
+            let left_ty = left_ty.try_as_ground().unwrap();
+            let right_ty = right_ty.try_as_ground().unwrap();
+            Ok(ctx
+               .type_interner
+               .alt(left_ty.borrow().clone(), right_ty.borrow().clone()))
+        }
+        Tree::Fix(inner) => {
+            let shape = Rc::new(Type::GuardedFunction(GuardedFunction(RefCell::new(Rc::new(GroundType::Variable)), RefCell::new(Rc::new(GroundType::Variable.into())))));
+            ctx.type_of(inner)?
+                .unify(&mut shape)
+                .map_err(|_| todo!())?;
+            todo!()
+        }
+        Tree::Call(_, _) => todo!(),
+        Tree::Lambda(_) => todo!(),
+        Tree::Let(_, _, _) => todo!(),
+    }
+}
diff --git a/src/lib.rs b/src/lib.rs
index a94e08c..f505a04 100644
--- a/src/lib.rs
+++ b/src/lib.rs
@@ -56,6 +56,8 @@
 #![warn(clippy::unwrap_used)]
 #![warn(clippy::wildcard_enum_match_arm)]
 
+#![feature(arc_new_cyclic)]
+
 pub mod chomp;
-pub mod lower;
-pub mod nibble;
+// pub mod lower;
+// pub mod nibble;