From 865fc1b4b6e9e7c4a47009f684e190bf4acc2484 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Tue, 14 Mar 2023 20:14:17 -0400 Subject: [PATCH] Update flake, split ast out into ast & pe_ast, and main into main & test --- flake.lock | 18 +- kr/src/ast.rs | 1029 --------------------------------------------- kr/src/main.rs | 618 +-------------------------- kr/src/pe_ast.rs | 1039 ++++++++++++++++++++++++++++++++++++++++++++++ kr/src/test.rs | 618 +++++++++++++++++++++++++++ 5 files changed, 1671 insertions(+), 1651 deletions(-) create mode 100644 kr/src/pe_ast.rs create mode 100644 kr/src/test.rs diff --git a/flake.lock b/flake.lock index eb27d87..52d0507 100644 --- a/flake.lock +++ b/flake.lock @@ -36,11 +36,11 @@ "nixpkgs": "nixpkgs" }, "locked": { - "lastModified": 1676341851, - "narHash": "sha256-T8cmSiriXdpZfqlserNyJ1solTCR0DbD8A75epSDOVY=", + "lastModified": 1678760344, + "narHash": "sha256-N8u9/O0NWt3PUQc9xmCeod1SFilOFicALjtYtslib2g=", "owner": "oxalica", "repo": "rust-overlay", - "rev": "956ddb5047f98ea08b792b22004b94a9971932c4", + "rev": "d907affef544f64bd6886fe6bcc5fa2495a82373", "type": "github" }, "original": { @@ -67,11 +67,11 @@ }, "nixpkgs_stable_new": { "locked": { - "lastModified": 1676177817, - "narHash": "sha256-OQnBnuKkpwkfNY31xQyfU5hNpLs1ilWt+hVY6ztEEOM=", + "lastModified": 1678703398, + "narHash": "sha256-Y1mW3dBsoWLHpYm+UIHb5VZ7rx024NNHaF16oZBx++o=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "1b82144edfcd0c86486d2e07c7298f85510e7fb8", + "rev": "67f26c1cfc5d5783628231e776a81c1ade623e0b", "type": "github" }, "original": { @@ -97,11 +97,11 @@ }, "nixpkgs_unstable": { "locked": { - "lastModified": 1676342081, - "narHash": "sha256-zpHbXgvUYTJ9r1WgKtwhj/dmVthZ/GlW1oBYOdqJ9yg=", + "lastModified": 1678838343, + "narHash": "sha256-aA48yVAUyppdlVHhMStlWjB8u9uzA5iel3C47xlbkrw=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "4106c7519bff1d14fa5f942da645b3f18d16309e", + "rev": "b16f2a75619fe8e6adf4583f5fc6448bc967d482", "type": "github" }, "original": { diff --git a/kr/src/ast.rs b/kr/src/ast.rs index 794ce11..d68c6e2 100644 --- a/kr/src/ast.rs +++ b/kr/src/ast.rs @@ -1,11 +1,6 @@ use std::fmt; use std::rc::Rc; use std::convert::From; -use std::collections::{BTreeSet,BTreeMap,hash_map::DefaultHasher}; -use std::result::Result; -use std::iter; -use std::hash::{Hash,Hasher}; - // TODO: // -extend vau & env logic and SuspendedPair PE with sequence_params & wrap_level @@ -119,71 +114,6 @@ impl fmt::Display for Form { } } } -impl fmt::Display for MarkedForm { - fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - match self { - MarkedForm::Nil => write!(f, "nil"), - MarkedForm::Int(i) => write!(f, "{}", i), - MarkedForm::Bool(b) => write!(f, "{}", b), - MarkedForm::Symbol(s) => write!(f, "{}", s), - MarkedForm::Pair(hash, ids, car, cdr) => { - //write!(f, "{:?}#({}", ids, car)?; - write!(f, "({}", car)?; - let mut traverse: Rc = Rc::clone(cdr); - loop { - match &*traverse { - MarkedForm::Pair(ref hash, ref ids, ref carp, ref cdrp) => { - write!(f, " {}", carp)?; - traverse = Rc::clone(cdrp); - }, - MarkedForm::Nil => { - write!(f, ")")?; - return Ok(()); - }, - x => { - write!(f, ". {})", x)?; - return Ok(()); - }, - } - } - }, - MarkedForm::SuspendedEnvEval { hash, ids, x, e } => write!(f, "({:?}){{Sveval {} {}}}", ids, x, e), - MarkedForm::SuspendedIf { hash, ids, c, t, e } => write!(f, "({:?}){{Sif {} {} {}}}", ids, c, t, e), - MarkedForm::SuspendedSymbol(name) => write!(f, "{}", name), - MarkedForm::SuspendedEnvLookup { name, id } => write!(f, "{:?}({:?}env)", name, id), - MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => write!(f, "{:?}({:?}{}{})", name, id, cdr_num, car), - MarkedForm::PrimComb { name, wrap_level, .. } => write!(f, "<{}{}>", name, wrap_level), - - //MarkedForm::DeriComb { ids, se, de, id, wrap_level, sequence_params, rest_params, body } => write!(f, "{:?}#[{}/{:?}/{:?}/{}/{:?}/{:?}/{}]", ids, se, de, id, wrap_level, sequence_params, rest_params, body), - MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => { - //let env_form = format!("{}", se); - write!(f, "{:?}#[{:?}/{:?}/{:?}/{}/{:?}/{:?}/{}]", ids, lookup_name, de, id, wrap_level, sequence_params, rest_params, body) - }, - - MarkedForm::SuspendedPair{ hash, ids, attempted, car, cdr } => { - //write!(f, "{:?}{:?}#{{{}", ids, attempted, car)?; - write!(f, "{{{}", car)?; - let mut traverse: Rc = Rc::clone(cdr); - loop { - match &*traverse { - MarkedForm::Pair(ref hash, ref ids, ref carp, ref cdrp) => { - write!(f, " {}", carp)?; - traverse = Rc::clone(cdrp); - }, - MarkedForm::Nil => { - write!(f, "}}")?; - return Ok(()); - }, - x => { - write!(f, ". {}}}", x)?; - return Ok(()); - }, - } - } - }, - } - } -} pub fn eval(e: Rc
, f: Rc) -> Rc { let mut e = e; @@ -228,13 +158,6 @@ pub fn eval(e: Rc, f: Rc) -> Rc { } } } -fn massoc(k: &str, v: Rc, l: Rc) -> Rc { - MarkedForm::new_pair( - MarkedForm::new_pair( - Rc::new(MarkedForm::Symbol(k.to_owned())), - v), - l) -} fn assoc(k: &str, v: Rc, l: Rc) -> Rc { Rc::new(Form::Pair( Rc::new(Form::Pair( @@ -413,955 +336,3 @@ pub fn root_env() -> Rc { ]) } -#[derive(Debug, Clone, Hash, Eq, PartialEq, Ord, PartialOrd)] -pub struct EnvID(i32); -#[derive(Debug, Clone, Copy, Hash, Eq, PartialEq, Ord, PartialOrd)] -pub struct MFHash(u64); -impl MFHash { - pub fn combine(&self, other: &MFHash) -> Self { - let mut h = DefaultHasher::new(); - "combine/".hash(&mut h); self.0.hash(&mut h); other.hash(&mut h); - MFHash(h.finish()) - } -} - -#[derive(Debug, Clone, Hash, Eq, PartialEq)] -pub enum NeededIds { - True(BTreeSet), - None(BTreeSet), - Some(BTreeSet,BTreeSet), -} -impl NeededIds { - fn new_true() -> Self { NeededIds::True( BTreeSet::new()) } - fn new_none() -> Self { NeededIds::None( BTreeSet::new()) } - fn new_single(i: EnvID) -> Self { NeededIds::Some(iter::once(i).collect(), BTreeSet::new()) } - fn needs_nothing(&self) -> bool { - match self { - NeededIds::True( under) => false, - NeededIds::None( under) => under.is_empty(), - NeededIds::Some(set,under) => false, - } - } - fn is_true(&self) -> bool { - match self { - NeededIds::True( under) => true, - NeededIds::None( under) => false, - NeededIds::Some(set,under) => false, - } - } - fn under(&self) -> &BTreeSet { - match self { - NeededIds::True(under) => under, - NeededIds::None(under) => under, - NeededIds::Some(needed,under) => under, - } - } - fn union(&self, other: &NeededIds) -> Self { - match self { - // add assert that otherhashes!={} -> hashes=={} - NeededIds::True(under) => NeededIds::True(under.union(other.under()).cloned().collect()), - NeededIds::None(under) => other.union_under(under), - NeededIds::Some(set, under) => match other { - NeededIds::True(ounder) => NeededIds::True( under.union(ounder).cloned().collect()), - NeededIds::None(ounder) => NeededIds::Some(set.clone(), under.union(ounder).cloned().collect()), - NeededIds::Some(oset,ounder) => NeededIds::Some(set.union(oset).cloned().collect(), under.union(ounder).cloned().collect()), - }, - } - } - fn union_without(&self, other: &NeededIds, without: EnvID) -> Self { - self.union(other).without(without) - } - fn without(self, without: EnvID) -> Self { - match self { - NeededIds::True(_) => self, - NeededIds::None(_) => self, - NeededIds::Some(set, under) => { - let new: BTreeSet = set.into_iter().filter(|x| *x != without).collect(); - if new.is_empty() { - NeededIds::None(under) - } else { - NeededIds::Some(new, under) - } - }, - } - } - fn without_under(self, without: &EnvID) -> Self { - match self { - NeededIds::True( under) => NeededIds::True( under.into_iter().filter(|x| x != without).collect()), - NeededIds::None( under) => NeededIds::None( under.into_iter().filter(|x| x != without).collect()), - NeededIds::Some(set, under) => NeededIds::Some(set, (under.into_iter().filter(|x| x != without).collect())), - } - } - fn union_under(&self, other: &BTreeSet) -> Self { - match self { - // add assert that otherhashes!={} -> hashes=={} - NeededIds::True( under) => NeededIds::True( other.union(under).cloned().collect()), - NeededIds::None( under) => NeededIds::None( other.union(under).cloned().collect()), - NeededIds::Some(set, under) => NeededIds::Some(set.clone(), other.union(under).cloned().collect()), - } - } - // This should kinda eliminate True, as it can't progress, but we still want true in the sense - // that it could contain all sorts of IDs - // True() should really only exist if kkkkkkkkkkkkkk - fn add_under(&self, u: EnvID) -> Self { - match self { - NeededIds::True( under) => NeededIds::True( under.iter().cloned().chain(iter::once(u)).collect()), - NeededIds::None( under) => NeededIds::None( under.iter().cloned().chain(iter::once(u)).collect()), - NeededIds::Some(set, under) => NeededIds::Some(set.clone(), under.iter().cloned().chain(iter::once(u)).collect()), - } - } - fn add_id(&self, i: EnvID) -> Self { - match self { - NeededIds::True( under) => NeededIds::True( under.clone()), - NeededIds::None( under) => NeededIds::Some(iter::once(i).collect(), under.clone()), - NeededIds::Some(set, under) => NeededIds::Some(set.iter().cloned().chain(iter::once(i)).collect(), under.clone()), - } - } - fn may_contain_id(&self, i: EnvID) -> bool { - match self { - NeededIds::True( under) => true, - NeededIds::None( under) => false, - NeededIds::Some(set, under) => set.contains(&i), - } - } -} - -#[derive(Clone)] -pub struct BCtx { - id_counter: i32 -} -impl BCtx { - pub fn new_id(mut self) -> (Self, EnvID) { - let new_id = EnvID(self.id_counter); - self.id_counter += 1; - (self, new_id) - } -} - - -// force is for drop_redundent_eval, which will be integrated now -// 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 -#[derive(Clone)] -pub struct DCtx { - e : Rc, - current_id: Option, - sus_env_stack: Rc>>, - sus_prm_stack: Rc>>, - real_set: Rc>, - fake_set: Rc>, - fake_if_set: Rc>, - ident: usize, -} -impl DCtx { - pub fn copy_set_env(&self, e: &Rc) -> Self { - DCtx { e: Rc::clone(e), current_id: self.current_id.clone(), sus_env_stack: Rc::clone(&self.sus_env_stack), sus_prm_stack: Rc::clone(&self.sus_prm_stack), real_set: Rc::clone(&self.real_set), fake_set: Rc::clone(&self.fake_set), fake_if_set: Rc::clone(&self.fake_if_set), ident: self.ident+1 } - } - //pub fn copy_push_hash(&self, h: MFHash) -> Result { - //if !self.current.contains(&h) { - //Ok(DCtx { e: Rc::clone(&self.e), sus_env_stack: Rc::clone(&self.sus_env_stack), sus_prm_stack: Rc::clone(&self.sus_prm_stack), real_set: Rc::clone(&self.real_set), current: Rc::new(self.current.iter().cloned().chain(iter::once(h)).collect()), ident: self.ident }) - //} else { - //Err("hash already in") - //} - //} - pub fn copy_push_frame(&self, id: EnvID, se: &Rc, de: &Option, e: Option>, rest_params: &Option, prms: Option>, body: &Rc) -> Result { - let mut sus_env_stack = Rc::clone(&self.sus_env_stack); - let mut sus_prm_stack = Rc::clone(&self.sus_prm_stack); - let mut real_set = (*self.real_set).clone(); - let mut fake_set = (*self.fake_set).clone(); - if self.fake_if_set.contains(&id) { - println!("Fake if real rec stopper"); - return Err(id); - } - if (e.is_some() || prms.is_some()) { - real_set.insert(id.clone()); - // We're not actually not under fake still! - //fake_set.remove(&id); - } else { - if fake_set.contains(&id) { - return Err(id.clone()); - } - fake_set.insert(id.clone()); - real_set.remove(&id); - } - let inner_env = if let Some(de) = de { - let de_val = if let Some(e) = e { - Rc::make_mut(&mut sus_env_stack).insert(id.clone(), Rc::clone(&e)); - e - } else { - Rc::make_mut(&mut sus_env_stack).remove(&id); - Rc::new(MarkedForm::SuspendedEnvLookup { name: Some(de.clone()), id: id.clone() }) - }; - massoc(de, de_val, Rc::clone(se)) - } else { Rc::clone(se) }; - // not yet supporting sequence params - let inner_env = if let Some(p) = rest_params { - let p_val = if let Some(prms) = prms { - Rc::make_mut(&mut sus_prm_stack).insert(id.clone(), Rc::clone(&prms)); - prms - } else { - Rc::make_mut(&mut sus_prm_stack).remove(&id); - Rc::new(MarkedForm::SuspendedParamLookup { name: Some(p.clone()), id: id.clone(), cdr_num: 0, car: false }) - }; - massoc(p, p_val, inner_env) - } else { inner_env }; - Ok(DCtx { e: inner_env, current_id: Some(id), sus_env_stack, sus_prm_stack, real_set: Rc::new(real_set), fake_set: Rc::new(fake_set), fake_if_set: Rc::clone(&self.fake_if_set), ident: self.ident+1 }) - } - pub fn copy_push_fake_if(&self) -> Self { - let new_fake_if_set = if let Some(current_id) = self.current_id.as_ref() { - let mut x = (*self.fake_if_set).clone(); - x.insert(current_id.clone()); - Rc::new(x) - } else { Rc::clone(&self.fake_if_set) }; - DCtx { e: Rc::clone(&self.e), current_id: self.current_id.clone(), sus_env_stack: Rc::clone(&self.sus_env_stack), sus_prm_stack: Rc::clone(&self.sus_prm_stack), real_set: Rc::clone(&self.real_set), fake_set: Rc::clone(&self.fake_set), fake_if_set: new_fake_if_set, ident: self.ident+1 } - } - - pub fn can_progress(&self, ids: NeededIds) -> bool { - // check if ids is true || ids intersection EnvIDs in our stacks is non empty || ids.hashes - current is non empty - match ids { - NeededIds::True( under) => under.is_empty() || (!(self.fake_set.union(&self.fake_if_set).cloned().collect::>()).is_superset(&under)), //true, - if we have hashes, that means we don't know what's in but can't progress b/c hashes - NeededIds::None( under) => !(self.fake_set.union(&self.fake_if_set).cloned().collect::>()).is_superset(&under), - NeededIds::Some(ids,under) => (!self.real_set.is_disjoint(&ids)) || (!(self.fake_set.union(&self.fake_if_set).cloned().collect::>()).is_superset(&under)), - } - } -} - -pub fn new_base_ctxs() -> (BCtx,DCtx) { - let bctx = BCtx { id_counter: 0 }; - let (bctx, root_env) = mark(root_env(), bctx); - (bctx, DCtx { e: root_env, current_id: None, sus_env_stack: Rc::new(BTreeMap::new()), sus_prm_stack: Rc::new(BTreeMap::new()), real_set: Rc::new(BTreeSet::new()), fake_set: Rc::new(BTreeSet::new()), fake_if_set: Rc::new(BTreeSet::new()), ident: 0 } ) -} - -#[derive(Debug, Clone, Hash, Eq, PartialEq)] -pub enum Attempted { - True(Option), - False, -} -#[derive(Debug, Clone, Eq, PartialEq)] -pub enum MarkedForm { - Nil, - Int(i32), - Bool(bool), - Symbol(String), - Pair(MFHash, NeededIds, Rc,Rc), - - SuspendedSymbol(String), - SuspendedParamLookup { name: Option, id: EnvID, cdr_num: i32, car: bool }, - SuspendedEnvLookup { name: Option, id: EnvID }, - // resume hash is folded into ids - SuspendedPair { hash: MFHash, ids: NeededIds, attempted: Attempted, car: Rc, cdr: Rc}, - - SuspendedEnvEval { hash: MFHash, ids: NeededIds, x: Rc, e: Rc }, - SuspendedIf { hash: MFHash, ids: NeededIds, c: Rc, t: Rc, e: Rc }, - - PrimComb { name: String, nonval_ok: bool, takes_de: bool, wrap_level: i32, f: fn(BCtx,DCtx,Rc) -> Result<(BCtx,Rc),String> }, - DeriComb { hash: MFHash, lookup_name: Option, ids: NeededIds, se: Rc, de: Option, id: EnvID, wrap_level: i32, sequence_params: Vec, rest_params: Option, body: Rc }, -} -impl MarkedForm { - pub fn new_suspended_env_eval(x: Rc, e: Rc) -> Rc { - let mut h = DefaultHasher::new(); - "SuspendedEnvEval(x,e)".hash(&mut h); x.hash().hash(&mut h); e.hash().hash(&mut h); - Rc::new(MarkedForm::SuspendedEnvEval{ hash: MFHash(h.finish()), ids: e.ids(), x, e }) - } - pub fn new_suspended_if(c: Rc, t: Rc, e: Rc, rec_under: Option) -> Rc { - let mut h = DefaultHasher::new(); - "SuspendedIf(c,t,e)".hash(&mut h); c.hash().hash(&mut h); t.hash().hash(&mut h); e.hash().hash(&mut h); - let new_ids = c.ids().union(&t.ids()).union(&e.ids()); - let new_ids = if let Some(rec_under) = rec_under { new_ids.add_under(rec_under) } else { new_ids }; - Rc::new(MarkedForm::SuspendedIf{ hash: MFHash(h.finish()), ids: new_ids, c, t, e }) - } - pub fn new_pair(car: Rc, cdr: Rc) -> Rc { - let mut h = DefaultHasher::new(); - "Pair(ids,car,cdr)".hash(&mut h); car.hash().hash(&mut h); cdr.hash().hash(&mut h); - let new_ids = car.ids().union(&cdr.ids()); - //println!("For new pair, union of {:?} and {:?} is {:?}", car.ids(), cdr.ids(), new_ids); - Rc::new(MarkedForm::Pair(MFHash(h.finish()), new_ids, car, cdr)) - } - pub fn new_suspended_pair(attempted: Attempted, car: Rc, cdr: Rc, rec_under: Option) -> Rc { - let mut h = DefaultHasher::new(); - "SuspendedPair".hash(&mut h); attempted.hash(&mut h); car.hash().hash(&mut h); cdr.hash().hash(&mut h); - let ids = car.ids().union(&cdr.ids()); - let ids = match ids { - NeededIds::True(_) => ids, - NeededIds::None(under) => match &attempted { - Attempted::False => NeededIds::True(under), - Attempted::True(Some(oids)) => oids.union_under(&under), - Attempted::True(None) => NeededIds::None(under), - }, - NeededIds::Some(_,_) => ids, - }; - let ids = if let Some(rec_under) = rec_under { ids.add_under(rec_under) } else { ids }; - Rc::new(MarkedForm::SuspendedPair{ hash: MFHash(h.finish()), attempted, ids, car, cdr }) - } - pub fn new_deri_comb(se: Rc, lookup_name: Option, de: Option, id: EnvID, wrap_level: i32, sequence_params: Vec, rest_params: Option, body: Rc, rec_under: Option) -> Rc { - let mut h = DefaultHasher::new(); - "DeriComb".hash(&mut h); se.hash().hash(&mut h); de.hash(&mut h); id.hash(&mut h); wrap_level.hash(&mut h); - sequence_params.hash(&mut h); rest_params.hash(&mut h); body.hash().hash(&mut h); - let ids = se.ids().union_without(&body.ids(), id.clone()); - let ids = if let Some(rec_under) = rec_under { - ids.add_under(rec_under) - } else { - ids.without_under(&id) - }; - Rc::new(MarkedForm::DeriComb{ hash: MFHash(h.finish()), lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body }) - } - pub fn tag_name(self: &Rc, name: &str) -> Rc { - match &**self { - MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => - Rc::new(MarkedForm::DeriComb { hash: hash.clone(), lookup_name: Some(name.to_owned()), ids: ids.clone(), se: Rc::clone(se), de: de.clone(), id: id.clone(), wrap_level: *wrap_level, sequence_params: sequence_params.clone(), rest_params: rest_params.clone(), body: Rc::clone(body) }), - _ => Rc::clone(self), - } - } - pub fn hash(&self) -> MFHash { - let mut h = DefaultHasher::new(); - { - let state = &mut h; - match self { - MarkedForm::Nil => { "Nil".hash(state); }, - MarkedForm::Int(i) => { "Int(i)".hash(state); i.hash(state); }, - MarkedForm::Bool(b) => { "Bool(b)".hash(state); b.hash(state); }, - MarkedForm::Symbol(s) => { "Symbol(s)".hash(state); s.hash(state); }, - MarkedForm::Pair(hash,ids,car,cdr) => { return *hash; }, - MarkedForm::SuspendedSymbol(name) => { "SuspendedSymbol(name)".hash(state); name.hash(state); }, - MarkedForm::SuspendedParamLookup { name, id, cdr_num, car }=> { "SuspendedParamLookup".hash(state); name.hash(state); id.hash(state); cdr_num.hash(state); car.hash(state); }, - MarkedForm::SuspendedEnvEval { hash, .. } => { return *hash; }, - MarkedForm::SuspendedIf { hash, .. } => { return *hash; }, - MarkedForm::SuspendedEnvLookup { name, id } => { "SuspendedEnvLookup".hash(state); name.hash(state); id.hash(state); }, - MarkedForm::SuspendedPair{ hash, .. } => { return *hash; }, - MarkedForm::PrimComb { name, wrap_level, .. } => { "PrimComb".hash(state); name.hash(state); wrap_level.hash(state); }, - MarkedForm::DeriComb { hash, .. } => { return *hash; }, - } - } - MFHash(h.finish()) - } - pub fn wrap_level(&self) -> Option { - match self { - MarkedForm::PrimComb { wrap_level, .. } => Some(*wrap_level), - MarkedForm::DeriComb { wrap_level, .. } => Some(*wrap_level), - _ => None, - } - } - pub fn decrement_wrap_level(&self) -> Option> { - match self { - MarkedForm::PrimComb { name, nonval_ok, takes_de, wrap_level, f } => Some(Rc::new(MarkedForm::PrimComb { name: name.clone(), nonval_ok: *nonval_ok, takes_de: *takes_de, wrap_level: wrap_level-1, f: *f })), - MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => - Some(Rc::new(MarkedForm::DeriComb { hash: hash.clone(), lookup_name: lookup_name.clone(), 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) })), - //Some(MarkedForm::new_deri_comb(Rc::clone(se), lookup_name.clone(), de.clone(), id.clone(), wrap_level-1, sequence_params.clone(), rest_params.clone(), Rc::clone(body))), - - _ => None, - } - } - pub fn ids(&self) -> NeededIds { - match self { - MarkedForm::Nil => NeededIds::new_none(), - MarkedForm::Int(i) => NeededIds::new_none(), - MarkedForm::Bool(b) => NeededIds::new_none(), - MarkedForm::Symbol(s) => NeededIds::new_none(), - MarkedForm::Pair(hash,ids,car,cdr) => ids.clone(), - MarkedForm::SuspendedSymbol(name) => NeededIds::new_true(), - MarkedForm::SuspendedEnvLookup { id, .. } => NeededIds::new_single(id.clone()), - MarkedForm::SuspendedParamLookup { id, .. } => NeededIds::new_single(id.clone()), - MarkedForm::SuspendedEnvEval { ids, ..} => ids.clone(), - MarkedForm::SuspendedIf { ids, ..} => ids.clone(), - MarkedForm::SuspendedPair{ ids, .. } => ids.clone(), - MarkedForm::PrimComb { .. } => NeededIds::new_none(), - 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, - MarkedForm::Int(i) => return true, - MarkedForm::Bool(b) => return true, - MarkedForm::Symbol(s) => return true, - MarkedForm::SuspendedSymbol(name) => return false, - MarkedForm::SuspendedEnvLookup { id, .. } => return false, - MarkedForm::SuspendedParamLookup { id, .. } => return false, - MarkedForm::SuspendedEnvEval { ids, ..} => return false, - MarkedForm::SuspendedIf { ids, ..} => return false, - MarkedForm::SuspendedPair{ ids, .. } => return false, - MarkedForm::PrimComb { .. } => return true, - // TODO ths might be wrong as it could have captured some suspended computation - // On the other hand, that would surely show up in ids, right? - MarkedForm::Pair(hash,ids,car,cdr) => ids.clone(), - MarkedForm::DeriComb { ids, .. } => ids.clone(), - } { - NeededIds::True(hashes) => false, - NeededIds::None(hashes) => true, - NeededIds::Some(ids,hashes) => false, - } - } - pub fn unval(self: &Rc) -> Result, &'static str> { - match &**self { - MarkedForm::Nil => Ok(Rc::clone(self)), - MarkedForm::Int(i) => Ok(Rc::clone(self)), - MarkedForm::Bool(b) => Ok(Rc::clone(self)), - MarkedForm::Symbol(s) => Ok(Rc::new(MarkedForm::SuspendedSymbol(s.clone()))), - MarkedForm::Pair(hash,ids,car,cdr) => Ok(MarkedForm::new_suspended_pair( Attempted::False, car.unval()?, Rc::clone(cdr), None)), - MarkedForm::SuspendedSymbol(name) => Err("trying to unval a suspended symbol"), - MarkedForm::SuspendedEnvLookup { .. } => Err("trying to unval a suspended env lookup"), - MarkedForm::SuspendedParamLookup { .. } => Err("trying to unval a suspended param lookup"), - MarkedForm::SuspendedEnvEval { .. } => Err("trying to unval a suspended env eval"), - MarkedForm::SuspendedIf { .. } => Err("trying to unval a suspended if"), - MarkedForm::SuspendedPair{ ids, .. } => Err("trying to unval a suspended pair"), - MarkedForm::PrimComb { .. } => Ok(Rc::clone(self)), - MarkedForm::DeriComb { .. } => Ok(Rc::clone(self)), - } - } - pub fn truthy(&self) -> Result { - match self { - MarkedForm::Nil => Ok(false), - MarkedForm::Int(i) => Ok(true), - MarkedForm::Bool(b) => Ok(*b), - MarkedForm::Symbol(s) => Ok(true), - MarkedForm::Pair(hash,ids,car,cdr) => Ok(true), - MarkedForm::SuspendedSymbol(name) => Err("trying to truthy a suspended symbol"), - MarkedForm::SuspendedEnvLookup { .. } => Err("trying to truthy a suspended env lookup"), - MarkedForm::SuspendedParamLookup { .. } => Err("trying to truthy a suspended param lookup"), - MarkedForm::SuspendedEnvEval { .. } => Err("trying to truthy a suspended env eval"), - MarkedForm::SuspendedIf { .. } => Err("trying to truthy a suspended if"), - MarkedForm::SuspendedPair{ ids, .. } => Err("trying to truthy a suspended pair"), - MarkedForm::PrimComb { .. } => Ok(true), - MarkedForm::DeriComb { .. } => Ok(true), - } - } - pub fn sym(&self) -> Result<&str,&'static str> { - match self { - MarkedForm::Symbol(s) => Ok(s), - _ => Err("not a symbol"), - } - } - pub fn int(&self) -> Result { - match self { - MarkedForm::Int(i) => Ok(*i), - _ => Err("not a int"), - } - } - pub fn car(&self) -> Result, String> { - match self { - MarkedForm::Pair(hash,ids,car,cdr) => Ok(Rc::clone(car)), - MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } if !car => Ok(Rc::new(MarkedForm::SuspendedParamLookup { name: name.clone(), id: id.clone(), cdr_num: *cdr_num, car: true })), - _ => Err(format!("not a pair for car: {}", self)), - } - } - pub fn cdr(&self) -> Result, String> { - match self { - MarkedForm::Pair(hash,ids,car,cdr) => Ok(Rc::clone(cdr)), - MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => Ok(Rc::new(MarkedForm::SuspendedParamLookup { name: name.clone(), id: id.clone(), cdr_num: *cdr_num+1, car: *car })), - _ => Err(format!("not a pair for cdr: {}", self)), - } - } -} - -pub fn mark(form: Rc, bctx: BCtx) -> (BCtx, Rc) { - match &*form { - Form::Nil => (bctx, Rc::new(MarkedForm::Nil)), - Form::Int(i) => (bctx, Rc::new(MarkedForm::Int(*i))), - Form::Bool(b) => (bctx, Rc::new(MarkedForm::Bool(*b))), - Form::Symbol(s) => (bctx, Rc::new(MarkedForm::Symbol(s.clone()))), - Form::Pair(car, cdr) => { - let (bctx, car) = mark(Rc::clone(car),bctx); - let (bctx, cdr) = mark(Rc::clone(cdr),bctx); - (bctx, MarkedForm::new_pair(car, cdr)) - }, - Form::DeriComb { se, de, params, body } => { - panic!(); - }, - Form::PrimComb(name, _f) => { - (bctx, match &name[..] { - "eval" => Rc::new(MarkedForm::PrimComb { name: "eval".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - println!("Ok, this is inside eval looking at {}", p); - if !p.car()?.is_value() { - Err("can't eval without form being a value, since we're changing the env".to_owned()) - } else { - println!("Ok, returning new suspended env eval with"); - println!("\t{} {}", p.car()?.unval()?, p.cdr()?.car()?); - Ok((bctx, MarkedForm::new_suspended_env_eval(p.car()?.unval()?, p.cdr()?.car()?))) - } - }}), - "vau" => Rc::new(MarkedForm::PrimComb { name: "vau".to_owned(), nonval_ok: false, 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()?; - let se = Rc::clone(&dctx.e); - let (bctx, id) = bctx.new_id(); - let wrap_level = 0; - let sequence_params = vec![]; - let rest_params = Some(params); - Ok((bctx, MarkedForm::new_deri_comb( se, None, de, id, wrap_level, sequence_params, rest_params, body, None ))) - }}), - "if" => Rc::new(MarkedForm::PrimComb { name: "if".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 0, f: |bctx, dctx, p| { - Ok((bctx, MarkedForm::new_suspended_if(p.car()?.unval()?, p.cdr()?.car()?.unval()?, p.cdr()?.cdr()?.car()?.unval()?, None))) - }}), - // TODO: handle these in the context of paritals - "cons" => Rc::new(MarkedForm::PrimComb { name: "cons".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let h = p.car()?; - //println!("Consing with head {}", h); - let t = p.cdr()?.car()?; - //println!("Consing with tail {}", t); - Ok((bctx, MarkedForm::new_pair(h, t))) - }}), - "car" => Rc::new(MarkedForm::PrimComb { name: "car".to_owned(), nonval_ok: true, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, p.car()?.car()?)) - }}), - "cdr" => Rc::new(MarkedForm::PrimComb { name: "cdr".to_owned(), nonval_ok: true, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, p.car()?.cdr()?)) - }}), - "quote" => Rc::new(MarkedForm::PrimComb { name: "quote".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 0, f: |bctx, dctx, p| { - Ok((bctx, p.car()?)) - }}), - "debug" => Rc::new(MarkedForm::PrimComb { name: "debug".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - // This one is a bit weird - we put the wrap level at 1 so both sides are pe'd, - // and always returns Err so that it's not optimized away - Err("debug can't be partial-evaluated away".to_owned()) - }}), - // ditto - "assert" => Rc::new(MarkedForm::PrimComb { name: "assert".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let cond = p.car()?; - if !cond.truthy()? { - println!("Assert failed: {:?}", cond); - } - assert!(cond.truthy()?); - Ok((bctx, p.cdr()?.car()?)) - }}), - "=" => Rc::new(MarkedForm::PrimComb { name: "=".to_owned(), nonval_ok: false, 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); - // TODO: double check that this ignores ids etc. It should, since - // wrap_level=1 should mean that everything's a value - // also, it should just check by hash then? - Ok((bctx, Rc::new(MarkedForm::Bool(a == b)))) - }}), - "<" => Rc::new(MarkedForm::PrimComb { name: "<".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?; - let b = p.cdr()?.car()?; - Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? < b.int()?)))) - }}), - ">" => Rc::new(MarkedForm::PrimComb { name: ">".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?; - let b = p.cdr()?.car()?; - Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? > b.int()?)))) - }}), - "<=" => Rc::new(MarkedForm::PrimComb { name: "<=".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?; - let b = p.cdr()?.car()?; - Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? <= b.int()?)))) - }}), - ">=" => Rc::new(MarkedForm::PrimComb { name: ">=".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?; - let b = p.cdr()?.car()?; - Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? >= b.int()?)))) - }}), - "+" => Rc::new(MarkedForm::PrimComb { name: "+".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a + b)))) - }}), - "-" => Rc::new(MarkedForm::PrimComb { name: "-".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a - b)))) - }}), - "*" => Rc::new(MarkedForm::PrimComb { name: "*".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a * b)))) - }}), - "/" => Rc::new(MarkedForm::PrimComb { name: "/".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a / b)))) - }}), - "%" => Rc::new(MarkedForm::PrimComb { name: "%".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a % b)))) - }}), - "&" => Rc::new(MarkedForm::PrimComb { name: "&".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a & b)))) - }}), - "|" => Rc::new(MarkedForm::PrimComb { name: "|".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a | b)))) - }}), - "^" => Rc::new(MarkedForm::PrimComb { name: "^".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - let a = p.car()?.int()?; - let b = p.cdr()?.car()?.int()?; - Ok((bctx, Rc::new(MarkedForm::Int(a ^ b)))) - }}), - "comb?" => Rc::new(MarkedForm::PrimComb { name: "comb?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { - MarkedForm::PrimComb { .. } => true, - MarkedForm::DeriComb { .. } => true, - _ => false, - })))) - }}), - "pair?" => Rc::new(MarkedForm::PrimComb { name: "pair?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { - MarkedForm::Pair(_h, _i, _a,_b) => true, - _ => false, - })))) - }}), - "symbol?" => Rc::new(MarkedForm::PrimComb { name: "symbol?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { - MarkedForm::Symbol(_) => true, - _ => false, - })))) - }}), - "int?" => Rc::new(MarkedForm::PrimComb { name: "int?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, 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(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { - MarkedForm::Bool(_) => true, - _ => false, - })))) - }}), - "nil?" => Rc::new(MarkedForm::PrimComb { name: "nil?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { - Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { - MarkedForm::Nil => true, - _ => false, - })))) - }}), - _ => panic!("gah! don't have partial eval version of {}", name), - }) - }, - } -} - -pub fn combiner_return_ok(x: &Rc, check_id: Option) -> bool { - match match &**x { - MarkedForm::Nil => return true, - MarkedForm::Int(_) => return true, - MarkedForm::Bool(_) => return true, - MarkedForm::Symbol(_) => return true, - // Hmm, we allow Pair to included suspended now... - // so now we have to be extra careful - MarkedForm::Pair(h,ids,car,cdr) => ids, - - MarkedForm::SuspendedSymbol(_) => return false, - MarkedForm::SuspendedParamLookup { id, .. } => return check_id.map(|check_id| *id != check_id).unwrap_or(true), - MarkedForm::SuspendedEnvLookup { id, .. } => return check_id.map(|check_id| *id != check_id).unwrap_or(true), - - MarkedForm::SuspendedEnvEval { e, .. } => return combiner_return_ok(e, check_id), - MarkedForm::SuspendedIf { c, t, e, .. } => return combiner_return_ok(c, check_id.clone()) && - combiner_return_ok(t, check_id.clone()) && - combiner_return_ok(e, check_id), - MarkedForm::SuspendedPair { car, cdr, .. } => { - // expand with (func ...params) | func doesn't take de and func+params are return ok - return false - }, - - MarkedForm::PrimComb { .. } => return true, - MarkedForm::DeriComb { ids, .. } => ids, - } { - NeededIds::True( _under) => false, - NeededIds::None( _under) => true, - NeededIds::Some(ids,_under) => check_id.map(|check_id| !ids.contains(&check_id)).unwrap_or(true), - } - //; Handles let 4.3 through macro level leaving it as ( 13) - //; need handling of symbols (which is illegal for eval but ok for calls) to push it farther - //(combiner_return_ok (rec-lambda combiner_return_ok (func_result env_id) - // (cond ((not (later_head? func_result)) (not (check_for_env_id_in_result env_id func_result))) - // ; special cases now - // ; *(veval body {env}) => (combiner_return_ok {env}) - // ; The reason we don't have to check body is that this form is only creatable in ways that body was origionally a value and only need {env} - // ; Either it's created by eval, in which case it's fine, or it's created by something like (eval (array veval x de) de2) and the array has checked it, - // ; or it's created via literal vau invocation, in which case the body is a value. - // ((and (marked_array? func_result) - // (prim_comb? (idx (.marked_array_values func_result) 0)) - // (= 'veval (.prim_comb_sym (idx (.marked_array_values func_result) 0))) - // (= 3 (len (.marked_array_values func_result))) - // (combiner_return_ok (idx (.marked_array_values func_result) 2) env_id)) true) - // ; (func ...params) => (and (doesn't take de func) (foldl combiner_return_ok (cons func params))) - // ; - // ((and (marked_array? func_result) - // (not (comb_takes_de? (idx (.marked_array_values func_result) 0) (len (.marked_array_values func_result)))) - // (foldl (lambda (a x) (and a (combiner_return_ok x env_id))) true (.marked_array_values func_result))) true) - - // ; So that's enough for macro like, but we would like to take it farther - // ; For like (let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a))))) - // ; we get to (+ 13 x 12) not being a value, and it reconstructs - // ; ( 13) - // ; and that's what eval gets, and eval then gives up as well. - - // ; That will get caught by the above cases to remain the expansion ( 13), - // ; but ideally we really want another case to allow (+ 13 x 12) to bubble up - // ; I think it would be covered by the (func ...params) case if a case is added to allow symbols to be bubbled up if their - // ; needed for progress wasn't true or the current environment, BUT this doesn't work for eval, just for functions, - // ; since eval changes the entire env chain (but that goes back to case 1, and might be eliminated at compile if it's an env reachable from the func). - // ; - // ; - // ; Do note a key thing to be avoided is allowing any non-val inside a comb, since that can cause a fake env's ID to - // ; reference the wrong env/comb in the chain. - // ; We do allow calling eval with a fake env, but since it's only callable withbody value and is strict (by calling this) - // ; about it's return conditions, and the env it's called with must be ok in the chain, and eval doesn't introduce a new scope, it works ok. - // ; We do have to be careful about allowing returned later symbols from it though, since it could be an entirely different env chain. - - // (true false) - // ) - //)) -} - -pub fn partial_eval(bctx_in: BCtx, dctx_in: DCtx, form: Rc) -> (BCtx,Rc) { - let mut bctx = bctx_in; - let mut dctx = dctx_in; - let mut next_form = Some(form); - let mut force = false; - loop { - let x = next_form.take().unwrap(); - //println!("{:ident$}PE: {}", "", x, ident=dctx.ident*4); - if !(force || dctx.can_progress(x.ids())) { - //println!("{:ident$}Shouldn't go!", "", ident=dctx.ident*4); - return (bctx, x); - } - //println!("{:ident$}({}) PE(force:{}) {:?} (because of {:?})", "", dctx.ident, force, x, x.ids(), ident=dctx.ident*4); - println!("{:ident$}({}) PE(force:{}) {} (because of {:?})", "", dctx.ident, force, x, x.ids(), ident=dctx.ident*4); - match partial_eval_step(&x, force, bctx.clone(), &mut dctx) { - Ok((new_bctx,new_force,new_form)) => { - bctx = new_bctx; force = new_force; next_form = Some(new_form); - println!("{:ident$}({}) was ok, result was {}", "", dctx.ident, next_form.as_ref().unwrap(), ident=dctx.ident*4); - } - Err(msg) => { - println!("{:ident$}({}) was error, reconstructing (error was {})", "", dctx.ident, msg, ident=dctx.ident*4); - return (bctx, x); - } - } - // basic Drop redundent veval - // Old one was recursive over parameters to combs, which we might need, since the redundent veval isn't captured by - // ids. TODO! - if let Some(form) = next_form.as_ref() { - if let MarkedForm::SuspendedEnvEval { x, e, .. } = &**form { - if (combiner_return_ok(&x, None) || *e == dctx.e) { - next_form = Some(Rc::clone(x)); - force = true; - } - } - } - } -} -fn partial_eval_step(x: &Rc, forced: bool, bctx: BCtx, dctx: &mut DCtx) -> Result<(BCtx,bool,Rc), String> { - //println!("{:ident$}({}) {}", "", dctx.ident, x, ident=dctx.ident*4); - match &**x { - MarkedForm::Pair(h,ids,car,cdr) => { - //println!("{:ident$}pair ({}) {}", "", dctx.ident, x, ident=dctx.ident*4); - let (bctx, car) = partial_eval(bctx, dctx.clone(), Rc::clone(car)); - let (bctx, cdr) = partial_eval(bctx, dctx.clone(), Rc::clone(cdr)); - Ok((bctx, false, MarkedForm::new_pair(car, cdr))) - }, - MarkedForm::SuspendedSymbol(name) => { - println!("Lookin up symbol {}", name); - let mut t = Rc::clone(&dctx.e); - while name != t.car()?.car()?.sym()? { - t = t.cdr()?; - } - println!("found it, pair is {}", t.car()?); - Ok((bctx, false, t.car()?.cdr()?.tag_name(name))) - }, - MarkedForm::SuspendedEnvLookup { name, id } => { - if let Some(v) = dctx.sus_env_stack.get(id) { - Ok((bctx, false, if let Some(name) = name { v.tag_name(name) } else { Rc::clone(v) })) - } else { - Err("failed env lookup (forced)".to_owned()) - } - }, - MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => { - if let Some(v) = dctx.sus_prm_stack.get(id) { - let mut translated_value = if let Some(name) = name { v.tag_name(name) } else { Rc::clone(v) }; - for i in 0..*cdr_num { - translated_value = translated_value.cdr()?; - } - if *car { - translated_value = translated_value.car()?; - } - Ok((bctx, false, translated_value)) - } else { - Err("failed param lookup (forced)".to_owned()) - } - }, - MarkedForm::SuspendedEnvEval { x, e, .. } => { - // this bit is a little tricky - we'd like to tail call, but we can't lose our env - // if it fails. - let (bctx, e) = partial_eval(bctx, dctx.clone(), Rc::clone(e)); - let (bctx, x) = partial_eval(bctx, dctx.copy_set_env(&e), Rc::clone(x)); - if x.is_value() { - Ok((bctx, false, x)) - } else { - Ok((bctx, false, MarkedForm::new_suspended_env_eval(x, e))) - } - // Note also that we drop redundent vevals at the bottom of the loop tail-call loop - // with force - }, - MarkedForm::SuspendedIf { c, t, e, .. } => { - let (bctx, c) = partial_eval(bctx, dctx.clone(), Rc::clone(c)); - if let Ok(b) = c.truthy() { - if b { - Ok((bctx, false, Rc::clone(t))) - } else { - Ok((bctx, false, Rc::clone(e))) - } - } else { - // TODO: Need to add hash checking to this one - //let new_if_hash = MarkedForm::new_suspended_if(Rc::clone(&c), Rc::clone(t), Rc::clone(e), None).hash(); - //println!("IF HASH {:?} ? {:?}", new_if_hash, dctx.current); - //match dctx.copy_push_hash(new_if_hash.clone()) { - //Ok(dctx) => { - //println!("SIF hash fine, doing both subs"); - let dctx = dctx.copy_push_fake_if(); - let (bctx, t) = partial_eval(bctx, dctx.clone(), Rc::clone(t)); - let (bctx, e) = partial_eval(bctx, dctx.clone(), Rc::clone(e)); - Ok((bctx, false, MarkedForm::new_suspended_if(c,t,e, None))) - //}, - //Err(rec_stop_msg) => { - //println!("SIF hash stopped {}", rec_stop_msg); - //Ok((bctx, false, MarkedForm::new_suspended_if(c, Rc::clone(t), Rc::clone(e), Some(new_if_hash)))) - //} - //} - } - }, - MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => { - // TODO: figure out wrap level, sequence params, etc - if forced || !se.ids().needs_nothing() { - //if ids.is_true() || !se.ids().needs_nothing() { - let old_se_ids = se.ids(); - let se = if !se.ids().needs_nothing() { - // the current env is our new se - Rc::clone(&dctx.e) - } else { - Rc::clone(se) - }; - - let ident_amount = dctx.ident*4; - - match dctx.copy_push_frame(id.clone(), &se, &de, None, &rest_params, None, body) { - Ok(inner_dctx) => { - println!("{:ident$}Doing a body deri for {:?} because ({} || {:?}) which is {}", "", lookup_name, forced, old_se_ids, x, ident=ident_amount); - println!("{:ident$}and also body ids is {:?}", "", body.ids(), ident=ident_amount); - //println!("{:ident$}and fake is {:?} and fake_if is {:?}", "", , ident=ident_amount); - let (bctx, body) = partial_eval(bctx, inner_dctx, Rc::clone(&body)); - println!("{:ident$}result was {}", "", body, ident=ident_amount); - Ok((bctx, false, MarkedForm::new_deri_comb(se, lookup_name.clone(), de.clone(), id.clone(), *wrap_level, sequence_params.clone(), rest_params.clone(), body, None))) - }, - Err(rec_stop_under) => { - println!("{:ident$}call of {:?} failed b/c rec_stop_under", "", lookup_name, ident=dctx.ident*4); - //maybe_rec_hash = Some(rec_stop_hash); - // TODO: should this mark the hash on DeriComb? - //Err("recursion stopped in dericomb".to_owned()) - Ok((bctx, false, MarkedForm::new_deri_comb(se, lookup_name.clone(), de.clone(), id.clone(), *wrap_level, sequence_params.clone(), rest_params.clone(), Rc::clone(body), Some(rec_stop_under)))) - //Ok((bctx, false, MarkedForm::new_suspended_pair( new_attempted, car, cdr, maybe_rec_hash ))) - }, - } - } else { - //panic!("impossible {}", x); - Err("impossible!?".to_owned()) - } - }, - MarkedForm::SuspendedPair { hash, 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(); - let mut maybe_rec_under = None; - let mut return_ok = false; - while let Some(wrap_level) = car.wrap_level() { - if wrap_level > 0 { - fn map_unval_peval(bctx: BCtx, dctx: DCtx, x: Rc) -> Result<(BCtx,Rc),String> { - match &*x { - MarkedForm::Pair(h, ids, x_car, x_cdr) => { - let (bctx, new_x_car) = partial_eval(bctx, dctx.clone(), x_car.unval()?); - let (bctx, new_x_cdr) = map_unval_peval(bctx, dctx.clone(), Rc::clone(x_cdr))?; - return Ok((bctx, MarkedForm::new_pair(new_x_car, new_x_cdr))); - }, - MarkedForm::Nil => return Ok((bctx,x)), - _ => return Err("not a list".to_owned()), - } - } - match map_unval_peval(bctx.clone(), dctx.clone(), Rc::clone(&cdr)) { - Ok((new_bctx, new_cdr)) => { - car = car.decrement_wrap_level().unwrap(); - cdr = new_cdr; - bctx = new_bctx; - } - Err(msg) => { - println!("{:ident$} evaling parameters failed b/c {}", "", msg, ident=dctx.ident*4); - break; - } - } - } else { - // check to see if can do call - // We might want to enable not pure values for cons/car/cdr? - match &*car { - MarkedForm::PrimComb { name, nonval_ok, takes_de, wrap_level, f} => { - if !nonval_ok && !cdr.is_value() { - break; - } - new_attempted = Attempted::True(if *takes_de { Some(dctx.e.ids()) } else { None }); - let ident_amount = dctx.ident*4; - println!("{:ident$}doing a call eval of {}", "", name, ident=ident_amount); - println!("{:ident$}parameters {} are? a val because {:?}", "", cdr, cdr.ids(), ident=ident_amount); - match f(bctx.clone(), dctx.clone(), Rc::clone(&cdr)) { - Ok((bctxp, r)) => { - // force true b/c might be a tail call - return Ok((bctx, true, r)); - //return Ok((bctx, name == "eval" || name == "if", r)); - }, - Err(msg) => { - println!("{:ident$} call to {} failed {:?}", "", name, msg, ident=ident_amount); - }, - } - } - MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => { - if !cdr.is_value() { - break; - } - new_attempted = Attempted::True(if de.is_some() { Some(dctx.e.ids()) } else { None }); - if de.is_some() && dctx.e.ids().may_contain_id(id.clone()) { - // The current environment may contain a reference to our ID, which - // means if we take that environment, if we then PE that - // environment we will replace it with our real environment that - // still has a dynamic reference to the current environment, which - // will be an infinate loop - break; - } - // not yet supporting sequence params - match dctx.copy_push_frame(id.clone(), &se, &de, Some(Rc::clone(&dctx.e)), &rest_params, Some(Rc::clone(&cdr)), body) { - Ok(inner_dctx) => { - let ident_amount = inner_dctx.ident*4; - //println!("{:ident$}doing a call eval of {} in {}", "", body, inner_dctx.e, ident=inner_dctx.ident*4); - println!("{:ident$}doing a call eval of {:?}", "", lookup_name, ident=ident_amount); - //println!("{:ident$}with_parameters {}", "", cdr, ident=ident_amount); - - //Here is where we could do a tail call instead, but there - //would be no recovery back into the call-form... - let (bctx, r) = partial_eval(bctx.clone(), inner_dctx, Rc::clone(body)); - if combiner_return_ok(&r, Some(id.clone())) { - return Ok((bctx, false, r)); - } - }, - Err(rec_stop_under) => { - println!("{:ident$}call of {:?} failed b/c rec_stop_under", "", lookup_name, ident=dctx.ident*4); - maybe_rec_under = Some(rec_stop_under); - }, - } - }, - _ => {}, - } - break; - } - } - // Call failed, do the re-wrap-up ourselves b/c of our possibly advanced wrap/params - Ok((bctx, false, MarkedForm::new_suspended_pair( new_attempted, car, cdr, maybe_rec_under ))) - }, - // Values should never get here b/c ids UNLESS FORCE HAH - _ => Err("value evaled".to_owned()), - } -} diff --git a/kr/src/main.rs b/kr/src/main.rs index 1e66439..e975e2e 100644 --- a/kr/src/main.rs +++ b/kr/src/main.rs @@ -4,7 +4,11 @@ lalrpop_mod!(pub grammar); use std::rc::Rc; mod ast; -use crate::ast::{mark,partial_eval,new_base_ctxs,eval,root_env,MarkedForm,Form,PossibleTailCall}; +use crate::ast::{eval,root_env}; +mod pe_ast; +use crate::pe_ast::{mark,partial_eval,new_base_ctxs}; + +mod test; fn main() { @@ -20,615 +24,3 @@ fn main() { println!("Result is {} - {:?}", result, result); } -#[test] -fn parse_test() { - let g = grammar::TermParser::new(); - for test in [ - "22", "(22)", "(((22)))", - "(22 )", "()", "( )", "( 44)", "(44 )", - "(22 44 (1) 33 (4 5 (6) 6))", "hello", - "-", "+", "(+ 1 ;hi - 3)", "'13", "hello-world", "_", - ] { - assert!(g.parse(test).is_ok()); - } - assert!(g.parse("((22)").is_err()); -} - -fn eval_test>(also_pe: bool, gram: &grammar::TermParser, e: &Rc, code: &str, expected: T) { - println!("Doing test {}", 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()); - if also_pe { - let (bctx, dctx) = new_base_ctxs(); - let (bctx, marked) = mark(parsed,bctx); - let unvaled = marked.unval().unwrap(); - let (bctx, ped) = partial_eval(bctx, dctx, unvaled); - let (bctx, marked_basic_result) = mark(basic_result,bctx); - println!("Final PE {}", ped); - println!("wanted {}", marked_basic_result); - assert_eq!(*ped, *marked_basic_result); - } -} -fn partial_eval_test(gram: &grammar::TermParser, code: &str, expected: &str) { - println!("Doing PE test {}", code); - let parsed = Rc::new(gram.parse(code).unwrap()); - let (bctx, dctx) = new_base_ctxs(); - let (bctx, marked) = mark(parsed,bctx); - let unvaled = marked.unval().unwrap(); - let (bctx, ped) = partial_eval(bctx, dctx, unvaled); - println!("Final PE {}", ped); - println!("wanted {}", expected); - assert_eq!(format!("{}", ped), expected); -} -#[test] -fn basic_pe_test() { - let g = grammar::TermParser::new(); - partial_eval_test(&g, "(+ 2 (car (cons 4 '(1 2))))", "6"); - partial_eval_test(&g, "(vau 0 p (+ 1 2))", "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/3]"); -} - -#[test] -fn basic_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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(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(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(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(true, &g, &e, "!(bool?) 1", false); - eval_test(true, &g, &e, "!(bool?) true", true); - - 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"); -} - - -use once_cell::sync::Lazy; -static LET: Lazy = Lazy::new(|| { - "!((vau root_env p (eval (car p) - (cons (cons 'let1 - (vau de p (eval (car (cdr (cdr p))) (cons (cons (car p) (eval (car (cdr p)) de)) de))) - ) root_env))))".to_owned() -}); - -#[test] -fn let_pe_test() { - let g = grammar::TermParser::new(); - partial_eval_test(&g, &format!("{} (let1 a 2 (+ a (car (cons 4 '(1 2)))))", *LET), "6"); - partial_eval_test(&g, &format!("{} (let1 a 2 (vau 0 p (+ 1 a)))", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/3]"); - partial_eval_test(&g, &format!("{} - !(let1 a 2) - (vau 0 p (+ 1 a)) - ", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/3]"); - partial_eval_test(&g, &format!("{} - !(let1 a 2) - !(let1 b 5) - (vau 0 p (+ b a)) - ", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/7]"); - /* - partial_eval_test(&g, &format!("{} - (vau 0 p - !(let1 a 2) - !(let1 b 5) - (+ b a) - ) - ", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/7]"); - partial_eval_test(&g, &format!("{} - (vau d p - !(let1 a 2) - (+ (eval (car p) d) a) - ) - ", *LET), "None({})#[None/None/EnvID(2)/0/[]/Some(\"p\")/7]"); - */ -} - -#[test] -fn fib_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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)) - !(let1 n (eval (car (cdr p)) de)) - !(if (= 0 n) 0) - !(if (= 1 n) 1) - (+ (self self (- n 1)) (self self (- n 2))) - ))"; - eval_test(false, &g, &e, &format!("{} {} (fib fib 6)", *LET, def_fib), 8); -} -#[test] -fn fact_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - let def_fact = " - !(let1 fact (vau de p - !(let1 self (eval (car p) de)) - !(let1 n (eval (car (cdr p)) de)) - !(if (= 0 n) 1) - (* n (self self (- n 1))) - ))"; - eval_test(true, &g, &e, &format!("{} {} (fact fact 6)", *LET, def_fact), 720); -} -static VAPPLY: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 vapply (vau de p - !(let1 f (eval (car p) de)) - !(let1 ip (eval (car (cdr p)) de)) - !(let1 nde (eval (car (cdr (cdr p))) de)) - (eval (cons f ip) nde) - ))", *LET) -}); -#[test] -fn vapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - // need the vapply to keep env in check because otherwise the env keeps growing - // and the Rc::drop will overflow the stack lol - let def_badid = format!(" - {} - !(let1 badid (vau de p - !(let1 inner (vau ide ip - !(let1 self (car ip)) - !(let1 n (car (cdr ip))) - !(let1 acc (car (cdr (cdr ip)))) - !(if (= 0 n) acc) - (vapply self (cons self (cons (- n 1) (cons (+ acc 1) nil))) de) - )) - (vapply inner (cons inner (cons (eval (car p) de) (cons 0 nil))) de) - ))", *VAPPLY); - // Won't work unless tail calls work - // so no PE? - eval_test(false, &g, &e, &format!("{} (badid 1000)", def_badid), 1000); -} - -static VMAP: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 vmap (vau de p - !(let1 vmap_inner (vau ide ip - !(let1 self (car ip)) - !(let1 f (car (cdr ip))) - !(let1 l (car (cdr (cdr ip)))) - !(if (= nil l) l) - (cons (vapply f (cons (car l) nil) de) (vapply self (cons self (cons f (cons (cdr l) nil))) de)) - )) - (vapply vmap_inner (cons vmap_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de) - ))", *VAPPLY) -}); -#[test] -fn vmap_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - // Maybe define in terms of a right fold? - //eval_test(true, &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))", *VMAP), (2, Form::Nil)); -} - -static WRAP: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 wrap (vau de p - !(let1 f (eval (car p) de)) - (vau ide p (vapply f (vmap (vau _ xp (eval (car xp) ide)) p) ide)) - ))", *VMAP) -}); -#[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(true, &g, &e, &format!("{} ((wrap (vau _ p (+ (car p) 1))) (+ 1 2))", *WRAP), 4); -} - -static UNWRAP: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 unwrap (vau de p - !(let1 f (eval (car p) de)) - (vau ide p (vapply f (vmap (vau _ xp (cons quote (cons (car xp) nil))) p) ide)) - ))", *WRAP) -}); -#[test] -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(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 = Lazy::new(|| { - format!(" - {} - !(let1 lapply (vau de p - !(let1 f (eval (car p) de)) - !(let1 ip (eval (car (cdr p)) de)) - !(let1 nde (eval (car (cdr (cdr p))) de)) - (eval (cons (unwrap f) ip) nde) - ))", *UNWRAP) -}); -#[test] -fn lapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - // Should this allow envs at all? It technically can, but I feel like it kinda goes against the - // sensible deriviation - let def_lbadid = format!(" - {} - !(let1 lbadid (vau de p - !(let1 inner (wrap (vau ide ip - !(let1 self (car ip)) - !(let1 n (car (cdr ip))) - !(let1 acc (car (cdr (cdr ip)))) - !(if (= 0 n) acc) - (lapply self (cons self (cons (- n 1) (cons (+ acc 1) nil))) de) - ))) - (lapply inner (cons inner (cons (eval (car p) de) (cons 0 nil))) de) - ))", *LAPPLY); - // Won't work unless tail calls work - // takes a while though - eval_test(false, &g, &e, &format!("{} (lbadid 1000)", def_lbadid), 1000); -} - -static VFOLDL: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 vfoldl (vau de p - !(let1 vfoldl_inner (vau ide ip - !(let1 self (car ip)) - !(let1 f (car (cdr ip))) - !(let1 a (car (cdr (cdr ip)))) - !(let1 l (car (cdr (cdr (cdr ip))))) - !(if (= nil l) a) - (vapply self (cons self (cons f (cons (vapply f (cons a (cons (car l) nil)) de) (cons (cdr l) nil)))) de) - )) - (vapply vfoldl_inner (cons vfoldl_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) (cons (eval (car (cdr (cdr p))) de) nil)))) de) - ))", *LAPPLY) -}); -#[test] -fn vfoldl_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - eval_test(true, &g, &e, &format!("{} (vfoldl (vau de p (+ (car p) (car (cdr p)))) 0 '(1 2 3))", *VFOLDL), 6); -} -static ZIPD: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 zipd (vau de p - !(let1 zipd_inner (vau ide ip - !(let1 self (car ip)) - !(let1 a (car (cdr ip))) - !(let1 b (car (cdr (cdr ip)))) - !(if (= nil a) a) - !(if (= nil b) b) - (cons (cons (car a) (car b)) (vapply self (cons self (cons (cdr a) (cons (cdr b) nil))) de)) - )) - (vapply zipd_inner (cons zipd_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de) - ))", *VFOLDL) -}); -#[test] -fn zipd_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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 = Lazy::new(|| { - format!(" - {} - !(let1 concat (vau de p - !(let1 concat_inner (vau ide ip - !(let1 self (car ip)) - !(let1 a (car (cdr ip))) - !(let1 b (car (cdr (cdr ip)))) - !(if (= nil a) b) - (cons (car a) (vapply self (cons self (cons (cdr a) (cons b nil))) de)) - )) - (vapply concat_inner (cons concat_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de) - ))", *ZIPD) -}); - -#[test] -fn concat_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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 = Lazy::new(|| { - format!(" - {} - !(let1 match_params (wrap (vau 0 p - !(let1 self (car p)) - !(let1 p_ls (car (cdr p))) - !(let1 dp (car (cdr (cdr p)))) - !(let1 e (car (cdr (cdr (cdr p))))) - !(if (= nil p_ls) (assert (= nil dp) e)) - !(if (symbol? p_ls) (cons (cons p_ls dp) e)) - (self self (cdr p_ls) (cdr dp) (self self (car p_ls) (car dp) e)) - ))) - !(let1 bvau (vau se p - (if (= nil (cdr (cdr p))) - ; No de case - !(let1 p_ls (car p)) - !(let1 b_v (car (cdr p))) - (vau 0 dp - (eval b_v (match_params match_params p_ls dp se)) - ) - - ; de case - !(let1 de_s (car p)) - !(let1 p_ls (car (cdr p))) - !(let1 b_v (car (cdr (cdr p)))) - (vau dde dp - (eval b_v (match_params match_params p_ls dp (cons (cons de_s dde) se))) - ) - ) - ))", *CONCAT) -}); -#[test] -fn bvau_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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(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(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 = Lazy::new(|| { - format!(" - {} - !(let1 lambda (vau de p - (wrap (vapply bvau p de)) - ))", *BVAU) -}); -#[test] -fn lambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - eval_test(true, &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) 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(true, &g, &e, &format!("{} ((lambda (a b c) c) 10 2 3 4)", *LAMBDA), 3); -} - -static LET2: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 let1 (bvau dp (s v b) - (eval b (match_params match_params s (eval v dp) dp)) - )) - ", *LAMBDA) -}); - -#[test] -fn let2_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - - 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(true, &g, &e, &format!("{} (let1 (a b c) '(10 2 3 4) a)", *LET2), 10); -} - -static LIST: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 list (lambda args args)) - ", *LET2) -}); - -#[test] -fn list_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - eval_test(true, &g, &e, &format!("{} (list 1 2 (+ 3 4))", *LIST), (1, (2, (7, Form::Nil)))); -} - -static Y: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 Y (lambda (f3) - ((lambda (x1) (x1 x1)) - (lambda (x2) (f3 (wrap (vau app_env y (lapply (x2 x2) y app_env))))))) - ) - ", *LIST) -}); - -#[test] -fn y_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - - eval_test(true, &g, &e, &format!("{} ((Y (lambda (recurse) (lambda (n) (if (= 0 n) 1 (* n (recurse (- n 1))))))) 5)", *Y), 120); - -} - -static RLAMBDA: Lazy = Lazy::new(|| { - format!(" - {} - !(let1 rlambda (bvau se (n p b) - (eval (list Y (list lambda (list n) (list lambda p b))) se) - )) - ", *Y) -}); - -#[test] -fn rlambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - eval_test(true, &g, &e, &format!("{} ((rlambda recurse (n) (if (= 0 n) 1 (* n (recurse (- n 1))))) 5)", *RLAMBDA), 120); -} -static AND_OR: Lazy = Lazy::new(|| { - // need to extend for varidac - format!(" - {} - !(let1 and (bvau se (a b) - !(let1 ae (eval a se)) - (if ae (eval b se) ae) - )) - !(let1 or (bvau se (a b) - !(let1 ae (eval a se)) - (if ae ae (eval b se)) - )) - ", *RLAMBDA) -}); - -#[test] -fn and_or_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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(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 = Lazy::new(|| { - format!(" - {} - !(let1 len (lambda (l) - !(let1 len_helper (rlambda len_helper (l a) - (if (pair? l) (len_helper (cdr l) (+ 1 a)) - a) - )) - (len_helper l 0) - )) - ", *AND_OR) -}); - -#[test] -fn len_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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 = Lazy::new(|| { - format!(" - {} - !(let1 match (bvau de (x . cases) - !(let1 evaluate_case (rlambda evaluate_case (access c) - !(if (symbol? c) (list true (lambda (b) (list let1 c access b)))) - !(if (and (pair? c) (= 'unquote (car c))) (list (list = access (car (cdr c))) (lambda (b) b))) - !(if (and (pair? c) (= 'quote (car c))) (list (list = access c) (lambda (b) b))) - !(if (pair? c) - !(let1 tests (list and (list pair? access) (list = (len c) (list len access)))) - !(let1 (tests body_func) ((rlambda recurse (c tests access body_func) (if (pair? c) - !(let1 (inner_test inner_body_func) (evaluate_case (list car access) (car c))) - (recurse (cdr c) - (list and tests inner_test) - (list cdr access) - (lambda (b) (body_func (inner_body_func b)))) - ; else - (list tests body_func) - )) - c tests access (lambda (b) b))) - (list tests body_func)) - (list (list = access c) (lambda (b) b)) - )) - !(let1 helper (rlambda helper (x_sym cases) (if (= nil cases) (list assert false) - (let1 (test body_func) (evaluate_case x_sym (car cases)) - (concat (list if test (body_func (car (cdr cases)))) (list (helper x_sym (cdr (cdr cases))))))))) - - (eval (list let1 '___MATCH_SYM x (helper '___MATCH_SYM cases)) de) - ;!(let1 expanded (list let1 '___MATCH_SYM x (helper '___MATCH_SYM cases))) - ;(debug expanded (eval expanded de)) - )) - ", *LEN) -}); -#[test] -fn match_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - 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 = Lazy::new(|| { - format!(" - {} - !(let1 empty (list 'B nil nil nil)) - !(let1 E empty) - !(let1 EE (list 'BB nil nil nil)) - - !(let1 generic-foldl (rlambda generic-foldl (f z t) (match t - (unquote E) z - - (c a x b) !(let1 new_left_result (generic-foldl f z a)) - !(let1 folded (f new_left_result x)) - (generic-foldl f folded b)))) - - !(let1 blacken (lambda (t) (match t - ('R a x b) (list 'B a x b) - t t))) - !(let1 balance (lambda (t) (match t - ; figures 1 and 2 - ('B ('R ('R a x b) y c) z d) (list 'R (list 'B a x b) y (list 'B c z d)) - ('B ('R a x ('R b y c)) z d) (list 'R (list 'B a x b) y (list 'B c z d)) - ('B a x ('R ('R b y c) z d)) (list 'R (list 'B a x b) y (list 'B c z d)) - ('B a x ('R b y ('R c z d))) (list 'R (list 'B a x b) y (list 'B c z d)) - ; figure 8, double black cases - ('BB ('R a x ('R b y c)) z d) (list 'B (list 'B a x b) y (list 'B c z d)) - ('BB a x ('R ('R b y c) z d)) (list 'B (list 'B a x b) y (list 'B c z d)) - ; already balenced - t t))) - - !(let1 map-insert !(let1 ins (rlambda ins (t k v) (match t - (unquote E) (list 'R t (list k v) t) - (c a x b) !(if (< k (car x)) (balance (list c (ins a k v) x b))) - !(if (= k (car x)) (list c a (list k v) b)) - (balance (list c a x (ins b k v)))))) - (lambda (t k v) (blacken (ins t k v)))) - - !(let1 map-empty empty) - - !(let1 make-test-tree (rlambda make-test-tree (n t) (if (<= n 0) t - (make-test-tree (- n 1) (map-insert t n (= 0 (% n 10))))))) - !(let1 reduce-test-tree (lambda (tree) (generic-foldl (lambda (a x) (if (car (cdr x)) (+ a 1) a)) 0 tree))) - ", *MATCH) -}); -#[test] -fn rbtree_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); - eval_test(false, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 10 map-empty))", *RBTREE), 1); - //eval_test(false, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 20 map-empty))", *RBTREE), 2); -} diff --git a/kr/src/pe_ast.rs b/kr/src/pe_ast.rs new file mode 100644 index 0000000..251bbd8 --- /dev/null +++ b/kr/src/pe_ast.rs @@ -0,0 +1,1039 @@ +use std::fmt; +use std::rc::Rc; +use std::convert::From; +use std::collections::{BTreeSet,BTreeMap,hash_map::DefaultHasher}; +use std::result::Result; +use std::iter; +use std::hash::{Hash,Hasher}; + +use crate::ast::{root_env,Form}; + +impl fmt::Display for MarkedForm { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self { + MarkedForm::Nil => write!(f, "nil"), + MarkedForm::Int(i) => write!(f, "{}", i), + MarkedForm::Bool(b) => write!(f, "{}", b), + MarkedForm::Symbol(s) => write!(f, "{}", s), + MarkedForm::Pair(hash, ids, car, cdr) => { + //write!(f, "{:?}#({}", ids, car)?; + write!(f, "({}", car)?; + let mut traverse: Rc = Rc::clone(cdr); + loop { + match &*traverse { + MarkedForm::Pair(ref hash, ref ids, ref carp, ref cdrp) => { + write!(f, " {}", carp)?; + traverse = Rc::clone(cdrp); + }, + MarkedForm::Nil => { + write!(f, ")")?; + return Ok(()); + }, + x => { + write!(f, ". {})", x)?; + return Ok(()); + }, + } + } + }, + MarkedForm::SuspendedEnvEval { hash, ids, x, e } => write!(f, "({:?}){{Sveval {} {}}}", ids, x, e), + MarkedForm::SuspendedIf { hash, ids, c, t, e } => write!(f, "({:?}){{Sif {} {} {}}}", ids, c, t, e), + MarkedForm::SuspendedSymbol(name) => write!(f, "{}", name), + MarkedForm::SuspendedEnvLookup { name, id } => write!(f, "{:?}({:?}env)", name, id), + MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => write!(f, "{:?}({:?}{}{})", name, id, cdr_num, car), + MarkedForm::PrimComb { name, wrap_level, .. } => write!(f, "<{}{}>", name, wrap_level), + + //MarkedForm::DeriComb { ids, se, de, id, wrap_level, sequence_params, rest_params, body } => write!(f, "{:?}#[{}/{:?}/{:?}/{}/{:?}/{:?}/{}]", ids, se, de, id, wrap_level, sequence_params, rest_params, body), + MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => { + //let env_form = format!("{}", se); + write!(f, "{:?}#[{:?}/{:?}/{:?}/{}/{:?}/{:?}/{}]", ids, lookup_name, de, id, wrap_level, sequence_params, rest_params, body) + }, + + MarkedForm::SuspendedPair{ hash, ids, attempted, car, cdr } => { + //write!(f, "{:?}{:?}#{{{}", ids, attempted, car)?; + write!(f, "{{{}", car)?; + let mut traverse: Rc = Rc::clone(cdr); + loop { + match &*traverse { + MarkedForm::Pair(ref hash, ref ids, ref carp, ref cdrp) => { + write!(f, " {}", carp)?; + traverse = Rc::clone(cdrp); + }, + MarkedForm::Nil => { + write!(f, "}}")?; + return Ok(()); + }, + x => { + write!(f, ". {}}}", x)?; + return Ok(()); + }, + } + } + }, + } + } +} + +fn massoc(k: &str, v: Rc, l: Rc) -> Rc { + MarkedForm::new_pair( + MarkedForm::new_pair( + Rc::new(MarkedForm::Symbol(k.to_owned())), + v), + l) +} + + + + +#[derive(Debug, Clone, Hash, Eq, PartialEq, Ord, PartialOrd)] +pub struct EnvID(i32); +#[derive(Debug, Clone, Copy, Hash, Eq, PartialEq, Ord, PartialOrd)] +pub struct MFHash(u64); +impl MFHash { + pub fn combine(&self, other: &MFHash) -> Self { + let mut h = DefaultHasher::new(); + "combine/".hash(&mut h); self.0.hash(&mut h); other.hash(&mut h); + MFHash(h.finish()) + } +} + +#[derive(Debug, Clone, Hash, Eq, PartialEq)] +pub enum NeededIds { + True(BTreeSet), + None(BTreeSet), + Some(BTreeSet,BTreeSet), +} +impl NeededIds { + fn new_true() -> Self { NeededIds::True( BTreeSet::new()) } + fn new_none() -> Self { NeededIds::None( BTreeSet::new()) } + fn new_single(i: EnvID) -> Self { NeededIds::Some(iter::once(i).collect(), BTreeSet::new()) } + fn needs_nothing(&self) -> bool { + match self { + NeededIds::True( under) => false, + NeededIds::None( under) => under.is_empty(), + NeededIds::Some(set,under) => false, + } + } + fn is_true(&self) -> bool { + match self { + NeededIds::True( under) => true, + NeededIds::None( under) => false, + NeededIds::Some(set,under) => false, + } + } + fn under(&self) -> &BTreeSet { + match self { + NeededIds::True(under) => under, + NeededIds::None(under) => under, + NeededIds::Some(needed,under) => under, + } + } + fn union(&self, other: &NeededIds) -> Self { + match self { + // add assert that otherhashes!={} -> hashes=={} + NeededIds::True(under) => NeededIds::True(under.union(other.under()).cloned().collect()), + NeededIds::None(under) => other.union_under(under), + NeededIds::Some(set, under) => match other { + NeededIds::True(ounder) => NeededIds::True( under.union(ounder).cloned().collect()), + NeededIds::None(ounder) => NeededIds::Some(set.clone(), under.union(ounder).cloned().collect()), + NeededIds::Some(oset,ounder) => NeededIds::Some(set.union(oset).cloned().collect(), under.union(ounder).cloned().collect()), + }, + } + } + fn union_without(&self, other: &NeededIds, without: EnvID) -> Self { + self.union(other).without(without) + } + fn without(self, without: EnvID) -> Self { + match self { + NeededIds::True(_) => self, + NeededIds::None(_) => self, + NeededIds::Some(set, under) => { + let new: BTreeSet = set.into_iter().filter(|x| *x != without).collect(); + if new.is_empty() { + NeededIds::None(under) + } else { + NeededIds::Some(new, under) + } + }, + } + } + fn without_under(self, without: &EnvID) -> Self { + match self { + NeededIds::True( under) => NeededIds::True( under.into_iter().filter(|x| x != without).collect()), + NeededIds::None( under) => NeededIds::None( under.into_iter().filter(|x| x != without).collect()), + NeededIds::Some(set, under) => NeededIds::Some(set, (under.into_iter().filter(|x| x != without).collect())), + } + } + fn union_under(&self, other: &BTreeSet) -> Self { + match self { + // add assert that otherhashes!={} -> hashes=={} + NeededIds::True( under) => NeededIds::True( other.union(under).cloned().collect()), + NeededIds::None( under) => NeededIds::None( other.union(under).cloned().collect()), + NeededIds::Some(set, under) => NeededIds::Some(set.clone(), other.union(under).cloned().collect()), + } + } + // This should kinda eliminate True, as it can't progress, but we still want true in the sense + // that it could contain all sorts of IDs + // True() should really only exist if kkkkkkkkkkkkkk + fn add_under(&self, u: EnvID) -> Self { + match self { + NeededIds::True( under) => NeededIds::True( under.iter().cloned().chain(iter::once(u)).collect()), + NeededIds::None( under) => NeededIds::None( under.iter().cloned().chain(iter::once(u)).collect()), + NeededIds::Some(set, under) => NeededIds::Some(set.clone(), under.iter().cloned().chain(iter::once(u)).collect()), + } + } + fn add_id(&self, i: EnvID) -> Self { + match self { + NeededIds::True( under) => NeededIds::True( under.clone()), + NeededIds::None( under) => NeededIds::Some(iter::once(i).collect(), under.clone()), + NeededIds::Some(set, under) => NeededIds::Some(set.iter().cloned().chain(iter::once(i)).collect(), under.clone()), + } + } + fn may_contain_id(&self, i: EnvID) -> bool { + match self { + NeededIds::True( under) => true, + NeededIds::None( under) => false, + NeededIds::Some(set, under) => set.contains(&i), + } + } +} + +#[derive(Clone)] +pub struct BCtx { + id_counter: i32 +} +impl BCtx { + pub fn new_id(mut self) -> (Self, EnvID) { + let new_id = EnvID(self.id_counter); + self.id_counter += 1; + (self, new_id) + } +} + + +// force is for drop_redundent_eval, which will be integrated now +// 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 +#[derive(Clone)] +pub struct DCtx { + e : Rc, + current_id: Option, + sus_env_stack: Rc>>, + sus_prm_stack: Rc>>, + real_set: Rc>, + fake_set: Rc>, + fake_if_set: Rc>, + ident: usize, +} +impl DCtx { + pub fn copy_set_env(&self, e: &Rc) -> Self { + DCtx { e: Rc::clone(e), current_id: self.current_id.clone(), sus_env_stack: Rc::clone(&self.sus_env_stack), sus_prm_stack: Rc::clone(&self.sus_prm_stack), real_set: Rc::clone(&self.real_set), fake_set: Rc::clone(&self.fake_set), fake_if_set: Rc::clone(&self.fake_if_set), ident: self.ident+1 } + } + //pub fn copy_push_hash(&self, h: MFHash) -> Result { + //if !self.current.contains(&h) { + //Ok(DCtx { e: Rc::clone(&self.e), sus_env_stack: Rc::clone(&self.sus_env_stack), sus_prm_stack: Rc::clone(&self.sus_prm_stack), real_set: Rc::clone(&self.real_set), current: Rc::new(self.current.iter().cloned().chain(iter::once(h)).collect()), ident: self.ident }) + //} else { + //Err("hash already in") + //} + //} + pub fn copy_push_frame(&self, id: EnvID, se: &Rc, de: &Option, e: Option>, rest_params: &Option, prms: Option>, body: &Rc) -> Result { + let mut sus_env_stack = Rc::clone(&self.sus_env_stack); + let mut sus_prm_stack = Rc::clone(&self.sus_prm_stack); + let mut real_set = (*self.real_set).clone(); + let mut fake_set = (*self.fake_set).clone(); + if self.fake_if_set.contains(&id) { + println!("Fake if real rec stopper"); + return Err(id); + } + if (e.is_some() || prms.is_some()) { + real_set.insert(id.clone()); + // We're not actually not under fake still! + //fake_set.remove(&id); + } else { + if fake_set.contains(&id) { + return Err(id.clone()); + } + fake_set.insert(id.clone()); + real_set.remove(&id); + } + let inner_env = if let Some(de) = de { + let de_val = if let Some(e) = e { + Rc::make_mut(&mut sus_env_stack).insert(id.clone(), Rc::clone(&e)); + e + } else { + Rc::make_mut(&mut sus_env_stack).remove(&id); + Rc::new(MarkedForm::SuspendedEnvLookup { name: Some(de.clone()), id: id.clone() }) + }; + massoc(de, de_val, Rc::clone(se)) + } else { Rc::clone(se) }; + // not yet supporting sequence params + let inner_env = if let Some(p) = rest_params { + let p_val = if let Some(prms) = prms { + Rc::make_mut(&mut sus_prm_stack).insert(id.clone(), Rc::clone(&prms)); + prms + } else { + Rc::make_mut(&mut sus_prm_stack).remove(&id); + Rc::new(MarkedForm::SuspendedParamLookup { name: Some(p.clone()), id: id.clone(), cdr_num: 0, car: false }) + }; + massoc(p, p_val, inner_env) + } else { inner_env }; + Ok(DCtx { e: inner_env, current_id: Some(id), sus_env_stack, sus_prm_stack, real_set: Rc::new(real_set), fake_set: Rc::new(fake_set), fake_if_set: Rc::clone(&self.fake_if_set), ident: self.ident+1 }) + } + pub fn copy_push_fake_if(&self) -> Self { + let new_fake_if_set = if let Some(current_id) = self.current_id.as_ref() { + let mut x = (*self.fake_if_set).clone(); + x.insert(current_id.clone()); + Rc::new(x) + } else { Rc::clone(&self.fake_if_set) }; + DCtx { e: Rc::clone(&self.e), current_id: self.current_id.clone(), sus_env_stack: Rc::clone(&self.sus_env_stack), sus_prm_stack: Rc::clone(&self.sus_prm_stack), real_set: Rc::clone(&self.real_set), fake_set: Rc::clone(&self.fake_set), fake_if_set: new_fake_if_set, ident: self.ident+1 } + } + + pub fn can_progress(&self, ids: NeededIds) -> bool { + // check if ids is true || ids intersection EnvIDs in our stacks is non empty || ids.hashes - current is non empty + match ids { + NeededIds::True( under) => under.is_empty() || (!(self.fake_set.union(&self.fake_if_set).cloned().collect::>()).is_superset(&under)), //true, - if we have hashes, that means we don't know what's in but can't progress b/c hashes + NeededIds::None( under) => !(self.fake_set.union(&self.fake_if_set).cloned().collect::>()).is_superset(&under), + NeededIds::Some(ids,under) => (!self.real_set.is_disjoint(&ids)) || (!(self.fake_set.union(&self.fake_if_set).cloned().collect::>()).is_superset(&under)), + } + } +} + +pub fn new_base_ctxs() -> (BCtx,DCtx) { + let bctx = BCtx { id_counter: 0 }; + let (bctx, root_env) = mark(root_env(), bctx); + (bctx, DCtx { e: root_env, current_id: None, sus_env_stack: Rc::new(BTreeMap::new()), sus_prm_stack: Rc::new(BTreeMap::new()), real_set: Rc::new(BTreeSet::new()), fake_set: Rc::new(BTreeSet::new()), fake_if_set: Rc::new(BTreeSet::new()), ident: 0 } ) +} + +#[derive(Debug, Clone, Hash, Eq, PartialEq)] +pub enum Attempted { + True(Option), + False, +} +#[derive(Debug, Clone, Eq, PartialEq)] +pub enum MarkedForm { + Nil, + Int(i32), + Bool(bool), + Symbol(String), + Pair(MFHash, NeededIds, Rc,Rc), + + SuspendedSymbol(String), + SuspendedParamLookup { name: Option, id: EnvID, cdr_num: i32, car: bool }, + SuspendedEnvLookup { name: Option, id: EnvID }, + // resume hash is folded into ids + SuspendedPair { hash: MFHash, ids: NeededIds, attempted: Attempted, car: Rc, cdr: Rc}, + + SuspendedEnvEval { hash: MFHash, ids: NeededIds, x: Rc, e: Rc }, + SuspendedIf { hash: MFHash, ids: NeededIds, c: Rc, t: Rc, e: Rc }, + + PrimComb { name: String, nonval_ok: bool, takes_de: bool, wrap_level: i32, f: fn(BCtx,DCtx,Rc) -> Result<(BCtx,Rc),String> }, + DeriComb { hash: MFHash, lookup_name: Option, ids: NeededIds, se: Rc, de: Option, id: EnvID, wrap_level: i32, sequence_params: Vec, rest_params: Option, body: Rc }, +} +impl MarkedForm { + pub fn new_suspended_env_eval(x: Rc, e: Rc) -> Rc { + let mut h = DefaultHasher::new(); + "SuspendedEnvEval(x,e)".hash(&mut h); x.hash().hash(&mut h); e.hash().hash(&mut h); + Rc::new(MarkedForm::SuspendedEnvEval{ hash: MFHash(h.finish()), ids: e.ids(), x, e }) + } + pub fn new_suspended_if(c: Rc, t: Rc, e: Rc, rec_under: Option) -> Rc { + let mut h = DefaultHasher::new(); + "SuspendedIf(c,t,e)".hash(&mut h); c.hash().hash(&mut h); t.hash().hash(&mut h); e.hash().hash(&mut h); + let new_ids = c.ids().union(&t.ids()).union(&e.ids()); + let new_ids = if let Some(rec_under) = rec_under { new_ids.add_under(rec_under) } else { new_ids }; + Rc::new(MarkedForm::SuspendedIf{ hash: MFHash(h.finish()), ids: new_ids, c, t, e }) + } + pub fn new_pair(car: Rc, cdr: Rc) -> Rc { + let mut h = DefaultHasher::new(); + "Pair(ids,car,cdr)".hash(&mut h); car.hash().hash(&mut h); cdr.hash().hash(&mut h); + let new_ids = car.ids().union(&cdr.ids()); + //println!("For new pair, union of {:?} and {:?} is {:?}", car.ids(), cdr.ids(), new_ids); + Rc::new(MarkedForm::Pair(MFHash(h.finish()), new_ids, car, cdr)) + } + pub fn new_suspended_pair(attempted: Attempted, car: Rc, cdr: Rc, rec_under: Option) -> Rc { + let mut h = DefaultHasher::new(); + "SuspendedPair".hash(&mut h); attempted.hash(&mut h); car.hash().hash(&mut h); cdr.hash().hash(&mut h); + let ids = car.ids().union(&cdr.ids()); + let ids = match ids { + NeededIds::True(_) => ids, + NeededIds::None(under) => match &attempted { + Attempted::False => NeededIds::True(under), + Attempted::True(Some(oids)) => oids.union_under(&under), + Attempted::True(None) => NeededIds::None(under), + }, + NeededIds::Some(_,_) => ids, + }; + let ids = if let Some(rec_under) = rec_under { ids.add_under(rec_under) } else { ids }; + Rc::new(MarkedForm::SuspendedPair{ hash: MFHash(h.finish()), attempted, ids, car, cdr }) + } + pub fn new_deri_comb(se: Rc, lookup_name: Option, de: Option, id: EnvID, wrap_level: i32, sequence_params: Vec, rest_params: Option, body: Rc, rec_under: Option) -> Rc { + let mut h = DefaultHasher::new(); + "DeriComb".hash(&mut h); se.hash().hash(&mut h); de.hash(&mut h); id.hash(&mut h); wrap_level.hash(&mut h); + sequence_params.hash(&mut h); rest_params.hash(&mut h); body.hash().hash(&mut h); + let ids = se.ids().union_without(&body.ids(), id.clone()); + let ids = if let Some(rec_under) = rec_under { + ids.add_under(rec_under) + } else { + ids.without_under(&id) + }; + Rc::new(MarkedForm::DeriComb{ hash: MFHash(h.finish()), lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body }) + } + pub fn tag_name(self: &Rc, name: &str) -> Rc { + match &**self { + MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => + Rc::new(MarkedForm::DeriComb { hash: hash.clone(), lookup_name: Some(name.to_owned()), ids: ids.clone(), se: Rc::clone(se), de: de.clone(), id: id.clone(), wrap_level: *wrap_level, sequence_params: sequence_params.clone(), rest_params: rest_params.clone(), body: Rc::clone(body) }), + _ => Rc::clone(self), + } + } + pub fn hash(&self) -> MFHash { + let mut h = DefaultHasher::new(); + { + let state = &mut h; + match self { + MarkedForm::Nil => { "Nil".hash(state); }, + MarkedForm::Int(i) => { "Int(i)".hash(state); i.hash(state); }, + MarkedForm::Bool(b) => { "Bool(b)".hash(state); b.hash(state); }, + MarkedForm::Symbol(s) => { "Symbol(s)".hash(state); s.hash(state); }, + MarkedForm::Pair(hash,ids,car,cdr) => { return *hash; }, + MarkedForm::SuspendedSymbol(name) => { "SuspendedSymbol(name)".hash(state); name.hash(state); }, + MarkedForm::SuspendedParamLookup { name, id, cdr_num, car }=> { "SuspendedParamLookup".hash(state); name.hash(state); id.hash(state); cdr_num.hash(state); car.hash(state); }, + MarkedForm::SuspendedEnvEval { hash, .. } => { return *hash; }, + MarkedForm::SuspendedIf { hash, .. } => { return *hash; }, + MarkedForm::SuspendedEnvLookup { name, id } => { "SuspendedEnvLookup".hash(state); name.hash(state); id.hash(state); }, + MarkedForm::SuspendedPair{ hash, .. } => { return *hash; }, + MarkedForm::PrimComb { name, wrap_level, .. } => { "PrimComb".hash(state); name.hash(state); wrap_level.hash(state); }, + MarkedForm::DeriComb { hash, .. } => { return *hash; }, + } + } + MFHash(h.finish()) + } + pub fn wrap_level(&self) -> Option { + match self { + MarkedForm::PrimComb { wrap_level, .. } => Some(*wrap_level), + MarkedForm::DeriComb { wrap_level, .. } => Some(*wrap_level), + _ => None, + } + } + pub fn decrement_wrap_level(&self) -> Option> { + match self { + MarkedForm::PrimComb { name, nonval_ok, takes_de, wrap_level, f } => Some(Rc::new(MarkedForm::PrimComb { name: name.clone(), nonval_ok: *nonval_ok, takes_de: *takes_de, wrap_level: wrap_level-1, f: *f })), + MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => + Some(Rc::new(MarkedForm::DeriComb { hash: hash.clone(), lookup_name: lookup_name.clone(), 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) })), + //Some(MarkedForm::new_deri_comb(Rc::clone(se), lookup_name.clone(), de.clone(), id.clone(), wrap_level-1, sequence_params.clone(), rest_params.clone(), Rc::clone(body))), + + _ => None, + } + } + pub fn ids(&self) -> NeededIds { + match self { + MarkedForm::Nil => NeededIds::new_none(), + MarkedForm::Int(i) => NeededIds::new_none(), + MarkedForm::Bool(b) => NeededIds::new_none(), + MarkedForm::Symbol(s) => NeededIds::new_none(), + MarkedForm::Pair(hash,ids,car,cdr) => ids.clone(), + MarkedForm::SuspendedSymbol(name) => NeededIds::new_true(), + MarkedForm::SuspendedEnvLookup { id, .. } => NeededIds::new_single(id.clone()), + MarkedForm::SuspendedParamLookup { id, .. } => NeededIds::new_single(id.clone()), + MarkedForm::SuspendedEnvEval { ids, ..} => ids.clone(), + MarkedForm::SuspendedIf { ids, ..} => ids.clone(), + MarkedForm::SuspendedPair{ ids, .. } => ids.clone(), + MarkedForm::PrimComb { .. } => NeededIds::new_none(), + 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, + MarkedForm::Int(i) => return true, + MarkedForm::Bool(b) => return true, + MarkedForm::Symbol(s) => return true, + MarkedForm::SuspendedSymbol(name) => return false, + MarkedForm::SuspendedEnvLookup { id, .. } => return false, + MarkedForm::SuspendedParamLookup { id, .. } => return false, + MarkedForm::SuspendedEnvEval { ids, ..} => return false, + MarkedForm::SuspendedIf { ids, ..} => return false, + MarkedForm::SuspendedPair{ ids, .. } => return false, + MarkedForm::PrimComb { .. } => return true, + // TODO ths might be wrong as it could have captured some suspended computation + // On the other hand, that would surely show up in ids, right? + MarkedForm::Pair(hash,ids,car,cdr) => ids.clone(), + MarkedForm::DeriComb { ids, .. } => ids.clone(), + } { + NeededIds::True(hashes) => false, + NeededIds::None(hashes) => true, + NeededIds::Some(ids,hashes) => false, + } + } + pub fn unval(self: &Rc) -> Result, &'static str> { + match &**self { + MarkedForm::Nil => Ok(Rc::clone(self)), + MarkedForm::Int(i) => Ok(Rc::clone(self)), + MarkedForm::Bool(b) => Ok(Rc::clone(self)), + MarkedForm::Symbol(s) => Ok(Rc::new(MarkedForm::SuspendedSymbol(s.clone()))), + MarkedForm::Pair(hash,ids,car,cdr) => Ok(MarkedForm::new_suspended_pair( Attempted::False, car.unval()?, Rc::clone(cdr), None)), + MarkedForm::SuspendedSymbol(name) => Err("trying to unval a suspended symbol"), + MarkedForm::SuspendedEnvLookup { .. } => Err("trying to unval a suspended env lookup"), + MarkedForm::SuspendedParamLookup { .. } => Err("trying to unval a suspended param lookup"), + MarkedForm::SuspendedEnvEval { .. } => Err("trying to unval a suspended env eval"), + MarkedForm::SuspendedIf { .. } => Err("trying to unval a suspended if"), + MarkedForm::SuspendedPair{ ids, .. } => Err("trying to unval a suspended pair"), + MarkedForm::PrimComb { .. } => Ok(Rc::clone(self)), + MarkedForm::DeriComb { .. } => Ok(Rc::clone(self)), + } + } + pub fn truthy(&self) -> Result { + match self { + MarkedForm::Nil => Ok(false), + MarkedForm::Int(i) => Ok(true), + MarkedForm::Bool(b) => Ok(*b), + MarkedForm::Symbol(s) => Ok(true), + MarkedForm::Pair(hash,ids,car,cdr) => Ok(true), + MarkedForm::SuspendedSymbol(name) => Err("trying to truthy a suspended symbol"), + MarkedForm::SuspendedEnvLookup { .. } => Err("trying to truthy a suspended env lookup"), + MarkedForm::SuspendedParamLookup { .. } => Err("trying to truthy a suspended param lookup"), + MarkedForm::SuspendedEnvEval { .. } => Err("trying to truthy a suspended env eval"), + MarkedForm::SuspendedIf { .. } => Err("trying to truthy a suspended if"), + MarkedForm::SuspendedPair{ ids, .. } => Err("trying to truthy a suspended pair"), + MarkedForm::PrimComb { .. } => Ok(true), + MarkedForm::DeriComb { .. } => Ok(true), + } + } + pub fn sym(&self) -> Result<&str,&'static str> { + match self { + MarkedForm::Symbol(s) => Ok(s), + _ => Err("not a symbol"), + } + } + pub fn int(&self) -> Result { + match self { + MarkedForm::Int(i) => Ok(*i), + _ => Err("not a int"), + } + } + pub fn car(&self) -> Result, String> { + match self { + MarkedForm::Pair(hash,ids,car,cdr) => Ok(Rc::clone(car)), + MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } if !car => Ok(Rc::new(MarkedForm::SuspendedParamLookup { name: name.clone(), id: id.clone(), cdr_num: *cdr_num, car: true })), + _ => Err(format!("not a pair for car: {}", self)), + } + } + pub fn cdr(&self) -> Result, String> { + match self { + MarkedForm::Pair(hash,ids,car,cdr) => Ok(Rc::clone(cdr)), + MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => Ok(Rc::new(MarkedForm::SuspendedParamLookup { name: name.clone(), id: id.clone(), cdr_num: *cdr_num+1, car: *car })), + _ => Err(format!("not a pair for cdr: {}", self)), + } + } +} + +pub fn mark(form: Rc, bctx: BCtx) -> (BCtx, Rc) { + match &*form { + Form::Nil => (bctx, Rc::new(MarkedForm::Nil)), + Form::Int(i) => (bctx, Rc::new(MarkedForm::Int(*i))), + Form::Bool(b) => (bctx, Rc::new(MarkedForm::Bool(*b))), + Form::Symbol(s) => (bctx, Rc::new(MarkedForm::Symbol(s.clone()))), + Form::Pair(car, cdr) => { + let (bctx, car) = mark(Rc::clone(car),bctx); + let (bctx, cdr) = mark(Rc::clone(cdr),bctx); + (bctx, MarkedForm::new_pair(car, cdr)) + }, + Form::DeriComb { se, de, params, body } => { + panic!(); + }, + Form::PrimComb(name, _f) => { + (bctx, match &name[..] { + "eval" => Rc::new(MarkedForm::PrimComb { name: "eval".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + println!("Ok, this is inside eval looking at {}", p); + if !p.car()?.is_value() { + Err("can't eval without form being a value, since we're changing the env".to_owned()) + } else { + println!("Ok, returning new suspended env eval with"); + println!("\t{} {}", p.car()?.unval()?, p.cdr()?.car()?); + Ok((bctx, MarkedForm::new_suspended_env_eval(p.car()?.unval()?, p.cdr()?.car()?))) + } + }}), + "vau" => Rc::new(MarkedForm::PrimComb { name: "vau".to_owned(), nonval_ok: false, 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()?; + let se = Rc::clone(&dctx.e); + let (bctx, id) = bctx.new_id(); + let wrap_level = 0; + let sequence_params = vec![]; + let rest_params = Some(params); + Ok((bctx, MarkedForm::new_deri_comb( se, None, de, id, wrap_level, sequence_params, rest_params, body, None ))) + }}), + "if" => Rc::new(MarkedForm::PrimComb { name: "if".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 0, f: |bctx, dctx, p| { + Ok((bctx, MarkedForm::new_suspended_if(p.car()?.unval()?, p.cdr()?.car()?.unval()?, p.cdr()?.cdr()?.car()?.unval()?, None))) + }}), + // TODO: handle these in the context of paritals + "cons" => Rc::new(MarkedForm::PrimComb { name: "cons".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let h = p.car()?; + //println!("Consing with head {}", h); + let t = p.cdr()?.car()?; + //println!("Consing with tail {}", t); + Ok((bctx, MarkedForm::new_pair(h, t))) + }}), + "car" => Rc::new(MarkedForm::PrimComb { name: "car".to_owned(), nonval_ok: true, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, p.car()?.car()?)) + }}), + "cdr" => Rc::new(MarkedForm::PrimComb { name: "cdr".to_owned(), nonval_ok: true, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, p.car()?.cdr()?)) + }}), + "quote" => Rc::new(MarkedForm::PrimComb { name: "quote".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 0, f: |bctx, dctx, p| { + Ok((bctx, p.car()?)) + }}), + "debug" => Rc::new(MarkedForm::PrimComb { name: "debug".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + // This one is a bit weird - we put the wrap level at 1 so both sides are pe'd, + // and always returns Err so that it's not optimized away + Err("debug can't be partial-evaluated away".to_owned()) + }}), + // ditto + "assert" => Rc::new(MarkedForm::PrimComb { name: "assert".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let cond = p.car()?; + if !cond.truthy()? { + println!("Assert failed: {:?}", cond); + } + assert!(cond.truthy()?); + Ok((bctx, p.cdr()?.car()?)) + }}), + "=" => Rc::new(MarkedForm::PrimComb { name: "=".to_owned(), nonval_ok: false, 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); + // TODO: double check that this ignores ids etc. It should, since + // wrap_level=1 should mean that everything's a value + // also, it should just check by hash then? + Ok((bctx, Rc::new(MarkedForm::Bool(a == b)))) + }}), + "<" => Rc::new(MarkedForm::PrimComb { name: "<".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?; + let b = p.cdr()?.car()?; + Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? < b.int()?)))) + }}), + ">" => Rc::new(MarkedForm::PrimComb { name: ">".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?; + let b = p.cdr()?.car()?; + Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? > b.int()?)))) + }}), + "<=" => Rc::new(MarkedForm::PrimComb { name: "<=".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?; + let b = p.cdr()?.car()?; + Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? <= b.int()?)))) + }}), + ">=" => Rc::new(MarkedForm::PrimComb { name: ">=".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?; + let b = p.cdr()?.car()?; + Ok((bctx, Rc::new(MarkedForm::Bool(a.int()? >= b.int()?)))) + }}), + "+" => Rc::new(MarkedForm::PrimComb { name: "+".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a + b)))) + }}), + "-" => Rc::new(MarkedForm::PrimComb { name: "-".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a - b)))) + }}), + "*" => Rc::new(MarkedForm::PrimComb { name: "*".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a * b)))) + }}), + "/" => Rc::new(MarkedForm::PrimComb { name: "/".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a / b)))) + }}), + "%" => Rc::new(MarkedForm::PrimComb { name: "%".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a % b)))) + }}), + "&" => Rc::new(MarkedForm::PrimComb { name: "&".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a & b)))) + }}), + "|" => Rc::new(MarkedForm::PrimComb { name: "|".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a | b)))) + }}), + "^" => Rc::new(MarkedForm::PrimComb { name: "^".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + let a = p.car()?.int()?; + let b = p.cdr()?.car()?.int()?; + Ok((bctx, Rc::new(MarkedForm::Int(a ^ b)))) + }}), + "comb?" => Rc::new(MarkedForm::PrimComb { name: "comb?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { + MarkedForm::PrimComb { .. } => true, + MarkedForm::DeriComb { .. } => true, + _ => false, + })))) + }}), + "pair?" => Rc::new(MarkedForm::PrimComb { name: "pair?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { + MarkedForm::Pair(_h, _i, _a,_b) => true, + _ => false, + })))) + }}), + "symbol?" => Rc::new(MarkedForm::PrimComb { name: "symbol?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { + MarkedForm::Symbol(_) => true, + _ => false, + })))) + }}), + "int?" => Rc::new(MarkedForm::PrimComb { name: "int?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, 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(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { + MarkedForm::Bool(_) => true, + _ => false, + })))) + }}), + "nil?" => Rc::new(MarkedForm::PrimComb { name: "nil?".to_owned(), nonval_ok: false, takes_de: false, wrap_level: 1, f: |bctx, dctx, p| { + Ok((bctx, Rc::new(MarkedForm::Bool(match &* p.car()? { + MarkedForm::Nil => true, + _ => false, + })))) + }}), + _ => panic!("gah! don't have partial eval version of {}", name), + }) + }, + } +} + +pub fn combiner_return_ok(x: &Rc, check_id: Option) -> bool { + match match &**x { + MarkedForm::Nil => return true, + MarkedForm::Int(_) => return true, + MarkedForm::Bool(_) => return true, + MarkedForm::Symbol(_) => return true, + // Hmm, we allow Pair to included suspended now... + // so now we have to be extra careful + MarkedForm::Pair(h,ids,car,cdr) => ids, + + MarkedForm::SuspendedSymbol(_) => return false, + MarkedForm::SuspendedParamLookup { id, .. } => return check_id.map(|check_id| *id != check_id).unwrap_or(true), + MarkedForm::SuspendedEnvLookup { id, .. } => return check_id.map(|check_id| *id != check_id).unwrap_or(true), + + MarkedForm::SuspendedEnvEval { e, .. } => return combiner_return_ok(e, check_id), + MarkedForm::SuspendedIf { c, t, e, .. } => return combiner_return_ok(c, check_id.clone()) && + combiner_return_ok(t, check_id.clone()) && + combiner_return_ok(e, check_id), + MarkedForm::SuspendedPair { car, cdr, .. } => { + // expand with (func ...params) | func doesn't take de and func+params are return ok + return false + }, + + MarkedForm::PrimComb { .. } => return true, + MarkedForm::DeriComb { ids, .. } => ids, + } { + NeededIds::True( _under) => false, + NeededIds::None( _under) => true, + NeededIds::Some(ids,_under) => check_id.map(|check_id| !ids.contains(&check_id)).unwrap_or(true), + } + //; Handles let 4.3 through macro level leaving it as ( 13) + //; need handling of symbols (which is illegal for eval but ok for calls) to push it farther + //(combiner_return_ok (rec-lambda combiner_return_ok (func_result env_id) + // (cond ((not (later_head? func_result)) (not (check_for_env_id_in_result env_id func_result))) + // ; special cases now + // ; *(veval body {env}) => (combiner_return_ok {env}) + // ; The reason we don't have to check body is that this form is only creatable in ways that body was origionally a value and only need {env} + // ; Either it's created by eval, in which case it's fine, or it's created by something like (eval (array veval x de) de2) and the array has checked it, + // ; or it's created via literal vau invocation, in which case the body is a value. + // ((and (marked_array? func_result) + // (prim_comb? (idx (.marked_array_values func_result) 0)) + // (= 'veval (.prim_comb_sym (idx (.marked_array_values func_result) 0))) + // (= 3 (len (.marked_array_values func_result))) + // (combiner_return_ok (idx (.marked_array_values func_result) 2) env_id)) true) + // ; (func ...params) => (and (doesn't take de func) (foldl combiner_return_ok (cons func params))) + // ; + // ((and (marked_array? func_result) + // (not (comb_takes_de? (idx (.marked_array_values func_result) 0) (len (.marked_array_values func_result)))) + // (foldl (lambda (a x) (and a (combiner_return_ok x env_id))) true (.marked_array_values func_result))) true) + + // ; So that's enough for macro like, but we would like to take it farther + // ; For like (let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a))))) + // ; we get to (+ 13 x 12) not being a value, and it reconstructs + // ; ( 13) + // ; and that's what eval gets, and eval then gives up as well. + + // ; That will get caught by the above cases to remain the expansion ( 13), + // ; but ideally we really want another case to allow (+ 13 x 12) to bubble up + // ; I think it would be covered by the (func ...params) case if a case is added to allow symbols to be bubbled up if their + // ; needed for progress wasn't true or the current environment, BUT this doesn't work for eval, just for functions, + // ; since eval changes the entire env chain (but that goes back to case 1, and might be eliminated at compile if it's an env reachable from the func). + // ; + // ; + // ; Do note a key thing to be avoided is allowing any non-val inside a comb, since that can cause a fake env's ID to + // ; reference the wrong env/comb in the chain. + // ; We do allow calling eval with a fake env, but since it's only callable withbody value and is strict (by calling this) + // ; about it's return conditions, and the env it's called with must be ok in the chain, and eval doesn't introduce a new scope, it works ok. + // ; We do have to be careful about allowing returned later symbols from it though, since it could be an entirely different env chain. + + // (true false) + // ) + //)) +} + +pub fn partial_eval(bctx_in: BCtx, dctx_in: DCtx, form: Rc) -> (BCtx,Rc) { + let mut bctx = bctx_in; + let mut dctx = dctx_in; + let mut next_form = Some(form); + let mut force = false; + loop { + let x = next_form.take().unwrap(); + //println!("{:ident$}PE: {}", "", x, ident=dctx.ident*4); + if !(force || dctx.can_progress(x.ids())) { + //println!("{:ident$}Shouldn't go!", "", ident=dctx.ident*4); + return (bctx, x); + } + //println!("{:ident$}({}) PE(force:{}) {:?} (because of {:?})", "", dctx.ident, force, x, x.ids(), ident=dctx.ident*4); + println!("{:ident$}({}) PE(force:{}) {} (because of {:?})", "", dctx.ident, force, x, x.ids(), ident=dctx.ident*4); + match partial_eval_step(&x, force, bctx.clone(), &mut dctx) { + Ok((new_bctx,new_force,new_form)) => { + bctx = new_bctx; force = new_force; next_form = Some(new_form); + println!("{:ident$}({}) was ok, result was {}", "", dctx.ident, next_form.as_ref().unwrap(), ident=dctx.ident*4); + } + Err(msg) => { + println!("{:ident$}({}) was error, reconstructing (error was {})", "", dctx.ident, msg, ident=dctx.ident*4); + return (bctx, x); + } + } + // basic Drop redundent veval + // Old one was recursive over parameters to combs, which we might need, since the redundent veval isn't captured by + // ids. TODO! + if let Some(form) = next_form.as_ref() { + if let MarkedForm::SuspendedEnvEval { x, e, .. } = &**form { + if (combiner_return_ok(&x, None) || *e == dctx.e) { + next_form = Some(Rc::clone(x)); + force = true; + } + } + } + } +} +fn partial_eval_step(x: &Rc, forced: bool, bctx: BCtx, dctx: &mut DCtx) -> Result<(BCtx,bool,Rc), String> { + //println!("{:ident$}({}) {}", "", dctx.ident, x, ident=dctx.ident*4); + match &**x { + MarkedForm::Pair(h,ids,car,cdr) => { + //println!("{:ident$}pair ({}) {}", "", dctx.ident, x, ident=dctx.ident*4); + let (bctx, car) = partial_eval(bctx, dctx.clone(), Rc::clone(car)); + let (bctx, cdr) = partial_eval(bctx, dctx.clone(), Rc::clone(cdr)); + Ok((bctx, false, MarkedForm::new_pair(car, cdr))) + }, + MarkedForm::SuspendedSymbol(name) => { + println!("Lookin up symbol {}", name); + let mut t = Rc::clone(&dctx.e); + while name != t.car()?.car()?.sym()? { + t = t.cdr()?; + } + println!("found it, pair is {}", t.car()?); + Ok((bctx, false, t.car()?.cdr()?.tag_name(name))) + }, + MarkedForm::SuspendedEnvLookup { name, id } => { + if let Some(v) = dctx.sus_env_stack.get(id) { + Ok((bctx, false, if let Some(name) = name { v.tag_name(name) } else { Rc::clone(v) })) + } else { + Err("failed env lookup (forced)".to_owned()) + } + }, + MarkedForm::SuspendedParamLookup { name, id, cdr_num, car } => { + if let Some(v) = dctx.sus_prm_stack.get(id) { + let mut translated_value = if let Some(name) = name { v.tag_name(name) } else { Rc::clone(v) }; + for i in 0..*cdr_num { + translated_value = translated_value.cdr()?; + } + if *car { + translated_value = translated_value.car()?; + } + Ok((bctx, false, translated_value)) + } else { + Err("failed param lookup (forced)".to_owned()) + } + }, + MarkedForm::SuspendedEnvEval { x, e, .. } => { + // this bit is a little tricky - we'd like to tail call, but we can't lose our env + // if it fails. + let (bctx, e) = partial_eval(bctx, dctx.clone(), Rc::clone(e)); + let (bctx, x) = partial_eval(bctx, dctx.copy_set_env(&e), Rc::clone(x)); + if x.is_value() { + Ok((bctx, false, x)) + } else { + Ok((bctx, false, MarkedForm::new_suspended_env_eval(x, e))) + } + // Note also that we drop redundent vevals at the bottom of the loop tail-call loop + // with force + }, + MarkedForm::SuspendedIf { c, t, e, .. } => { + let (bctx, c) = partial_eval(bctx, dctx.clone(), Rc::clone(c)); + if let Ok(b) = c.truthy() { + if b { + Ok((bctx, false, Rc::clone(t))) + } else { + Ok((bctx, false, Rc::clone(e))) + } + } else { + // TODO: Need to add hash checking to this one + //let new_if_hash = MarkedForm::new_suspended_if(Rc::clone(&c), Rc::clone(t), Rc::clone(e), None).hash(); + //println!("IF HASH {:?} ? {:?}", new_if_hash, dctx.current); + //match dctx.copy_push_hash(new_if_hash.clone()) { + //Ok(dctx) => { + //println!("SIF hash fine, doing both subs"); + let dctx = dctx.copy_push_fake_if(); + let (bctx, t) = partial_eval(bctx, dctx.clone(), Rc::clone(t)); + let (bctx, e) = partial_eval(bctx, dctx.clone(), Rc::clone(e)); + Ok((bctx, false, MarkedForm::new_suspended_if(c,t,e, None))) + //}, + //Err(rec_stop_msg) => { + //println!("SIF hash stopped {}", rec_stop_msg); + //Ok((bctx, false, MarkedForm::new_suspended_if(c, Rc::clone(t), Rc::clone(e), Some(new_if_hash)))) + //} + //} + } + }, + MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => { + // TODO: figure out wrap level, sequence params, etc + if forced || !se.ids().needs_nothing() { + //if ids.is_true() || !se.ids().needs_nothing() { + let old_se_ids = se.ids(); + let se = if !se.ids().needs_nothing() { + // the current env is our new se + Rc::clone(&dctx.e) + } else { + Rc::clone(se) + }; + + let ident_amount = dctx.ident*4; + + match dctx.copy_push_frame(id.clone(), &se, &de, None, &rest_params, None, body) { + Ok(inner_dctx) => { + println!("{:ident$}Doing a body deri for {:?} because ({} || {:?}) which is {}", "", lookup_name, forced, old_se_ids, x, ident=ident_amount); + println!("{:ident$}and also body ids is {:?}", "", body.ids(), ident=ident_amount); + //println!("{:ident$}and fake is {:?} and fake_if is {:?}", "", , ident=ident_amount); + let (bctx, body) = partial_eval(bctx, inner_dctx, Rc::clone(&body)); + println!("{:ident$}result was {}", "", body, ident=ident_amount); + Ok((bctx, false, MarkedForm::new_deri_comb(se, lookup_name.clone(), de.clone(), id.clone(), *wrap_level, sequence_params.clone(), rest_params.clone(), body, None))) + }, + Err(rec_stop_under) => { + println!("{:ident$}call of {:?} failed b/c rec_stop_under", "", lookup_name, ident=dctx.ident*4); + //maybe_rec_hash = Some(rec_stop_hash); + // TODO: should this mark the hash on DeriComb? + //Err("recursion stopped in dericomb".to_owned()) + Ok((bctx, false, MarkedForm::new_deri_comb(se, lookup_name.clone(), de.clone(), id.clone(), *wrap_level, sequence_params.clone(), rest_params.clone(), Rc::clone(body), Some(rec_stop_under)))) + //Ok((bctx, false, MarkedForm::new_suspended_pair( new_attempted, car, cdr, maybe_rec_hash ))) + }, + } + } else { + //panic!("impossible {}", x); + Err("impossible!?".to_owned()) + } + }, + MarkedForm::SuspendedPair { hash, 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(); + let mut maybe_rec_under = None; + let mut return_ok = false; + while let Some(wrap_level) = car.wrap_level() { + if wrap_level > 0 { + fn map_unval_peval(bctx: BCtx, dctx: DCtx, x: Rc) -> Result<(BCtx,Rc),String> { + match &*x { + MarkedForm::Pair(h, ids, x_car, x_cdr) => { + let (bctx, new_x_car) = partial_eval(bctx, dctx.clone(), x_car.unval()?); + let (bctx, new_x_cdr) = map_unval_peval(bctx, dctx.clone(), Rc::clone(x_cdr))?; + return Ok((bctx, MarkedForm::new_pair(new_x_car, new_x_cdr))); + }, + MarkedForm::Nil => return Ok((bctx,x)), + _ => return Err("not a list".to_owned()), + } + } + match map_unval_peval(bctx.clone(), dctx.clone(), Rc::clone(&cdr)) { + Ok((new_bctx, new_cdr)) => { + car = car.decrement_wrap_level().unwrap(); + cdr = new_cdr; + bctx = new_bctx; + } + Err(msg) => { + println!("{:ident$} evaling parameters failed b/c {}", "", msg, ident=dctx.ident*4); + break; + } + } + } else { + // check to see if can do call + // We might want to enable not pure values for cons/car/cdr? + match &*car { + MarkedForm::PrimComb { name, nonval_ok, takes_de, wrap_level, f} => { + if !nonval_ok && !cdr.is_value() { + break; + } + new_attempted = Attempted::True(if *takes_de { Some(dctx.e.ids()) } else { None }); + let ident_amount = dctx.ident*4; + println!("{:ident$}doing a call eval of {}", "", name, ident=ident_amount); + println!("{:ident$}parameters {} are? a val because {:?}", "", cdr, cdr.ids(), ident=ident_amount); + match f(bctx.clone(), dctx.clone(), Rc::clone(&cdr)) { + Ok((bctxp, r)) => { + // force true b/c might be a tail call + return Ok((bctx, true, r)); + //return Ok((bctx, name == "eval" || name == "if", r)); + }, + Err(msg) => { + println!("{:ident$} call to {} failed {:?}", "", name, msg, ident=ident_amount); + }, + } + } + MarkedForm::DeriComb { hash, lookup_name, ids, se, de, id, wrap_level, sequence_params, rest_params, body } => { + if !cdr.is_value() { + break; + } + new_attempted = Attempted::True(if de.is_some() { Some(dctx.e.ids()) } else { None }); + if de.is_some() && dctx.e.ids().may_contain_id(id.clone()) { + // The current environment may contain a reference to our ID, which + // means if we take that environment, if we then PE that + // environment we will replace it with our real environment that + // still has a dynamic reference to the current environment, which + // will be an infinate loop + break; + } + // not yet supporting sequence params + match dctx.copy_push_frame(id.clone(), &se, &de, Some(Rc::clone(&dctx.e)), &rest_params, Some(Rc::clone(&cdr)), body) { + Ok(inner_dctx) => { + let ident_amount = inner_dctx.ident*4; + //println!("{:ident$}doing a call eval of {} in {}", "", body, inner_dctx.e, ident=inner_dctx.ident*4); + println!("{:ident$}doing a call eval of {:?}", "", lookup_name, ident=ident_amount); + //println!("{:ident$}with_parameters {}", "", cdr, ident=ident_amount); + + //Here is where we could do a tail call instead, but there + //would be no recovery back into the call-form... + let (bctx, r) = partial_eval(bctx.clone(), inner_dctx, Rc::clone(body)); + if combiner_return_ok(&r, Some(id.clone())) { + return Ok((bctx, false, r)); + } + }, + Err(rec_stop_under) => { + println!("{:ident$}call of {:?} failed b/c rec_stop_under", "", lookup_name, ident=dctx.ident*4); + maybe_rec_under = Some(rec_stop_under); + }, + } + }, + _ => {}, + } + break; + } + } + // Call failed, do the re-wrap-up ourselves b/c of our possibly advanced wrap/params + Ok((bctx, false, MarkedForm::new_suspended_pair( new_attempted, car, cdr, maybe_rec_under ))) + }, + // Values should never get here b/c ids UNLESS FORCE HAH + _ => Err("value evaled".to_owned()), + } +} diff --git a/kr/src/test.rs b/kr/src/test.rs new file mode 100644 index 0000000..fcdaee7 --- /dev/null +++ b/kr/src/test.rs @@ -0,0 +1,618 @@ +use std::rc::Rc; + +use crate::grammar; +use crate::ast::{eval,root_env,Form,PossibleTailCall}; +use crate::pe_ast::{mark,partial_eval,new_base_ctxs,MarkedForm}; + +#[test] +fn parse_test() { + let g = grammar::TermParser::new(); + for test in [ + "22", "(22)", "(((22)))", + "(22 )", "()", "( )", "( 44)", "(44 )", + "(22 44 (1) 33 (4 5 (6) 6))", "hello", + "-", "+", "(+ 1 ;hi + 3)", "'13", "hello-world", "_", + ] { + assert!(g.parse(test).is_ok()); + } + assert!(g.parse("((22)").is_err()); +} + +fn eval_test>(also_pe: bool, gram: &grammar::TermParser, e: &Rc, code: &str, expected: T) { + println!("Doing test {}", 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()); + if also_pe { + let (bctx, dctx) = new_base_ctxs(); + let (bctx, marked) = mark(parsed,bctx); + let unvaled = marked.unval().unwrap(); + let (bctx, ped) = partial_eval(bctx, dctx, unvaled); + let (bctx, marked_basic_result) = mark(basic_result,bctx); + println!("Final PE {}", ped); + println!("wanted {}", marked_basic_result); + assert_eq!(*ped, *marked_basic_result); + } +} +fn partial_eval_test(gram: &grammar::TermParser, code: &str, expected: &str) { + println!("Doing PE test {}", code); + let parsed = Rc::new(gram.parse(code).unwrap()); + let (bctx, dctx) = new_base_ctxs(); + let (bctx, marked) = mark(parsed,bctx); + let unvaled = marked.unval().unwrap(); + let (bctx, ped) = partial_eval(bctx, dctx, unvaled); + println!("Final PE {}", ped); + println!("wanted {}", expected); + assert_eq!(format!("{}", ped), expected); +} +#[test] +fn basic_pe_test() { + let g = grammar::TermParser::new(); + partial_eval_test(&g, "(+ 2 (car (cons 4 '(1 2))))", "6"); + partial_eval_test(&g, "(vau 0 p (+ 1 2))", "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/3]"); +} + +#[test] +fn basic_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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(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(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(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(true, &g, &e, "!(bool?) 1", false); + eval_test(true, &g, &e, "!(bool?) true", true); + + 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"); +} + + +use once_cell::sync::Lazy; +static LET: Lazy = Lazy::new(|| { + "!((vau root_env p (eval (car p) + (cons (cons 'let1 + (vau de p (eval (car (cdr (cdr p))) (cons (cons (car p) (eval (car (cdr p)) de)) de))) + ) root_env))))".to_owned() +}); + +#[test] +fn let_pe_test() { + let g = grammar::TermParser::new(); + partial_eval_test(&g, &format!("{} (let1 a 2 (+ a (car (cons 4 '(1 2)))))", *LET), "6"); + partial_eval_test(&g, &format!("{} (let1 a 2 (vau 0 p (+ 1 a)))", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/3]"); + partial_eval_test(&g, &format!("{} + !(let1 a 2) + (vau 0 p (+ 1 a)) + ", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/3]"); + partial_eval_test(&g, &format!("{} + !(let1 a 2) + !(let1 b 5) + (vau 0 p (+ b a)) + ", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/7]"); + /* + partial_eval_test(&g, &format!("{} + (vau 0 p + !(let1 a 2) + !(let1 b 5) + (+ b a) + ) + ", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/7]"); + partial_eval_test(&g, &format!("{} + (vau d p + !(let1 a 2) + (+ (eval (car p) d) a) + ) + ", *LET), "None({})#[None/None/EnvID(2)/0/[]/Some(\"p\")/7]"); + */ +} + +#[test] +fn fib_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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)) + !(let1 n (eval (car (cdr p)) de)) + !(if (= 0 n) 0) + !(if (= 1 n) 1) + (+ (self self (- n 1)) (self self (- n 2))) + ))"; + eval_test(false, &g, &e, &format!("{} {} (fib fib 6)", *LET, def_fib), 8); +} +#[test] +fn fact_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + let def_fact = " + !(let1 fact (vau de p + !(let1 self (eval (car p) de)) + !(let1 n (eval (car (cdr p)) de)) + !(if (= 0 n) 1) + (* n (self self (- n 1))) + ))"; + eval_test(true, &g, &e, &format!("{} {} (fact fact 6)", *LET, def_fact), 720); +} +static VAPPLY: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 vapply (vau de p + !(let1 f (eval (car p) de)) + !(let1 ip (eval (car (cdr p)) de)) + !(let1 nde (eval (car (cdr (cdr p))) de)) + (eval (cons f ip) nde) + ))", *LET) +}); +#[test] +fn vapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + // need the vapply to keep env in check because otherwise the env keeps growing + // and the Rc::drop will overflow the stack lol + let def_badid = format!(" + {} + !(let1 badid (vau de p + !(let1 inner (vau ide ip + !(let1 self (car ip)) + !(let1 n (car (cdr ip))) + !(let1 acc (car (cdr (cdr ip)))) + !(if (= 0 n) acc) + (vapply self (cons self (cons (- n 1) (cons (+ acc 1) nil))) de) + )) + (vapply inner (cons inner (cons (eval (car p) de) (cons 0 nil))) de) + ))", *VAPPLY); + // Won't work unless tail calls work + // so no PE? + eval_test(false, &g, &e, &format!("{} (badid 1000)", def_badid), 1000); +} + +static VMAP: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 vmap (vau de p + !(let1 vmap_inner (vau ide ip + !(let1 self (car ip)) + !(let1 f (car (cdr ip))) + !(let1 l (car (cdr (cdr ip)))) + !(if (= nil l) l) + (cons (vapply f (cons (car l) nil) de) (vapply self (cons self (cons f (cons (cdr l) nil))) de)) + )) + (vapply vmap_inner (cons vmap_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de) + ))", *VAPPLY) +}); +#[test] +fn vmap_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + // Maybe define in terms of a right fold? + //eval_test(true, &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))", *VMAP), (2, Form::Nil)); +} + +static WRAP: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 wrap (vau de p + !(let1 f (eval (car p) de)) + (vau ide p (vapply f (vmap (vau _ xp (eval (car xp) ide)) p) ide)) + ))", *VMAP) +}); +#[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(true, &g, &e, &format!("{} ((wrap (vau _ p (+ (car p) 1))) (+ 1 2))", *WRAP), 4); +} + +static UNWRAP: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 unwrap (vau de p + !(let1 f (eval (car p) de)) + (vau ide p (vapply f (vmap (vau _ xp (cons quote (cons (car xp) nil))) p) ide)) + ))", *WRAP) +}); +#[test] +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(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 = Lazy::new(|| { + format!(" + {} + !(let1 lapply (vau de p + !(let1 f (eval (car p) de)) + !(let1 ip (eval (car (cdr p)) de)) + !(let1 nde (eval (car (cdr (cdr p))) de)) + (eval (cons (unwrap f) ip) nde) + ))", *UNWRAP) +}); +#[test] +fn lapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + // Should this allow envs at all? It technically can, but I feel like it kinda goes against the + // sensible deriviation + let def_lbadid = format!(" + {} + !(let1 lbadid (vau de p + !(let1 inner (wrap (vau ide ip + !(let1 self (car ip)) + !(let1 n (car (cdr ip))) + !(let1 acc (car (cdr (cdr ip)))) + !(if (= 0 n) acc) + (lapply self (cons self (cons (- n 1) (cons (+ acc 1) nil))) de) + ))) + (lapply inner (cons inner (cons (eval (car p) de) (cons 0 nil))) de) + ))", *LAPPLY); + // Won't work unless tail calls work + // takes a while though + eval_test(false, &g, &e, &format!("{} (lbadid 1000)", def_lbadid), 1000); +} + +static VFOLDL: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 vfoldl (vau de p + !(let1 vfoldl_inner (vau ide ip + !(let1 self (car ip)) + !(let1 f (car (cdr ip))) + !(let1 a (car (cdr (cdr ip)))) + !(let1 l (car (cdr (cdr (cdr ip))))) + !(if (= nil l) a) + (vapply self (cons self (cons f (cons (vapply f (cons a (cons (car l) nil)) de) (cons (cdr l) nil)))) de) + )) + (vapply vfoldl_inner (cons vfoldl_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) (cons (eval (car (cdr (cdr p))) de) nil)))) de) + ))", *LAPPLY) +}); +#[test] +fn vfoldl_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + eval_test(true, &g, &e, &format!("{} (vfoldl (vau de p (+ (car p) (car (cdr p)))) 0 '(1 2 3))", *VFOLDL), 6); +} +static ZIPD: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 zipd (vau de p + !(let1 zipd_inner (vau ide ip + !(let1 self (car ip)) + !(let1 a (car (cdr ip))) + !(let1 b (car (cdr (cdr ip)))) + !(if (= nil a) a) + !(if (= nil b) b) + (cons (cons (car a) (car b)) (vapply self (cons self (cons (cdr a) (cons (cdr b) nil))) de)) + )) + (vapply zipd_inner (cons zipd_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de) + ))", *VFOLDL) +}); +#[test] +fn zipd_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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 = Lazy::new(|| { + format!(" + {} + !(let1 concat (vau de p + !(let1 concat_inner (vau ide ip + !(let1 self (car ip)) + !(let1 a (car (cdr ip))) + !(let1 b (car (cdr (cdr ip)))) + !(if (= nil a) b) + (cons (car a) (vapply self (cons self (cons (cdr a) (cons b nil))) de)) + )) + (vapply concat_inner (cons concat_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de) + ))", *ZIPD) +}); + +#[test] +fn concat_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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 = Lazy::new(|| { + format!(" + {} + !(let1 match_params (wrap (vau 0 p + !(let1 self (car p)) + !(let1 p_ls (car (cdr p))) + !(let1 dp (car (cdr (cdr p)))) + !(let1 e (car (cdr (cdr (cdr p))))) + !(if (= nil p_ls) (assert (= nil dp) e)) + !(if (symbol? p_ls) (cons (cons p_ls dp) e)) + (self self (cdr p_ls) (cdr dp) (self self (car p_ls) (car dp) e)) + ))) + !(let1 bvau (vau se p + (if (= nil (cdr (cdr p))) + ; No de case + !(let1 p_ls (car p)) + !(let1 b_v (car (cdr p))) + (vau 0 dp + (eval b_v (match_params match_params p_ls dp se)) + ) + + ; de case + !(let1 de_s (car p)) + !(let1 p_ls (car (cdr p))) + !(let1 b_v (car (cdr (cdr p)))) + (vau dde dp + (eval b_v (match_params match_params p_ls dp (cons (cons de_s dde) se))) + ) + ) + ))", *CONCAT) +}); +#[test] +fn bvau_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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(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(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 = Lazy::new(|| { + format!(" + {} + !(let1 lambda (vau de p + (wrap (vapply bvau p de)) + ))", *BVAU) +}); +#[test] +fn lambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + eval_test(true, &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) 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(true, &g, &e, &format!("{} ((lambda (a b c) c) 10 2 3 4)", *LAMBDA), 3); +} + +static LET2: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 let1 (bvau dp (s v b) + (eval b (match_params match_params s (eval v dp) dp)) + )) + ", *LAMBDA) +}); + +#[test] +fn let2_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + + 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(true, &g, &e, &format!("{} (let1 (a b c) '(10 2 3 4) a)", *LET2), 10); +} + +static LIST: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 list (lambda args args)) + ", *LET2) +}); + +#[test] +fn list_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + eval_test(true, &g, &e, &format!("{} (list 1 2 (+ 3 4))", *LIST), (1, (2, (7, Form::Nil)))); +} + +static Y: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 Y (lambda (f3) + ((lambda (x1) (x1 x1)) + (lambda (x2) (f3 (wrap (vau app_env y (lapply (x2 x2) y app_env))))))) + ) + ", *LIST) +}); + +#[test] +fn y_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + + eval_test(true, &g, &e, &format!("{} ((Y (lambda (recurse) (lambda (n) (if (= 0 n) 1 (* n (recurse (- n 1))))))) 5)", *Y), 120); + +} + +static RLAMBDA: Lazy = Lazy::new(|| { + format!(" + {} + !(let1 rlambda (bvau se (n p b) + (eval (list Y (list lambda (list n) (list lambda p b))) se) + )) + ", *Y) +}); + +#[test] +fn rlambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + eval_test(true, &g, &e, &format!("{} ((rlambda recurse (n) (if (= 0 n) 1 (* n (recurse (- n 1))))) 5)", *RLAMBDA), 120); +} +static AND_OR: Lazy = Lazy::new(|| { + // need to extend for varidac + format!(" + {} + !(let1 and (bvau se (a b) + !(let1 ae (eval a se)) + (if ae (eval b se) ae) + )) + !(let1 or (bvau se (a b) + !(let1 ae (eval a se)) + (if ae ae (eval b se)) + )) + ", *RLAMBDA) +}); + +#[test] +fn and_or_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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(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 = Lazy::new(|| { + format!(" + {} + !(let1 len (lambda (l) + !(let1 len_helper (rlambda len_helper (l a) + (if (pair? l) (len_helper (cdr l) (+ 1 a)) + a) + )) + (len_helper l 0) + )) + ", *AND_OR) +}); + +#[test] +fn len_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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 = Lazy::new(|| { + format!(" + {} + !(let1 match (bvau de (x . cases) + !(let1 evaluate_case (rlambda evaluate_case (access c) + !(if (symbol? c) (list true (lambda (b) (list let1 c access b)))) + !(if (and (pair? c) (= 'unquote (car c))) (list (list = access (car (cdr c))) (lambda (b) b))) + !(if (and (pair? c) (= 'quote (car c))) (list (list = access c) (lambda (b) b))) + !(if (pair? c) + !(let1 tests (list and (list pair? access) (list = (len c) (list len access)))) + !(let1 (tests body_func) ((rlambda recurse (c tests access body_func) (if (pair? c) + !(let1 (inner_test inner_body_func) (evaluate_case (list car access) (car c))) + (recurse (cdr c) + (list and tests inner_test) + (list cdr access) + (lambda (b) (body_func (inner_body_func b)))) + ; else + (list tests body_func) + )) + c tests access (lambda (b) b))) + (list tests body_func)) + (list (list = access c) (lambda (b) b)) + )) + !(let1 helper (rlambda helper (x_sym cases) (if (= nil cases) (list assert false) + (let1 (test body_func) (evaluate_case x_sym (car cases)) + (concat (list if test (body_func (car (cdr cases)))) (list (helper x_sym (cdr (cdr cases))))))))) + + (eval (list let1 '___MATCH_SYM x (helper '___MATCH_SYM cases)) de) + ;!(let1 expanded (list let1 '___MATCH_SYM x (helper '___MATCH_SYM cases))) + ;(debug expanded (eval expanded de)) + )) + ", *LEN) +}); +#[test] +fn match_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + 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 = Lazy::new(|| { + format!(" + {} + !(let1 empty (list 'B nil nil nil)) + !(let1 E empty) + !(let1 EE (list 'BB nil nil nil)) + + !(let1 generic-foldl (rlambda generic-foldl (f z t) (match t + (unquote E) z + + (c a x b) !(let1 new_left_result (generic-foldl f z a)) + !(let1 folded (f new_left_result x)) + (generic-foldl f folded b)))) + + !(let1 blacken (lambda (t) (match t + ('R a x b) (list 'B a x b) + t t))) + !(let1 balance (lambda (t) (match t + ; figures 1 and 2 + ('B ('R ('R a x b) y c) z d) (list 'R (list 'B a x b) y (list 'B c z d)) + ('B ('R a x ('R b y c)) z d) (list 'R (list 'B a x b) y (list 'B c z d)) + ('B a x ('R ('R b y c) z d)) (list 'R (list 'B a x b) y (list 'B c z d)) + ('B a x ('R b y ('R c z d))) (list 'R (list 'B a x b) y (list 'B c z d)) + ; figure 8, double black cases + ('BB ('R a x ('R b y c)) z d) (list 'B (list 'B a x b) y (list 'B c z d)) + ('BB a x ('R ('R b y c) z d)) (list 'B (list 'B a x b) y (list 'B c z d)) + ; already balenced + t t))) + + !(let1 map-insert !(let1 ins (rlambda ins (t k v) (match t + (unquote E) (list 'R t (list k v) t) + (c a x b) !(if (< k (car x)) (balance (list c (ins a k v) x b))) + !(if (= k (car x)) (list c a (list k v) b)) + (balance (list c a x (ins b k v)))))) + (lambda (t k v) (blacken (ins t k v)))) + + !(let1 map-empty empty) + + !(let1 make-test-tree (rlambda make-test-tree (n t) (if (<= n 0) t + (make-test-tree (- n 1) (map-insert t n (= 0 (% n 10))))))) + !(let1 reduce-test-tree (lambda (tree) (generic-foldl (lambda (a x) (if (car (cdr x)) (+ a 1) a)) 0 tree))) + ", *MATCH) +}); +#[test] +fn rbtree_eval_test() { let g = grammar::TermParser::new(); let e = root_env(); + eval_test(false, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 10 map-empty))", *RBTREE), 1); + //eval_test(false, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 20 map-empty))", *RBTREE), 2); +}