From 06d896277c6c6167787f6c7b40d9c0bb285ba4fb Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Tue, 15 May 2018 22:47:36 -0600 Subject: [PATCH] major refactor --- Cargo.toml | 2 +- README.md | 6 +- src/main.rs | 10 +- src/prolog/ast.rs | 38 +- src/prolog/builtins.rs | 778 ----------------------- src/prolog/codegen.rs | 13 + src/prolog/compile.rs | 317 +++++++++ src/prolog/heap_print.rs | 6 +- src/prolog/io.rs | 333 +--------- src/prolog/iterators.rs | 9 + src/prolog/lib/builtins.pl | 71 ++- src/prolog/lib/control.pl | 10 +- src/prolog/lib/lists.pl | 35 +- src/prolog/lib/queues.pl | 2 + src/prolog/machine/machine_state.rs | 21 +- src/prolog/machine/machine_state_impl.rs | 21 +- src/prolog/machine/mod.rs | 33 +- src/prolog/machine/system_calls.rs | 52 +- src/prolog/macros.rs | 5 + src/prolog/mod.rs | 2 +- src/prolog/toplevel.rs | 18 +- src/tests.rs | 81 +-- 22 files changed, 587 insertions(+), 1276 deletions(-) delete mode 100644 src/prolog/builtins.rs create mode 100644 src/prolog/compile.rs diff --git a/Cargo.toml b/Cargo.toml index 3e19297a..b030b91e 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "rusty-wam" -version = "0.7.7" +version = "0.7.8" authors = ["Mark Thom"] [dependencies] diff --git a/README.md b/README.md index c1722354..4be008f5 100644 --- a/README.md +++ b/README.md @@ -26,11 +26,11 @@ Extend rusty-wam to include the following, among other features: associativity and precedence (_done_). * Bignum, rational number and floating point arithmetic (_done_). * Built-in control operators (`,`, `;`, `->`, etc.) (_done_). +* A revised, not-terrible module system (_in progress_). * Built-in predicates for list processing and top-level declarative control (`setup_call_control/3`, `call_with_inference_limit/3`, - etc.) (_done_). -* A rudimentary module system (_done_). -* Definite Clause Grammars (_in progress_). + etc.) (NEEDS REVISION) +* Definite Clause Grammars * Attributed variables using the SICStus Prolog interface and semantics. Adding coroutines like `dif/2`, `freeze/2`, etc. is straightforward with attributed variables. diff --git a/src/main.rs b/src/main.rs index 7bae9750..c4c749fe 100644 --- a/src/main.rs +++ b/src/main.rs @@ -5,16 +5,13 @@ extern crate termion; mod prolog; use prolog::ast::*; +use prolog::compile::*; use prolog::io::*; use prolog::machine::*; #[cfg(test)] mod tests; -pub static LISTS: &str = include_str!("./prolog/lib/lists.pl"); -pub static CONTROL: &str = include_str!("./prolog/lib/control.pl"); -pub static QUEUES: &str = include_str!("./prolog/lib/queues.pl"); - fn parse_and_compile_line(wam: &mut Machine, buffer: &str) { match parse_code(wam, buffer) { @@ -29,11 +26,6 @@ fn parse_and_compile_line(wam: &mut Machine, buffer: &str) fn prolog_repl() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); - load_init_str(&mut wam, LISTS); - // load_init_str(&mut wam, CONTROL); - // load_init_str(&mut wam, QUEUES); - loop { print!("prolog> "); diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 47e1b11d..c5f24cb4 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -1,4 +1,3 @@ -use prolog::builtins::*; use prolog::num::bigint::BigInt; use prolog::num::{Float, ToPrimitive, Zero}; use prolog::num::rational::Ratio; @@ -161,6 +160,19 @@ pub struct Module { pub op_dir: OpDir } +pub fn default_op_dir() -> OpDir { + let module_name = clause_name!("builtins"); + let mut op_dir = OpDir::new(); + + op_dir.insert((clause_name!(":-"), Fixity::In), (XFX, 1200, module_name.clone())); + op_dir.insert((clause_name!(":-"), Fixity::Pre), (FX, 1200, module_name.clone())); + op_dir.insert((clause_name!("?-"), Fixity::Pre), (FX, 1200, module_name.clone())); + + op_dir +} + +pub static BUILTINS: &str = include_str!("./lib/builtins.pl"); + impl Module { pub fn new(module_decl: ModuleDecl) -> Self { Module { module_decl, @@ -468,7 +480,7 @@ pub enum ParserError { Arithmetic(ArithmeticError), BackQuotedString, - BuiltInArityMismatch(&'static str), + // BuiltInArityMismatch(&'static str), UnexpectedChar(char), UnexpectedEOF, IO(IOError), @@ -682,6 +694,7 @@ pub enum QueryTerm { Clause(Cell, ClauseType, Vec>), BlockedCut, // a cut which is 'blocked by letters', like the P term in P -> Q. UnblockedCut(Cell), + GetLevelAndUnify(Cell, Rc), Jump(JumpStub) } @@ -690,7 +703,8 @@ impl QueryTerm { match self { &QueryTerm::Clause(_, _, ref subterms) => subterms.len(), &QueryTerm::BlockedCut | &QueryTerm::UnblockedCut(..) => 0, - &QueryTerm::Jump(ref vars) => vars.len() + &QueryTerm::Jump(ref vars) => vars.len(), + &QueryTerm::GetLevelAndUnify(..) => 1, } } } @@ -763,7 +777,7 @@ impl SystemClauseType { match (name, arity) { ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner), - ("$install_scc_cleaner", 1) => + ("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner), ("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter), @@ -940,7 +954,7 @@ impl BuiltInClauseType { ("@>", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)), ("@<", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThan)), ("@>=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual)), - ("@<=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)), + ("@=<", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)), ("\\=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::NotEqual)), ("=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::Equal)), ("display", 1) => Some(BuiltInClauseType::Display), @@ -1040,6 +1054,7 @@ pub enum ChoiceInstruction { pub enum CutInstruction { Cut(RegType), GetLevel(RegType), + GetLevelAndUnify(RegType), NeckCut } @@ -1372,7 +1387,7 @@ pub enum ArithmeticInstruction { pub enum ControlInstruction { Allocate(usize), // num_frames. CallClause(ClauseType, usize, usize, bool), // name, arity, perm_vars after threshold, last call. - Deallocate, + Deallocate, JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call. Proceed } @@ -1481,7 +1496,7 @@ impl PartialOrd for Addr { Some(Ordering::Equal) } else { Some(Ordering::Less) - } + } }, &Addr::HeapCell(h) => match r { @@ -1635,13 +1650,6 @@ pub enum LocalCodePtr { } impl LocalCodePtr { - pub fn module_name(&self) -> ClauseName { - match self { - &LocalCodePtr::DirEntry(_, ref name) => name.clone(), - _ => ClauseName::BuiltIn("user") - } - } - pub fn assign_if_local(&mut self, cp: CodePtr) { match cp { CodePtr::Local(local) => *self = local, @@ -1690,7 +1698,7 @@ impl Add for LocalCodePtr { fn add(self, rhs: usize) -> Self::Output { match self { - LocalCodePtr::DirEntry(p, name) => LocalCodePtr::DirEntry(p + rhs, name), + LocalCodePtr::DirEntry(p, name) => LocalCodePtr::DirEntry(p + rhs, name), LocalCodePtr::TopLevel(cn, p) => LocalCodePtr::TopLevel(cn, p + rhs) } } diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs deleted file mode 100644 index d3796300..00000000 --- a/src/prolog/builtins.rs +++ /dev/null @@ -1,778 +0,0 @@ -use prolog::ast::*; - -use std::collections::HashMap; - -/* -fn get_builtins() -> Code { - vec![internal_call_n!(), // callN/N, 0. - is_atomic!(temp_v!(1)), // atomic/1, 1. - proceed!(), - is_var!(temp_v!(1)), // var/1, 3. - proceed!(), - allocate!(4), // catch/3, 5. - fact![get_var_in_fact!(perm_v!(2), 1), - get_var_in_fact!(perm_v!(3), 2), - get_var_in_fact!(perm_v!(1), 3)], - query![put_var!(perm_v!(4), 1)], - get_current_block!(), - query![put_value!(perm_v!(2), 1), - put_value!(perm_v!(3), 2), - put_value!(perm_v!(1), 3), - put_unsafe_value!(4, 4)], - deallocate!(), - goto_execute!(12, 4), // goto catch/4. - try_me_else!(10), // catch/4, 12. - allocate!(3), - fact![get_var_in_fact!(perm_v!(3), 1), - get_var_in_fact!(perm_v!(2), 4)], - query![put_var!(perm_v!(1), 1)], - install_new_block!(), - query![put_value!(perm_v!(3), 1)], - call_n!(1), - query![put_value!(perm_v!(2), 1), - put_unsafe_value!(1, 2)], - deallocate!(), - goto_execute!(44, 2), //21: goto end_block/2. - default_trust_me!(), - allocate!(3), - fact![get_var_in_fact!(perm_v!(2), 2), - get_var_in_fact!(perm_v!(1), 3)], - query![get_var_in_query!(temp_v!(2), 1), - put_value!(temp_v!(4), 1)], - reset_block!(), - query![put_var!(perm_v!(3), 1)], - get_ball!(), - query![put_unsafe_value!(3, 1), - put_value!(perm_v!(2), 2), - put_value!(perm_v!(1), 3)], - deallocate!(), - goto_execute!(32, 2), // goto handle_ball/2. - try_me_else!(10), // handle_ball/2, 32. - allocate!(2), - get_level!(perm_v!(1)), - fact![get_var_in_fact!(perm_v!(2), 3)], - unify!(), - cut!(perm_v!(1)), - erase_ball!(), - query![put_value!(perm_v!(2), 1)], - deallocate!(), - execute_n!(1), - default_trust_me!(), - unwind_stack!(), - try_me_else!(9), // end_block/2, 44. - allocate!(1), - fact![get_var_in_fact!(perm_v!(1), 1)], - query![put_value!(temp_v!(2), 1)], - clean_up_block!(), - query![put_value!(perm_v!(1), 1)], - deallocate!(), - reset_block!(), - proceed!(), - default_trust_me!(), // 53. - allocate!(0), - query![get_var_in_query!(temp_v!(3), 1), - put_value!(temp_v!(2), 1)], - reset_block!(), - deallocate!(), - goto_execute!(61, 0), - set_ball!(), // throw/1, 59. - unwind_stack!(), - fail!(), // false/0, 61. - try_me_else!(7), // not/1, 62. - allocate!(1), - get_level!(perm_v!(1)), - call_n!(1), - cut!(perm_v!(1)), - deallocate!(), - goto_execute!(61, 0), - trust_me!(), - proceed!(), - duplicate_term!(), // duplicate_term/2, 71. - proceed!(), - fact![get_value!(temp_v!(1), 2)], // =/2, 73. - proceed!(), - proceed!(), // true/0, 75. - get_cp!(temp_v!(3)), // ','/2, 76. - try_me_else!(18), // ','/3, 77. - switch_on_term!(4, 1, 0, 0), - indexed_try!(4), - retry!(7), - trust!(10), - try_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(1)), - get_structure!(",", 2, temp_v!(2), Some(infix!())), - unify_variable!(temp_v!(1)), - unify_variable!(temp_v!(2))], - set_cp!(temp_v!(3)), - goto_execute!(77, 3), - retry_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(1)), - get_constant!(atom!("!"), temp_v!(2))], - set_cp!(temp_v!(3)), - proceed!(), - trust_me!(), - fact![get_constant!(atom!("!"), temp_v!(1))], - set_cp!(temp_v!(3)), - query![put_value!(temp_v!(2), 1)], - execute_n!(1), - retry_me_else!(8), // 95. - allocate!(3), - fact![get_structure!(",", 2, temp_v!(2), Some(infix!())), - unify_variable!(perm_v!(2)), - unify_variable!(perm_v!(1)), - get_var_in_fact!(perm_v!(3), 3)], - neck_cut!(), - call_n!(1), - query![put_unsafe_value!(2, 1), - put_unsafe_value!(1, 2), - put_value!(perm_v!(3), 3)], - deallocate!(), - goto_execute!(77, 3), - retry_me_else!(10), - allocate!(2), - get_level!(perm_v!(2)), - fact![get_constant!(atom!("!"), temp_v!(2)), - get_var_in_fact!(perm_v!(1), 3)], - neck_cut!(), - call_n!(1), - query![put_value!(perm_v!(1), 1)], - set_cp!(temp_v!(1)), - deallocate!(), - proceed!(), - trust_me!(), - allocate!(1), - fact![get_var_in_fact!(perm_v!(1), 2)], - call_n!(1), - query![put_value!(perm_v!(1), 1)], - deallocate!(), - execute_n!(1), - get_cp!(temp_v!(3)), // ';'/2, 120. - try_me_else!(16), // ';'/3, 121. - switch_on_term!(0, 12, 0, 1), // Fail on variable input. - indexed_try!(2), - trust!(5), - fact![get_structure!("->", 2, temp_v!(1), Some(infix!())), - unify_variable!(temp_v!(1)), - unify_variable!(temp_v!(4))], - query![put_value!(temp_v!(4), 2)], - goto_execute!(147, 3), // goto '->'/3. - retry_me_else!(5), - fact![get_structure!("->", 2, temp_v!(1), Some(infix!())), - unify_void!(2)], - set_cp!(temp_v!(3)), - query![put_value!(temp_v!(2), 1)], - execute_n!(1), - retry_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(1))], - set_cp!(temp_v!(3)), - proceed!(), - retry_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(2))], - set_cp!(temp_v!(3)), - proceed!(), - retry_me_else!(2), - execute_n!(1), - trust_me!(), - query![put_value!(temp_v!(2), 1)], - execute_n!(1), - get_cp!(temp_v!(3)), // '->'/2, 146. - try_me_else!(7), // '->'/3, 147. - allocate!(1), - fact![get_constant!(atom!("!"), temp_v!(2)), - get_var_in_fact!(perm_v!(1), 3)], - call_n!(1), - set_cp!(perm_v!(1)), - deallocate!(), - proceed!(), - trust_me!(), - allocate!(2), - fact![get_var_in_fact!(perm_v!(1), 2), - get_var_in_fact!(perm_v!(2), 3)], - call_n!(1), - set_cp!(perm_v!(2)), - query![put_unsafe_value!(1, 1)], - deallocate!(), - execute_n!(1), - functor_execute!(), // functor/3, 162. - is_integer!(temp_v!(1)), // integer/1, 163. - proceed!(), - get_arg_execute!(), // get_arg/3, 165. - try_me_else!(10), // arg/3, 166. - allocate!(4), - fact![get_var_in_fact!(perm_v!(1), 1), - get_var_in_fact!(perm_v!(2), 2), - get_var_in_fact!(perm_v!(4), 3)], - is_var!(perm_v!(1)), - neck_cut!(), - query![put_value!(perm_v!(2), 1), - put_var!(temp_v!(4), 2), - put_var!(perm_v!(3), 3)], - functor_call!(), - query![put_value!(perm_v!(1), 1), - put_constant!(Level::Shallow, integer!(1), temp_v!(2)), - put_unsafe_value!(3, 3), - put_value!(perm_v!(2), 4), - put_value!(perm_v!(4), 5)], - deallocate!(), - goto_execute!(189, 5), // goto arg_/5, 175. - retry_me_else!(10), - allocate!(3), - fact![get_var_in_fact!(perm_v!(1), 1), - get_var_in_fact!(perm_v!(2), 2), - get_var_in_fact!(perm_v!(3), 3)], - is_integer!(perm_v!(1)), - neck_cut!(), - query![put_value!(perm_v!(2), 1), - put_var!(temp_v!(4), 2), - put_var!(temp_v!(3), 3)], - functor_call!(), - query![put_value!(perm_v!(1), 1), - put_value!(perm_v!(2), 2), - put_value!(perm_v!(3), 3)], - deallocate!(), - goto_execute!(165, 3), // goto get_arg/3, 185. - trust_me!(), - query![get_var_in_query!(temp_v!(4), 1), - put_structure!("type_error", 2, temp_v!(2), None), - set_constant!(atom!(ValidType::Integer.as_str())), - set_value!(temp_v!(4)), - put_structure!("error", 2, temp_v!(1), None), - set_value!(temp_v!(2)), - set_void!(1)], - goto_execute!(59, 1), // goto throw/1. - try_me_else!(5), // arg_/5, 189. - fact![get_value!(temp_v!(1), 2), - get_value!(temp_v!(1), 3)], - neck_cut!(), - query![put_value!(temp_v!(4), 2), - put_value!(temp_v!(5), 3)], - goto_execute!(165, 3), // goto get_arg/3. - retry_me_else!(4), - fact![get_value!(temp_v!(1), 2)], - query![put_value!(temp_v!(4), 2), - get_var_in_query!(temp_v!(6), 3), - put_value!(temp_v!(5), 3)], - goto_execute!(165, 3), // goto get_arg/3, 197. - trust_me!(), - allocate!(5), - fact![get_var_in_fact!(perm_v!(2), 1), - get_var_in_fact!(perm_v!(4), 3), - get_var_in_fact!(perm_v!(3), 4), - get_var_in_fact!(perm_v!(5), 5)], - compare_number_instr!(CompareNumberQT::LessThan, - ArithmeticTerm::Reg(temp_v!(2)), - ArithmeticTerm::Reg(perm_v!(4))), - add!(ArithmeticTerm::Reg(temp_v!(2)), - ArithmeticTerm::Number(rc_integer!(1)), - 1), - query![put_var!(perm_v!(1), 1)], - is_call!(perm_v!(1), interm!(1)), - query![put_value!(perm_v!(2), 1), - put_unsafe_value!(1, 2), - put_value!(perm_v!(4), 3), - put_value!(perm_v!(3), 4), - put_value!(perm_v!(5), 5)], - deallocate!(), - goto_execute!(189, 5), // goto arg_/5, 207. - display!(), // display/1, 208. - proceed!(), - dynamic_is!(), // is/2, 210. - proceed!(), - dynamic_num_test!(cmp_gt!()), // >/2, 212. - proceed!(), - dynamic_num_test!(cmp_lt!()), // =/2, 216. - proceed!(), - dynamic_num_test!(cmp_lte!()), // ==)/2, 403. - compare_term_execute!(term_cmp_lte!()), // (@=<)/2, 404. - compare_term_execute!(term_cmp_gt!()), // (@>)/2, 405. - compare_term_execute!(term_cmp_lt!()), // (@<)/2, 406. - compare_term_execute!(term_cmp_eq!()), // (=@=)/2, 407. - compare_term_execute!(term_cmp_ne!()), // (\=@=)/2, 408. - allocate!(5), // call_with_inference_limit/3, 409. - fact![get_var_in_fact!(perm_v!(4), 1), - get_var_in_fact!(perm_v!(3), 2), - get_var_in_fact!(perm_v!(2), 3)], - query![put_var!(perm_v!(5), 1)], - get_current_block!(), - get_cp!(perm_v!(1)), - query![put_value!(perm_v!(4), 1), - put_value!(perm_v!(3), 2), - put_value!(perm_v!(2), 3), - put_value!(perm_v!(5), 4), - put_value!(perm_v!(1), 5)], - goto_call!(420, 5), // goto call_with_inference_limit/5, 415 - query![put_value!(perm_v!(1), 1)], - deallocate!(), - remove_call_policy_check!(), - proceed!(), - try_me_else!(19), // call_with_inference_limit/5, 420. - allocate!(9), - fact![get_var_in_fact!(perm_v!(9), 1), - get_var_in_fact!(perm_v!(5), 2), - get_var_in_fact!(perm_v!(8), 3), - get_var_in_fact!(perm_v!(3), 4), - get_var_in_fact!(perm_v!(4), 5)], - query![put_var!(perm_v!(1), 1)], - install_new_block!(), - query![put_var!(perm_v!(7), 3)], - install_inference_counter!(perm_v!(4), perm_v!(5), perm_v!(7)), - query![put_value!(perm_v!(9), 1)], - call_n!(1), - inference_level!(perm_v!(8), perm_v!(4)), - query![put_var!(perm_v!(6), 2)], - remove_inference_counter!(perm_v!(4), perm_v!(6)), - sub!(ArithmeticTerm::Reg(perm_v!(6)), - ArithmeticTerm::Reg(perm_v!(7)), - 1), - sub!(ArithmeticTerm::Reg(perm_v!(5)), - ArithmeticTerm::Interm(1), - 1), - query![put_var!(perm_v!(2), 1)], - is_call!(temp_v!(1), ArithmeticTerm::Interm(1)), - query![put_value!(perm_v!(4), 1), - put_value!(perm_v!(3), 2), - put_value!(perm_v!(1), 3), - put_value!(perm_v!(2), 4)], - deallocate!(), - goto_execute!(468, 4), // goto end_block/4, 468 - default_trust_me!(), // 439 - allocate!(3), - fact![get_var_in_fact!(perm_v!(1), 3), - get_var_in_fact!(perm_v!(3), 5)], - query![put_value!(temp_v!(4), 1)], - reset_block!(), - query![put_var!(temp_v!(3), 2)], - remove_inference_counter!(perm_v!(3), temp_v!(2)), - query![put_value!(perm_v!(3), 1), - put_var!(perm_v!(2), 2)], - jmp_call!(2, 5, 0), - erase_ball!(), - query![put_value!(perm_v!(3), 1), - put_unsafe_value!(2, 2), - put_value!(perm_v!(1), 3)], - deallocate!(), - goto_execute!(460, 3), // goto handle_ile/3, 451. - try_me_else!(5), // the inner clause. - query![put_value!(temp_v!(2), 1)], - get_ball!(), - neck_cut!(), - proceed!(), - default_trust_me!(), - remove_call_policy_check!(), - fail!(), - try_me_else!(4), // handle_ile/3, 460. - fact![get_structure!("inference_limit_exceeded", 1, temp_v!(2), None), - unify_value!(temp_v!(1)), - get_constant!(atom!("inference_limit_exceeded"), temp_v!(3))], - neck_cut!(), - proceed!(), - default_trust_me!(), - remove_call_policy_check!(), - query![put_value!(temp_v!(2), 1)], - goto_execute!(59, 1), // goto throw/1, 59. - try_me_else!(6), // end_block/4, 468. - query![put_value!(temp_v!(3), 1)], - clean_up_block!(), - query![put_value!(temp_v!(2), 1)], - reset_block!(), - proceed!(), - default_trust_me!(), - query![get_var_in_query!(temp_v!(5), 3), - put_value!(temp_v!(4), 2), - put_var!(temp_v!(6), 3)], - install_inference_counter!(temp_v!(1), temp_v!(4), temp_v!(6)), - query![put_value!(temp_v!(5), 1)], - reset_block!(), - fail!(), - compare_execute!(), // compare/3, 480. - is_atom!(temp_v!(1)), // atom/1, 481. - proceed!(), - sort_execute!(), // sort/2, 483. - keysort_execute!(), // keysort/2, 484. - acyclic_term_execute!(), // acyclic_term/1, 485. - cyclic_term_execute!(), // cyclic_term/1, 486. - ] -} */ - -pub fn default_op_dir() -> OpDir -{ - let mut op_dir = HashMap::new(); - let module_name = clause_name!("builtins"); - - op_dir.insert((clause_name!(":-"), Fixity::In), (XFX, 1200, module_name.clone())); - op_dir.insert((clause_name!(":-"), Fixity::Pre), (FX, 1200, module_name.clone())); - op_dir.insert((clause_name!("?-"), Fixity::Pre), (FX, 1200, module_name.clone())); - op_dir.insert((clause_name!("/"), Fixity::In), (YFX, 400, module_name.clone())); - -/* - // control operators. - op_dir.insert((clause_name!("\\+"), Fixity::Pre), (FY, 900, builtin.clone())); - op_dir.insert((clause_name!("="), Fixity::In), (XFX, 700, builtin.clone())); - - // arithmetic operators. - op_dir.insert((clause_name!("is"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("+"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("-"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("/\\"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("\\/"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("xor"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("//"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("div"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("*"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("-"), Fixity::Pre), (FY, 200, builtin.clone())); - op_dir.insert((clause_name!("rdiv"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("<<"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!(">>"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("mod"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("rem"), Fixity::In), (YFX, 400, builtin.clone())); - - // arithmetic comparison operators. - op_dir.insert((clause_name!(">"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("<"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=\\="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=:="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!(">="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=<"), Fixity::In), (XFX, 700, builtin.clone())); - - // control operators. - op_dir.insert((clause_name!(";"), Fixity::In), (XFY, 1100, builtin.clone())); - op_dir.insert((clause_name!("->"), Fixity::In), (XFY, 1050, builtin.clone())); - - op_dir.insert((clause_name!("=.."), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("\\=="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@=<"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@>="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@<"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@>"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=@="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("\\=@="), Fixity::In), (XFX, 700, builtin.clone())); - - // there are 63 registers in the VM, so call/N is defined for all 0 <= N <= 62 - // (an extra register is needed for the predicate name) - for arity in 0 .. 63 { - code_dir.insert((clause_name!("call"), arity), CodeIndex::from((0, builtin.clone()))); - } - - code_dir.insert((clause_name!("atomic"), 1), CodeIndex::from((1, builtin.clone()))); - code_dir.insert((clause_name!("var"), 1), CodeIndex::from((3, builtin.clone()))); - code_dir.insert((clause_name!("false"), 0), CodeIndex::from((61, builtin.clone()))); - code_dir.insert((clause_name!("\\+"), 1), CodeIndex::from((62, builtin.clone()))); - code_dir.insert((clause_name!("duplicate_term"), 2), CodeIndex::from((71, builtin.clone()))); - code_dir.insert((clause_name!("catch"), 3), CodeIndex::from((5, builtin.clone()))); - code_dir.insert((clause_name!("throw"), 1), CodeIndex::from((59, builtin.clone()))); - code_dir.insert((clause_name!("="), 2), CodeIndex::from((73, builtin.clone()))); - code_dir.insert((clause_name!("true"), 0), CodeIndex::from((75, builtin.clone()))); - - code_dir.insert((clause_name!(","), 2), CodeIndex::from((76, builtin.clone()))); - code_dir.insert((clause_name!(";"), 2), CodeIndex::from((120, builtin.clone()))); - code_dir.insert((clause_name!("->"), 2), CodeIndex::from((146, builtin.clone()))); - - code_dir.insert((clause_name!("functor"), 3), CodeIndex::from((162, builtin.clone()))); - code_dir.insert((clause_name!("arg"), 3), CodeIndex::from((166, builtin.clone()))); - code_dir.insert((clause_name!("integer"), 1), CodeIndex::from((163, builtin.clone()))); - code_dir.insert((clause_name!("display"), 1), CodeIndex::from((208, builtin.clone()))); - - //code_dir.insert((clause_name!("is"), 2), CodeIndex::from((210, builtin.clone()))); - code_dir.insert((clause_name!(">"), 2), CodeIndex::from((212, builtin.clone()))); - code_dir.insert((clause_name!("<"), 2), CodeIndex::from((214, builtin.clone()))); - code_dir.insert((clause_name!(">="), 2), CodeIndex::from((216, builtin.clone()))); - code_dir.insert((clause_name!("=<"), 2), CodeIndex::from((218, builtin.clone()))); - code_dir.insert((clause_name!("=\\="), 2), CodeIndex::from((220, builtin.clone()))); - code_dir.insert((clause_name!("=:="), 2), CodeIndex::from((222, builtin.clone()))); - code_dir.insert((clause_name!("=.."), 2), CodeIndex::from((224, builtin.clone()))); - - code_dir.insert((clause_name!("length"), 2), CodeIndex::from((277, builtin.clone()))); - code_dir.insert((clause_name!("setup_call_cleanup"), 3), - CodeIndex::from((310, builtin.clone()))); - code_dir.insert((clause_name!("call_with_inference_limit"), 3), - CodeIndex::from((409, builtin.clone()))); - - code_dir.insert((clause_name!("compound"), 1), CodeIndex::from((388, builtin.clone()))); - code_dir.insert((clause_name!("rational"), 1), CodeIndex::from((390, builtin.clone()))); - code_dir.insert((clause_name!("string"), 1), CodeIndex::from((392, builtin.clone()))); - code_dir.insert((clause_name!("float"), 1), CodeIndex::from((394, builtin.clone()))); - code_dir.insert((clause_name!("nonvar"), 1), CodeIndex::from((396, builtin.clone()))); - - code_dir.insert((clause_name!("ground"), 1), CodeIndex::from((400, builtin.clone()))); - code_dir.insert((clause_name!("=="), 2), CodeIndex::from((401, builtin.clone()))); - code_dir.insert((clause_name!("\\=="), 2), CodeIndex::from((402, builtin.clone()))); - code_dir.insert((clause_name!("@>="), 2), CodeIndex::from((403, builtin.clone()))); - code_dir.insert((clause_name!("@=<"), 2), CodeIndex::from((404, builtin.clone()))); - code_dir.insert((clause_name!("@>"), 2), CodeIndex::from((405, builtin.clone()))); - code_dir.insert((clause_name!("@<"), 2), CodeIndex::from((406, builtin.clone()))); - code_dir.insert((clause_name!("=@="), 2), CodeIndex::from((407, builtin.clone()))); - code_dir.insert((clause_name!("\\=@="), 2), CodeIndex::from((408, builtin.clone()))); - code_dir.insert((clause_name!("compare"), 3), CodeIndex::from((480, builtin.clone()))); - code_dir.insert((clause_name!("atom"), 1), CodeIndex::from((481, builtin.clone()))); - - (code_dir, op_dir) - */ - op_dir -} - -/* -pub fn default_build() -> (Code, CodeDir, OpDir) -{ - let builtin_code = get_builtins(); - let (code_dir, op_dir) = build_code_and_op_dirs(); - - (builtin_code, code_dir, op_dir) -} -*/ diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index 1b1703e8..274b557d 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -404,6 +404,19 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator }; match *term { + &QueryTerm::GetLevelAndUnify(ref cell, ref var) => { + let mut target = Vec::new(); + + self.marker.reset_arg(1); + self.marker.mark_var(var.clone(), Level::Shallow, cell, + term_loc, &mut target); + + if !target.is_empty() { + code.push(Line::Query(target)); + } + + code.push(get_level_and_unify!(cell.get().norm())); + }, &QueryTerm::UnblockedCut(ref cell) => code.push(set_cp!(cell.get().norm())), &QueryTerm::BlockedCut => diff --git a/src/prolog/compile.rs b/src/prolog/compile.rs new file mode 100644 index 00000000..38900c3c --- /dev/null +++ b/src/prolog/compile.rs @@ -0,0 +1,317 @@ +use prolog::ast::*; +use prolog::debray_allocator::*; +use prolog::codegen::*; +use prolog::machine::*; +use prolog::toplevel::*; + +#[allow(dead_code)] +fn print_code(code: &Code) { + for clause in code { + match clause { + &Line::Arithmetic(ref arith) => + println!("{}", arith), + &Line::Fact(ref fact) => + for fact_instr in fact { + println!("{}", fact_instr); + }, + &Line::Cut(ref cut) => + println!("{}", cut), + &Line::Choice(ref choice) => + println!("{}", choice), + &Line::Control(ref control) => + println!("{}", control), + &Line::IndexedChoice(ref choice) => + println!("{}", choice), + &Line::Indexing(ref indexing) => + println!("{}", indexing), + &Line::Query(ref query) => + for query_instr in query { + println!("{}", query_instr); + } + } + } +} + +pub(crate) trait TLInfo { + fn update_entry_index(&self, &ClauseName, usize, CodeIndex, &mut CodeIndex, usize); + + // give the correct CodePtr offsets to CallClause's whose types are + // Named and Op. Enable late binding by setting to the default. + fn label_clauses(&self, code_size: usize, code_dir: &mut CodeDir, code: &mut Code) + { + for line in code.iter_mut() { + if let &mut Line::Control(ControlInstruction::CallClause(ref mut ct, a1, ..)) = line { + match ct { + &mut ClauseType::Named(ref n1, ref mut cp) + | &mut ClauseType::Op(ref n1, _, ref mut cp) => { + let entry = code_dir.entry((n1.clone(), a1)).or_insert(CodeIndex::default()); + self.update_entry_index(n1, a1, entry.clone(), cp, code_size); + }, + _ => {} + } + } + } + } +} + +struct DeclInfo { name: ClauseName, arity: usize, module_name: ClauseName } + +impl TLInfo for DeclInfo { + fn update_entry_index(&self, n1: &ClauseName, a1: usize, entry: CodeIndex, + cp: &mut CodeIndex, code_size: usize) + { + let (name, arity) = (self.name.clone(), self.arity); + + { + let mut entry = entry.0.borrow_mut(); + + if entry.0 == IndexPtr::Undefined { + if &name == n1 && arity == a1 { + entry.0 = IndexPtr::Index(code_size); + } + } + + entry.1 = self.module_name.clone(); + } + + *cp = entry; + } +} + +struct QueryInfo {} + +impl TLInfo for QueryInfo { + fn update_entry_index(&self, _: &ClauseName, _: usize, entry: CodeIndex, + cp: &mut CodeIndex, _: usize) + { + *cp = entry; + } +} + +pub fn parse_code(wam: &Machine, buffer: &str) -> Result +{ + let mut worker = TopLevelWorker::new(buffer.as_bytes(), wam.atom_tbl()); + worker.parse_code(&wam.op_dir) +} + +// throw errors if declaration or query found. +fn compile_relation(tl: &TopLevel) -> Result +{ + let mut cg = CodeGenerator::::new(); + + match tl { + &TopLevel::Declaration(_) | &TopLevel::Query(_) => + Err(ParserError::ExpectedRel), + &TopLevel::Predicate(ref clauses) => + cg.compile_predicate(&clauses.0), + &TopLevel::Fact(ref fact) => + Ok(cg.compile_fact(fact)), + &TopLevel::Rule(ref rule) => + cg.compile_rule(rule) + } +} + +// set first jmp_by_call or jmp_by_index instruction to code.len() - +// idx, where idx is the place it occurs. It only does this to the +// *first* uninitialized jmp index it encounters, then returns. +fn set_first_index(code: &mut Code) +{ + let code_len = code.len(); + + for (idx, line) in code.iter_mut().enumerate() { + match line { + &mut Line::Control(ControlInstruction::JmpBy(_, ref mut offset, ..)) if *offset == 0 => { + *offset = code_len - idx; + break; + }, + _ => {} + }; + } +} + +fn compile_appendix(code: &mut Code, queue: Vec) -> Result<(), ParserError> +{ + for tl in queue.iter() { + set_first_index(code); + code.append(&mut compile_relation(tl)?); + } + + Ok(()) +} + +fn compile_query(terms: Vec, queue: Vec, code_size: usize, + code_dir: &mut CodeDir) + -> Result<(Code, AllocVarDict), ParserError> +{ + let mut cg = CodeGenerator::::new(); + let mut code = try!(cg.compile_query(&terms)); + + compile_appendix(&mut code, queue)?; + + let query_info = QueryInfo {}; + query_info.label_clauses(code_size, code_dir, &mut code); + + Ok((code, cg.take_vars())) +} + +fn compile_decl(wam: &mut Machine, tl: TopLevel, queue: Vec) -> EvalSession +{ + match tl { + TopLevel::Declaration(Declaration::Op(op_decl)) => { + try_eval_session!(op_decl.submit(clause_name!("user"), &mut wam.op_dir)); + EvalSession::EntrySuccess + }, + TopLevel::Declaration(Declaration::UseModule(name)) => + wam.use_module_in_toplevel(name), + TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)) => + wam.use_qualified_module_in_toplevel(name, exports), + TopLevel::Declaration(_) => + EvalSession::from(ParserError::InvalidModuleDecl), + _ => { + let name = try_eval_session!(if let Some(name) = tl.name() { + Ok(name) + } else { + Err(SessionError::NamelessEntry) + }); + + let mut code = try_eval_session!(compile_relation(&tl)); + try_eval_session!(compile_appendix(&mut code, queue)); + + let decl_info = DeclInfo { name: name.clone(), arity: tl.arity(), + module_name: clause_name!("user") }; + + decl_info.label_clauses(wam.code_size(), &mut wam.code_dir, &mut code); + + if !code.is_empty() { + wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap()) + } else { + EvalSession::from(SessionError::ImpermissibleEntry(String::from("no code generated."))) + } + } + } +} + +pub fn compile_packet(wam: &mut Machine, tl: TopLevelPacket) -> EvalSession +{ + match tl { + TopLevelPacket::Query(terms, queue) => + match compile_query(terms, queue, wam.code_size(), &mut wam.code_dir) { + Ok((mut code, vars)) => wam.submit_query(code, vars), + Err(e) => EvalSession::from(e) + }, + TopLevelPacket::Decl(tl, queue) => + compile_decl(wam, tl, queue) + } +} + +pub fn compile_listing(wam: &mut Machine, src_str: &str) -> EvalSession +{ + fn get_module_name(module: &Option) -> ClauseName { + match module { + &Some(ref module) => module.module_decl.name.clone(), + _ => ClauseName::BuiltIn("user") + } + } + + let mut module: Option = None; + + let mut code_dir = CodeDir::new(); + let mut op_dir = default_op_dir(); + + let mut code = Vec::new(); + + let mut worker = TopLevelWorker::new(src_str.as_bytes(), wam.atom_tbl()); + + let tls = { + let indices = MachineCodeIndex { code_dir: &mut code_dir, + op_dir: &mut op_dir }; + + try_eval_session!(worker.parse_batch(&wam, indices)) + }; + + for tl in tls { + match tl { + TopLevelPacket::Query(..) => + return EvalSession::from(ParserError::ExpectedRel), + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Module(module_decl)), _) => + if module.is_none() { + module = Some(Module::new(module_decl)); + } else { + return EvalSession::from(ParserError::InvalidModuleDecl); + }, + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseModule(name)), _) => { + if let Some(ref submodule) = wam.get_module(name.clone()) { + if let Some(ref mut module) = module { + let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); + + module.use_module(submodule); + code_index.use_module(submodule); + + continue; + } + } else { + return EvalSession::from(SessionError::ModuleNotFound); + } + + wam.use_module_in_toplevel(name); + }, + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)), _) + => + { + if let Some(ref submodule) = wam.get_module(name.clone()) { + if let Some(ref mut module) = module { + let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); + + module.use_qualified_module(submodule, &exports); + code_index.use_qualified_module(submodule, &exports); + + continue; + } + } else { + return EvalSession::from(SessionError::ModuleNotFound); + } + + wam.use_qualified_module_in_toplevel(name, exports); + }, + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Op(..)), _) => {}, + TopLevelPacket::Decl(decl, queue) => { + let p = code.len() + wam.code_size(); + let mut decl_code = try_eval_session!(compile_relation(&decl)); + + try_eval_session!(compile_appendix(&mut decl_code, queue)); + + let name = try_eval_session!(if let Some(name) = decl.name() { + Ok(name) + } else { + Err(SessionError::NamelessEntry) + }); + + let module_name = get_module_name(&module); + let decl_info = DeclInfo { name, arity: decl.arity(), + module_name: module_name.clone() }; + + { + let idx = code_dir.entry((decl_info.name.clone(), decl_info.arity)) + .or_insert(CodeIndex::default()); + + set_code_index!(idx, IndexPtr::Index(p), module_name); + } + + decl_info.label_clauses(p, &mut code_dir, &mut decl_code); + code.extend(decl_code.into_iter()); + } + } + } + + if let Some(mut module) = module { + module.code_dir.extend(as_module_code_dir(code_dir)); + module.op_dir.extend(op_dir.into_iter()); + + wam.add_module(module, code); + } else { + wam.add_batched_code(code, code_dir); + wam.add_batched_ops(op_dir); + } + + EvalSession::EntrySuccess +} diff --git a/src/prolog/heap_print.rs b/src/prolog/heap_print.rs index caa1b7b5..4ce563ea 100644 --- a/src/prolog/heap_print.rs +++ b/src/prolog/heap_print.rs @@ -17,7 +17,7 @@ pub enum TokenOrRedirect { OpenList(Rc>), CloseList(Rc>), HeadTailSeparator, - Space +// Space } pub trait HCValueFormatter { @@ -283,8 +283,8 @@ impl<'a, Formatter: HCValueFormatter, Outputter: HCValueOutputter> loop { if let Some(loc_data) = self.state_stack.pop() { match loc_data { - TokenOrRedirect::Space => - self.outputter.append(" "), +// TokenOrRedirect::Space => +// self.outputter.append(" "), TokenOrRedirect::Atom(atom) => self.outputter.append(atom.as_str()), TokenOrRedirect::Redirect => diff --git a/src/prolog/io.rs b/src/prolog/io.rs index ff6e195d..70965751 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -1,10 +1,6 @@ use prolog::ast::*; -use prolog::builtins::*; -use prolog::codegen::*; -use prolog::debray_allocator::*; use prolog::heap_print::*; use prolog::machine::*; -use prolog::toplevel::*; use termion::raw::IntoRawMode; use termion::input::TermRead; @@ -255,7 +251,9 @@ impl fmt::Display for CutInstruction { &CutInstruction::NeckCut => write!(f, "neck_cut"), &CutInstruction::GetLevel(r) => - write!(f, "get_level {}", r) + write!(f, "get_level {}", r), + &CutInstruction::GetLevelAndUnify(r) => + write!(f, "get_level_and_unify {}", r) } } } @@ -291,40 +289,6 @@ impl fmt::Display for RegType { } } -#[allow(dead_code)] -pub fn print_code(code: &Code) { - for clause in code { - match clause { - &Line::Arithmetic(ref arith) => - println!("{}", arith), - &Line::Fact(ref fact) => - for fact_instr in fact { - println!("{}", fact_instr); - }, - &Line::Cut(ref cut) => - println!("{}", cut), - &Line::Choice(ref choice) => - println!("{}", choice), - &Line::Control(ref control) => - println!("{}", control), - &Line::IndexedChoice(ref choice) => - println!("{}", choice), - &Line::Indexing(ref indexing) => - println!("{}", indexing), - &Line::Query(ref query) => - for query_instr in query { - println!("{}", query_instr); - } - } - } -} - -pub fn parse_code(wam: &Machine, buffer: &str) -> Result -{ - let mut worker = TopLevelWorker::new(buffer.as_bytes(), wam.atom_tbl()); - worker.parse_code(&wam.op_dir) -} - pub enum Input { Quit, Clear, @@ -364,297 +328,6 @@ pub fn read() -> Input { } } -pub(crate) trait TLInfo { - fn update_entry_index(&self, &ClauseName, usize, CodeIndex, &mut CodeIndex, usize); - - // give the correct CodePtr offsets to CallClause's whose types are - // Named and Op. Enable late binding by setting to the default. - fn label_clauses(&self, code_size: usize, code_dir: &mut CodeDir, code: &mut Code) - { - for line in code.iter_mut() { - if let &mut Line::Control(ControlInstruction::CallClause(ref mut ct, a1, ..)) = line { - match ct { - &mut ClauseType::Named(ref n1, ref mut cp) - | &mut ClauseType::Op(ref n1, _, ref mut cp) => { - let entry = code_dir.entry((n1.clone(), a1)).or_insert(CodeIndex::default()); - self.update_entry_index(n1, a1, entry.clone(), cp, code_size); - }, - _ => {} - } - } - } - } -} - -struct DeclInfo { name: ClauseName, arity: usize, module_name: ClauseName } - -impl TLInfo for DeclInfo { - fn update_entry_index(&self, n1: &ClauseName, a1: usize, entry: CodeIndex, - cp: &mut CodeIndex, code_size: usize) - { - let (name, arity) = (self.name.clone(), self.arity); - - { - let mut entry = entry.0.borrow_mut(); - - if entry.0 == IndexPtr::Undefined { - if &name == n1 && arity == a1 { - entry.0 = IndexPtr::Index(code_size); - } - } - - entry.1 = self.module_name.clone(); - } - - *cp = entry; - } -} - -struct QueryInfo {} - -impl TLInfo for QueryInfo { - fn update_entry_index(&self, _: &ClauseName, _: usize, entry: CodeIndex, - cp: &mut CodeIndex, _: usize) - { - *cp = entry; - } -} - -// throw errors if declaration or query found. -fn compile_relation(tl: &TopLevel) -> Result -{ - let mut cg = CodeGenerator::::new(); - - match tl { - &TopLevel::Declaration(_) | &TopLevel::Query(_) => - Err(ParserError::ExpectedRel), - &TopLevel::Predicate(ref clauses) => - cg.compile_predicate(&clauses.0), - &TopLevel::Fact(ref fact) => - Ok(cg.compile_fact(fact)), - &TopLevel::Rule(ref rule) => - cg.compile_rule(rule) - } -} - -// set first jmp_by_call or jmp_by_index instruction to code.len() - -// idx, where idx is the place it occurs. It only does this to the -// *first* uninitialized jmp index it encounters, then returns. -fn set_first_index(code: &mut Code) -{ - let code_len = code.len(); - - for (idx, line) in code.iter_mut().enumerate() { - match line { - &mut Line::Control(ControlInstruction::JmpBy(_, ref mut offset, ..)) if *offset == 0 => { - *offset = code_len - idx; - break; - }, - _ => {} - }; - } -} - -fn compile_appendix(code: &mut Code, queue: Vec) -> Result<(), ParserError> -{ - for tl in queue.iter() { - set_first_index(code); - code.append(&mut compile_relation(tl)?); - } - - Ok(()) -} - -fn compile_query(terms: Vec, queue: Vec, code_size: usize, - code_dir: &mut CodeDir) - -> Result<(Code, AllocVarDict), ParserError> -{ - let mut cg = CodeGenerator::::new(); - let mut code = try!(cg.compile_query(&terms)); - - compile_appendix(&mut code, queue)?; - - let query_info = QueryInfo {}; - query_info.label_clauses(code_size, code_dir, &mut code); - - Ok((code, cg.take_vars())) -} - -fn compile_decl(wam: &mut Machine, tl: TopLevel, queue: Vec) -> EvalSession -{ - match tl { - TopLevel::Declaration(Declaration::Op(op_decl)) => { - try_eval_session!(op_decl.submit(clause_name!("user"), &mut wam.op_dir)); - EvalSession::EntrySuccess - }, - TopLevel::Declaration(Declaration::UseModule(name)) => - wam.use_module_in_toplevel(name), - TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)) => - wam.use_qualified_module_in_toplevel(name, exports), - TopLevel::Declaration(_) => - EvalSession::from(ParserError::InvalidModuleDecl), - _ => { - let name = try_eval_session!(if let Some(name) = tl.name() { - Ok(name) - } else { - Err(SessionError::NamelessEntry) - }); - - let mut code = try_eval_session!(compile_relation(&tl)); - try_eval_session!(compile_appendix(&mut code, queue)); - - let decl_info = DeclInfo { name: name.clone(), arity: tl.arity(), - module_name: clause_name!("user") }; - - decl_info.label_clauses(wam.code_size(), &mut wam.code_dir, &mut code); - - if !code.is_empty() { - wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap()) - } else { - EvalSession::from(SessionError::ImpermissibleEntry(String::from("no code generated."))) - } - } - } -} - -pub fn compile_packet(wam: &mut Machine, tl: TopLevelPacket) -> EvalSession -{ - match tl { - TopLevelPacket::Query(terms, queue) => - match compile_query(terms, queue, wam.code_size(), &mut wam.code_dir) { - Ok((mut code, vars)) => wam.submit_query(code, vars), - Err(e) => EvalSession::from(e) - }, - TopLevelPacket::Decl(tl, queue) => - compile_decl(wam, tl, queue) - } -} - -pub static BUILTINS: &str = include_str!("./lib/builtins.pl"); - -pub fn load_init_str(wam: &mut Machine, src_str: &str) -{ - match compile_listing(wam, src_str) { - EvalSession::Error(_) => panic!("failed to parse batch from string."), - _ => {} - } -} - -pub fn load_init_str_and_include(wam: &mut Machine, src_str: &str, module: &'static str) -{ - load_init_str(wam, src_str); - wam.use_module_in_toplevel(clause_name!(module)); -} - -pub fn compile_listing(wam: &mut Machine, src_str: &str) -> EvalSession -{ - fn get_module_name(module: &Option) -> ClauseName { - match module { - &Some(ref module) => module.module_decl.name.clone(), - _ => ClauseName::BuiltIn("user") - } - } - - let mut module: Option = None; - - let mut code_dir = CodeDir::new(); - let mut op_dir = default_op_dir(); - - let mut code = Vec::new(); - - let mut worker = TopLevelWorker::new(src_str.as_bytes(), wam.atom_tbl()); - let tls = try_eval_session!(worker.parse_batch(&mut op_dir)); - - for tl in tls { - match tl { - TopLevelPacket::Query(..) => - return EvalSession::from(ParserError::ExpectedRel), - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Module(module_decl)), _) => - if module.is_none() { - // let builtin_op_dir = default_module_setup(module_decl.name.clone()); - - // code_dir.extend(builtin_code_dir.into_iter()); - // op_dir.extend(builtin_op_dir.into_iter()); - - module = Some(Module::new(module_decl)); - } else { - return EvalSession::from(ParserError::InvalidModuleDecl); - }, - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseModule(name)), _) => { - if let Some(ref submodule) = wam.get_module(name.clone()) { - if let Some(ref mut module) = module { - let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); - - module.use_module(submodule); - code_index.use_module(submodule); - - continue; - } - } else { - return EvalSession::from(SessionError::ModuleNotFound); - } - - wam.use_module_in_toplevel(name); - }, - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)), _) => { - if let Some(ref submodule) = wam.get_module(name.clone()) { - if let Some(ref mut module) = module { - let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); - - module.use_qualified_module(submodule, &exports); - code_index.use_qualified_module(submodule, &exports); - - continue; - } - } else { - return EvalSession::from(SessionError::ModuleNotFound); - } - - wam.use_qualified_module_in_toplevel(name, exports); - }, - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Op(..)), _) => {}, - TopLevelPacket::Decl(decl, queue) => { - let p = code.len() + wam.code_size(); - let mut decl_code = try_eval_session!(compile_relation(&decl)); - - try_eval_session!(compile_appendix(&mut decl_code, queue)); - - let name = try_eval_session!(if let Some(name) = decl.name() { - Ok(name) - } else { - Err(SessionError::NamelessEntry) - }); - - let module_name = get_module_name(&module); - let decl_info = DeclInfo { name, arity: decl.arity(), - module_name: module_name.clone() }; - - { - let idx = code_dir.entry((decl_info.name.clone(), decl_info.arity)) - .or_insert(CodeIndex::default()); - - set_code_index!(idx, IndexPtr::Index(p), module_name); - } - - decl_info.label_clauses(p, &mut code_dir, &mut decl_code); - code.extend(decl_code.into_iter()); - } - } - } - - if let Some(mut module) = module { - module.code_dir.extend(as_module_code_dir(code_dir)); - module.op_dir.extend(op_dir.into_iter()); - - wam.add_module(module, code); - } else { - wam.add_batched_code(code, code_dir); - wam.add_batched_ops(op_dir); - } - - EvalSession::EntrySuccess -} - fn error_string(e: &String) -> String { format!("error: exception thrown: {}", e) } diff --git a/src/prolog/iterators.rs b/src/prolog/iterators.rs index 5ce7f36e..c887b4d8 100644 --- a/src/prolog/iterators.rs +++ b/src/prolog/iterators.rs @@ -57,6 +57,10 @@ impl<'a> QueryIterator<'a> { let state = TermIterState::Var(Level::Root, cell, rc_atom!("!")); QueryIterator { state_stack: vec![state] } }, + &QueryTerm::GetLevelAndUnify(ref cell, ref var) => { + let state = TermIterState::Var(Level::Root, cell, var.clone()); + QueryIterator { state_stack: vec![state] } + }, &QueryTerm::Jump(ref vars) => { let state_stack = vars.iter().rev().map(|t| { TermIterState::subterm_to_state(Level::Shallow, t) @@ -337,6 +341,11 @@ impl<'a> ChunkedIterator<'a> self.deep_cut_encountered = true; } }, + ChunkedTerm::BodyTerm(&QueryTerm::GetLevelAndUnify(..)) => { + result.push(term); + arity = 1; + break; + }, ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) => result.push(term), ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), _)) => diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 9531d7ab..a53664b7 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -4,7 +4,8 @@ (\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2, - (\==)/2, catch/3, throw/1, true/0, false/0, length/2]). + (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, + catch/3, throw/1, true/0, false/0]). % arithmetic operators. :- op(700, xfx, is). @@ -43,6 +44,12 @@ % term comparison. :- op(700, xfx, ==). :- op(700, xfx, \==). +:- op(700, xfx, @=<). +:- op(700, xfx, @>=). +:- op(700, xfx, @<). +:- op(700, xfx, @>). +:- op(700, xfx, =@=). +:- op(700, xfx, \=@=). % the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY). max_arity(63). @@ -137,6 +144,39 @@ univ_worker(Term, List, _) :- I1 is I0 + 1, '$get_args'(Args, Func, I1, N). +% setup_call_cleanup. + +/* past work on setup_call_cleanup. + +setup_call_cleanup(S, G, C) :- + S, !, '$get_current_block'(Bb), + ( var(C) -> throw(error(instantiation_error, setup_call_cleanup/3)) + ; scc_helper(C, G, Bb) ). + +scc_helper(C, G, Bb) :- + '$get_level'(Cp), '$install_scc_cleaner'(C, NBb), call(G), + ( '$check_cp'(Cp) -> '$reset_block'(Bb), run_cleaners_without_handling(Cp) + ; true + ; '$reset_block'(NBb), '$fail'). +scc_helper(_, _, Bb) :- + '$reset_block'(Bb), '$get_ball'(Ball), + run_cleaners_with_handling, throw(Ball). +scc_helper(_, _, _) :- + run_cleaners_without_handling(Cp), false. + +run_cleaners_with_handling :- + '$get_scc_cleaner'(C), catch(C, _, true), !, + run_cleaners_with_handling. +run_cleaners_with_handling :- + '$restore_cut_policy'. + +run_cleaners_without_handling(Cp) :- + '$get_scc_cleaner'(C), C, !, run_cleaners_without_handling(Cp). +run_cleaners_without_handling(Cp) :- + '$set_cp'(Cp), '$restore_cut_policy'. + +*/ + % exceptions. catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb). @@ -151,32 +191,3 @@ handle_ball(Ball, C, R) :- Ball = C, !, '$erase_ball', call(R). handle_ball(_, _, _) :- '$unwind_stack'. throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'. - -% length. - -length(Xs, N) :- - var(N), !, - '$skip_max_list'(M, -1, Xs, Xs0), - ( Xs0 == [] -> N = M - ; var(Xs0) -> '$length_addendum'(Xs0, N, M)). -length(Xs, N) :- - integer(N), - N >= 0, !, - '$skip_max_list'(M, N, Xs, Xs0), - ( Xs0 == [] -> N = M - ; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)). -length(_, N) :- - integer(N), !, - throw(error(domain_error(not_less_than_zero, N), length/2)). -length(_, N) :- - throw(error(type_error(integer, N), length/2)). - -'$length_addendum'([], N, N). -'$length_addendum'([_|Xs], N, M) :- - M1 is M + 1, - '$length_addendum'(Xs, N, M1). - -'$length_rundown'([], 0) :- !. -'$length_rundown'([_|Xs], N) :- - N1 is N-1, - '$length_rundown'(Xs, N1). diff --git a/src/prolog/lib/control.pl b/src/prolog/lib/control.pl index 2c1b113d..4f641e59 100644 --- a/src/prolog/lib/control.pl +++ b/src/prolog/lib/control.pl @@ -1,13 +1,19 @@ -:- module(control, [(\=)/2, between/3, call_cleanup/2, once/1, repeat/0]). +:- use_module(library(builtins)). +:- module(control, [(\=)/2, (\+)/1, between/3, once/1, repeat/0]). + +:- op(900, fy, \+). :- op(700, xfx, \=). once(G) :- G, !. +\+ G :- G, !, false. +\+ _. + X \= X :- !, false. _ \= _. -call_cleanup(G, C) :- setup_call_cleanup(true, G, C). +% call_cleanup(G, C) :- setup_call_cleanup(true, G, C). between(Lower, Upper, Lower) :- Lower =< Upper. diff --git a/src/prolog/lib/lists.pl b/src/prolog/lib/lists.pl index 11c0f275..05725838 100644 --- a/src/prolog/lib/lists.pl +++ b/src/prolog/lib/lists.pl @@ -1,7 +1,36 @@ +:- use_module(library(builtins)). + :- module(lists, [member/2, select/3, append/3, memberchk/2, - reverse/2, maplist/2, maplist/3, maplist/4, - maplist/5, maplist/6, maplist/7, maplist/8, - maplist/9]). + reverse/2, length/2, maplist/2, maplist/3, + maplist/4, maplist/5, maplist/6, maplist/7, + maplist/8, maplist/9]). + +length(Xs, N) :- + var(N), !, + '$skip_max_list'(M, -1, Xs, Xs0), + ( Xs0 == [] -> N = M + ; var(Xs0) -> length_addendum(Xs0, N, M)). +length(Xs, N) :- + integer(N), + N >= 0, !, + '$skip_max_list'(M, N, Xs, Xs0), + ( Xs0 == [] -> N = M + ; var(Xs0) -> R is N-M, length_rundown(Xs0, R)). +length(_, N) :- + integer(N), !, + throw(error(domain_error(not_less_than_zero, N), length/2)). +length(_, N) :- + throw(error(type_error(integer, N), length/2)). + +length_addendum([], N, N). +length_addendum([_|Xs], N, M) :- + M1 is M + 1, + length_addendum(Xs, N, M1). + +length_rundown([], 0) :- !. +length_rundown([_|Xs], N) :- + N1 is N-1, + length_rundown(Xs, N1). member(X, [X|_]). member(X, [_|Xs]) :- member(X, Xs). diff --git a/src/prolog/lib/queues.pl b/src/prolog/lib/queues.pl index 1cc1e6c8..f1faf80b 100644 --- a/src/prolog/lib/queues.pl +++ b/src/prolog/lib/queues.pl @@ -1,3 +1,5 @@ +:- use_module(library(builtins)). + :- module(queues, [queue/1, queue/2, queue_head/3, queue_head_list/3, queue_last/3, queue_last_list/3, list_queue/2, queue_length/2]). diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 7fc0eeaf..2dd2ba59 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -715,8 +715,8 @@ impl SCCCutPolicy { self.cont_pts.is_empty() } - pub(crate) fn push_cont_pt(&mut self, addr: Addr, b: usize, block: usize) { - self.cont_pts.push((addr, b, block)); + pub(crate) fn push_cont_pt(&mut self, addr: Addr, b: usize, prev_b: usize) { + self.cont_pts.push((addr, b, prev_b)); } pub(crate) fn pop_cont_pt(&mut self) -> Option<(Addr, usize, usize)> { @@ -729,7 +729,7 @@ impl CutPolicy for SCCCutPolicy { let b = machine_st.b; if let Addr::Con(Constant::Usize(b0)) = machine_st[r].clone() { - if b > b0 { + if b > b0 { machine_st.b = b0; machine_st.tidy_trail(); machine_st.or_stack.truncate(machine_st.b); @@ -737,14 +737,13 @@ impl CutPolicy for SCCCutPolicy { } else { machine_st.fail = true; return; - } - - if !self.out_of_cont_pts() { - machine_st.cp.assign_if_local(machine_st.p.clone()); - machine_st.num_of_args = 0; - machine_st.b0 = machine_st.b; - // goto_call run_cleaners_without_handling/0, 370. - machine_st.p = dir_entry!(370, clause_name!("builtin")); + } + + if let Some(&(_, b_cutoff, prev_block)) = self.cont_pts.last() { + if machine_st.b < b_cutoff { + machine_st.block = prev_block; + machine_st.unwind_stack(); + } } } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 9c1d625d..06b9298d 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1065,13 +1065,6 @@ impl MachineState { duplicator.duplicate_term(addr); } - pub(super) fn unwind_stack(&mut self) { - self.b = self.block; - self.or_stack.truncate(self.b); - - self.fail = true; - } - pub(super) fn setup_call_n(&mut self, arity: usize) -> Option { let stub = self.functor_stub(clause_name!("call"), arity + 1); @@ -1121,7 +1114,14 @@ impl MachineState { Some((name, arity + narity - 1)) } + + pub(super) fn unwind_stack(&mut self) { + self.b = self.block; + self.or_stack.truncate(self.b); + self.fail = true; + } + fn heap_ball_boundary_diff(&self) -> usize { if self.ball.boundary > self.heap.h { self.ball.boundary - self.heap.h @@ -1945,6 +1945,13 @@ impl MachineState { self[r] = Addr::Con(Constant::Usize(b0)); self.p += 1; }, + &CutInstruction::GetLevelAndUnify(r) => { + let b0 = Addr::Con(Constant::Usize(self.b0)); + let a = self[r].clone(); + + self.unify(a, b0); + self.p += 1; + }, &CutInstruction::Cut(r) => { cut_policy.cut(self, r); self.p += 1; diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index d1848238..6753fc91 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -1,5 +1,5 @@ use prolog::ast::*; -use prolog::builtins::*; +use prolog::compile::*; use prolog::heap_print::*; use prolog::tabled_rc::*; @@ -17,9 +17,9 @@ use std::mem::swap; use std::ops::Index; use std::rc::Rc; -pub(super) struct MachineCodeIndex<'a> { - pub(super) code_dir: &'a mut CodeDir, - pub(super) op_dir: &'a mut OpDir, +pub struct MachineCodeIndex<'a> { + pub code_dir: &'a mut CodeDir, + pub op_dir: &'a mut OpDir, } pub struct Machine { @@ -66,24 +66,33 @@ impl<'a> SubModuleUser for MachineCodeIndex<'a> { self.code_dir.insert((name, arity), CodeIndex::from(idx)); } } + +static LISTS: &str = include_str!("../lib/lists.pl"); +static CONTROL: &str = include_str!("../lib/control.pl"); +static QUEUES: &str = include_str!("../lib/queues.pl"); impl Machine { pub fn new() -> Self { - let atom_tbl = Rc::new(RefCell::new(HashSet::new())); - let op_dir = default_op_dir(); //TODO: change to the builtins module once it's done. - //let (code, code_dir, op_dir) = default_build(); - - Machine { - ms: MachineState::new(atom_tbl), + let mut wam = Machine { + ms: MachineState::new(Rc::new(RefCell::new(HashSet::new()))), call_policy: Box::new(DefaultCallPolicy {}), cut_policy: Box::new(DefaultCutPolicy {}), code: Code::new(), code_dir: CodeDir::new(), term_dir: TermDir::new(), - op_dir, + op_dir: default_op_dir(), modules: HashMap::new(), cached_query: None - } + }; + + compile_listing(&mut wam, BUILTINS); + wam.use_module_in_toplevel(clause_name!("builtins")); + + compile_listing(&mut wam, LISTS); + compile_listing(&mut wam, CONTROL); + compile_listing(&mut wam, QUEUES); + + wam } fn remove_module(&mut self, module_name: ClauseName) { diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 75d80332..bbf4d237 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -151,39 +151,57 @@ impl MachineState { Ok(()) } - - pub(super) fn system_call(&mut self, ct: &SystemClauseType, call_policy: &mut Box, + + fn install_new_block(&mut self, r: RegType) -> usize { + self.block = self.b; + + let c = Constant::Usize(self.block); + let addr = self[r].clone(); + + self.write_constant_to_var(addr, c); + self.block + } + + pub(super) fn system_call(&mut self, ct: &SystemClauseType, + call_policy: &mut Box, cut_policy: &mut Box,) -> CallResult { match ct { - &SystemClauseType::CheckCutPoint => {}, + &SystemClauseType::CheckCutPoint => { + let addr = self.store(self.deref(self[temp_v!(1)].clone())); + + match addr { + Addr::Con(Constant::Usize(old_b)) if self.b <= old_b + 2 => {}, + _ => self.fail = true + }; + }, &SystemClauseType::GetSCCCleaner => { let dest = self[temp_v!(1)].clone(); match cut_policy.downcast_mut::().ok() { Some(sgc_policy) => - if let Some((addr, b_cutoff, prev_block)) = sgc_policy.pop_cont_pt() { + if let Some((addr, b_cutoff, prev_b)) = sgc_policy.pop_cont_pt() { if self.b <= b_cutoff + 1 { - self.block = prev_block; + self.block = prev_b; if let Some(r) = dest.as_var() { - self.bind(r, addr); + self.bind(r, addr.clone()); return Ok(()); } } else { - sgc_policy.push_cont_pt(addr, b_cutoff, prev_block); + sgc_policy.push_cont_pt(addr, b_cutoff, prev_b); } }, None => panic!("expected SCCCutPolicy trait object.") }; - self.fail = true; + self.fail = true; }, &SystemClauseType::InstallSCCCleaner => { let addr = self[temp_v!(1)].clone(); let b = self.b; - let block = self.block; + let prev_block = self.block; if cut_policy.downcast_ref::().is_err() { *cut_policy = Box::new(SCCCutPolicy::new()); @@ -191,7 +209,10 @@ impl MachineState { match cut_policy.downcast_mut::().ok() { - Some(cut_policy) => cut_policy.push_cont_pt(addr, b, block), + Some(cut_policy) => { + self.install_new_block(temp_v!(2)); + cut_policy.push_cont_pt(addr, b, prev_block); + }, None => panic!("install_cleaner: should have installed \\ SCCCutPolicy.") }; @@ -292,7 +313,7 @@ impl MachineState { }, _ => self.fail = true }; - }, + }, &SystemClauseType::CleanUpBlock => { let nb = self.store(self.deref(self[temp_v!(1)].clone())); @@ -337,16 +358,11 @@ impl MachineState { &SystemClauseType::GetCutPoint => { let a1 = self[temp_v!(1)].clone(); let a2 = Addr::Con(Constant::Usize(self.b)); - + self.unify(a1, a2); }, &SystemClauseType::InstallNewBlock => { - self.block = self.b; - - let c = Constant::Usize(self.block); - let addr = self[temp_v!(1)].clone(); - - self.write_constant_to_var(addr, c); + self.install_new_block(temp_v!(1)); }, &SystemClauseType::ResetBlock => { let addr = self.deref(self[temp_v!(1)].clone()); diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 4124beca..ec289eca 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -248,3 +248,8 @@ macro_rules! top_level_code_ptr { ) } +macro_rules! get_level_and_unify { + ($r: expr) => ( + Line::Cut(CutInstruction::GetLevelAndUnify($r)) + ) +} diff --git a/src/prolog/mod.rs b/src/prolog/mod.rs index 954417f9..8403bb4a 100644 --- a/src/prolog/mod.rs +++ b/src/prolog/mod.rs @@ -9,8 +9,8 @@ pub mod ast; #[macro_use] pub mod allocator; pub mod toplevel; +pub mod compile; pub mod arithmetic; -pub mod builtins; pub mod codegen; pub mod copier; pub mod debray_allocator; diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 673167f3..cfb5c0e2 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -1,4 +1,5 @@ use prolog::ast::*; +use prolog::machine::*; use prolog::num::*; use prolog::parser::parser::*; use prolog::tabled_rc::*; @@ -412,6 +413,12 @@ impl RelationWorker { self.queue.push_back(clauses); Ok(QueryTerm::Jump(stub)) + } else if name.as_str() == "$get_level" && terms.len() == 1 { + if let Term::Var(_, ref var) = *terms[0] { + Ok(QueryTerm::GetLevelAndUnify(Cell::default(), var.clone())) + } else { + Err(ParserError::InadmissibleQueryTerm) + } } else { Ok(QueryTerm::Clause(Cell::default(), ClauseType::from(name, terms.len(), fixity), @@ -558,7 +565,8 @@ impl TopLevelWorker { TopLevelWorker { parser: Parser::new(inner, atom_tbl) } } - pub fn parse_batch(&mut self, op_dir: &mut OpDir) -> Result, SessionError> + pub fn parse_batch<'a>(&mut self, wam: &Machine, mut indices: MachineCodeIndex<'a>) + -> Result, SessionError> { let mut preds = vec![]; let mut mod_name = clause_name!("user"); @@ -572,7 +580,7 @@ impl TopLevelWorker { while !self.parser.eof() { self.parser.reset(); // empty the parser stack of token descriptions. - let term = self.parser.read_term(&op_dir)?; + let term = self.parser.read_term(&indices.op_dir)?; let mut new_rel_worker = RelationWorker::new(); let tl = new_rel_worker.try_term_to_tl(term, true)?; @@ -584,8 +592,12 @@ impl TopLevelWorker { rel_worker.absorb(new_rel_worker); match tl { + TopLevel::Declaration(Declaration::UseModule(name)) => + if let Some(module) = wam.get_module(name) { + indices.use_module(module); + }, TopLevel::Declaration(Declaration::Op(op_decl)) => { - op_decl.submit(mod_name.clone(), op_dir)?; + op_decl.submit(mod_name.clone(), indices.op_dir)?; }, TopLevel::Declaration(Declaration::Module(actual_mod)) => { mod_name = actual_mod.name.clone(); diff --git a/src/tests.rs b/src/tests.rs index 42b6e3e5..2581884a 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1,6 +1,6 @@ use prolog::ast::*; use prolog::heap_print::*; -use prolog::io::*; +use prolog::compile::*; use prolog::machine::*; use std::collections::HashSet; @@ -937,7 +937,6 @@ fn test_queries_on_call_n() fn test_queries_on_arithmetic() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); assert_prolog_success!(&mut wam, "?- X is 1, X is X.", [["X = 1"]]); assert_prolog_failure!(&mut wam, "?- X is 1, X is X + 1."); @@ -1022,7 +1021,6 @@ fn test_queries_on_arithmetic() fn test_queries_on_exceptions() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); submit(&mut wam, "f(a). f(_) :- throw(stuff)."); submit(&mut wam, "handle(stuff)."); @@ -1127,7 +1125,6 @@ fn test_queries_on_exceptions() #[test] fn test_queries_on_skip_max_list() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); // test on proper and empty lists. assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 5, [], Xs).", @@ -1205,7 +1202,6 @@ fn test_queries_on_skip_max_list() { fn test_queries_on_conditionals() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); submit(&mut wam, "test(A) :- ( A =:= 2 -> display(\"A is 2\") ; A =:= 3 -> display(\"A is 3\") @@ -1266,12 +1262,12 @@ fn test_queries_on_conditionals() [["X = a"], ["X = b"]]); } -/* #[test] fn test_queries_on_builtins() { let mut wam = Machine::new(); - + wam.use_module_in_toplevel(clause_name!("lists")); + assert_prolog_failure!(&mut wam, "?- atom(X)."); assert_prolog_success!(&mut wam, "?- atom(a)."); assert_prolog_failure!(&mut wam, "?- atom(\"string\")."); @@ -1295,33 +1291,14 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- var(X), X = 3, atomic(X).", [["X = 3"]]); assert_prolog_failure!(&mut wam, "?- var(X), X = 3, var(X)."); - assert_prolog_success!(&mut wam, "?- arg(N, f(a,b,c,d), Arg).", - [["N = 1", "Arg = a"], - ["N = 2", "Arg = b"], - ["N = 3", "Arg = c"], - ["N = 4", "Arg = d"]]); - assert_prolog_success!(&mut wam, "?- arg(1, f(a,b,c,d), Arg).", [["Arg = a"]]); assert_prolog_success!(&mut wam, "?- arg(2, f(a,b,c,d), Arg).", [["Arg = b"]]); assert_prolog_success!(&mut wam, "?- arg(3, f(a,b,c,d), Arg).", [["Arg = c"]]); assert_prolog_success!(&mut wam, "?- arg(4, f(a,b,c,d), Arg).", [["Arg = d"]]); - assert_prolog_success!(&mut wam, "?- catch(arg(N, f, Arg), error(type_error(E, _), _), true).", - [["E = compound", "Arg = _3", "N = _1"]]); - - assert_prolog_success!(&mut wam, "?- catch(arg(N, _, Arg), error(E, _), true).", + assert_prolog_success!(&mut wam, "?- catch(arg(N, f, Arg), error(E, _), true).", [["E = instantiation_error", "Arg = _3", "N = _1"]]); - - assert_prolog_success!(&mut wam, "?- arg(N, f(X, Y, Z), arg_val).", - [["X = arg_val", "Y = _3", "N = 1", "Z = _4"], - ["X = _2", "Y = arg_val", "N = 2", "Z = _4"], - ["X = _2", "Y = _3", "N = 3", "Z = arg_val"]]); - - assert_prolog_success!(&mut wam, "?- arg(N, f(arg, not_arg, arg, X), arg).", - [["X = _5", "N = 1"], - ["X = _5", "N = 3"], - ["X = arg", "N = 4"]]); - + assert_prolog_failure!(&mut wam, "?- arg(N, f(arg, arg, arg), not_arg)."); assert_prolog_failure!(&mut wam, "?- arg(1, f(arg, not_arg, not_arg), not_arg)."); assert_prolog_success!(&mut wam, "?- arg(2, f(arg, not_arg, not_arg), not_arg)."); @@ -1343,7 +1320,7 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- functor(Func, f, 4).", [["Func = f(_2, _3, _4, _5)"]]); assert_prolog_success!(&mut wam, "?- catch(functor(F, \"sdf\", 3), error(E, _), true).", - [["E = instantiation_error", "F = _1"]]); + [["E = type_error(atom, \"sdf\")", "F = _1"]]); assert_prolog_success!(&mut wam, "?- catch(functor(Func, F, 3), error(E, _), true).", [["E = instantiation_error", "Func = _1", "F = _2"]]); assert_prolog_success!(&mut wam, "?- catch(functor(Func, f, N), error(E, _), true).", @@ -1352,13 +1329,13 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- X is 3, call(integer, X)."); assert_prolog_failure!(&mut wam, "?- X is 3 + 3.5, call(integer, X)."); - assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ call(integer, X)."); - assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ integer(X)."); +// assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ call(integer, X)."); +// assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ integer(X)."); assert_prolog_success!(&mut wam, "?- Func =.. [atom].", [["Func = atom"]]); assert_prolog_success!(&mut wam, "?- Func =.. [\"sdf\"].", [["Func = \"sdf\""]]); assert_prolog_success!(&mut wam, "?- Func =.. [1].", [["Func = 1"]]); - assert_prolog_success!(&mut wam, "?- catch(Func =.. [1,2], error(instantiation_error, _), true)."); + assert_prolog_success!(&mut wam, "?- catch(Func =.. [1,2], error(type_error(atom, 1), _), true)."); assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. List.", [["List = [f, 1, 2, 3]"]]); assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. [f,1,2,3]."); assert_prolog_failure!(&mut wam, "?- f(1,2,3) =.. [f,1]."); @@ -1366,23 +1343,23 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. [f,X,Y,Z].", [["X = 1", "Y = 2", "Z = 3"]]); + assert_prolog_success!(&mut wam, "?- length([a,b,c], N).", [["N = 3"]]); assert_prolog_success_with_limit!(&mut wam, "?- length(Xs, N).", [["N = 0", "Xs = []"], - ["N = 1", "Xs = [_3]"], - ["N = 2", "Xs = [_3, _6]"], - ["N = 3", "Xs = [_3, _6, _9]"], - ["N = 4", "Xs = [_3, _6, _9, _12]"], - ["N = 5", "Xs = [_3, _6, _9, _12, _15]"]], + ["N = 1", "Xs = [_4]"], + ["N = 2", "Xs = [_4, _8]"], + ["N = 3", "Xs = [_4, _8, _12]"], + ["N = 4", "Xs = [_4, _8, _12, _16]"], + ["N = 5", "Xs = [_4, _8, _12, _16, _20]"]], 6); - assert_prolog_success!(&mut wam, "?- length(Xs, 3).", [["Xs = [_2, _5, _8]"]]); - assert_prolog_success!(&mut wam, "?- length([a,b,c], N).", [["N = 3"]]); + assert_prolog_success!(&mut wam, "?- length(Xs, 3).", [["Xs = [_4, _8, _12]"]]); assert_prolog_success!(&mut wam, "?- length([], N).", [["N = 0"]]); assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]); assert_prolog_success!(&mut wam, "?- length([a,b,[a,b,c]], 3)."); assert_prolog_failure!(&mut wam, "?- length([a,b,[a,b,c]], 2)."); - assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(integer, E), true).", - [["E = []"]]); + assert_prolog_success!(&mut wam, "?- catch(length(a, []), error(E, _), true).", + [["E = type_error(integer, [])"]]); assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).", [["Z = 3", "Y = 2", "X = 1"]]); @@ -1497,15 +1474,15 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- g(B) = B, g(A) = A, A =@= B."); assert_prolog_success!(&mut wam, "?- keysort([1-1, 1-1], Sorted).", - [["Sorted = [1 - 1, 1 - 1]"]]); + [["Sorted = [1-1, 1-1]"]]); assert_prolog_success!(&mut wam, "?- keysort([2-99, 1-a, 3-f(_), 1-z, 1-a, 2-44], Sorted).", - [["Sorted = [1 - a, 1 - z, 1 - a, 2 - 99, 2 - 44, 3 - f(_7)]"]]); + [["Sorted = [1-a, 1-z, 1-a, 2-99, 2-44, 3-f(_7)]"]]); assert_prolog_success!(&mut wam, "?- keysort([X-1,1-1],[2-1,1-1]).", [["X = 2"]]); assert_prolog_failure!(&mut wam, "?- Pairs = [a-a|Pairs], keysort(Pairs, _)."); assert_prolog_success!(&mut wam, "?- Pairs = [a-a|Pairs], catch(keysort(Pairs, _), error(E, _), true).", - [["E = type_error(list, [a - a | _21])", "Pairs = [a - a | Pairs]"]]); + [["E = type_error(list, [a-a | _22])", "Pairs = [a-a | Pairs]"]]); assert_prolog_success!(&mut wam, "?- keysort([], L).", [["L = []"]]); @@ -1514,9 +1491,9 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).", [["Pat = type_error(list, [a | a])"]]); assert_prolog_success!(&mut wam, "?- catch(keysort(_, _), error(E, _), true).", - [["E = type_error(list, _12)"]]); + [["E = type_error(list, _13)"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [_|b]), error(E, _), true).", - [["E = type_error(list, [_23 | b])"]]); + [["E = type_error(list, [_24 | b])"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [a-b,c-d,a]), error(E, _), true).", [["E = type_error(pair, a)"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a], [a-b]), error(E, _), true).", @@ -1529,33 +1506,37 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- sort([], L).", [["L = []"]]); assert_prolog_success!(&mut wam, "?- catch(sort(_, []), error(E, _), true).", - [["E = type_error(list, _12)"]]); + [["E = type_error(list, _13)"]]); assert_prolog_success!(&mut wam, "?- catch(sort([a,b,c], not_a_list), error(E, _), true).", [["E = type_error(list, not_a_list)"]]); assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).", [["G = 2", "B = 3"]]); + /* assert_prolog_success!(&mut wam, "?- call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),display(S+G>B)), B=3, !), 100, R).", [["G = 2", "B = 3", "R = !", "S = 1"]]); assert_prolog_success!(&mut wam, "?- call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),display(S+G>B)), B=3, !), 10, R).", [["S = _1", "G = _4", "B = _14", "R = inference_limit_exceeded"]]); + */ } +/* #[test] fn test_queries_on_setup_call_cleanup() { let mut wam = Machine::new(); - + load_init_str_and_include(&mut wam, BUILTINS, "builtins"); + // Test examples from the ISO Prolog page for setup_call_catch. assert_prolog_failure!(&mut wam, "?- setup_call_cleanup(false, _, _)."); - assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, throw(unthrown), _), instantiation_error, true)."); + assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, throw(unthrown), _), error(instantiation_error, _), true)."); assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, true, (true ; throw(x)))."); assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, X = 1, X = 2).", [["X = 1"]]); assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, true, X = 2).", [["X = 2"]]); - assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, X=true, X), E, true).", + assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, X=true, X), error(E, _), true).", [["E = instantiation_error", "X = _1"]]); assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(X=throw(ex), true, X), E, true).", [["E = ex", "X = _3"]]); -- 2.54.0