#![allow(non_local_definitions)]
use gc::{Gc, GcCell};
use std::fmt;
use std::rc::Rc;
use crate::scheme::parser::Position;
#[derive(Debug, Clone, PartialEq, Eq)]
pub struct SourceInfo {
pub file: String,
pub pos: Position,
}
impl SourceInfo {
pub fn new(file: String, pos: Position) -> Self {
SourceInfo { file, pos }
}
}
impl fmt::Display for SourceInfo {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
write!(f, "{}:{}", self.file, self.pos)
}
}
#[derive(Clone)]
pub enum Value {
Nil,
Bool(bool),
Integer(i64),
Real(f64),
Char(char),
String(Gc<String>),
Symbol(Rc<str>),
Keyword(Rc<str>),
Pair(Gc<GcCell<PairData>>),
Vector(Gc<GcCell<Vec<Value>>>),
Procedure(Gc<Procedure>),
Node(Rc<Box<dyn crate::grove::Node>>),
NodeList(Rc<Box<dyn crate::grove::NodeList>>),
Sosofo,
Unspecified,
Error,
}
#[derive(Clone, gc::Trace, gc::Finalize)]
pub struct PairData {
pub car: Value,
pub cdr: Value,
pub pos: Option<Position>,
}
impl PairData {
pub fn new(car: Value, cdr: Value) -> Self {
PairData { car, cdr, pos: None }
}
pub fn with_pos(car: Value, cdr: Value, pos: Position) -> Self {
PairData { car, cdr, pos: Some(pos) }
}
}
#[derive(gc::Finalize)]
pub enum Procedure {
Primitive {
name: &'static str,
func: fn(&[Value]) -> Result<Value, String>,
},
Lambda {
params: Gc<Vec<String>>,
body: Gc<Value>,
env: Gc<crate::scheme::environment::Environment>,
source: Option<SourceInfo>,
name: Option<String>,
},
}
impl Clone for Procedure {
fn clone(&self) -> Self {
match self {
Procedure::Primitive { name, func } => Procedure::Primitive {
name,
func: *func,
},
Procedure::Lambda { params, body, env, source, name } => Procedure::Lambda {
params: params.clone(),
body: body.clone(),
env: env.clone(),
source: source.clone(),
name: name.clone(),
},
}
}
}
unsafe impl gc::Trace for Procedure {
unsafe fn trace(&self) {
match self {
Procedure::Primitive { .. } => {
}
Procedure::Lambda { params, body, env, source: _, name: _ } => {
params.trace();
body.trace();
env.trace();
}
}
}
unsafe fn root(&self) {
match self {
Procedure::Primitive { .. } => {}
Procedure::Lambda { params, body, env, source: _, name: _ } => {
params.root();
body.root();
env.root();
}
}
}
unsafe fn unroot(&self) {
match self {
Procedure::Primitive { .. } => {}
Procedure::Lambda { params, body, env, source: _, name: _ } => {
params.unroot();
body.unroot();
env.unroot();
}
}
}
fn finalize_glue(&self) {
gc::Finalize::finalize(self);
}
}
impl Value {
pub fn bool(b: bool) -> Self {
Value::Bool(b)
}
pub fn integer(n: i64) -> Self {
Value::Integer(n)
}
pub fn real(n: f64) -> Self {
Value::Real(n)
}
pub fn char(ch: char) -> Self {
Value::Char(ch)
}
pub fn string(s: String) -> Self {
Value::String(Gc::new(s))
}
pub fn symbol(s: &str) -> Self {
Value::Symbol(Rc::from(s))
}
pub fn keyword(s: &str) -> Self {
Value::Keyword(Rc::from(s))
}
pub fn cons(car: Value, cdr: Value) -> Self {
Value::Pair(Gc::new(GcCell::new(PairData::new(car, cdr))))
}
pub fn cons_with_pos(car: Value, cdr: Value, pos: Position) -> Self {
Value::Pair(Gc::new(GcCell::new(PairData::with_pos(car, cdr, pos))))
}
pub fn vector(elements: Vec<Value>) -> Self {
Value::Vector(Gc::new(GcCell::new(elements)))
}
pub fn primitive(name: &'static str, func: fn(&[Value]) -> Result<Value, String>) -> Self {
Value::Procedure(Gc::new(Procedure::Primitive { name, func }))
}
pub fn lambda(
params: Vec<String>,
body: Value,
env: Gc<crate::scheme::environment::Environment>,
) -> Self {
Value::Procedure(Gc::new(Procedure::Lambda {
params: Gc::new(params),
body: Gc::new(body),
env,
source: None,
name: None,
}))
}
pub fn lambda_with_source(
params: Vec<String>,
body: Value,
env: Gc<crate::scheme::environment::Environment>,
source: Option<SourceInfo>,
name: Option<String>,
) -> Self {
Value::Procedure(Gc::new(Procedure::Lambda {
params: Gc::new(params),
body: Gc::new(body),
env,
source,
name,
}))
}
pub fn node(node: Box<dyn crate::grove::Node>) -> Self {
Value::Node(Rc::new(node))
}
pub fn node_list(node_list: Box<dyn crate::grove::NodeList>) -> Self {
Value::NodeList(Rc::new(node_list))
}
}
impl Value {
pub fn equal(&self, other: &Value) -> bool {
match (self, other) {
(Value::Pair(p1), Value::Pair(p2)) => {
let pair1 = p1.borrow();
let pair2 = p2.borrow();
pair1.car.equal(&pair2.car) && pair1.cdr.equal(&pair2.cdr)
}
(Value::Vector(v1), Value::Vector(v2)) => {
let vec1 = v1.borrow();
let vec2 = v2.borrow();
if vec1.len() != vec2.len() {
return false;
}
vec1.iter().zip(vec2.iter()).all(|(a, b)| a.equal(b))
}
(Value::String(s1), Value::String(s2)) => **s1 == **s2,
_ => self.eqv(other),
}
}
pub fn eqv(&self, other: &Value) -> bool {
match (self, other) {
(Value::Nil, Value::Nil) => true,
(Value::Bool(b1), Value::Bool(b2)) => b1 == b2,
(Value::Integer(n1), Value::Integer(n2)) => n1 == n2,
(Value::Real(n1), Value::Real(n2)) => n1 == n2,
(Value::Char(c1), Value::Char(c2)) => c1 == c2,
(Value::Symbol(s1), Value::Symbol(s2)) => **s1 == **s2,
(Value::Keyword(k1), Value::Keyword(k2)) => **k1 == **k2,
(Value::Pair(p1), Value::Pair(p2)) => Gc::ptr_eq(p1, p2),
(Value::Vector(v1), Value::Vector(v2)) => Gc::ptr_eq(v1, v2),
(Value::Procedure(proc1), Value::Procedure(proc2)) => Gc::ptr_eq(proc1, proc2),
(Value::String(_), Value::String(_)) => false,
(Value::Node(n1), Value::Node(n2)) => {
Rc::ptr_eq(n1, n2)
}
(Value::NodeList(nl1), Value::NodeList(nl2)) => {
Rc::ptr_eq(nl1, nl2)
}
(Value::Sosofo, Value::Sosofo) => true,
(Value::Unspecified, Value::Unspecified) => true,
(Value::Error, Value::Error) => true,
_ => false,
}
}
pub fn eq(&self, other: &Value) -> bool {
self.eqv(other)
}
}
impl Value {
pub fn is_nil(&self) -> bool {
matches!(self, Value::Nil)
}
pub fn is_bool(&self) -> bool {
matches!(self, Value::Bool(_))
}
pub fn is_true(&self) -> bool {
!matches!(self, Value::Bool(false))
}
pub fn is_integer(&self) -> bool {
matches!(self, Value::Integer(_))
}
pub fn is_real(&self) -> bool {
matches!(self, Value::Real(_))
}
pub fn is_number(&self) -> bool {
matches!(self, Value::Integer(_) | Value::Real(_))
}
pub fn is_char(&self) -> bool {
matches!(self, Value::Char(_))
}
pub fn is_string(&self) -> bool {
matches!(self, Value::String(_))
}
pub fn is_symbol(&self) -> bool {
matches!(self, Value::Symbol(_))
}
pub fn is_pair(&self) -> bool {
matches!(self, Value::Pair(_))
}
pub fn is_list(&self) -> bool {
matches!(self, Value::Nil | Value::Pair(_))
}
pub fn is_vector(&self) -> bool {
matches!(self, Value::Vector(_))
}
pub fn is_procedure(&self) -> bool {
matches!(self, Value::Procedure(_))
}
pub fn is_node(&self) -> bool {
matches!(self, Value::Node(_))
}
pub fn is_node_list(&self) -> bool {
matches!(self, Value::NodeList(_))
}
}
impl fmt::Debug for Value {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
match self {
Value::Nil => write!(f, "()"),
Value::Bool(true) => write!(f, "#t"),
Value::Bool(false) => write!(f, "#f"),
Value::Integer(n) => write!(f, "{}", n),
Value::Real(n) => write!(f, "{}", n),
Value::Char(ch) => write!(f, "#\\{}", ch),
Value::String(s) => write!(f, "{:?}", **s),
Value::Symbol(s) => write!(f, "{}", s),
Value::Keyword(s) => write!(f, "#:{}", s),
Value::Pair(p) => {
let pair = p.borrow();
write!(f, "({:?} . {:?})", pair.car, pair.cdr)
}
Value::Vector(v) => {
let vec = v.borrow();
write!(f, "#(")?;
for (i, val) in vec.iter().enumerate() {
if i > 0 {
write!(f, " ")?;
}
write!(f, "{:?}", val)?;
}
write!(f, ")")
}
Value::Procedure(proc) => match &**proc {
Procedure::Primitive { name, .. } => write!(f, "#<primitive:{}>", name),
Procedure::Lambda { .. } => write!(f, "#<lambda>"),
},
Value::Node(node) => {
if let Some(gi) = node.gi() {
write!(f, "#<node:{}>", gi)
} else {
write!(f, "#<node>")
}
}
Value::NodeList(nl) => write!(f, "#<node-list:{}>", nl.length()),
Value::Sosofo => write!(f, "#<sosofo>"),
Value::Unspecified => write!(f, "#<unspecified>"),
Value::Error => write!(f, "#<error>"),
}
}
}
impl fmt::Display for Value {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
write!(f, "{:?}", self)
}
}
unsafe impl gc::Trace for Value {
unsafe fn trace(&self) {
match self {
Value::Nil => {}
Value::Bool(_) => {}
Value::Integer(_) => {}
Value::Real(_) => {}
Value::Char(_) => {}
Value::String(s) => s.trace(),
Value::Symbol(s) => s.trace(),
Value::Keyword(k) => k.trace(),
Value::Pair(p) => p.trace(),
Value::Vector(v) => v.trace(),
Value::Procedure(proc) => proc.trace(),
Value::Node(_) => {}
Value::NodeList(_) => {}
Value::Sosofo => {}
Value::Unspecified => {}
Value::Error => {}
}
}
unsafe fn root(&self) {
match self {
Value::String(s) => s.root(),
Value::Symbol(s) => s.root(),
Value::Keyword(k) => k.root(),
Value::Pair(p) => p.root(),
Value::Vector(v) => v.root(),
Value::Procedure(proc) => proc.root(),
_ => {}
}
}
unsafe fn unroot(&self) {
match self {
Value::String(s) => s.unroot(),
Value::Symbol(s) => s.unroot(),
Value::Keyword(k) => k.unroot(),
Value::Pair(p) => p.unroot(),
Value::Vector(v) => v.unroot(),
Value::Procedure(proc) => proc.unroot(),
_ => {}
}
}
fn finalize_glue(&self) {
match self {
Value::String(s) => s.finalize_glue(),
Value::Symbol(s) => s.finalize_glue(),
Value::Keyword(k) => k.finalize_glue(),
Value::Pair(p) => p.finalize_glue(),
Value::Vector(v) => v.finalize_glue(),
Value::Procedure(proc) => proc.finalize_glue(),
_ => {}
}
}
}
impl gc::Finalize for Value {}
#[cfg(test)]
mod tests {
use super::*;
#[test]
fn test_value_constructors() {
assert!(Value::bool(true).is_bool());
assert!(Value::integer(42).is_integer());
assert!(Value::real(3.14).is_real());
assert!(Value::char('a').is_char());
assert!(Value::string("hello".to_string()).is_string());
assert!(Value::symbol("foo").is_symbol());
assert!(Value::Nil.is_nil());
}
#[test]
fn test_truth_values() {
assert!(!Value::Bool(false).is_true());
assert!(Value::Bool(true).is_true());
assert!(Value::Nil.is_true()); assert!(Value::integer(0).is_true()); }
#[test]
fn test_cons() {
let pair = Value::cons(Value::integer(1), Value::integer(2));
assert!(pair.is_pair());
assert!(pair.is_list());
}
#[test]
fn test_vector() {
let vec = Value::vector(vec![Value::integer(1), Value::integer(2), Value::integer(3)]);
assert!(vec.is_vector());
}
#[test]
fn test_equality_simple() {
assert!(Value::integer(42).eqv(&Value::integer(42)));
assert!(!Value::integer(42).eqv(&Value::integer(43)));
assert!(Value::real(3.14).eqv(&Value::real(3.14)));
assert!(Value::bool(true).eqv(&Value::bool(true)));
assert!(!Value::bool(true).eqv(&Value::bool(false)));
assert!(Value::char('a').eqv(&Value::char('a')));
assert!(!Value::char('a').eqv(&Value::char('b')));
let sym1 = Value::symbol("foo");
let sym2 = Value::symbol("foo");
assert!(sym1.eqv(&sym2));
assert!(Value::Nil.eqv(&Value::Nil));
}
#[test]
fn test_equality_strings() {
let s1 = Value::string("hello".to_string());
let s2 = Value::string("hello".to_string());
let s3 = Value::string("world".to_string());
assert!(!s1.eqv(&s2));
assert!(s1.equal(&s2));
assert!(!s1.equal(&s3));
}
#[test]
fn test_equality_lists() {
let list1 = Value::cons(
Value::integer(1),
Value::cons(Value::integer(2), Value::Nil),
);
let list2 = Value::cons(
Value::integer(1),
Value::cons(Value::integer(2), Value::Nil),
);
let list3 = Value::cons(
Value::integer(1),
Value::cons(Value::integer(3), Value::Nil),
);
assert!(!list1.eqv(&list2));
assert!(list1.equal(&list2));
assert!(!list1.equal(&list3));
}
#[test]
fn test_equality_vectors() {
let vec1 = Value::vector(vec![Value::integer(1), Value::integer(2)]);
let vec2 = Value::vector(vec![Value::integer(1), Value::integer(2)]);
let vec3 = Value::vector(vec![Value::integer(1), Value::integer(3)]);
assert!(!vec1.eqv(&vec2));
assert!(vec1.equal(&vec2));
assert!(!vec1.equal(&vec3));
}
}