marwood 1.0.0

Scheme R7RS Virtual Machine
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

use crate::cell::Cell;
use crate::error::Error;
use crate::pretty;
use crate::vm::builtin::pop_argc;
use crate::vm::vcell::VCell;
use crate::vm::Vm;

pub fn load_builtins(vm: &mut Vm) {
    vm.load_builtin("display", display);
    vm.load_builtin("write", write);
    vm.load_builtin("pretty-print", pretty_print);
    vm.load_builtin("term-rows", term_rows);
    vm.load_builtin("term-cols", term_cols);
    vm.load_builtin("time-utc", time_utc);
    vm.load_builtin("eof-object", eof_object);
    vm.load_builtin("eof-object?", eof_object_p);
    vm.load_builtin("read-char", read_char);
    vm.load_builtin("peek-char", peek_char);
    vm.load_builtin("char-ready?", char_ready);
}

pub fn display(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 1, Some(1), "display")?;
    let obj = vm.heap.get_as_cell(vm.stack.pop()?);
    vm.display(&obj);
    Ok(VCell::Void)
}

pub fn write(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 1, Some(1), "write")?;
    let obj = vm.heap.get_as_cell(vm.stack.pop()?);
    vm.write(&obj);
    Ok(VCell::Void)
}

pub fn pretty_print(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 1, Some(1), "pretty-print")?;
    let obj = vm.heap.get_as_cell(vm.stack.pop()?);
    let width = vm.term_cols();
    let width = if width == 0 { 80 } else { width };
    let mut formatted = pretty::format(&obj, width);
    formatted.push('\n');
    // Cell::String in display form prints the raw string (no quoting),
    // so this routes the formatted output through the same path as
    // (display ...).
    vm.display(&Cell::String(formatted));
    Ok(VCell::Void)
}

pub fn term_rows(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 0, Some(0), "term-rows")?;
    Ok(VCell::Number(vm.term_rows().into()))
}

pub fn term_cols(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 0, Some(0), "term-cols")?;
    Ok(VCell::Number(vm.term_cols().into()))
}

pub fn time_utc(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 0, Some(0), "time-utc")?;
    Ok(VCell::Number(vm.time_utc().into()))
}

pub fn eof_object(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 0, Some(0), "eof-object")?;
    Ok(VCell::Eof)
}

pub fn eof_object_p(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 1, Some(1), "eof-object?")?;
    let val = vm.heap.get(vm.stack.pop()?);
    Ok(VCell::Bool(val.is_eof()))
}

pub fn read_char(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 0, Some(0), "read-char")?;
    Ok(match vm.read_char() {
        Some(c) => VCell::Char(c),
        None => VCell::Eof,
    })
}

pub fn peek_char(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 0, Some(0), "peek-char")?;
    Ok(match vm.peek_char() {
        Some(c) => VCell::Char(c),
        None => VCell::Eof,
    })
}

pub fn char_ready(vm: &mut Vm) -> Result<VCell, Error> {
    pop_argc(vm, 0, Some(0), "char-ready?")?;
    Ok(VCell::Bool(vm.char_ready()))
}