miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix attempted in SuspendedPair, a lot more tests also work PE-wise now. Many are overflowing the stack, might be recursion causing or just really bad lack of tail calls, or a bug...

Browse Source
This commit is contained in:
Nathan Braswell
2023-02-20 00:22:29 -05:00
parent 5107c1d7e4
commit 7f10d111ac
2 changed files with 190 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

136
kr/src/ast.rs
View File

@@ -5,6 +5,15 @@ use std::collections::{BTreeSet,BTreeMap};
use std::result::Result;
use std::iter;
// TODO:
// -extend vau & env logic and SuspendedPair PE with sequence_params & wrap_level
// -add veval and vif & -1 wrap_level handling to SuspendedPair
// -add current-hashes to if, DeriComb Calls, and DCtx-push/can_progress, and Hash to *everything*
// -expand combiner_Return_ok with (veval body {env}) and (func ...params) | func doesn't take de and func+params are return ok
// -add drop redundent veval
// -add compiler
impl From<i32> for Form { fn from(item: i32) -> Self { Form::Int(item) } }
impl From<bool> for Form { fn from(item: bool) -> Self { Form::Bool(item) } }
// todo, strings not symbols?
@@ -83,6 +92,8 @@ impl Form {
(bctx, Rc::new(MarkedForm::Pair(NeededIds::new_none(), car, cdr)))
},
Form::DeriComb { se, de, params, body } => {
// this is a bit sus, but we don't run into it as of yet
panic!();
let (bctx, se) = se.marked(bctx);
let (bctx, body) = body.marked(bctx);
let (bctx, new_id) = bctx.new_id();
@@ -92,16 +103,15 @@ impl Form {
},
Form::PrimComb(name, _f) => {
(bctx, match &name[..] {
// should be able to take in wrap_level != 1 and do stuff
"eval" => Rc::new(MarkedForm::PrimComb { name: "eval".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
// put in partial eval logic, maybe?
"eval" => Rc::new(MarkedForm::PrimComb { name: "eval".to_owned(), takes_de: true, wrap_level: 1, f: |bctx, dctx, p| {
// put in partial eval logic,
// and veval
let b = p.car()?.unval()?;
let e = p.cdr()?.car()?;
println!("Doing Eval (via tail call) of {} in {}", b, e);
Ok((bctx, PossibleMarkedTailCall::TailCall(e, b)))
}}),
// (vau de params body), should be able to take in wrap_level != 1 and do stuff
"vau" => Rc::new(MarkedForm::PrimComb { name: "vau".to_owned(), wrap_level: 0, f: |bctx, dctx, p| {
"vau" => Rc::new(MarkedForm::PrimComb { name: "vau".to_owned(), takes_de: true, wrap_level: 0, f: |bctx, dctx, p| {
let de = p.car()?.sym().map(|s| s.to_owned()).ok();
let params = p.cdr()?.car()?.sym()?.to_owned();
let body = p.cdr()?.cdr()?.car()?.unval()?;
@@ -122,8 +132,8 @@ impl Form {
MarkedForm::DeriComb { ids, se, de, id, wrap_level, sequence_params, rest_params, body },
))))
}}),
// TODO: handle vif etc
"if" => Rc::new(MarkedForm::PrimComb { name: "if".to_owned(), wrap_level: 0, f: |bctx, dctx, p| {
// TODO: handle vif, partial eval branches
"if" => Rc::new(MarkedForm::PrimComb { name: "if".to_owned(), takes_de: true, wrap_level: 0, f: |bctx, dctx, p| {
let (bctx, cond) = partial_eval(bctx, dctx.clone(), p.car()?.unval()?)?;
let e = Rc::clone(&dctx.e);
if cond.truthy()? {
@@ -133,29 +143,31 @@ impl Form {
}
}}),
// TODO: handle these in the context of paritals
"cons" => Rc::new(MarkedForm::PrimComb { name: "cons".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"cons" => Rc::new(MarkedForm::PrimComb { name: "cons".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let h = p.car()?;
let t = p.cdr()?.car()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Pair(h.ids().union(&t.ids()), h, t)))))
}}),
"car" => Rc::new(MarkedForm::PrimComb { name: "car".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"car" => Rc::new(MarkedForm::PrimComb { name: "car".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(p.car()?.car()?)))
}}),
"cdr" => Rc::new(MarkedForm::PrimComb { name: "cdr".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"cdr" => Rc::new(MarkedForm::PrimComb { name: "cdr".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(p.car()?.cdr()?)))
}}),
"quote" => Rc::new(MarkedForm::PrimComb { name: "quote".to_owned(), wrap_level: 0, f: |bctx, dctx, p| {
"quote" => Rc::new(MarkedForm::PrimComb { name: "quote".to_owned(), takes_de: false, wrap_level: 0, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(p.car()?)))
}}),
// This one needs to control eval to print debug before continuint
// which is werid to PE
"debug" => Rc::new(MarkedForm::PrimComb { name: "debug".to_owned(), wrap_level: 0, f: |bctx, dctx, p| {
"debug" => Rc::new(MarkedForm::PrimComb { name: "debug".to_owned(), takes_de: true, wrap_level: 0, f: |bctx, dctx, p| {
panic!();
let e = Rc::clone(&dctx.e);
Ok((bctx, PossibleMarkedTailCall::TailCall(e, p.cdr()?.car()?)))
}}),
// ditto
"assert" => Rc::new(MarkedForm::PrimComb { name: "assert".to_owned(), wrap_level: 0, f: |bctx, dctx, p| {
let (bctx, cond) = partial_eval(bctx, dctx.clone(), p.car()?)?;
"assert" => Rc::new(MarkedForm::PrimComb { name: "assert".to_owned(), takes_de: true, wrap_level: 0, f: |bctx, dctx, p| {
panic!();
let (bctx, cond) = partial_eval(bctx, dctx.clone(), p.car()?.unval()?)?;
if !cond.truthy()? {
println!("Assert failed: {:?}", cond);
}
@@ -164,7 +176,7 @@ impl Form {
Ok((bctx, PossibleMarkedTailCall::TailCall(e, p.cdr()?.car()?)))
}}),
// (vau de params body), should be able to take in wrap_level != 1 and do stuff
"=" => Rc::new(MarkedForm::PrimComb { name: "=".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"=" => Rc::new(MarkedForm::PrimComb { name: "=".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?;
let b = p.cdr()?.car()?;
println!("DOing (= {} {}) = {}", a, b, a==b);
@@ -173,99 +185,99 @@ impl Form {
// also, it should just check by hash then?
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(a == b)))))
}}),
"<" => Rc::new(MarkedForm::PrimComb { name: "<".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"<" => Rc::new(MarkedForm::PrimComb { name: "<".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?;
let b = p.cdr()?.car()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(a.int()? < b.int()?)))))
}}),
">" => Rc::new(MarkedForm::PrimComb { name: ">".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
">" => Rc::new(MarkedForm::PrimComb { name: ">".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?;
let b = p.cdr()?.car()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(a.int()? > b.int()?)))))
}}),
"<=" => Rc::new(MarkedForm::PrimComb { name: "<=".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"<=" => Rc::new(MarkedForm::PrimComb { name: "<=".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?;
let b = p.cdr()?.car()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(a.int()? <= b.int()?)))))
}}),
">=" => Rc::new(MarkedForm::PrimComb { name: ">=".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
">=" => Rc::new(MarkedForm::PrimComb { name: ">=".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?;
let b = p.cdr()?.car()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(a.int()? >= b.int()?)))))
}}),
"+" => Rc::new(MarkedForm::PrimComb { name: "+".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"+" => Rc::new(MarkedForm::PrimComb { name: "+".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a + b)))))
}}),
"-" => Rc::new(MarkedForm::PrimComb { name: "-".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"-" => Rc::new(MarkedForm::PrimComb { name: "-".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a - b)))))
}}),
"*" => Rc::new(MarkedForm::PrimComb { name: "*".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"*" => Rc::new(MarkedForm::PrimComb { name: "*".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a * b)))))
}}),
"/" => Rc::new(MarkedForm::PrimComb { name: "/".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"/" => Rc::new(MarkedForm::PrimComb { name: "/".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a / b)))))
}}),
"%" => Rc::new(MarkedForm::PrimComb { name: "%".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"%" => Rc::new(MarkedForm::PrimComb { name: "%".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a % b)))))
}}),
"&" => Rc::new(MarkedForm::PrimComb { name: "&".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"&" => Rc::new(MarkedForm::PrimComb { name: "&".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a & b)))))
}}),
"|" => Rc::new(MarkedForm::PrimComb { name: "|".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"|" => Rc::new(MarkedForm::PrimComb { name: "|".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a | b)))))
}}),
"^" => Rc::new(MarkedForm::PrimComb { name: "^".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"^" => Rc::new(MarkedForm::PrimComb { name: "^".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
let a = p.car()?.int()?;
let b = p.cdr()?.car()?.int()?;
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Int(a ^ b)))))
}}),
"comb?" => Rc::new(MarkedForm::PrimComb { name: "comb?".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"comb?" => Rc::new(MarkedForm::PrimComb { name: "comb?".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(match &* p.car()? {
MarkedForm::PrimComb { .. } => true,
MarkedForm::DeriComb { .. } => true,
_ => false,
})))))
}}),
"pair?" => Rc::new(MarkedForm::PrimComb { name: "pair?".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"pair?" => Rc::new(MarkedForm::PrimComb { name: "pair?".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(match &* p.car()? {
MarkedForm::Pair(_i, _a,_b) => true,
_ => false,
})))))
}}),
"symbol?" => Rc::new(MarkedForm::PrimComb { name: "symbol?".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"symbol?" => Rc::new(MarkedForm::PrimComb { name: "symbol?".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(match &* p.car()? {
MarkedForm::Symbol(_) => true,
_ => false,
})))))
}}),
"int?" => Rc::new(MarkedForm::PrimComb { name: "int?".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"int?" => Rc::new(MarkedForm::PrimComb { name: "int?".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(match &* p.car()? {
MarkedForm::Int(_) => true,
_ => false,
})))))
}}),
// maybe bool? but also could be derived. Nil def
"bool?" => Rc::new(MarkedForm::PrimComb { name: "bool?".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"bool?" => Rc::new(MarkedForm::PrimComb { name: "bool?".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(match &* p.car()? {
MarkedForm::Bool(_) => true,
_ => false,
})))))
}}),
"nil?" => Rc::new(MarkedForm::PrimComb { name: "nil?".to_owned(), wrap_level: 1, f: |bctx, dctx, p| {
"nil?" => Rc::new(MarkedForm::PrimComb { name: "nil?".to_owned(), takes_de: false, wrap_level: 1, f: |bctx, dctx, p| {
Ok((bctx, PossibleMarkedTailCall::Result(Rc::new(MarkedForm::Bool(match &* p.car()? {
MarkedForm::Nil => true,
_ => false,
@@ -333,7 +345,6 @@ impl NeededIds {
NeededIds::None(hashes) => hashes.is_empty(),
NeededIds::Some(set,hashes) => false,
}
}
fn hashes(&self) -> &BTreeSet<Hash> {
match self {
@@ -341,7 +352,6 @@ impl NeededIds {
NeededIds::None(hashes) => hashes,
NeededIds::Some(set,hashes) => hashes,
}
}
fn union(&self, other: &NeededIds) -> Self {
match self {
@@ -412,20 +422,9 @@ impl BCtx {
// force is for drop_redundent_eval
// memo is only for recording currently executing hashes (calls and if's)
// memo is only for recording currently executing hashes (calls and if's, current for us)
// only_head is not currently used
//only_head env env_counter memo env_stack force
//
//I feel like ctx should only be used for things passed back up?
//or maybe we split into an upwards and downwards ctx
//bidirectional is only env_counter, though a true memoization would also count
//ok
//we have Ctx - env_counter (maybe true memoization eventually)
//and Dctx - env env_stack memo(currently_executing) force
//
//env_stack should be something like BTreeMap<EnvID, (EnvLookup,ParamLookupMain)>
// SuspendedEnvLookup { name: Option<String>, id: EnvID },
// SuspendedParamLookup { name: Option<String>, id: EnvID, cdr_num: i32, car: bool },
#[derive(Clone)]
pub struct DCtx {
e : Rc<MarkedForm>,
@@ -558,7 +557,7 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
println!("{:ident$}PE: {}", "", x, ident=dctx.ident*4);
let should_go = dctx.force || dctx.can_progress(x.ids());
if !should_go {
println!("Shouldn't go!");
println!("{:ident$}Shouldn't go!", "", ident=dctx.ident*4);
return Ok((bctx, x));
}
match &*x {
@@ -569,14 +568,14 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
}
return Ok((bctx, t.car()?.cdr()?));
},
MarkedForm::SuspendedEnvLookup { name, id } => {
MarkedForm::SuspendedEnvLookup { name, id } => {
if let Some(v) = dctx.sus_env_stack.get(id) {
Ok((bctx, Rc::clone(v)))
} else {
Ok((bctx, x))
}
},
MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => {
MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => {
if let Some(v) = dctx.sus_prm_stack.get(id) {
Ok((bctx, Rc::clone(v)))
} else {
@@ -586,6 +585,7 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
MarkedForm::SuspendedPair { ids, attempted, car, cdr } => {
let ( bctx, mut car) = partial_eval(bctx, dctx.clone(), Rc::clone(car))?;
let (mut bctx, mut cdr) = partial_eval(bctx, dctx.clone(), Rc::clone(cdr))?;
let mut new_attempted = attempted.clone();
while let Some(wrap_level) = car.wrap_level() {
if wrap_level > 0 {
fn map_unval_peval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,Rc<MarkedForm>),String> {
@@ -599,7 +599,6 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
_ => return Err("not a list".to_owned()),
}
}
//asdf
if let Ok((new_bctx, new_cdr)) = map_unval_peval(bctx.clone(), dctx.clone(), Rc::clone(&cdr)) {
car = car.decrement_wrap_level().unwrap();
cdr = new_cdr;
@@ -609,11 +608,13 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
}
} else {
// check to see if can do call
// not pure values are fine for -1 wraps, which we need to add? veval and vif?
if !cdr.is_value() {
break;
}
match &*car {
MarkedForm::PrimComb { name, wrap_level, f} => {
MarkedForm::PrimComb { name, takes_de, wrap_level, f} => {
new_attempted = Attempted::True(if *takes_de { Some(dctx.e.ids()) } else { None });
if let Ok((bctx, r)) = f(bctx.clone(), dctx.clone(), Rc::clone(&cdr)) {
match r {
PossibleMarkedTailCall::Result(result) => return Ok((bctx, result)),
@@ -637,6 +638,7 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
} else { break; }
}
MarkedForm::DeriComb { ids, se, de, id, wrap_level, sequence_params, rest_params, body } => {
new_attempted = Attempted::True(if de.is_some() { Some(dctx.e.ids()) } else { None });
// not yet supporting sequence params
// needs to check hash
let inner_dctx = dctx.copy_push_frame(id.clone(), &se, &de, Some(Rc::clone(&dctx.e)), &rest_params, Some(Rc::clone(&cdr)));
@@ -656,12 +658,15 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
}
// update IDs
let new_ids = car.ids().union(&cdr.ids());
// TODO: This should be new-attempted and only if it takes the dynamic env? (if not attempted, carry over)
// basicallly if rec-stop OR not good to return
// This would come from trying it again, if you do
let new_ids = if let Attempted::True(Some(id)) = attempted { new_ids.add_id(id.clone()) } else { new_ids };
//let new_ids = if let Some(hash) = resume_hash { new_ids.add_hash(hash) } else { new_ids };
let new_attempted = attempted.clone();
let new_ids = match new_ids {
NeededIds::True(_) => new_ids,
NeededIds::None(hashes) => match &new_attempted {
Attempted::False => NeededIds::True(hashes),
Attempted::True(Some(oids)) => oids.union_hashes(&hashes),
Attempted::True(None) => NeededIds::None(hashes),
},
NeededIds::Some(_,_) => new_ids,
};
Ok((bctx, Rc::new(MarkedForm::SuspendedPair{ ids: new_ids, attempted: new_attempted, car, cdr })))
},
MarkedForm::Pair(ids,car,cdr) => {
@@ -669,10 +674,6 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
let (bctx, cdr) = partial_eval(bctx, dctx, Rc::clone(cdr))?;
Ok((bctx, Rc::new(MarkedForm::Pair(car.ids().union(&cdr.ids()), car, cdr))))
},
// Sub stuff
//
// (mif (or (and (not (marked_env_real? env)) (not (marked_env_real? se))) ; both aren't real, re-evaluation of creation site
// (and (marked_env_real? env) (not (marked_env_real? se)))) ; new env real, but se isn't - creation!
MarkedForm::DeriComb { ids, se, de, id, wrap_level, sequence_params, rest_params, body } => {
if !se.ids().needs_nothing() {
// the current env is our new se
@@ -694,7 +695,7 @@ pub fn partial_eval(bctx: BCtx, dctx: DCtx, x: Rc<MarkedForm>) -> Result<(BCtx,R
}
#[derive(Debug, Clone, Eq, PartialEq)]
pub enum Attempted {
True(Option<EnvID>),
True(Option<NeededIds>),
False,
}
#[derive(Debug, Clone, Eq, PartialEq)]
@@ -711,20 +712,20 @@ pub enum MarkedForm {
// resume hash is folded into ids
SuspendedPair { ids: NeededIds, attempted: Attempted, car: Rc<MarkedForm>, cdr: Rc<MarkedForm>},
PrimComb { name: String, wrap_level: i32, f: fn(BCtx,DCtx,Rc<MarkedForm>) -> Result<(BCtx,PossibleMarkedTailCall),String> },
PrimComb { name: String, takes_de: bool, wrap_level: i32, f: fn(BCtx,DCtx,Rc<MarkedForm>) -> Result<(BCtx,PossibleMarkedTailCall),String> },
DeriComb { ids: NeededIds, se: Rc<MarkedForm>, de: Option<String>, id: EnvID, wrap_level: i32, sequence_params: Vec<String>, rest_params: Option<String>, body: Rc<MarkedForm> },
}
impl MarkedForm {
pub fn wrap_level(&self) -> Option<i32> {
match self {
MarkedForm::PrimComb { name, wrap_level, f} => Some(*wrap_level),
MarkedForm::DeriComb { ids, se, de, id, wrap_level, sequence_params, rest_params, body } => Some(*wrap_level),
MarkedForm::PrimComb { wrap_level, .. } => Some(*wrap_level),
MarkedForm::DeriComb { wrap_level, .. } => Some(*wrap_level),
_ => None,
}
}
pub fn decrement_wrap_level(&self) -> Option<Rc<Self>> {
match self {
MarkedForm::PrimComb { name, wrap_level, f } => Some(Rc::new(MarkedForm::PrimComb { name: name.clone(), wrap_level: wrap_level-1, f: *f })),
MarkedForm::PrimComb { name, takes_de, wrap_level, f } => Some(Rc::new(MarkedForm::PrimComb { name: name.clone(), takes_de: *takes_de, wrap_level: wrap_level-1, f: *f })),
MarkedForm::DeriComb { ids, se, de, id, wrap_level, sequence_params, rest_params, body } => Some(Rc::new(MarkedForm::DeriComb { ids: ids.clone(), se: Rc::clone(se), de: de.clone(), id: id.clone(), wrap_level: wrap_level-1, sequence_params: sequence_params.clone(), rest_params: rest_params.clone(), body: Rc::clone(body) })),
_ => None,
}
@@ -744,6 +745,7 @@ impl MarkedForm {
MarkedForm::DeriComb { ids, .. } => ids.clone(),
}
}
// TODO: this might be essentially the same as NeededIds.nothing_needed()
pub fn is_value(&self) -> bool {
match match self {
MarkedForm::Nil => return true,

239
kr/src/main.rs
View File

@@ -38,68 +38,70 @@ fn parse_test() {
assert!(g.parse("((22)").is_err());
}
fn eval_test<T: Into<Form>>(gram: &grammar::TermParser, e: &Rc<Form>, code: &str, expected: T) {
fn eval_test<T: Into<Form>>(also_pe: bool, gram: &grammar::TermParser, e: &Rc<Form>, code: &str, expected: T) {
println!("Doing {}", code);
let parsed = Rc::new(gram.parse(code).unwrap());
let basic_result = eval(Rc::clone(e), Rc::clone(&parsed));
assert_eq!(*basic_result, expected.into());
let (bctx, dctx) = new_base_ctxs();
let (bctx, marked) = parsed.marked(bctx);
let unvaled = marked.unval().unwrap();
let (bctx, ped) = partial_eval(bctx, dctx, unvaled).unwrap();
let (bctx, marked_basic_result) = basic_result.marked(bctx);
println!("Final PE {}", ped);
assert_eq!(*ped, *marked_basic_result);
if also_pe {
let (bctx, dctx) = new_base_ctxs();
let (bctx, marked) = parsed.marked(bctx);
let unvaled = marked.unval().unwrap();
let (bctx, ped) = partial_eval(bctx, dctx, unvaled).unwrap();
let (bctx, marked_basic_result) = basic_result.marked(bctx);
println!("Final PE {}", ped);
assert_eq!(*ped, *marked_basic_result);
}
}
#[test]
fn basic_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, "(+ 2 (car (cons 4 '(1 2))))", 6);
eval_test(&g, &e, "(= 17 ((vau d p (+ (eval (car p) d) 13)) (+ 1 3)))", true);
eval_test(&g, &e, "(if (= 2 2) (+ 1 2) (+ 3 4))", 3);
eval_test(&g, &e, "(quote a)", "a");
eval_test(&g, &e, "'a", "a");
eval_test(&g, &e, "'(1 . a)", (1, "a"));
eval_test(&g, &e, "'(1 a)", (1, ("a", Form::Nil)));
eval_test(&g, &e, "true", true);
eval_test(&g, &e, "false", false);
eval_test(&g, &e, "nil", Form::Nil);
eval_test(true, &g, &e, "(+ 2 (car (cons 4 '(1 2))))", 6);
eval_test(true, &g, &e, "(= 17 ((vau d p (+ (eval (car p) d) 13)) (+ 1 3)))", true);
eval_test(true, &g, &e, "(if (= 2 2) (+ 1 2) (+ 3 4))", 3);
eval_test(true, &g, &e, "(quote a)", "a");
eval_test(true, &g, &e, "'a", "a");
eval_test(true, &g, &e, "'(1 . a)", (1, "a"));
eval_test(true, &g, &e, "'(1 a)", (1, ("a", Form::Nil)));
eval_test(true, &g, &e, "true", true);
eval_test(true, &g, &e, "false", false);
eval_test(true, &g, &e, "nil", Form::Nil);
eval_test(&g, &e, "(+ 1 2)", 3);
eval_test(&g, &e, "(- 1 2)", -1);
eval_test(&g, &e, "(* 1 2)", 2);
eval_test(&g, &e, "(/ 4 2)", 2);
eval_test(&g, &e, "(% 3 2)", 1);
eval_test(&g, &e, "(& 3 2)", 2);
eval_test(&g, &e, "(| 2 1)", 3);
eval_test(&g, &e, "(^ 2 1)", 3);
eval_test(&g, &e, "(^ 3 1)", 2);
eval_test(true, &g, &e, "(+ 1 2)", 3);
eval_test(true, &g, &e, "(- 1 2)", -1);
eval_test(true, &g, &e, "(* 1 2)", 2);
eval_test(true, &g, &e, "(/ 4 2)", 2);
eval_test(true, &g, &e, "(% 3 2)", 1);
eval_test(true, &g, &e, "(& 3 2)", 2);
eval_test(true, &g, &e, "(| 2 1)", 3);
eval_test(true, &g, &e, "(^ 2 1)", 3);
eval_test(true, &g, &e, "(^ 3 1)", 2);
eval_test(&g, &e, "(< 3 1)", false);
eval_test(&g, &e, "(<= 3 1)", false);
eval_test(&g, &e, "(> 3 1)", true);
eval_test(&g, &e, "(>= 3 1)", true);
eval_test(true, &g, &e, "(< 3 1)", false);
eval_test(true, &g, &e, "(<= 3 1)", false);
eval_test(true, &g, &e, "(> 3 1)", true);
eval_test(true, &g, &e, "(>= 3 1)", true);
eval_test(&g, &e, "(comb? +)", true);
eval_test(&g, &e, "(comb? (vau d p 1))", true);
eval_test(&g, &e, "(comb? 1)", false);
eval_test(&g, &e, "(pair? '(a))", true);
//eval_test(&g, &e, "(pair? '())", true);
eval_test(&g, &e, "(nil? nil)", true);
eval_test(&g, &e, "(nil? 1)", false);
eval_test(&g, &e, "(pair? 1)", false);
eval_test(&g, &e, "(symbol? 'a)", true);
eval_test(&g, &e, "(symbol? 1)", false);
eval_test(&g, &e, "(int? 1)", true);
eval_test(&g, &e, "(int? true)", false);
eval_test(&g, &e, "(bool? true)", true);
eval_test(&g, &e, "(bool? 1)", false);
eval_test(true, &g, &e, "(comb? +)", true);
eval_test(true, &g, &e, "(comb? (vau d p 1))", true);
eval_test(true, &g, &e, "(comb? 1)", false);
eval_test(true, &g, &e, "(pair? '(a))", true);
//eval_test(true, &g, &e, "(pair? '())", true);
eval_test(true, &g, &e, "(nil? nil)", true);
eval_test(true, &g, &e, "(nil? 1)", false);
eval_test(true, &g, &e, "(pair? 1)", false);
eval_test(true, &g, &e, "(symbol? 'a)", true);
eval_test(true, &g, &e, "(symbol? 1)", false);
eval_test(true, &g, &e, "(int? 1)", true);
eval_test(true, &g, &e, "(int? true)", false);
eval_test(true, &g, &e, "(bool? true)", true);
eval_test(true, &g, &e, "(bool? 1)", false);
eval_test(&g, &e, "!(bool?) 1", false);
eval_test(&g, &e, "!(bool?) true", true);
eval_test(true, &g, &e, "!(bool?) 1", false);
eval_test(true, &g, &e, "!(bool?) true", true);
eval_test(&g, &e, "((vau root_env _ (eval 'a (cons (cons 'a 2) root_env))))", 2);
eval_test(&g, &e, "'name-dash", "name-dash");
eval_test(true, &g, &e, "((vau root_env _ (eval 'a (cons (cons 'a 2) root_env))))", 2);
eval_test(true, &g, &e, "'name-dash", "name-dash");
}
@@ -113,7 +115,7 @@ static LET: Lazy<String> = Lazy::new(|| {
#[test]
fn fib_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (let1 x 10 (+ x 7))", *LET), 17);
eval_test(true, &g, &e, &format!("{} (let1 x 10 (+ x 7))", *LET), 17);
let def_fib = "
!(let1 fib (vau de p
!(let1 self (eval (car p) de))
@@ -122,7 +124,7 @@ fn fib_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
!(if (= 1 n) 1)
(+ (self self (- n 1)) (self self (- n 2)))
))";
eval_test(&g, &e, &format!("{} {} (fib fib 6)", *LET, def_fib), 8);
eval_test(true, &g, &e, &format!("{} {} (fib fib 6)", *LET, def_fib), 8);
}
#[test]
fn fact_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
@@ -133,7 +135,7 @@ fn fact_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
!(if (= 0 n) 1)
(* n (self self (- n 1)))
))";
eval_test(&g, &e, &format!("{} {} (fact fact 6)", *LET, def_fact), 720);
eval_test(true, &g, &e, &format!("{} {} (fact fact 6)", *LET, def_fact), 720);
}
static VAPPLY: Lazy<String> = Lazy::new(|| {
format!("
@@ -162,7 +164,8 @@ fn vapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
(vapply inner (cons inner (cons (eval (car p) de) (cons 0 nil))) de)
))", *VAPPLY);
// Won't work unless tail calls work
eval_test(&g, &e, &format!("{} (badid 1000)", def_badid), 1000);
// so no PE?
eval_test(true, &g, &e, &format!("{} (badid 1000)", def_badid), 1000);
}
static VMAP: Lazy<String> = Lazy::new(|| {
@@ -182,7 +185,7 @@ static VMAP: Lazy<String> = Lazy::new(|| {
#[test]
fn vmap_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// Maybe define in terms of a right fold?
eval_test(&g, &e, &format!("{} (vmap (vau de p (+ 1 (car p))) '(1 2 3))", *VMAP), (2, (3, (4, Form::Nil))));
eval_test(true, &g, &e, &format!("{} (vmap (vau de p (+ 1 (car p))) '(1 2 3))", *VMAP), (2, (3, (4, Form::Nil))));
}
static WRAP: Lazy<String> = Lazy::new(|| {
@@ -196,7 +199,7 @@ static WRAP: Lazy<String> = Lazy::new(|| {
#[test]
fn wrap_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// Make sure (wrap (vau ...)) and internal style are optimized the same
eval_test(&g, &e, &format!("{} ((wrap (vau _ p (+ (car p) 1))) (+ 1 2))", *WRAP), 4);
eval_test(true, &g, &e, &format!("{} ((wrap (vau _ p (+ (car p) 1))) (+ 1 2))", *WRAP), 4);
}
static UNWRAP: Lazy<String> = Lazy::new(|| {
@@ -211,10 +214,10 @@ static UNWRAP: Lazy<String> = Lazy::new(|| {
fn unwrap_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// Can't represent prims in tests :( - they do work though, uncommenting and checking the
// failed assert verifies
//eval_test(&g, &e, &format!("{} ((unwrap (vau de p (car p))) (+ 1 2))", def_unwrap), ("quote", (("+", (1, (2, Form::Nil))), Form::Nil)));
//eval_test(&g, &e, &format!("{} ((unwrap (vau de p (eval (car p) de))) (+ 1 2))", def_unwrap), (("+", (1, (2, Form::Nil))), Form::Nil));
eval_test(&g, &e, &format!("{} ((unwrap (vau de p (eval (eval (car p) de) de))) (+ 1 2))", *UNWRAP), 3);
eval_test(&g, &e, &format!("{} ((unwrap (vau de p (+ (eval (eval (car p) de) de) 1))) (+ 1 2))", *UNWRAP), 4);
//eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (car p))) (+ 1 2))", def_unwrap), ("quote", (("+", (1, (2, Form::Nil))), Form::Nil)));
//eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (eval (car p) de))) (+ 1 2))", def_unwrap), (("+", (1, (2, Form::Nil))), Form::Nil));
eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (eval (eval (car p) de) de))) (+ 1 2))", *UNWRAP), 3);
eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (+ (eval (eval (car p) de) de) 1))) (+ 1 2))", *UNWRAP), 4);
}
static LAPPLY: Lazy<String> = Lazy::new(|| {
@@ -245,7 +248,7 @@ fn lapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
))", *LAPPLY);
// Won't work unless tail calls work
// takes a while though
eval_test(&g, &e, &format!("{} (lbadid 1000)", def_lbadid), 1000);
eval_test(true, &g, &e, &format!("{} (lbadid 1000)", def_lbadid), 1000);
}
static VFOLDL: Lazy<String> = Lazy::new(|| {
@@ -265,7 +268,7 @@ static VFOLDL: Lazy<String> = Lazy::new(|| {
});
#[test]
fn vfoldl_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (vfoldl (vau de p (+ (car p) (car (cdr p)))) 0 '(1 2 3))", *VFOLDL), 6);
eval_test(true, &g, &e, &format!("{} (vfoldl (vau de p (+ (car p) (car (cdr p)))) 0 '(1 2 3))", *VFOLDL), 6);
}
static ZIPD: Lazy<String> = Lazy::new(|| {
format!("
@@ -284,7 +287,7 @@ static ZIPD: Lazy<String> = Lazy::new(|| {
});
#[test]
fn zipd_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (zipd '(1 2 3) '(4 5 6))", *ZIPD), ((1,4), ((2,5), ((3,6), Form::Nil))));
eval_test(true, &g, &e, &format!("{} (zipd '(1 2 3) '(4 5 6))", *ZIPD), ((1,4), ((2,5), ((3,6), Form::Nil))));
}
static CONCAT: Lazy<String> = Lazy::new(|| {
format!("
@@ -303,7 +306,7 @@ static CONCAT: Lazy<String> = Lazy::new(|| {
#[test]
fn concat_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (concat '(1 2 3) '(4 5 6))", *CONCAT), (1, (2, (3, (4, (5, (6, Form::Nil)))))));
eval_test(true, &g, &e, &format!("{} (concat '(1 2 3) '(4 5 6))", *CONCAT), (1, (2, (3, (4, (5, (6, Form::Nil)))))));
}
static BVAU: Lazy<String> = Lazy::new(|| {
@@ -339,20 +342,20 @@ static BVAU: Lazy<String> = Lazy::new(|| {
});
#[test]
fn bvau_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} ((bvau _ (a b c) (+ a (- b c))) 10 2 3)", *BVAU), 9);
eval_test(&g, &e, &format!("{} ((bvau (a b c) (+ a (- b c))) 10 2 3)", *BVAU), 9);
eval_test(true, &g, &e, &format!("{} ((bvau _ (a b c) (+ a (- b c))) 10 2 3)", *BVAU), 9);
eval_test(true, &g, &e, &format!("{} ((bvau (a b c) (+ a (- b c))) 10 2 3)", *BVAU), 9);
eval_test(&g, &e, &format!("{} ((bvau (a b . c) c) 10 2 3)", *BVAU), (3, Form::Nil));
eval_test(&g, &e, &format!("{} ((bvau (a b . c) c) 10 2)", *BVAU), Form::Nil);
eval_test(&g, &e, &format!("{} ((bvau (a b . c) c) 10 2 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
eval_test(&g, &e, &format!("{} ((bvau c c) 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
eval_test(&g, &e, &format!("{} ((bvau c c))", *BVAU), Form::Nil);
eval_test(&g, &e, &format!("{} ((bvau ((a b) . c) c) (10 2) 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
eval_test(&g, &e, &format!("{} ((bvau ((a b) . c) a) (10 2) 3 4 5)", *BVAU), 10);
eval_test(&g, &e, &format!("{} ((bvau ((a b) . c) b) (10 2) 3 4 5)", *BVAU), 2);
eval_test(true, &g, &e, &format!("{} ((bvau (a b . c) c) 10 2 3)", *BVAU), (3, Form::Nil));
eval_test(true, &g, &e, &format!("{} ((bvau (a b . c) c) 10 2)", *BVAU), Form::Nil);
eval_test(true, &g, &e, &format!("{} ((bvau (a b . c) c) 10 2 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((bvau c c) 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((bvau c c))", *BVAU), Form::Nil);
eval_test(true, &g, &e, &format!("{} ((bvau ((a b) . c) c) (10 2) 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((bvau ((a b) . c) a) (10 2) 3 4 5)", *BVAU), 10);
eval_test(true, &g, &e, &format!("{} ((bvau ((a b) . c) b) (10 2) 3 4 5)", *BVAU), 2);
eval_test(&g, &e, &format!("{} ((wrap (bvau _ (a b c) (+ a (- b c)))) (+ 10 1) (+ 2 2) (+ 5 3))", *BVAU), 7);
eval_test(&g, &e, &format!("{} ((wrap (bvau (a b c) (+ a (- b c)))) (+ 10 1) (+ 2 2) (+ 5 3))", *BVAU), 7);
eval_test(true, &g, &e, &format!("{} ((wrap (bvau _ (a b c) (+ a (- b c)))) (+ 10 1) (+ 2 2) (+ 5 3))", *BVAU), 7);
eval_test(true, &g, &e, &format!("{} ((wrap (bvau (a b c) (+ a (- b c)))) (+ 10 1) (+ 2 2) (+ 5 3))", *BVAU), 7);
}
static LAMBDA: Lazy<String> = Lazy::new(|| {
@@ -364,20 +367,20 @@ static LAMBDA: Lazy<String> = Lazy::new(|| {
});
#[test]
fn lambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} ((lambda (a b c) (+ a (- b c))) (+ 10 1) (+ 2 2) (+ 5 3))", *LAMBDA), 7);
eval_test(true, &g, &e, &format!("{} ((lambda (a b c) (+ a (- b c))) (+ 10 1) (+ 2 2) (+ 5 3))", *LAMBDA), 7);
eval_test(&g, &e, &format!("{} ((lambda (a b . c) c) 10 2 3)", *LAMBDA), (3, Form::Nil));
eval_test(&g, &e, &format!("{} ((lambda (a b . c) c) 10 2)", *LAMBDA), Form::Nil);
eval_test(&g, &e, &format!("{} ((lambda (a b . c) c) 10 2 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(&g, &e, &format!("{} ((lambda c c) 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(&g, &e, &format!("{} ((lambda c c))", *LAMBDA), Form::Nil);
eval_test(&g, &e, &format!("{} ((lambda ((a b) . c) c) '(10 2) 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(&g, &e, &format!("{} ((lambda ((a b) . c) a) '(10 2) 3 4 5)", *LAMBDA), 10);
eval_test(&g, &e, &format!("{} ((lambda ((a b) . c) b) '(10 2) 3 4 5)", *LAMBDA), 2);
eval_test(&g, &e, &format!("{} ((lambda ((a b . c) d) b) '(10 2 3 4) 3)", *LAMBDA), 2);
eval_test(&g, &e, &format!("{} ((lambda ((a b . c) d) c) '(10 2 3 4) 3)", *LAMBDA), (3, (4, Form::Nil)));
eval_test(true, &g, &e, &format!("{} ((lambda (a b . c) c) 10 2 3)", *LAMBDA), (3, Form::Nil));
eval_test(true, &g, &e, &format!("{} ((lambda (a b . c) c) 10 2)", *LAMBDA), Form::Nil);
eval_test(true, &g, &e, &format!("{} ((lambda (a b . c) c) 10 2 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((lambda c c) 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((lambda c c))", *LAMBDA), Form::Nil);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b) . c) c) '(10 2) 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((lambda ((a b) . c) a) '(10 2) 3 4 5)", *LAMBDA), 10);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b) . c) b) '(10 2) 3 4 5)", *LAMBDA), 2);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b . c) d) b) '(10 2 3 4) 3)", *LAMBDA), 2);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b . c) d) c) '(10 2 3 4) 3)", *LAMBDA), (3, (4, Form::Nil)));
// should fail
//eval_test(&g, &e, &format!("{} ((lambda (a b c) c) 10 2 3 4)", *LAMBDA), 3);
//eval_test(true, &g, &e, &format!("{} ((lambda (a b c) c) 10 2 3 4)", *LAMBDA), 3);
}
static LET2: Lazy<String> = Lazy::new(|| {
@@ -392,16 +395,16 @@ static LET2: Lazy<String> = Lazy::new(|| {
#[test]
fn let2_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (let1 x (+ 10 1) (+ x 1))", *LET2), 12);
eval_test(&g, &e, &format!("{} (let1 x '(10 1) x)", *LET2), (10, (1, Form::Nil)));
eval_test(&g, &e, &format!("{} (let1 (a b) '(10 1) a)", *LET2), 10);
eval_test(&g, &e, &format!("{} (let1 (a b) '(10 1) b)", *LET2), 1);
eval_test(&g, &e, &format!("{} (let1 (a b . c) '(10 1) c)", *LET2), Form::Nil);
eval_test(&g, &e, &format!("{} (let1 (a b . c) '(10 1 2 3) c)", *LET2), (2, (3, Form::Nil)));
eval_test(&g, &e, &format!("{} (let1 ((a . b) . c) '((10 1) 2 3) a)", *LET2), 10);
eval_test(&g, &e, &format!("{} (let1 ((a . b) . c) '((10 1) 2 3) b)", *LET2), (1, Form::Nil));
eval_test(true, &g, &e, &format!("{} (let1 x (+ 10 1) (+ x 1))", *LET2), 12);
eval_test(true, &g, &e, &format!("{} (let1 x '(10 1) x)", *LET2), (10, (1, Form::Nil)));
eval_test(true, &g, &e, &format!("{} (let1 (a b) '(10 1) a)", *LET2), 10);
eval_test(true, &g, &e, &format!("{} (let1 (a b) '(10 1) b)", *LET2), 1);
eval_test(true, &g, &e, &format!("{} (let1 (a b . c) '(10 1) c)", *LET2), Form::Nil);
eval_test(true, &g, &e, &format!("{} (let1 (a b . c) '(10 1 2 3) c)", *LET2), (2, (3, Form::Nil)));
eval_test(true, &g, &e, &format!("{} (let1 ((a . b) . c) '((10 1) 2 3) a)", *LET2), 10);
eval_test(true, &g, &e, &format!("{} (let1 ((a . b) . c) '((10 1) 2 3) b)", *LET2), (1, Form::Nil));
// should fail
//eval_test(&g, &e, &format!("{} (let1 (a b c) '(10 2 3 4) a)", *LET2), 10);
//eval_test(true, &g, &e, &format!("{} (let1 (a b c) '(10 2 3 4) a)", *LET2), 10);
}
static LIST: Lazy<String> = Lazy::new(|| {
@@ -413,7 +416,7 @@ static LIST: Lazy<String> = Lazy::new(|| {
#[test]
fn list_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (list 1 2 (+ 3 4))", *LIST), (1, (2, (7, Form::Nil))));
eval_test(true, &g, &e, &format!("{} (list 1 2 (+ 3 4))", *LIST), (1, (2, (7, Form::Nil))));
}
static Y: Lazy<String> = Lazy::new(|| {
@@ -429,7 +432,7 @@ static Y: Lazy<String> = Lazy::new(|| {
#[test]
fn y_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} ((Y (lambda (recurse) (lambda (n) (if (= 0 n) 1 (* n (recurse (- n 1))))))) 5)", *Y), 120);
eval_test(true, &g, &e, &format!("{} ((Y (lambda (recurse) (lambda (n) (if (= 0 n) 1 (* n (recurse (- n 1))))))) 5)", *Y), 120);
}
@@ -444,7 +447,7 @@ static RLAMBDA: Lazy<String> = Lazy::new(|| {
#[test]
fn rlambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} ((rlambda recurse (n) (if (= 0 n) 1 (* n (recurse (- n 1))))) 5)", *RLAMBDA), 120);
eval_test(true, &g, &e, &format!("{} ((rlambda recurse (n) (if (= 0 n) 1 (* n (recurse (- n 1))))) 5)", *RLAMBDA), 120);
}
static AND_OR: Lazy<String> = Lazy::new(|| {
// need to extend for varidac
@@ -463,15 +466,15 @@ static AND_OR: Lazy<String> = Lazy::new(|| {
#[test]
fn and_or_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (and true true)", *AND_OR), true);
eval_test(&g, &e, &format!("{} (and false true)", *AND_OR), false);
eval_test(&g, &e, &format!("{} (and true false)", *AND_OR), false);
eval_test(&g, &e, &format!("{} (and false false)", *AND_OR), false);
eval_test(true, &g, &e, &format!("{} (and true true)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (and false true)", *AND_OR), false);
eval_test(true, &g, &e, &format!("{} (and true false)", *AND_OR), false);
eval_test(true, &g, &e, &format!("{} (and false false)", *AND_OR), false);
eval_test(&g, &e, &format!("{} (or true true)", *AND_OR), true);
eval_test(&g, &e, &format!("{} (or false true)", *AND_OR), true);
eval_test(&g, &e, &format!("{} (or true false)", *AND_OR), true);
eval_test(&g, &e, &format!("{} (or false false)", *AND_OR), false);
eval_test(true, &g, &e, &format!("{} (or true true)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (or false true)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (or true false)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (or false false)", *AND_OR), false);
}
static LEN: Lazy<String> = Lazy::new(|| {
format!("
@@ -488,10 +491,10 @@ static LEN: Lazy<String> = Lazy::new(|| {
#[test]
fn len_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (len '())", *LEN), 0);
eval_test(&g, &e, &format!("{} (len '(1))", *LEN), 1);
eval_test(&g, &e, &format!("{} (len '(1 2))", *LEN), 2);
eval_test(&g, &e, &format!("{} (len '(1 2 3))", *LEN), 3);
eval_test(true, &g, &e, &format!("{} (len '())", *LEN), 0);
eval_test(true, &g, &e, &format!("{} (len '(1))", *LEN), 1);
eval_test(true, &g, &e, &format!("{} (len '(1 2))", *LEN), 2);
eval_test(true, &g, &e, &format!("{} (len '(1 2 3))", *LEN), 3);
}
static MATCH: Lazy<String> = Lazy::new(|| {
format!("
@@ -528,11 +531,11 @@ static MATCH: Lazy<String> = Lazy::new(|| {
});
#[test]
fn match_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (match (+ 1 2) 1 2 2 3 3 4 _ 0)", *MATCH), 4);
eval_test(&g, &e, &format!("{} (match '(1 2) 1 2 2 3 3 4 _ 0)", *MATCH), 0);
eval_test(&g, &e, &format!("{} (match '(1 2) 1 2 2 3 (a b) (+ a (+ 2 b)) _ 0)", *MATCH), 5);
eval_test(&g, &e, &format!("{} (match '(1 2) 1 2 2 3 '(1 2) 7 _ 0)", *MATCH), 7);
eval_test(&g, &e, &format!("{} (let1 a 70 (match (+ 60 10) (unquote a) 100 2 3 _ 0))", *MATCH), 100);
eval_test(true, &g, &e, &format!("{} (match (+ 1 2) 1 2 2 3 3 4 _ 0)", *MATCH), 4);
eval_test(true, &g, &e, &format!("{} (match '(1 2) 1 2 2 3 3 4 _ 0)", *MATCH), 0);
eval_test(true, &g, &e, &format!("{} (match '(1 2) 1 2 2 3 (a b) (+ a (+ 2 b)) _ 0)", *MATCH), 5);
eval_test(true, &g, &e, &format!("{} (match '(1 2) 1 2 2 3 '(1 2) 7 _ 0)", *MATCH), 7);
eval_test(true, &g, &e, &format!("{} (let1 a 70 (match (+ 60 10) (unquote a) 100 2 3 _ 0))", *MATCH), 100);
}
static RBTREE: Lazy<String> = Lazy::new(|| {
format!("
@@ -579,6 +582,6 @@ static RBTREE: Lazy<String> = Lazy::new(|| {
});
#[test]
fn rbtree_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(&g, &e, &format!("{} (reduce-test-tree (make-test-tree 10 map-empty))", *RBTREE), 1);
eval_test(&g, &e, &format!("{} (reduce-test-tree (make-test-tree 20 map-empty))", *RBTREE), 2);
eval_test(true, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 10 map-empty))", *RBTREE), 1);
eval_test(true, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 20 map-empty))", *RBTREE), 2);
}