↑Programmieren in Rust

Beispiele: Lisp-Interpreter

Inhaltsverzeichnis

1. Übersicht
2. Interpreter
3. Beispiele
4. Literatur

Übersicht

Der Interpreter implementiert einen minimalen Dialekt der Sprache Lisp. Die folgenden Funktionen stehen zur Verfügung.

Zur Kompilierzeit ist die Sprache untypisiert. Zur Laufzeit kann der Interpreter zwischen den folgenden Typen unterscheiden.

Der Typ Zero entspricht in Rust dem Never-Typ, und bedeutet, dass das Programm divergiert, beispielsweise durch Werfen einer Ausnahme. Der Typ Unit entspricht () in Rust. Kodiert ist Zero als Object::Err und Unit als Object::None.

Die Arbeitsweise des Interpreters ist grob unterteilbar in die folgenden Phasen:

1. Lexikalische Analyse durch scan,
2. Syntaktische Analyse durch parse und transform,
3. Syntaktische Umwandlung durch transform,
4. Ausführung durch eval.

Die syntaktische Umwandlung ist relativ komplex, da sie auch Variablen aus dem lexikalischen Kontext verarbeitet und dabei zudem die Bindungen für lexikalische Closures erzeugt. Lokale Variablenbindungen werden auf unmittelbar ausgeführte Funktionen zurückgeführt, d. h. (let ((x v)) body) entspricht ((fn (x) body) v).

Die Ausführung geschieht durch rekursive Auswertung des ausführbaren Baums, welcher durch den Typ Object kodiert ist. Diese Rekursion koppelt leider den Aufrufstapel mit dem der Host-Umgebung, so dass die maximale Rekursionstiefe beschränkt bleibt, sofern man den Aufrufstapel der Host-Umgebung nicht vergrößert.

Zugriff auf die implementierte Laufzeitumgebung findet durch einen Zeiger env auf die Struktur des Typs Env statt. Jede Funktion besitzt intern diesen Zeiger als Argument, da hierüber unter anderem auch der Aufrufstapel angesprochen wird.

Die Umsetzung von Endrekursion ohne Wachstum des Aufrufstapels ist als Trampolin-System gestaltet, wobei tail-call den Aufruf verzögert und tail-iter die Aufrufe in einer Trampolin-Schleife ausführt.

Interpreter

use std::rc::Rc;
use std::collections::HashMap;
use std::any::Any;
use std::mem::replace;

macro_rules! expect {
    ($x:expr, $p:path) => {
        match $x {$p(value) => value, _ => panic!()}
    };
    ($x:expr, $p:path, $otherwise:expr) => {
        match $x {$p(value) => value, _ => $otherwise}
    }
}

#[derive(Debug)]
enum Symbol {
    None, Int(i32), Identifier(String), String(String),
    ParenLeft, ParenRight
}

#[derive(Debug)]
struct Token {
    value: Symbol,
    line: usize,
    col: usize
}

enum ErrorEnum {
    Syntax {line: usize, col: usize, text: String},
    Value {text: String}
}
impl std::fmt::Display for ErrorEnum {
    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
        match self {
            ErrorEnum::Syntax {text, line, col} => {
                write!(f, "Syntax error (line {}, col {}): {}",
                    line + 1, col + 1, text)
            },
            ErrorEnum::Value {text} => {
                write!(f, "Error: {}", text)
            }
        }
    }
}


type Error = Rc<ErrorEnum>;

fn syntax_error(line: usize, col: usize, text: String) -> Error {
    Rc::new(ErrorEnum::Syntax {line, col, text})
}

fn mul10_add(value: i32, digit: u8) -> Option<i32> {
    value.checked_mul(10)?
        .checked_add(i32::from(digit) - i32::from(b'0'))
}

fn is_letter(c: u8) -> bool {
    c.is_ascii_alphabetic() || c == b'+' || c == b'-' || c == b'*' ||
    c == b'/' || c == b'%' || c == b'=' || c == b'<' || c == b'>'
}

fn scan(a: &[u8]) -> Result<Vec<Token>, Error> {
    let mut tokens: Vec<Token> = Vec::new();
    let mut i = 0;
    let mut line = 0;
    let mut col = 0;
    loop {
        let c = *expect!(a.get(i), Some, break);
        if c.is_ascii_digit() {
            let col0 = col;
            let mut value: i32 = i32::from(c) - i32::from(b'0');
            i += 1; col += 1;
            while let Some(&c) = a.get(i) {
                col += 1;
                if c.is_ascii_digit() {
                    match mul10_add(value, c) {
                        Some(x) => value = x,
                        None => return Err(syntax_error(line, col,
                            "integer literal overflow.".into()))
                    }
                    i += 1; col += 1;
                } else {
                    break;
                }
            }
            tokens.push(Token {value: Symbol::Int(value), line, col: col0});
        } else if is_letter(c) {
            let col0 = col;
            let mut id = String::new();
            id.push(char::from(c));
            i += 1; col += 1;
            while let Some(&c) = a.get(i) {
                if is_letter(c) || c.is_ascii_digit() {
                    id.push(char::from(c));
                    i += 1; col += 1;
                } else {
                    break;
                }
            }
            tokens.push(Token {value: Symbol::Identifier(id), line, col: col0});
        } else {
            match c {
                b'(' => {
                    tokens.push(Token {value: Symbol::ParenLeft, line, col});
                    i += 1; col += 1;
                },
                b')' => {
                    tokens.push(Token {value: Symbol::ParenRight, line, col});
                    i += 1; col += 1;
                },
                b' ' | b'\t' => {
                    i += 1; col += 1;
                },
                b'\n' => {
                    i += 1; col = 0; line += 1;
                },
                b'#' | b';' => {
                    while let Some(&c) = a.get(i) {
                        i += 1;
                        if c == b'\n' {break;}
                    }
                    col = 0; line += 1;
                },
                b'"' => {
                    let col0 = col;
                    let mut s = String::new();
                    i += 1; col += 1;
                    while let Some(&c) = a.get(i) {
                        i += 1; col += 1;
                        if c == b'"' {break;}
                        if c == b'\n' {col = 0; line += 1;}
                        s.push(char::from(c));
                    }
                    tokens.push(Token {
                        value: Symbol::String(s), line, col: col0});
                }
                c => {
                    return Err(syntax_error(line, col,
                        format!("unexpected character: '{}'.", char::from(c))));
                }
            }
        }
    }
    tokens.push(Token {value: Symbol::None, line, col});
    Ok(tokens)
}

struct ParserFrame<'a> {
    list: Vec<Object>,
    token: &'a Token
}

fn parse(tokens: &[Token]) -> Result<Vec<Object>, Error> {
    let mut stack: Vec<ParserFrame> = Vec::with_capacity(10);
    let mut list: Vec<Object> = Vec::new();
    for t in tokens {
        match t.value {
            Symbol::Int(value) => {
                list.push(Object::Int(value));
            },
            Symbol::Identifier(ref id) => {
                list.push(Object::Symbol(Rc::from(&**id)));
            },
            Symbol::String(ref id) => {
                list.push(Object::Interface(
                    Rc::from(StrObj(Rc::from(&**id)))));
            },
            Symbol::ParenLeft => {
                stack.push(ParserFrame {
                    list: std::mem::take(&mut list),
                    token: t
                });
            },
            Symbol::ParenRight => {
                if let Some(frame) = stack.pop() {
                    let app = replace(&mut list, frame.list);
                    if app.is_empty() {
                        list.push(Object::None);
                    } else {
                        list.push(Object::App(Rc::new(App {
                            list: app,
                            line: frame.token.line,
                            col: frame.token.col
                        })));
                    }
                } else {
                    return Err(syntax_error(t.line, t.col,
                        "bracket mismatch.".into()))
                }
            },
            Symbol::None => {
                if !stack.is_empty() {
                    return Err(syntax_error(t.line, t.col,
                        "bracket mismatch.".into()));
                }
                break;
            }
        }
    }
    for x in &mut list {
        let tab = &mut ScopeTable::new(None);
        *x = transform(tab, x)?;
    }
    Ok(list)
}

mod scope_table {
    use std::collections::HashMap;
    use std::{rc::Rc, cell::RefCell};
    use crate::{App, Object, transform_symbol, UNDEFINED};

    #[derive(Clone, Copy)]
    pub enum VarInfo {Argument(usize), Context(usize)}
    pub struct Frame {
        map: HashMap<Rc<str>, VarInfo>,
        count_arg: usize,
        count_context: usize,
        context: Vec<Object>
    }
    impl Frame {
        fn insert_context(&mut self, key: &Rc<str>) -> usize {
            let index = self.count_context;
            self.map.insert(key.clone(), VarInfo::Context(index));
            self.count_context += 1;
            index
        }
        pub fn insert_arg(&mut self, key: &Rc<str>) {
            let index = self.count_arg;
            self.map.insert(key.clone(), VarInfo::Argument(index));
            self.count_arg += 1;
        }
        pub(super) fn context(&mut self) -> Object {
            if self.context.is_empty() {
                Object::None
            } else {
                Object::App(Rc::new(App {
                    line: UNDEFINED, col: UNDEFINED,
                    list: std::mem::take(&mut self.context)}))
            }
        }
    }
    pub struct ScopeTable {
        env: Option<Rc<ScopeTable>>,
        pub frame: RefCell<Frame>
    }
    impl ScopeTable {
        pub fn new(env: Option<Rc<Self>>) -> Rc<Self> {
            Rc::new(Self {env,
                frame: RefCell::new(Frame {map: HashMap::new(),
                count_arg: 0, count_context: 0, context: vec![]})})
        }
        pub fn get(&self, key: &Rc<str>) -> Option<VarInfo> {
            if let Some(info) = self.frame.borrow().map.get(key) {
                return Some(*info);
            }
            if let Some(env) = &self.env {
                if env.get(key).is_some() {
                    let mut frame = self.frame.borrow_mut();
                    let index = frame.insert_context(key);
                    frame.context.push(transform_symbol(env, key));
                    return Some(VarInfo::Context(index));
                }
            }
            None
        }
    }
}

fn insert_args(env: &ScopeTable, list: &Object)
-> Result<usize, Error>
{
    if let Object::App(app) = list {
        for id in app.list.iter() {
            if let Object::Symbol(id) = id {
                env.frame.borrow_mut().insert_arg(id);
            } else {
                return Err(value_error("in (fn args body): \
                    args must consist of symbols.".into()))
            }
        }
        Ok(app.list.len())
    } else if let Object::None = list {
        Ok(0)
    } else {
        Err(value_error(
            "in (fn args body): args is not a list.".into()))
    }
}

fn let_syntax_error(app: &App) -> Result<Object, Error> {
    Err(syntax_error(app.line, app.col, String::from(
        "in line {}, col {}: expected (let ((id value) ...) body)")))
}

fn let_expression(env: &Rc<ScopeTable>, app: &App)
-> Result<Object, Error>
{
    if app.list.len() != 3 {
        return let_syntax_error(app);
    }
    let list = match &app.list[1] {
        Object::App(t) => &t.list,
        _ => return let_syntax_error(app)
    };
    let mut args: Vec<Object> = vec![];
    for object in list {
        match object {
            Object::App(t) => {
                if t.list.len() != 2 {return let_syntax_error(app);}
                args.push(t.list[0].clone())
            },
            _ => return let_syntax_error(app)
        }
    }
    let f = Object::App(Rc::new(App {
        line: app.line, col: app.col,
        list: vec![
            Object::Symbol(Rc::from("fn")),
            Object::App(Rc::new(App {
                line: app.line, col: app.col, list: args})),
            app.list[2].clone()]}));
    let mut a: Vec<Object> = vec![];
    a.push(f);
    for object in list {
        match object {
            Object::App(t) => a.push(t.list[1].clone()),
            _ => return let_syntax_error(app)
        }
    }
    transform_app(env, &Rc::new(App {
        line: app.line, col: app.col, list: a}))
}

use scope_table::{ScopeTable, VarInfo};

fn transform_symbol(env: &Rc<ScopeTable>, id: &Rc<str>) -> Object {
    if let Some(info) = env.get(id) {
        let (index, fp): (usize, LazyFp) = match info {
            VarInfo::Argument(index) => (index, load_arg),
            VarInfo::Context(index) => (index, load_context)
        };
        Object::App(Rc::new(App {
            line: UNDEFINED, col: UNDEFINED,
            list: vec![
                Object::FnLazy(Rc::new(FnLazyObj {fp, id: "load",
                    argc_min: 1, argc_max: 1})),
                Object::Int(index as i32)]}))
    } else {
        Object::Symbol(id.clone())
    }
}

fn transform_app(env: &Rc<ScopeTable>, app: &Rc<App>)
-> Result<Object, Error>
{
    if app.list.is_empty() {
        return Ok(Object::App(app.clone()));
    }
    if let Object::Symbol(id) = &app.list[0] {
        if id.as_ref() == "fn" {
            if app.list.len() != 3 {
                return Err(value_error(
                    "fn needs to have two arguments".into()));
            }
            let tab = ScopeTable::new(Some(env.clone()));
            let argc = insert_args(&tab, &app.list[1])?;
            let body = transform(&tab, &app.list[2])?;
            let context = tab.frame.borrow_mut().context();
            return Ok(Object::App(Rc::new(App {
                line: app.line, col: app.col,
                list: vec![
                    Object::Symbol(id.clone()),
                    Object::Interface(Rc::new(StrObj(
                        Rc::from(format!("function ({}:{})",
                            app.line + 1, app.col + 1))))),
                    Object::Int(argc as i32),
                    context,
                    body]})));
        } else if id.as_ref() == "let" {
            return let_expression(env, &app);
        }
    }
    let list = app.list.iter().map(|x| transform(env, x))
        .collect::<Result<Vec<Object>, _>>()?;
    Ok(Object::App(Rc::new(App {line: app.line, col: app.col, list})))
}

fn transform(env: &Rc<ScopeTable>, t: &Object)
-> Result<Object, Error>
{
    Ok(match t {
        Object::None => Object::None,
        Object::Bool(value) => Object::Bool(*value),
        Object::Int(value) => Object::Int(*value),
        Object::Fn(f) => Object::Fn(f.clone()),
        Object::FnLazy(f) => Object::FnLazy(f.clone()),
        Object::Err(e) => Object::Err(e.clone()),
        Object::Symbol(id) => transform_symbol(env, id),
        Object::App(app) => return transform_app(env, app),
        Object::Interface(x) => Object::Interface(x.clone())
    })
}

struct FnObj<F: ?Sized> {
    id: Rc<str>, argc_min: usize, argc_max: usize,
    context: Vec<Object>, fp: F
}

struct FnLazyObj<F: ?Sized> {
    id: &'static str, argc_min: usize, argc_max: usize,
    fp: F
}

type Function = FnObj<dyn Fn(&mut Env) -> Object>;
type FunctionLazy = FnLazyObj<dyn Fn(&mut Env, &App) -> Object>;

const UNDEFINED: usize = usize::MAX - 1;

struct App {
    line: usize, col: usize, list: Vec<Object>
}

#[derive(Clone)]
enum Object {
    None,
    Int(i32),
    Bool(bool),
    Symbol(Rc<str>),
    App(Rc<App>),
    Fn(Rc<Function>),
    FnLazy(Rc<FunctionLazy>),
    Interface(Rc<dyn Interface>),
    Err(Error)
}

impl std::fmt::Display for Object {
    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
        match self {
            Object::None => write!(f, "()"),
            Object::Bool(value) => write!(f, "{}", value),
            Object::Int(value) => write!(f, "{}", value),
            Object::Symbol(id) => write!(f, "{}", id),
            Object::Fn(fobj) => write!(f, "{}", fobj.id),
            Object::FnLazy(fobj) => write!(f, "{}", fobj.id),
            Object::Interface(x) => write!(f, "{}", x),
            Object::Err(e) => write!(f, "{}", e),
            Object::App(app) => {
                write!(f, "(")?;
                let mut first = true;
                for object in app.list.iter() {
                    if first {first = false;} else {write!(f, " ")?;}
                    write!(f, "{}", object)?;
                }
                write!(f, ")")
            }
        }
    }
}
impl std::fmt::Debug for Object {
    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
        write!(f, "{}", self)
    }
}

trait Interface: std::fmt::Display {
    fn as_any(&self) -> &dyn Any;
    fn as_any_mut(&mut self) -> &mut dyn Any;
}

fn downcast<T: 'static>(x: &Object) -> Option<&T> {
    if let Object::Interface(x) = x {
        x.as_any().downcast_ref::<T>()
    } else {
        None
    }
}

struct StrObj(Rc<str>);

impl Interface for StrObj {
    fn as_any(&self) -> &dyn Any {self}
    fn as_any_mut(&mut self) -> &mut dyn Any {self}
}
impl std::fmt::Display for StrObj {
    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
        write!(f, "\"{}\"", self.0)
    }
}

struct Node {
    first: Object,
    rest: Object
}

impl Interface for Node {
    fn as_any(&self) -> &dyn Any {self}
    fn as_any_mut(&mut self) -> &mut dyn Any {self}
}
impl std::fmt::Display for Node {
    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
        let mut node = self;
        write!(f, "(list {}", node.first)?;
        loop {
            if let Object::None = node.rest {break;}
            if let Some(rest) = downcast::<Node>(&node.rest) {
                write!(f, " {}", rest.first)?;
                node = rest;
            } else {
                write!(f, " . {}", node.rest)?;
                break;
            }
        }
        write!(f, ")")
    }
}

impl Drop for Node {
    fn drop(&mut self) {
        let mut node = replace(&mut self.rest, Object::None);
        while  let Object::Interface(obj) = &mut node {
            if let Some(obj) = Rc::get_mut(obj) {
                if let Some(list) = obj.as_any_mut().downcast_mut::<Node>() {
                    node = replace(&mut list.rest, Object::None);
                } else {break}
            } else {break}
        }
    }
}

fn op1_err(env: &Env, op: &str) -> Object {
    Object::Err(value_error(format!(
        "cannot evaluate ({} {}).", op, env.arg(0))))
}

fn op2_err(env: &Env, op: &str) -> Object {
    Object::Err(value_error(format!(
        "cannot evaluate ({} {} {}).", op, env.arg(0), env.arg(1))))
}

fn add(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "+"));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "+"));
    Object::Int(x + y)
}

fn sub(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "-"));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "-"));
    Object::Int(x - y)
}

fn mul(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "*"));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "*"));
    Object::Int(x*y)
}

fn div(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "/"));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "/"));
    Object::Int(x/y)
}

fn rem(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "%"));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "%"));
    Object::Int(x%y)
}

fn obj_eq(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "="));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "="));
    Object::Bool(x == y)
}

fn obj_lt(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "<"));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "<"));
    Object::Bool(x < y)
}

fn obj_le(env: &mut Env) -> Object {
    let x = expect!(env.arg(0), Object::Int, return op2_err(env, "<="));
    let y = expect!(env.arg(1), Object::Int, return op2_err(env, "<="));
    Object::Bool(x <= y)
}

fn print(env: &mut Env) -> Object {
    println!("{}", env.arg(0));
    Object::None
}

fn block(env: &mut Env) -> Object {
    env.arg(env.argc() - 1).clone()
}

fn log(env: &mut Env) -> Object {
    let value = env.arg(0);
    println!("log: {}", value);
    value.clone()
}

fn cons(env: &mut Env) -> Object {
    Object::Interface(Rc::new(Node {
        first: env.arg(0).clone(),
        rest: env.arg(1).clone()
    }))
}

fn first(env: &mut Env) -> Object {
    match downcast::<Node>(env.arg(0)) {
        Some(list) => list.first.clone(),
        None => op1_err(env, "first")
    }
}

fn rest(env: &mut Env) -> Object {
    match downcast::<Node>(env.arg(0)) {
        Some(list) => list.rest.clone(),
        None => op1_err(env, "rest")
    }
}

fn empty(env: &mut Env) -> Object {
    Object::Bool(matches!(env.arg(0), Object::None))
}

fn list_literal(env: &mut Env) -> Object {
    let mut list = Object::None;
    for arg in env.argv().iter().rev() {
        list = Object::Interface(Rc::new(Node {
            first: arg.clone(),
            rest: list
        }));
    }
    list
}

fn not(env: &mut Env) -> Object {
    let value = env.arg(0);
    if let Object::Err(e) = value {
        return Object::Err(e.clone());
    }
    Object::Bool(match value {Object::Bool(x) => !x, _ => false})
}

fn define(env: &mut Env, app: &App) -> Object {
    let id = expect!(&app.list[1], Object::Symbol).clone();
    let value = eval(env, &app.list[2]);
    if let Object::Err(_) = value {return value;}
    env.map.insert(id, value);
    Object::None
}

fn if_fn(env: &mut Env, app: &App) -> Object {
    let argv = &app.list[1..];
    let cond = eval(env, &argv[0]);
    if let Object::Bool(cond) = cond {
        eval(env, &argv[if cond {1} else {2}])
    } else {
        if let Object::Err(_) = cond {return cond;}
        Object::Err(value_error(
            format!("in (if cond x y): expected cond: Bool, got {}.",
                cond)))
    }
}

fn and(env: &mut Env, app: &App) -> Object {
    let argv = &app.list[1..];
    match eval(env, &argv[0]) {
        Object::Err(e) => Object::Err(e),
        Object::Bool(cond) if !cond => Object::Bool(false),
        _ => eval(env, &argv[1])
    }
}

fn or(env: &mut Env, app: &App) -> Object {
    let argv = &app.list[1..];
    match eval(env, &argv[0]) {
        Object::Err(e) => Object::Err(e),
        Object::Bool(cond) if !cond => eval(env, &argv[1]),
        cond => cond
    }
}

fn lambda(env: &mut Env, app: &App) -> Object {
    let argv = &app.list[1..];
    let id = downcast::<StrObj>(&argv[0]).unwrap();
    let argc = expect!(argv[1], Object::Int) as usize;
    let context: Vec<Object> = match argv[2] {
        Object::App(ref app) => {
            app.list.iter().map(|x| eval(env, x)).collect()
        },
        _ => Vec::new()
    };
    let body = argv[3].clone();
    let f: Rc<Function> = Rc::new(FnObj {
        argc_min: argc, argc_max: argc,
        id: id.0.clone(), context,
        fp: move |env: &mut Env| eval(env, &body),
    });
    Object::Fn(f)
}

fn load_arg(env: &mut Env, app: &App) -> Object {
    let index = expect!(&app.list[1], Object::Int);
    env.arg(*index as usize).clone()
}

fn load_context(env: &mut Env, app: &App) -> Object {
    let index = expect!(&app.list[1], Object::Int);
    env.active_fn.context[*index as usize].clone()
}

fn tail_call(env: &mut Env, app: &App) -> Object {
    let argv = &app.list[1..];
    let mut list = Vec::with_capacity(argv.len());
    for x in argv {
        let value = eval(env, x);
        if let Object::Err(_) = value {return value;}
        list.push(value);
    }
    Object::App(Rc::new(App {line: app.line, col: app.col, list}))
}

fn tail_iter(env: &mut Env, app: &App) -> Object {
    let mut value = eval(env, &app.list[1]);
    while let Object::App(_) = value {
        value = eval(env, &value);
    }
    value
}

fn load_file(env: &mut Env) -> Object {
    let path = match downcast::<StrObj>(env.arg(0)) {
        Some(s) => s.0.as_ref(),
        _ => return op1_err(env, "load")
    };
    let file_input = expect!(std::fs::read(path), Ok,
        return Object::Err(value_error(
            format!("could not load file '{}'.", path))));
    let result = eval_string(env, &file_input);
    print_result(env, &result);
    Object::None
}

const VARIADIC: usize = usize::MAX;

type Fp = fn(&mut Env) -> Object;
type LazyFp = fn(&mut Env, &App) -> Object;

static FN_TABLE: &[(&str, Fp, usize, usize)] = &[
    ("+", add, 2, 2), ("-", sub, 2, 2),
    ("*", mul, 2, 2), ("/", div, 2, 2), ("%", rem, 2, 2),
    ("=", obj_eq, 2, 2), ("<", obj_lt, 2, 2), ("<=", obj_le, 2, 2),
    ("print", print, 1, 1), ("empty", empty, 1, 1), ("not", not, 1, 1),
    ("cons", cons, 2, 2), ("first", first, 1, 1), ("rest", rest, 1, 1),
    ("block", block, 1, VARIADIC), ("list", list_literal, 0, VARIADIC),
    ("load", load_file, 1, 1), ("log", log, 1, 1)
];

static FN_LAZY_TABLE: &[(&str, LazyFp, usize, usize)] = &[
    ("define", define, 2, 2), ("fn", lambda, 4, 4),
    ("if", if_fn, 3, 3), ("and", and, 2, 2), ("or", or, 2, 2),
    ("tail-call", tail_call, 1, VARIADIC),
    ("tail-iter", tail_iter, 1, 1)
];

struct Env {
    map: HashMap<Rc<str>, Object>,
    stack: Vec<Object>,
    base_pointer: usize,
    traceback: Vec<(Rc<str>, usize, usize)>,
    active_fn: Rc<Function>
}
impl Env {
    fn new() -> Self {
        let mut map = HashMap::new();
        for (id, f, argc_min, argc_max) in FN_TABLE {
            let id: Rc<str> = Rc::from(*id);
            map.insert(id.clone(), Object::Fn(Rc::new(FnObj {
                fp: f, id,
                argc_min: *argc_min, argc_max: *argc_max,
                context: Vec::new()
            })));
        }
        for (id, fp, argc_min, argc_max) in FN_LAZY_TABLE {
            map.insert(Rc::from(*id), Object::FnLazy(Rc::new(FnLazyObj {
                fp, id, argc_min: *argc_min, argc_max: *argc_max})));
        }
        map.insert(Rc::from("true"), Object::Bool(true));
        map.insert(Rc::from("false"), Object::Bool(false));
        let main_fn = Rc::new(FnObj {
            fp: |_: &mut Env| Object::None, id: Rc::from("main"),
            argc_min: 0, argc_max: 0, context: Vec::new()
        });
        Self {map, stack: Vec::new(), base_pointer: 0,
            traceback: vec![], active_fn: main_fn}
    }
    fn arg(&self, index: usize) -> &Object {
        &self.stack[self.base_pointer + index]
    }
    fn argc(&self) -> usize {
        self.stack.len() - self.base_pointer
    }
    fn argv(&self) -> &[Object] {
        &self.stack[self.base_pointer..]
    }
    fn traceback(&mut self, id: &Rc<str>, line: usize, col: usize) {
        self.traceback.push((id.clone(), line, col));
    }
}

fn value_error(text: String) -> Error {
    Rc::new(ErrorEnum::Value {text})
}

fn argc_error(env: &mut Env, id: &Rc<str>, argc: usize,
    argc_min: usize, argc_max: usize, line: usize, col: usize
) -> Object
{
    let text = if argc_min == argc_max {
        format!("expected argument count {}, got {}.",
            argc_min, argc)
    } else {
        format!("expected argument count in [{}..{}], got {}.",
            argc_min, argc_max, argc)
    };
    env.traceback(id, line, col);
    Object::Err(value_error(text))
}

fn eval(env: &mut Env, object: &Object) -> Object {
    match object {
        Object::None => Object::None,
        Object::Bool(value) => Object::Bool(*value),
        Object::Int(value) => Object::Int(*value),
        Object::Fn(f) => Object::Fn(f.clone()),
        Object::FnLazy(f) => Object::FnLazy(f.clone()),
        Object::Interface(x) => Object::Interface(x.clone()),
        Object::Symbol(id) => {
            match env.map.get(id) {
                Some(value) => value.clone(),
                _ => Object::Err(value_error(
                    format!("undefined variable: {}.", id)))
            }
        },
        Object::App(app) => {
            let f = eval(env, &app.list[0]);
            if let Object::Err(e) = f {
                Object::Err(e)
            } else if let Object::Fn(f) = f {
                let argc = app.list.len() - 1;
                if argc < f.argc_min || argc > f.argc_max {
                    return argc_error(env, &f.id, argc,
                        f.argc_min, f.argc_max, app.line, app.col);
                }
                let len = env.stack.len();
                for x in &app.list[1..] {
                    let object = eval(env, x);
                    if let Object::Err(e) = object {
                        while len != env.stack.len() {
                            env.stack.pop();
                        }
                        return Object::Err(e);
                    }
                    env.stack.push(object);
                }
                let bp = env.base_pointer;
                env.base_pointer = len;
                let fsuper = replace(&mut env.active_fn, f.clone());
                let value = (f.fp)(env);
                env.active_fn = fsuper;
                env.base_pointer = bp;
                for _ in 0..argc {
                    env.stack.pop();
                }
                if let Object::Err(_) = value {
                    env.traceback(&f.id, app.line, app.col);
                }
                value
            } else if let Object::FnLazy(f) = f {
                let argc = app.list.len() - 1;
                if argc < f.argc_min || argc > f.argc_max {
                    return argc_error(env, &Rc::from(f.id), argc,
                        f.argc_min, f.argc_max, app.line, app.col);
                }
                (f.fp)(env, &app)
            } else {
                Object::Err(value_error(
                    format!("Object {} is not callable.", f)))
            }
        },
        Object::Err(e) => Object::Err(e.clone())
    }
}

fn eval_string(env: &mut Env, s: &[u8]) -> Result<Object, Error> {
    let tokens = scan(s)?;
    let a = parse(&tokens)?;
    let mut value = Object::None;
    for t in &a {
        value = eval(env, t);
        if let Object::Err(e) = value {
            return Err(e);
        }
    }
    Ok(value)
}

fn input(prompt: &str) -> std::io::Result<String> {
    use std::{io, io::Write};
    let mut buffer = String::new();
    print!("{}", prompt);
    io::stdout().flush()?;
    io::stdin().read_line(&mut buffer)?;
    if buffer.ends_with('\n') {
        buffer.pop();
        if buffer.ends_with('\r') {buffer.pop();}
    }
    Ok(buffer)
}

fn print_result(env: &mut Env, result: &Result<Object, Error>) {
    match result {
        Ok(value) => {
            if !matches!(value, Object::None) {
                println!("{}", value);
            }
        },
        Err(e) => {
            println!("{}", e);
            if !env.traceback.is_empty() {
                println!("\nTraceback:");
                for (id, line, col) in &env.traceback {
                    println!("in {}, entered at {}:{}",
                        id, line + 1, col + 1);
                }
            }
            println!();
            env.traceback.clear();
        }
    }
}

fn main() -> std::io::Result<()> {
    let argv: Vec<String> = std::env::args().collect();
    let env = &mut Env::new();
    if argv.len() == 1 {
        loop {
            let s = input("> ")?;
            let result = eval_string(env, s.as_bytes());
            print_result(env, &result);
        }
    } else {
        let file_input = std::fs::read(&argv[1])?;
        let result = eval_string(env, &file_input);
        print_result(env, &result);
    }
    Ok(())
}

Beispiele

Beispiel: Primzahlen

(define range-rec (fn (i j acc)
    (if (>= j i)
        acc
        (tail-call range-rec i (- j 1) (cons (- j 1) acc)))))

(define range (fn (i j)
    (tail-iter (range-rec i j ()))))

(define rev-rec (fn (a acc)
    (if (empty a)
        acc
        (tail-call rev-rec (rest a) (cons (first a) acc)))))

(define rev (fn (a)
    (tail-iter (rev-rec a ()))))

(define filter-rec (fn (p a acc)
    (if (empty a)
        acc
        (tail-call filter-rec p (rest a) (if (p (first a))
            (cons (first a) acc)
            acc)))))

(define filter (fn (p a)
    (rev (tail-iter (filter-rec p a ())))))

(define count-rec (fn (p a acc)
    (if (empty a)
        acc
        (tail-call count-rec p (rest a) (if (p (first a))
            (+ acc 1)
            acc)))))

(define count (fn (p a)
    (tail-iter (count-rec p a 0))))

(define is-prime (fn (n)
    (= 1 (count (fn (k) (= (% n k) 0)) (range 1 n)))))

(print
    (filter is-prime (range 0 100)))

Beispiel: Fixpunkt-Kombinator

(define fix (fn (F)
    ((fn (x) (x x)) (fn (x) (F (fn (n) ((x x) n)))))))

(define fac (fix (fn (f) (fn (n)
    (if (= n 0) 1 (* n (f (- n 1))))))))

(print (fac 4))

Literatur

1. Harold Abelson, Gerald Jay Sussman, Julie Sussman: »Struktur und Interpretation von Computerprogrammen: Eine Informatik-Einführung«. Springer, Berlin & Heidelberg, 4. Auflage 2001.
2. Peter Norvig: »(How to Write a (Lisp) Interpreter (in Python))«.
3. R7RS Working Group 1: »Overview of the Revised7 Algorithmic Language Scheme«. April 2013.
4. R7RS Working Group 1: »Revised7 Report on the Algorithmic Language Scheme«. Juli 2013.
5. Inanna Malick: »Elegant and performant recursion in Rust«. Juli 2022.