Implementation of Syntactic Closures in Rust

main.rs

use std::collections::HashMap;
use std::rc::Rc;
use std::sync::atomic::AtomicUsize;
use std::sync::atomic::Ordering;

pub fn main() {
    let x = Value::Symbol(Symbol("x".into()));
    let quote = Value::Symbol(Symbol("quote".into()));
    let quotx = cons(quote.clone(), cons(x.clone(), nil()));
    let lambda = Value::Symbol(Symbol("lambda".into()));
    let xs = cons(x.clone(), nil());
    let lam = cons(lambda, cons(xs, cons(x.clone(), nil())));
    let exp = cons(lam, cons(quotx, nil()));
    let env: SyntacticEnvObj = Rc::new(CoreSyntacticEnvironment);
    let run = compile(&env, &exp);
    let res = run(&Default::default());
    println!("{:?}", res);
}

fn nil() -> Value {
    Value::Nil
}
fn cons(a: Value, b: Value) -> Value {
    Value::Pair(Rc::new((a, b)))
}

// Compiler

fn make_syntactic_closure(
    syntactic_env: &SyntacticEnvObj,
    free_names: Vec<Symbol>,
    exp: &Value,
) -> Value {
    let syntactic_env = syntactic_env.clone();
    let exp = exp.clone();
    Value::SyntacticClosure(SC(Rc::new(move |free_names_syntactic_env| {
        let fenv: SyntacticEnvObj = Rc::new(SyntacticEnvFilter {
            names: free_names.clone(),
            names_syntactic_env: free_names_syntactic_env.clone(),
            else_syntactic_env: syntactic_env.clone(),
        });
        compile(&fenv, &exp)
    })))
}

fn compile_syntactic_closure(syntactic_env: &SyntacticEnvObj, syntactic_closure: &Value) -> Code {
    (syntactic_closure.as_syntactic_closure().unwrap())(syntactic_env)
}

fn compile_constant(_syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
    let exp = exp.clone();
    Rc::new(move |_| exp.clone())
}

fn compile_free_variable(_syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
    compile_variable(exp.expect_symbol())
}

fn compile_variable(var: &Symbol) -> Code {
    let var = var.clone();
    Rc::new(move |env| {
        env.get(&var)
            .unwrap_or_else(|| panic!("unbound variable: {:?}", var))
            .clone()
    })
}

fn compile_combination(syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
    let parts = compile_list(syntactic_env, exp);
    Rc::new(move |env| {
        let parts: Vec<_> = parts.iter().map(|p| p(env)).collect();
        println!("parts: {:?}", parts);
        let func = parts[0].expect_function();
        let args = &parts[1..];
        func.call(args)
    })
}

fn compile_simple(_syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
    unimplemented!("need specialized impl for {:?}", exp)
}

fn compile_lambda(syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
    let syntactic_env = add_identifier_list(syntactic_env, exp.cadr());
    let params = compile_param_list(&syntactic_env, exp.cadr());
    let body = compile_list(&syntactic_env, exp.cddr());
    Rc::new(move |env| Value::closure(params.clone(), body.clone(), env.clone()))
}

fn extend_syntactic_environment(
    outer_syntactic_env: &SyntacticEnvObj,
    keyword: Symbol,
    expander: &Expander,
) -> SyntacticEnvObj {
    let outer_syntactic_env = outer_syntactic_env.clone();
    let expander = expander.clone();
    Rc::new(SyntacticEnvExtension {
        outer_syntactic_env,
        keyword,
        expander,
    })
}

fn add_identifier_list(syntactic_env: &SyntacticEnvObj, identifiers: &Value) -> SyntacticEnvObj {
    if identifiers.is_null() {
        syntactic_env.clone()
    } else {
        add_identifier(
            add_identifier_list(syntactic_env, identifiers.cdr()),
            identifiers.car().clone(),
        )
    }
}

fn add_identifier(outer_syntactic_env: SyntacticEnvObj, identifier: Value) -> SyntacticEnvObj {
    let variable = make_unique_symbol(identifier.expect_symbol());
    Rc::new(SyntacticBinding {
        outer_syntactic_env,
        identifier,
        variable,
    })
}

fn compile(syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
    println!("compile: {:?}", exp);
    syntactic_env.apply(syntactic_env, exp)
}

fn compile_list(syntactic_env: &SyntacticEnvObj, mut exps: &Value) -> Vec<Code> {
    println!("compile list: {:?}", exps);
    let mut out = vec![];
    while !exps.is_null() {
        out.push(syntactic_env.apply(syntactic_env, exps.car()));
        exps = exps.cdr();
    }
    out
}

fn compile_param_list(syntactic_env: &SyntacticEnvObj, mut exps: &Value) -> Vec<Symbol> {
    let mut out = vec![];
    while !exps.is_null() {
        out.push(syntactic_env.transform(syntactic_env, exps.car().expect_symbol()));
        exps = exps.cdr();
    }
    out
}

type Expander = Rc<dyn Fn(&SyntacticEnvObj, &Value) -> Value>;

type Code = Rc<dyn Fn(&HashMap<Symbol, Value>) -> Value>;

type SyntacticEnvObj = Rc<dyn SyntacticEnvIntf>;
trait SyntacticEnvIntf {
    fn apply(&self, syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code;
    fn transform(&self, syntactic_env: &SyntacticEnvObj, name: &Symbol) -> Symbol;
}

struct NullSyntacticEnvironment;

impl SyntacticEnvIntf for NullSyntacticEnvironment {
    fn apply(&self, syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
        if exp.is_syntactic_closure() {
            compile_syntactic_closure(syntactic_env, exp)
        } else {
            panic!("Unclosed expression: {:?}", exp)
        }
    }

    fn transform(&self, _syntactic_env: &SyntacticEnvObj, _name: &Symbol) -> Symbol {
        unimplemented!()
    }
}

struct CoreSyntacticEnvironment;

impl SyntacticEnvIntf for CoreSyntacticEnvironment {
    fn apply(&self, syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
        match exp {
            _ if exp.is_syntactic_closure() => compile_syntactic_closure(syntactic_env, exp),
            _ if exp.is_symbol() => compile_free_variable(syntactic_env, exp),
            _ if !exp.is_pair() => compile_constant(syntactic_env, exp),
            _ => match exp.car().as_symbol_str() {
                Some("quote") => compile_constant(syntactic_env, exp.cadr()),
                Some("if" | "begin" | "set") => compile_simple(syntactic_env, exp),
                Some("lambda") => compile_lambda(syntactic_env, exp),
                _ => compile_combination(syntactic_env, exp),
            },
        }
    }

    fn transform(&self, _syntactic_env: &SyntacticEnvObj, _name: &Symbol) -> Symbol {
        unimplemented!()
    }
}

struct SyntacticBinding {
    outer_syntactic_env: SyntacticEnvObj,
    identifier: Value,
    variable: Symbol,
}

impl SyntacticEnvIntf for SyntacticBinding {
    fn apply(&self, syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
        if exp == &self.identifier {
            compile_variable(&self.variable)
        } else {
            self.outer_syntactic_env.apply(syntactic_env, exp)
        }
    }

    fn transform(&self, syntactic_env: &SyntacticEnvObj, name: &Symbol) -> Symbol {
        if name == self.identifier.expect_symbol() {
            self.variable.clone()
        } else {
            self.outer_syntactic_env.transform(syntactic_env, name)
        }
    }
}

struct SyntacticEnvExtension {
    outer_syntactic_env: SyntacticEnvObj,
    keyword: Symbol,
    expander: Expander,
}

impl SyntacticEnvIntf for SyntacticEnvExtension {
    fn apply(&self, syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
        if exp.is_pair() && exp.car() == &self.keyword {
            let nse: SyntacticEnvObj = Rc::new(NullSyntacticEnvironment);
            compile(&nse, &(self.expander)(syntactic_env, exp))
        } else {
            self.outer_syntactic_env.apply(syntactic_env, exp)
        }
    }

    fn transform(&self, syntactic_env: &SyntacticEnvObj, name: &Symbol) -> Symbol {
        self.outer_syntactic_env.transform(syntactic_env, name)
    }
}

struct SyntacticEnvFilter {
    names: Vec<Symbol>,
    names_syntactic_env: SyntacticEnvObj,
    else_syntactic_env: SyntacticEnvObj,
}

impl SyntacticEnvIntf for SyntacticEnvFilter {
    fn apply(&self, syntactic_env: &SyntacticEnvObj, exp: &Value) -> Code {
        (if self
            .names
            .contains((if exp.is_pair() { exp.car() } else { exp }).expect_symbol())
        {
            &self.names_syntactic_env
        } else {
            &self.else_syntactic_env
        })
        .apply(syntactic_env, exp)
    }

    fn transform(&self, _syntactic_env: &SyntacticEnvObj, _name: &Symbol) -> Symbol {
        todo!()
    }
}

// utilities

static UNIQUE_SYMBOL_COUNTER: AtomicUsize = AtomicUsize::new(0);

fn make_unique_symbol(symbol: &Symbol) -> Symbol {
    let n = UNIQUE_SYMBOL_COUNTER.fetch_add(1, Ordering::Relaxed);
    Symbol(format!("{}@{}", symbol.0, n))
}

// essentials

#[derive(Clone, Debug, Eq, Hash, PartialEq)]
struct Symbol(String);

#[derive(Clone, Debug, PartialEq)]
enum Value {
    Symbol(Symbol),
    Nil,
    Pair(Rc<(Value, Value)>),

    Closure(Closure),

    SyntacticClosure(SC),
}

impl Value {
    fn is_symbol(&self) -> bool {
        self.as_symbol().is_some()
    }

    fn as_symbol_str(&self) -> Option<&str> {
        self.as_symbol().map(|s| s.0.as_str())
    }

    fn as_symbol(&self) -> Option<&Symbol> {
        match self {
            Value::Symbol(s) => Some(s),
            _ => None,
        }
    }

    fn expect_symbol(&self) -> &Symbol {
        match self {
            Value::Symbol(s) => s,
            _ => panic!("expected symbol"),
        }
    }

    fn is_null(&self) -> bool {
        match self {
            Value::Nil => true,
            _ => false,
        }
    }

    fn is_pair(&self) -> bool {
        match self {
            Value::Pair(_) => true,
            _ => false,
        }
    }

    fn car(&self) -> &Value {
        match self {
            Value::Pair(p) => &p.0,
            _ => panic!("expected pair"),
        }
    }

    fn cdr(&self) -> &Value {
        match self {
            Value::Pair(p) => &p.1,
            _ => panic!("expected pair"),
        }
    }

    fn cadr(&self) -> &Value {
        self.cdr().car()
    }

    fn cddr(&self) -> &Value {
        self.cdr().cdr()
    }

    fn is_syntactic_closure(&self) -> bool {
        self.as_syntactic_closure().is_some()
    }

    fn as_syntactic_closure(&self) -> Option<&Rc<dyn Fn(&SyntacticEnvObj) -> Code>> {
        match self {
            Value::SyntacticClosure(sc) => Some(&sc.0),
            _ => None,
        }
    }

    fn closure(params: Vec<Symbol>, body: Vec<Code>, env: HashMap<Symbol, Value>) -> Self {
        Value::Closure(Closure(Rc::new((params, body, env))))
    }

    fn expect_function(&self) -> &Closure {
        match self {
            Value::Closure(c) => &c,
            _ => panic!("expected function: {:?}", self),
        }
    }
}

impl PartialEq<Symbol> for Value {
    fn eq(&self, s: &Symbol) -> bool {
        match self {
            Value::Symbol(sym) => s == sym,
            _ => false,
        }
    }
}

#[derive(Clone)]
struct Closure(Rc<(Vec<Symbol>, Vec<Code>, HashMap<Symbol, Value>)>);

impl Closure {
    fn call(&self, args: &[Value]) -> Value {
        let mut env = self.0 .2.clone();
        for (param, arg) in self.0 .0.iter().zip(args.iter()) {
            env.insert(param.clone(), arg.clone());
        }
        let mut res = Value::Nil;
        for code in self.0 .1.iter() {
            res = code(&env);
        }
        res
    }
}

impl std::fmt::Debug for Closure {
    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
        write!(f, "<closure {:?}>", self.0 .0)
    }
}

impl PartialEq for Closure {
    fn eq(&self, other: &Self) -> bool {
        Rc::ptr_eq(&self.0, &other.0)
    }
}

#[derive(Clone)]
struct SC(Rc<dyn Fn(&SyntacticEnvObj) -> Code>);

impl std::fmt::Debug for SC {
    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
        write!(f, "<syntax>")
    }
}

impl PartialEq for SC {
    fn eq(&self, other: &Self) -> bool {
        Rc::ptr_eq(&self.0, &other.0)
    }
}