The Pattern-Matching Compiler from TIFPL

main.rs

fn main() {
}

fn match_(k: usize, us: &[Variable], qs: Vec<Equation>, def: Expression) -> Expression {
    if us.is_empty() {
        let es = qs.into_iter().map(|Equation(_, e)|e).collect();
        foldr(Expression::fatbar, def, es)
    } else {
        foldr(|qq, dd|match_var_con(k, us, qq, dd), def, partition(is_var, qs))
    }
}

fn match_var_con(k: usize, us: &[Variable], qs: Vec<Equation>, def: Expression) -> Expression {
    if is_var(&qs[0]) { 
        return match_var(k, us[0], &us[1..], qs, def)
    }
    
    if is_con(&qs[0]) {
        // passing us including the first element is intentional
        return match_con(k, us[0], us, qs, def)
    }
    
    unreachable!()
}

fn match_var(k: usize, u: Variable, us: &[Variable], qs: Vec<Equation>, def: Expression) -> Expression {
    let qs_ = qs.into_iter().map(|Equation(mut ps, e)| {
        let Pattern::Var(v) = ps.remove(0) else { unreachable!() };
        Equation(ps, e.subst(u, v))
    }).collect();
    match_(k, us, qs_, def)
}

fn match_con(k: usize, u: Variable, uus: &[Variable], qs: Vec<Equation>, def: Expression) -> Expression {
    let cs = constructors(get_con(&qs[0]));
    let cs_ = cs.into_iter().map(|c|match_clause(c, k, &uus[1..], choose(c, &qs), def.clone())).collect();
    Expression::Case(u, cs_)
}

fn match_clause(c: Constructor, k: usize, us: &[Variable], qs: Vec<Equation>, def: Expression) -> Clause {
    let k_ = arity(c);
    let us_: Vec<Variable> = (1..=k_).map(|i|make_var(i+k)).collect();
    let qs_ = qs.into_iter().map(|Equation(mut ps, e)|{
        let Pattern::Con(c, ps_) = ps.remove(0) else {unreachable!()};
        Equation(concat(ps_, &ps), e)
    }).collect();
    let e_ = match_(k_ + k, &concat(us_.clone(), us), qs_, def);
    Clause(c, us_, e_)
}

fn choose(c: Constructor, qs: &[Equation]) -> Vec<Equation> {
    qs.into_iter().filter(|q| get_con(q) == c).cloned().collect()
}

#[derive(Clone, Debug, PartialEq)]
enum Pattern {
    Var(Variable),
    Con(Constructor, Vec<Pattern>),
}

type Variable = &'static str;
type Constructor = &'static str;

fn make_var(n: usize) -> Variable {
    let bx: Box<str> = format!("_u{n}").into();
    Box::leak(bx)
}

fn arity(c: Constructor) -> usize {
    match c {
        "FALSE" => 0,
        "TRUE" => 0,
        "NIL" => 0,
        "CONS" => 2,
        _ => unimplemented!("{c:?}")
    }
}

fn constructors(c: Constructor) -> &'static [Constructor] {
    match c {
        "FALSE" | "TRUE" => &["FALSE", "TRUE"],
        "NIL" | "CONS" => &["NIL", "CONS"],
        _ => unimplemented!("{c:?}")
    }
}

#[derive(Clone, Debug, PartialEq)]
enum Expression {
    Bottom,
    Case(Variable, Vec<Clause>),
    FatBar(Box<Expression>, Box<Expression>),
    //...
}

#[derive(Clone, Debug, PartialEq)]
struct Clause(Constructor, Vec<Variable>, Expression);

impl Expression {
    fn fatbar(a: Expression, b: Expression) -> Expression {
        Self::FatBar(Box::new(a), Box::new(b))
    }
    
    fn subst(self, x: Variable, y: Variable) -> Self {
        match self {
            Expression::Bottom => Expression::Bottom,
            Expression::Case(v, cs) => Expression::Case(if v==x {y} else {v}, cs.into_iter().map(|c|c.subst(x,y)).collect()),
            Expression::FatBar(a, b) => Expression::fatbar(a.subst(x,y), b.subst(x,y)),
        }
    }
}

impl Clause {
    fn subst(self, x: Variable, y: Variable) -> Self {
        let Clause(c, vs, e) = self;
        let vs_ = vs.into_iter().map(|v|if v==x {y} else {v}).collect();
        Clause(c, vs_, e.subst(x,y))
    }
}

#[derive(Clone, Debug, PartialEq)]
struct Equation(Vec<Pattern>, Expression);

fn is_var(Equation(ps, _): &Equation) -> bool {
    match ps.as_slice() {
        [] => unimplemented!(),
        [Pattern::Var(_), ..] => true,
        [Pattern::Con(_, _), ..] => false,
    }
}

fn is_con(q: &Equation) -> bool {
    return !is_var(q)
}

fn get_con(Equation(ps, _): &Equation) -> Constructor {
    match ps.as_slice() {
        [Pattern::Con(c, _), ..] => c,
        _ => unimplemented!()
    }
}

fn partition<T, U: PartialEq>(f: impl Fn(&T) -> U, mut xs: Vec<T>) -> Vec<Vec<T>> {
    match xs.len() {
        0 => vec![],
        1 => vec![xs],
        _ => {
            let c = f(&xs[0]) == f(&xs[1]);
            let x = xs.remove(0);
            let mut xs_ = partition(f, xs);
            if c {
                tack(x, xs_)
            } else {
                xs_.insert(0, vec![x]);
                xs_
            }
        }
    }
}

fn tack<T>(x: T, mut xss: Vec<Vec<T>>) -> Vec<Vec<T>> {
    xss[0].insert(0, x);
    xss
}

fn foldr<T, U>(f: impl Fn(T, U) -> U, a: U, xs: Vec<T>) -> U {
    xs.into_iter().rev().fold(a, |x, y|f(y, x))
}

fn concat<T:Clone>(mut xs: Vec<T>, ys: &[T]) -> Vec<T> {
    xs.extend_from_slice(ys);
    xs
}

#[cfg(test)]
mod tests {
    use super::*;
    use Expression::*;
    use Pattern::*;
    
    #[test]
    fn partition_example() {
        assert_eq!(partition(odd, vec![1,3,2,4,1]), vec![vec![1,3], vec![2,4], vec![1]]);
    }
    
    fn odd(x:&i32) -> bool {
        x % 2 != 0
    }
    
    #[test]
    fn matcher() {
        let out = match_(0, &[], vec![], Bottom);
        assert_eq!(out, Bottom);
        
        let out = match_(0, &["u"], vec![], Bottom);
        assert_eq!(out, Bottom);
        
        let out = match_(0, &["u"], vec![Equation(vec![Var("x")], Bottom)], Bottom);
        assert_eq!(out, Expression::fatbar(Bottom, Bottom));
        
        let fbb = Expression::fatbar(Bottom, Bottom);
        let out = match_(0, &["u"], vec![Equation(vec![Con("FALSE", vec![])], Bottom)], Bottom);
        assert_eq!(out, Expression::Case("u", vec![Clause("FALSE", vec![], fbb), Clause("TRUE", vec![], Bottom)]));
    }
}