rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

major refactor

Browse Source
This commit is contained in:
Mark Thom
2018-05-15 22:47:36 -06:00
parent 8f1d721477
commit 06d896277c
22 changed files with 587 additions and 1276 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Cargo.toml
View File

@@ -1,6 +1,6 @@
[package] [package]
name = "rusty-wam" name = "rusty-wam"
version = "0.7.7" version = "0.7.8"
authors = ["Mark Thom"] authors = ["Mark Thom"]
[dependencies] [dependencies]

6
README.md
View File

@@ -26,11 +26,11 @@ Extend rusty-wam to include the following, among other features:
associativity and precedence (_done_). associativity and precedence (_done_).
* Bignum, rational number and floating point arithmetic (_done_). * Bignum, rational number and floating point arithmetic (_done_).
* Built-in control operators (`,`, `;`, `->`, etc.) (_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 * Built-in predicates for list processing and top-level declarative
control (`setup_call_control/3`, `call_with_inference_limit/3`, control (`setup_call_control/3`, `call_with_inference_limit/3`,
etc.) (_done_). etc.) (NEEDS REVISION)
* A rudimentary module system (_done_). * Definite Clause Grammars
* Definite Clause Grammars (_in progress_).
* Attributed variables using the SICStus Prolog interface and * Attributed variables using the SICStus Prolog interface and
semantics. Adding coroutines like `dif/2`, `freeze/2`, etc. semantics. Adding coroutines like `dif/2`, `freeze/2`, etc.
is straightforward with attributed variables. is straightforward with attributed variables.

10
src/main.rs
View File

@@ -5,16 +5,13 @@ extern crate termion;
mod prolog; mod prolog;
use prolog::ast::*; use prolog::ast::*;
use prolog::compile::*;
use prolog::io::*; use prolog::io::*;
use prolog::machine::*; use prolog::machine::*;
#[cfg(test)] #[cfg(test)]
mod tests; 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) fn parse_and_compile_line(wam: &mut Machine, buffer: &str)
{ {
match parse_code(wam, buffer) { match parse_code(wam, buffer) {
@@ -29,11 +26,6 @@ fn parse_and_compile_line(wam: &mut Machine, buffer: &str)
fn prolog_repl() { fn prolog_repl() {
let mut wam = Machine::new(); 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 { loop {
print!("prolog> "); print!("prolog> ");

38
src/prolog/ast.rs
View File

@@ -1,4 +1,3 @@
use prolog::builtins::*;
use prolog::num::bigint::BigInt; use prolog::num::bigint::BigInt;
use prolog::num::{Float, ToPrimitive, Zero}; use prolog::num::{Float, ToPrimitive, Zero};
use prolog::num::rational::Ratio; use prolog::num::rational::Ratio;
@@ -161,6 +160,19 @@ pub struct Module {
pub op_dir: OpDir 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 { impl Module {
pub fn new(module_decl: ModuleDecl) -> Self { pub fn new(module_decl: ModuleDecl) -> Self {
Module { module_decl, Module { module_decl,
@@ -468,7 +480,7 @@ pub enum ParserError
{ {
Arithmetic(ArithmeticError), Arithmetic(ArithmeticError),
BackQuotedString, BackQuotedString,
BuiltInArityMismatch(&'static str), // BuiltInArityMismatch(&'static str),
UnexpectedChar(char), UnexpectedChar(char),
UnexpectedEOF, UnexpectedEOF,
IO(IOError), IO(IOError),
@@ -682,6 +694,7 @@ pub enum QueryTerm {
Clause(Cell<RegType>, ClauseType, Vec<Box<Term>>), Clause(Cell<RegType>, ClauseType, Vec<Box<Term>>),
BlockedCut, // a cut which is 'blocked by letters', like the P term in P -> Q. BlockedCut, // a cut which is 'blocked by letters', like the P term in P -> Q.
UnblockedCut(Cell<VarReg>), UnblockedCut(Cell<VarReg>),
GetLevelAndUnify(Cell<VarReg>, Rc<Var>),
Jump(JumpStub) Jump(JumpStub)
} }
@@ -690,7 +703,8 @@ impl QueryTerm {
match self { match self {
&QueryTerm::Clause(_, _, ref subterms) => subterms.len(), &QueryTerm::Clause(_, _, ref subterms) => subterms.len(),
&QueryTerm::BlockedCut | &QueryTerm::UnblockedCut(..) => 0, &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) { match (name, arity) {
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner), ("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner),
("$install_scc_cleaner", 1) => ("$install_scc_cleaner", 2) =>
Some(SystemClauseType::InstallSCCCleaner), Some(SystemClauseType::InstallSCCCleaner),
("$install_inference_counter", 3) => ("$install_inference_counter", 3) =>
Some(SystemClauseType::InstallInferenceCounter), Some(SystemClauseType::InstallInferenceCounter),
@@ -940,7 +954,7 @@ impl BuiltInClauseType {
("@>", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)), ("@>", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)),
("@<", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThan)), ("@<", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThan)),
("@>=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual)), ("@>=", 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::NotEqual)),
("=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::Equal)), ("=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::Equal)),
("display", 1) => Some(BuiltInClauseType::Display), ("display", 1) => Some(BuiltInClauseType::Display),
@@ -1040,6 +1054,7 @@ pub enum ChoiceInstruction {
pub enum CutInstruction { pub enum CutInstruction {
Cut(RegType), Cut(RegType),
GetLevel(RegType), GetLevel(RegType),
GetLevelAndUnify(RegType),
NeckCut NeckCut
} }
@@ -1372,7 +1387,7 @@ pub enum ArithmeticInstruction {
pub enum ControlInstruction { pub enum ControlInstruction {
Allocate(usize), // num_frames. Allocate(usize), // num_frames.
CallClause(ClauseType, usize, usize, bool), // name, arity, perm_vars after threshold, last call. 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. JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call.
Proceed Proceed
} }
@@ -1481,7 +1496,7 @@ impl PartialOrd<Ref> for Addr {
Some(Ordering::Equal) Some(Ordering::Equal)
} else { } else {
Some(Ordering::Less) Some(Ordering::Less)
} }
}, },
&Addr::HeapCell(h) => &Addr::HeapCell(h) =>
match r { match r {
@@ -1635,13 +1650,6 @@ pub enum LocalCodePtr {
} }
impl 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) { pub fn assign_if_local(&mut self, cp: CodePtr) {
match cp { match cp {
CodePtr::Local(local) => *self = local, CodePtr::Local(local) => *self = local,
@@ -1690,7 +1698,7 @@ impl Add<usize> for LocalCodePtr {
fn add(self, rhs: usize) -> Self::Output { fn add(self, rhs: usize) -> Self::Output {
match self { 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) LocalCodePtr::TopLevel(cn, p) => LocalCodePtr::TopLevel(cn, p + rhs)
} }
} }

778
src/prolog/builtins.rs
View File

@@ -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, 214.
proceed!(),
dynamic_num_test!(cmp_gte!()), // >=/2, 216.
proceed!(),
dynamic_num_test!(cmp_lte!()), // =</2, 218.
proceed!(),
dynamic_num_test!(cmp_ne!()), // =\=, 220.
proceed!(),
dynamic_num_test!(cmp_eq!()), // =:=, 222.
proceed!(),
try_me_else!(5), // =.., 224.
fact![get_var_in_fact!(temp_v!(3), 1),
get_list!(Level::Shallow, temp_v!(2)),
unify_value!(temp_v!(3)),
unify_constant!(Constant::EmptyList)],
is_atomic!(temp_v!(3)),
neck_cut!(),
proceed!(),
retry_me_else!(11),
allocate!(4),
get_level!(perm_v!(1)),
fact![get_var_in_fact!(perm_v!(3), 1),
get_list!(Level::Shallow, temp_v!(2)),
unify_variable!(temp_v!(2)),
unify_variable!(perm_v!(4))],
is_var!(perm_v!(4)),
query![put_value!(perm_v!(3), 1),
put_var!(perm_v!(2), 3)],
functor_call!(),
cut!(perm_v!(1)),
query![put_unsafe_value!(4, 1),
put_value!(perm_v!(3), 2),
put_constant!(Level::Shallow, integer!(1), temp_v!(3)),
put_unsafe_value!(2, 4)],
deallocate!(),
goto_execute!(252, 4), // goto get_args/4, 239.
trust_me!(),
allocate!(5),
get_level!(perm_v!(1)),
fact![get_var_in_fact!(perm_v!(3), 1),
get_list!(Level::Shallow, temp_v!(2)),
unify_variable!(perm_v!(5)),
unify_variable!(perm_v!(4))],
query![put_value!(perm_v!(4), 1),
put_var!(perm_v!(2), 2)],
goto_call!(277, 2), // goto length/2, 245.
query![put_value!(perm_v!(3), 1),
put_value!(perm_v!(5), 2),
put_value!(perm_v!(2), 3)],
functor_call!(),
cut!(perm_v!(1)),
query![put_unsafe_value!(4, 1),
put_value!(perm_v!(3), 2),
put_constant!(Level::Shallow, integer!(1), temp_v!(3)),
put_unsafe_value!(2, 4)],
deallocate!(),
goto_execute!(252, 4), // goto get_args/4, 251.
try_me_else!(5), // get_args/4, 252.
fact![get_var_in_fact!(temp_v!(5), 1),
get_constant!(integer!(0), temp_v!(4))],
neck_cut!(),
query![put_value!(temp_v!(5), 1),
put_constant!(Level::Shallow, Constant::EmptyList, temp_v!(2))],
goto_execute!(73, 2), // goto =/2, 256.
trust_me!(),
switch_on_term!(3, 0, 1, 0),
indexed_try!(3),
trust!(7),
try_me_else!(5),
fact![get_list!(Level::Shallow, temp_v!(1)),
unify_variable!(temp_v!(5)),
unify_constant!(Constant::EmptyList),
get_var_in_fact!(temp_v!(6), 2),
get_var_in_fact!(temp_v!(1), 3),
get_value!(temp_v!(1), 4)],
neck_cut!(),
query![put_value!(temp_v!(6), 2),
put_value!(temp_v!(5), 3)],
get_arg_execute!(),
trust_me!(),
allocate!(5),
fact![get_list!(Level::Shallow, temp_v!(1)),
unify_variable!(temp_v!(5)),
unify_variable!(perm_v!(4)),
get_var_in_fact!(perm_v!(3), 2),
get_var_in_fact!(perm_v!(5), 3),
get_var_in_fact!(perm_v!(1), 4)],
query![put_value!(perm_v!(5), 1),
put_value!(perm_v!(3), 2),
put_value!(temp_v!(5), 3)],
get_arg_call!(),
add!(ArithmeticTerm::Reg(perm_v!(5)),
ArithmeticTerm::Number(rc_integer!(1)),
1),
query![put_var!(perm_v!(2), 1)],
is_call!(perm_v!(2), ArithmeticTerm::Interm(1)),
query![put_unsafe_value!(4, 1),
put_value!(perm_v!(3), 2),
put_unsafe_value!(2, 3),
put_value!(perm_v!(1), 4)],
deallocate!(),
goto_execute!(252, 4), // goto get_args/4, 276.
try_me_else!(6), // length/2, 277.
fact![get_var_in_fact!(temp_v!(4), 1),
get_var_in_fact!(temp_v!(3), 2)],
is_var!(temp_v!(3)),
neck_cut!(),
query![put_value!(temp_v!(4), 1),
put_constant!(Level::Shallow, integer!(0), temp_v!(2))],
goto_execute!(297, 3), // goto length/3, 282.
retry_me_else!(10),
allocate!(1),
get_level!(perm_v!(1)),
fact![get_var_in_fact!(temp_v!(4), 1),
get_var_in_fact!(temp_v!(3), 2)],
is_integer!(temp_v!(3)),
query![put_value!(temp_v!(4), 1),
put_constant!(Level::Shallow, integer!(0), temp_v!(2))],
goto_call!(297, 3), // goto length/3, 289.
cut!(perm_v!(1)),
deallocate!(),
proceed!(),
trust_me!(),
fact![get_var_in_fact!(temp_v!(3), 1),
get_var_in_fact!(temp_v!(4), 2)],
query![put_structure!("type_error", 2, temp_v!(1), None),
set_constant!(atom!("integer_expected")),
set_value!(temp_v!(4))],
goto_execute!(59, 1), // goto throw/1, 296.
switch_on_term!(1, 2, 5, 0), // length/3, 297.
try_me_else!(3),
fact![get_constant!(Constant::EmptyList, temp_v!(1)),
get_var_in_fact!(temp_v!(4), 2),
get_value!(temp_v!(4), 3)],
proceed!(),
trust_me!(),
allocate!(3),
fact![get_list!(Level::Shallow, temp_v!(1)),
unify_void!(1),
unify_variable!(perm_v!(1)),
get_var_in_fact!(temp_v!(4), 2),
get_var_in_fact!(perm_v!(3), 3)],
add!(ArithmeticTerm::Reg(temp_v!(4)),
ArithmeticTerm::Number(rc_integer!(1)),
1),
query![put_var!(perm_v!(2), 1)],
is_call!(perm_v!(2), ArithmeticTerm::Interm(1)),
query![put_unsafe_value!(1, 1),
put_unsafe_value!(2, 2),
put_value!(perm_v!(3), 3)],
deallocate!(),
goto_execute!(297, 3), // goto length/3, 309.
allocate!(4), // setup_call_cleanup/3, 310.
get_level!(perm_v!(1)),
fact![get_var_in_fact!(perm_v!(2), 2),
get_var_in_fact!(perm_v!(3), 3)],
call_n!(1),
cut!(perm_v!(1)),
query![put_var!(perm_v!(4), 1)],
get_current_block!(),
query![put_value!(perm_v!(3), 1),
put_unsafe_value!(4, 2),
put_value!(perm_v!(2), 3)],
deallocate!(),
jmp_execute!(3, 1, 0),
try_me_else!(5), // 320.
is_var!(temp_v!(1)),
neck_cut!(),
query![put_constant!(Level::Shallow,
atom!("instantiation_error"),
temp_v!(1))],
goto_execute!(59, 1),
default_trust_me!(),
query![get_var_in_query!(temp_v!(4), 2),
put_value!(temp_v!(3), 2),
get_var_in_query!(temp_v!(5), 3),
put_value!(temp_v!(4), 3)],
goto_execute!(328, 3),
try_me_else!(13), // sgc_helper/3, 328.
allocate!(4),
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)],
get_level!(perm_v!(1)),
query![put_value!(perm_v!(4), 1)],
install_cleaner!(),
query![put_var!(temp_v!(2), 1)],
install_new_block!(),
query![put_value!(perm_v!(3), 1)],
call_n!(1),
query![put_value!(perm_v!(2), 1),
put_value!(perm_v!(1), 2)],
deallocate!(),
check_cp_execute!(),
default_retry_me_else!(12),
allocate!(2),
query![put_value!(temp_v!(3), 1)],
reset_block!(),
query![put_var!(perm_v!(1), 1)],
get_ball!(),
get_level!(perm_v!(2)),
default_set_cp!(perm_v!(2)),
goto_call!(358, 0), // goto run_cleaners_with_handling/0, 349.
query![put_unsafe_value!(1, 1)],
deallocate!(),
goto_execute!(59, 1), // goto throw/1, 59.
default_trust_me!(),
allocate!(0),
goto_call!(370, 0), // goto run_cleaners_without_handling/0, 355.
deallocate!(),
fail!(),
try_me_else!(10), // run_cleaners_with_handling/0, 358.
allocate!(2),
get_level!(perm_v!(1)),
query![put_var!(perm_v!(2), 1)],
get_cleaner_call!(),
query![put_value!(perm_v!(2), 1),
put_var!(temp_v!(4), 2),
put_constant!(Level::Shallow, atom!("true"), temp_v!(3))],
goto_call!(5, 3), // goto catch/3, 5.
default_set_cp!(perm_v!(1)),
deallocate!(),
goto_execute!(358, 0), // goto run_cleaners_with_handling/0, 367.
default_trust_me!(),
goto_execute!(398, 0), // goto restore_cut_points/0, 369.
try_me_else!(10), // run_cleaners_without_handling/0, 370.
allocate!(2),
get_level!(perm_v!(1)),
query![put_var!(perm_v!(2), 1)],
get_cleaner_call!(),
query![put_value!(perm_v!(2), 1)],
call_n!(1),
default_set_cp!(perm_v!(1)),
deallocate!(),
goto_execute!(370, 0), // goto run_cleaners_without_handling/0, 379.
default_trust_me!(),
goto_execute!(398, 0), // goto restore_cut_points/0, 381.
allocate!(1), // sgc_on_success/2, 382.
fact![get_var_in_fact!(perm_v!(1), 2)],
reset_block!(),
cut!(perm_v!(1)),
deallocate!(),
proceed!(),
is_compound!(temp_v!(1)), // compound/1, 388.
proceed!(),
is_rational!(temp_v!(1)), // rational/1, 390.
proceed!(),
is_string!(temp_v!(1)), // string/1, 392.
proceed!(),
is_float!(temp_v!(1)), // float/1, 394.
proceed!(),
is_nonvar!(temp_v!(1)), // nonvar/1, 396.
proceed!(),
restore_cut_policy!(), // restore_cut_policy/0, 398.
proceed!(),
ground_execute!(), // ground/1, 400.
eq_execute!(), // (==)/2, 401.
not_eq_execute!(), // (\==)/2, 402.
compare_term_execute!(term_cmp_gte!()), // (@>=)/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)
}
*/

13
src/prolog/codegen.rs
View File

@@ -404,6 +404,19 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker>
}; };
match *term { 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) => &QueryTerm::UnblockedCut(ref cell) =>
code.push(set_cp!(cell.get().norm())), code.push(set_cp!(cell.get().norm())),
&QueryTerm::BlockedCut => &QueryTerm::BlockedCut =>

317
src/prolog/compile.rs Normal file
View File

@@ -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<TopLevelPacket, ParserError>
{
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<Code, ParserError>
{
let mut cg = CodeGenerator::<DebrayAllocator>::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<TopLevel>) -> Result<(), ParserError>
{
for tl in queue.iter() {
set_first_index(code);
code.append(&mut compile_relation(tl)?);
}
Ok(())
}
fn compile_query(terms: Vec<QueryTerm>, queue: Vec<TopLevel>, code_size: usize,
code_dir: &mut CodeDir)
-> Result<(Code, AllocVarDict), ParserError>
{
let mut cg = CodeGenerator::<DebrayAllocator>::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<TopLevel>) -> 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<Module>) -> ClauseName {
match module {
&Some(ref module) => module.module_decl.name.clone(),
_ => ClauseName::BuiltIn("user")
}
}
let mut module: Option<Module> = 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
}

6
src/prolog/heap_print.rs
View File

@@ -17,7 +17,7 @@ pub enum TokenOrRedirect {
OpenList(Rc<Cell<bool>>), OpenList(Rc<Cell<bool>>),
CloseList(Rc<Cell<bool>>), CloseList(Rc<Cell<bool>>),
HeadTailSeparator, HeadTailSeparator,
Space // Space
} }
pub trait HCValueFormatter { pub trait HCValueFormatter {
@@ -283,8 +283,8 @@ impl<'a, Formatter: HCValueFormatter, Outputter: HCValueOutputter>
loop { loop {
if let Some(loc_data) = self.state_stack.pop() { if let Some(loc_data) = self.state_stack.pop() {
match loc_data { match loc_data {
TokenOrRedirect::Space => // TokenOrRedirect::Space =>
self.outputter.append(" "), // self.outputter.append(" "),
TokenOrRedirect::Atom(atom) => TokenOrRedirect::Atom(atom) =>
self.outputter.append(atom.as_str()), self.outputter.append(atom.as_str()),
TokenOrRedirect::Redirect => TokenOrRedirect::Redirect =>

333
src/prolog/io.rs
View File

@@ -1,10 +1,6 @@
use prolog::ast::*; use prolog::ast::*;
use prolog::builtins::*;
use prolog::codegen::*;
use prolog::debray_allocator::*;
use prolog::heap_print::*; use prolog::heap_print::*;
use prolog::machine::*; use prolog::machine::*;
use prolog::toplevel::*;
use termion::raw::IntoRawMode; use termion::raw::IntoRawMode;
use termion::input::TermRead; use termion::input::TermRead;
@@ -255,7 +251,9 @@ impl fmt::Display for CutInstruction {
&CutInstruction::NeckCut => &CutInstruction::NeckCut =>
write!(f, "neck_cut"), write!(f, "neck_cut"),
&CutInstruction::GetLevel(r) => &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<TopLevelPacket, ParserError>
{
let mut worker = TopLevelWorker::new(buffer.as_bytes(), wam.atom_tbl());
worker.parse_code(&wam.op_dir)
}
pub enum Input { pub enum Input {
Quit, Quit,
Clear, 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<Code, ParserError>
{
let mut cg = CodeGenerator::<DebrayAllocator>::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<TopLevel>) -> Result<(), ParserError>
{
for tl in queue.iter() {
set_first_index(code);
code.append(&mut compile_relation(tl)?);
}
Ok(())
}
fn compile_query(terms: Vec<QueryTerm>, queue: Vec<TopLevel>, code_size: usize,
code_dir: &mut CodeDir)
-> Result<(Code, AllocVarDict), ParserError>
{
let mut cg = CodeGenerator::<DebrayAllocator>::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<TopLevel>) -> 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<Module>) -> ClauseName {
match module {
&Some(ref module) => module.module_decl.name.clone(),
_ => ClauseName::BuiltIn("user")
}
}
let mut module: Option<Module> = 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 { fn error_string(e: &String) -> String {
format!("error: exception thrown: {}", e) format!("error: exception thrown: {}", e)
} }

9
src/prolog/iterators.rs
View File

@@ -57,6 +57,10 @@ impl<'a> QueryIterator<'a> {
let state = TermIterState::Var(Level::Root, cell, rc_atom!("!")); let state = TermIterState::Var(Level::Root, cell, rc_atom!("!"));
QueryIterator { state_stack: vec![state] } 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) => { &QueryTerm::Jump(ref vars) => {
let state_stack = vars.iter().rev().map(|t| { let state_stack = vars.iter().rev().map(|t| {
TermIterState::subterm_to_state(Level::Shallow, t) TermIterState::subterm_to_state(Level::Shallow, t)
@@ -337,6 +341,11 @@ impl<'a> ChunkedIterator<'a>
self.deep_cut_encountered = true; self.deep_cut_encountered = true;
} }
}, },
ChunkedTerm::BodyTerm(&QueryTerm::GetLevelAndUnify(..)) => {
result.push(term);
arity = 1;
break;
},
ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) => ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) =>
result.push(term), result.push(term),
ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), _)) => ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), _)) =>

71
src/prolog/lib/builtins.pl
View File

@@ -4,7 +4,8 @@
(\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2,
(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2,
(-)/1, (>=)/2, (=<)/2, (,)/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. % arithmetic operators.
:- op(700, xfx, is). :- op(700, xfx, is).
@@ -43,6 +44,12 @@
% term comparison. % 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, @>).
:- op(700, xfx, =@=).
:- op(700, xfx, \=@=).
% the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY). % the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY).
max_arity(63). max_arity(63).
@@ -137,6 +144,39 @@ univ_worker(Term, List, _) :-
I1 is I0 + 1, I1 is I0 + 1,
'$get_args'(Args, Func, I1, N). '$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. % exceptions.
catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb). 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'. handle_ball(_, _, _) :- '$unwind_stack'.
throw(Ball) :- '$set_ball'(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).

10
src/prolog/lib/control.pl
View File

@@ -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, \=). :- op(700, xfx, \=).
once(G) :- G, !. once(G) :- G, !.
\+ G :- G, !, false.
\+ _.
X \= X :- !, 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) :- between(Lower, Upper, Lower) :-
Lower =< Upper. Lower =< Upper.

35
src/prolog/lib/lists.pl
View File

@@ -1,7 +1,36 @@
:- use_module(library(builtins)).
:- module(lists, [member/2, select/3, append/3, memberchk/2, :- module(lists, [member/2, select/3, append/3, memberchk/2,
reverse/2, maplist/2, maplist/3, maplist/4, reverse/2, length/2, maplist/2, maplist/3,
maplist/5, maplist/6, maplist/7, maplist/8, maplist/4, maplist/5, maplist/6, maplist/7,
maplist/9]). 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, [X|_]).
member(X, [_|Xs]) :- member(X, Xs). member(X, [_|Xs]) :- member(X, Xs).

2
src/prolog/lib/queues.pl
View File

@@ -1,3 +1,5 @@
:- use_module(library(builtins)).
:- module(queues, [queue/1, queue/2, queue_head/3, queue_head_list/3, :- module(queues, [queue/1, queue/2, queue_head/3, queue_head_list/3,
queue_last/3, queue_last_list/3, list_queue/2, queue_last/3, queue_last_list/3, list_queue/2,
queue_length/2]). queue_length/2]).

21
src/prolog/machine/machine_state.rs
View File

@@ -715,8 +715,8 @@ impl SCCCutPolicy {
self.cont_pts.is_empty() self.cont_pts.is_empty()
} }
pub(crate) fn push_cont_pt(&mut self, addr: Addr, b: usize, block: usize) { pub(crate) fn push_cont_pt(&mut self, addr: Addr, b: usize, prev_b: usize) {
self.cont_pts.push((addr, b, block)); self.cont_pts.push((addr, b, prev_b));
} }
pub(crate) fn pop_cont_pt(&mut self) -> Option<(Addr, usize, usize)> { 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; let b = machine_st.b;
if let Addr::Con(Constant::Usize(b0)) = machine_st[r].clone() { if let Addr::Con(Constant::Usize(b0)) = machine_st[r].clone() {
if b > b0 { if b > b0 {
machine_st.b = b0; machine_st.b = b0;
machine_st.tidy_trail(); machine_st.tidy_trail();
machine_st.or_stack.truncate(machine_st.b); machine_st.or_stack.truncate(machine_st.b);
@@ -737,14 +737,13 @@ impl CutPolicy for SCCCutPolicy {
} else { } else {
machine_st.fail = true; machine_st.fail = true;
return; return;
} }
if !self.out_of_cont_pts() { if let Some(&(_, b_cutoff, prev_block)) = self.cont_pts.last() {
machine_st.cp.assign_if_local(machine_st.p.clone()); if machine_st.b < b_cutoff {
machine_st.num_of_args = 0; machine_st.block = prev_block;
machine_st.b0 = machine_st.b; machine_st.unwind_stack();
// goto_call run_cleaners_without_handling/0, 370. }
machine_st.p = dir_entry!(370, clause_name!("builtin"));
} }
} }
} }

21
src/prolog/machine/machine_state_impl.rs
View File

@@ -1065,13 +1065,6 @@ impl MachineState {
duplicator.duplicate_term(addr); 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<PredicateKey> pub(super) fn setup_call_n(&mut self, arity: usize) -> Option<PredicateKey>
{ {
let stub = self.functor_stub(clause_name!("call"), arity + 1); let stub = self.functor_stub(clause_name!("call"), arity + 1);
@@ -1121,7 +1114,14 @@ impl MachineState {
Some((name, arity + narity - 1)) 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 { fn heap_ball_boundary_diff(&self) -> usize {
if self.ball.boundary > self.heap.h { if self.ball.boundary > self.heap.h {
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[r] = Addr::Con(Constant::Usize(b0));
self.p += 1; 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) => { &CutInstruction::Cut(r) => {
cut_policy.cut(self, r); cut_policy.cut(self, r);
self.p += 1; self.p += 1;

33
src/prolog/machine/mod.rs
View File

@@ -1,5 +1,5 @@
use prolog::ast::*; use prolog::ast::*;
use prolog::builtins::*; use prolog::compile::*;
use prolog::heap_print::*; use prolog::heap_print::*;
use prolog::tabled_rc::*; use prolog::tabled_rc::*;
@@ -17,9 +17,9 @@ use std::mem::swap;
use std::ops::Index; use std::ops::Index;
use std::rc::Rc; use std::rc::Rc;
pub(super) struct MachineCodeIndex<'a> { pub struct MachineCodeIndex<'a> {
pub(super) code_dir: &'a mut CodeDir, pub code_dir: &'a mut CodeDir,
pub(super) op_dir: &'a mut OpDir, pub op_dir: &'a mut OpDir,
} }
pub struct Machine { pub struct Machine {
@@ -66,24 +66,33 @@ impl<'a> SubModuleUser for MachineCodeIndex<'a> {
self.code_dir.insert((name, arity), CodeIndex::from(idx)); 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 { impl Machine {
pub fn new() -> Self { pub fn new() -> Self {
let atom_tbl = Rc::new(RefCell::new(HashSet::new())); let mut wam = Machine {
let op_dir = default_op_dir(); //TODO: change to the builtins module once it's done. ms: MachineState::new(Rc::new(RefCell::new(HashSet::new()))),
//let (code, code_dir, op_dir) = default_build();
Machine {
ms: MachineState::new(atom_tbl),
call_policy: Box::new(DefaultCallPolicy {}), call_policy: Box::new(DefaultCallPolicy {}),
cut_policy: Box::new(DefaultCutPolicy {}), cut_policy: Box::new(DefaultCutPolicy {}),
code: Code::new(), code: Code::new(),
code_dir: CodeDir::new(), code_dir: CodeDir::new(),
term_dir: TermDir::new(), term_dir: TermDir::new(),
op_dir, op_dir: default_op_dir(),
modules: HashMap::new(), modules: HashMap::new(),
cached_query: None 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) { fn remove_module(&mut self, module_name: ClauseName) {

52
src/prolog/machine/system_calls.rs
View File

@@ -151,39 +151,57 @@ impl MachineState {
Ok(()) Ok(())
} }
pub(super) fn system_call(&mut self, ct: &SystemClauseType, call_policy: &mut Box<CallPolicy>, 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<CallPolicy>,
cut_policy: &mut Box<CutPolicy>,) cut_policy: &mut Box<CutPolicy>,)
-> CallResult -> CallResult
{ {
match ct { 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 => { &SystemClauseType::GetSCCCleaner => {
let dest = self[temp_v!(1)].clone(); let dest = self[temp_v!(1)].clone();
match cut_policy.downcast_mut::<SCCCutPolicy>().ok() { match cut_policy.downcast_mut::<SCCCutPolicy>().ok() {
Some(sgc_policy) => 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 { if self.b <= b_cutoff + 1 {
self.block = prev_block; self.block = prev_b;
if let Some(r) = dest.as_var() { if let Some(r) = dest.as_var() {
self.bind(r, addr); self.bind(r, addr.clone());
return Ok(()); return Ok(());
} }
} else { } 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.") None => panic!("expected SCCCutPolicy trait object.")
}; };
self.fail = true; self.fail = true;
}, },
&SystemClauseType::InstallSCCCleaner => { &SystemClauseType::InstallSCCCleaner => {
let addr = self[temp_v!(1)].clone(); let addr = self[temp_v!(1)].clone();
let b = self.b; let b = self.b;
let block = self.block; let prev_block = self.block;
if cut_policy.downcast_ref::<SCCCutPolicy>().is_err() { if cut_policy.downcast_ref::<SCCCutPolicy>().is_err() {
*cut_policy = Box::new(SCCCutPolicy::new()); *cut_policy = Box::new(SCCCutPolicy::new());
@@ -191,7 +209,10 @@ impl MachineState {
match cut_policy.downcast_mut::<SCCCutPolicy>().ok() match cut_policy.downcast_mut::<SCCCutPolicy>().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 \\ None => panic!("install_cleaner: should have installed \\
SCCCutPolicy.") SCCCutPolicy.")
}; };
@@ -292,7 +313,7 @@ impl MachineState {
}, },
_ => self.fail = true _ => self.fail = true
}; };
}, },
&SystemClauseType::CleanUpBlock => { &SystemClauseType::CleanUpBlock => {
let nb = self.store(self.deref(self[temp_v!(1)].clone())); let nb = self.store(self.deref(self[temp_v!(1)].clone()));
@@ -337,16 +358,11 @@ impl MachineState {
&SystemClauseType::GetCutPoint => { &SystemClauseType::GetCutPoint => {
let a1 = self[temp_v!(1)].clone(); let a1 = self[temp_v!(1)].clone();
let a2 = Addr::Con(Constant::Usize(self.b)); let a2 = Addr::Con(Constant::Usize(self.b));
self.unify(a1, a2); self.unify(a1, a2);
}, },
&SystemClauseType::InstallNewBlock => { &SystemClauseType::InstallNewBlock => {
self.block = self.b; self.install_new_block(temp_v!(1));
let c = Constant::Usize(self.block);
let addr = self[temp_v!(1)].clone();
self.write_constant_to_var(addr, c);
}, },
&SystemClauseType::ResetBlock => { &SystemClauseType::ResetBlock => {
let addr = self.deref(self[temp_v!(1)].clone()); let addr = self.deref(self[temp_v!(1)].clone());

5
src/prolog/macros.rs
View File

@@ -248,3 +248,8 @@ macro_rules! top_level_code_ptr {
) )
} }
macro_rules! get_level_and_unify {
($r: expr) => (
Line::Cut(CutInstruction::GetLevelAndUnify($r))
)
}

2
src/prolog/mod.rs
View File

@@ -9,8 +9,8 @@ pub mod ast;
#[macro_use] #[macro_use]
pub mod allocator; pub mod allocator;
pub mod toplevel; pub mod toplevel;
pub mod compile;
pub mod arithmetic; pub mod arithmetic;
pub mod builtins;
pub mod codegen; pub mod codegen;
pub mod copier; pub mod copier;
pub mod debray_allocator; pub mod debray_allocator;

18
src/prolog/toplevel.rs
View File

@@ -1,4 +1,5 @@
use prolog::ast::*; use prolog::ast::*;
use prolog::machine::*;
use prolog::num::*; use prolog::num::*;
use prolog::parser::parser::*; use prolog::parser::parser::*;
use prolog::tabled_rc::*; use prolog::tabled_rc::*;
@@ -412,6 +413,12 @@ impl RelationWorker {
self.queue.push_back(clauses); self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub)) 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 { } else {
Ok(QueryTerm::Clause(Cell::default(), Ok(QueryTerm::Clause(Cell::default(),
ClauseType::from(name, terms.len(), fixity), ClauseType::from(name, terms.len(), fixity),
@@ -558,7 +565,8 @@ impl<R: Read> TopLevelWorker<R> {
TopLevelWorker { parser: Parser::new(inner, atom_tbl) } TopLevelWorker { parser: Parser::new(inner, atom_tbl) }
} }
pub fn parse_batch(&mut self, op_dir: &mut OpDir) -> Result<Vec<TopLevelPacket>, SessionError> pub fn parse_batch<'a>(&mut self, wam: &Machine, mut indices: MachineCodeIndex<'a>)
-> Result<Vec<TopLevelPacket>, SessionError>
{ {
let mut preds = vec![]; let mut preds = vec![];
let mut mod_name = clause_name!("user"); let mut mod_name = clause_name!("user");
@@ -572,7 +580,7 @@ impl<R: Read> TopLevelWorker<R> {
while !self.parser.eof() { while !self.parser.eof() {
self.parser.reset(); // empty the parser stack of token descriptions. 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 mut new_rel_worker = RelationWorker::new();
let tl = new_rel_worker.try_term_to_tl(term, true)?; let tl = new_rel_worker.try_term_to_tl(term, true)?;
@@ -584,8 +592,12 @@ impl<R: Read> TopLevelWorker<R> {
rel_worker.absorb(new_rel_worker); rel_worker.absorb(new_rel_worker);
match tl { 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)) => { 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)) => { TopLevel::Declaration(Declaration::Module(actual_mod)) => {
mod_name = actual_mod.name.clone(); mod_name = actual_mod.name.clone();

81
src/tests.rs
View File

@@ -1,6 +1,6 @@
use prolog::ast::*; use prolog::ast::*;
use prolog::heap_print::*; use prolog::heap_print::*;
use prolog::io::*; use prolog::compile::*;
use prolog::machine::*; use prolog::machine::*;
use std::collections::HashSet; use std::collections::HashSet;
@@ -937,7 +937,6 @@ fn test_queries_on_call_n()
fn test_queries_on_arithmetic() fn test_queries_on_arithmetic()
{ {
let mut wam = Machine::new(); 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_success!(&mut wam, "?- X is 1, X is X.", [["X = 1"]]);
assert_prolog_failure!(&mut wam, "?- X is 1, X is 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() fn test_queries_on_exceptions()
{ {
let mut wam = Machine::new(); 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, "f(a). f(_) :- throw(stuff).");
submit(&mut wam, "handle(stuff)."); submit(&mut wam, "handle(stuff).");
@@ -1127,7 +1125,6 @@ fn test_queries_on_exceptions()
#[test] #[test]
fn test_queries_on_skip_max_list() { fn test_queries_on_skip_max_list() {
let mut wam = Machine::new(); let mut wam = Machine::new();
load_init_str_and_include(&mut wam, BUILTINS, "builtins");
// test on proper and empty lists. // test on proper and empty lists.
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 5, [], Xs).", 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() fn test_queries_on_conditionals()
{ {
let mut wam = Machine::new(); 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\") submit(&mut wam, "test(A) :- ( A =:= 2 -> display(\"A is 2\")
; A =:= 3 -> display(\"A is 3\") ; A =:= 3 -> display(\"A is 3\")
@@ -1266,12 +1262,12 @@ fn test_queries_on_conditionals()
[["X = a"], ["X = b"]]); [["X = a"], ["X = b"]]);
} }
/*
#[test] #[test]
fn test_queries_on_builtins() fn test_queries_on_builtins()
{ {
let mut wam = Machine::new(); let mut wam = Machine::new();
wam.use_module_in_toplevel(clause_name!("lists"));
assert_prolog_failure!(&mut wam, "?- atom(X)."); assert_prolog_failure!(&mut wam, "?- atom(X).");
assert_prolog_success!(&mut wam, "?- atom(a)."); assert_prolog_success!(&mut wam, "?- atom(a).");
assert_prolog_failure!(&mut wam, "?- atom(\"string\")."); 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_success!(&mut wam, "?- var(X), X = 3, atomic(X).", [["X = 3"]]);
assert_prolog_failure!(&mut wam, "?- var(X), X = 3, var(X)."); 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(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(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(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, "?- 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).", assert_prolog_success!(&mut wam, "?- catch(arg(N, f, Arg), error(E, _), true).",
[["E = compound", "Arg = _3", "N = _1"]]);
assert_prolog_success!(&mut wam, "?- catch(arg(N, _, Arg), error(E, _), true).",
[["E = instantiation_error", "Arg = _3", "N = _1"]]); [["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(N, f(arg, arg, arg), not_arg).");
assert_prolog_failure!(&mut wam, "?- arg(1, f(arg, not_arg, not_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)."); 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, "?- functor(Func, f, 4).", [["Func = f(_2, _3, _4, _5)"]]);
assert_prolog_success!(&mut wam, "?- catch(functor(F, \"sdf\", 3), error(E, _), true).", 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).", assert_prolog_success!(&mut wam, "?- catch(functor(Func, F, 3), error(E, _), true).",
[["E = instantiation_error", "Func = _1", "F = _2"]]); [["E = instantiation_error", "Func = _1", "F = _2"]]);
assert_prolog_success!(&mut wam, "?- catch(functor(Func, f, N), error(E, _), true).", 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_success!(&mut wam, "?- X is 3, call(integer, X).");
assert_prolog_failure!(&mut wam, "?- X is 3 + 3.5, 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, \\+ 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, \\+ integer(X).");
assert_prolog_success!(&mut wam, "?- Func =.. [atom].", [["Func = atom"]]); assert_prolog_success!(&mut wam, "?- Func =.. [atom].", [["Func = atom"]]);
assert_prolog_success!(&mut wam, "?- Func =.. [\"sdf\"].", [["Func = \"sdf\""]]); assert_prolog_success!(&mut wam, "?- Func =.. [\"sdf\"].", [["Func = \"sdf\""]]);
assert_prolog_success!(&mut wam, "?- Func =.. [1].", [["Func = 1"]]); 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) =.. List.", [["List = [f, 1, 2, 3]"]]);
assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. [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]."); 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].", assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. [f,X,Y,Z].",
[["X = 1", "Y = 2", "Z = 3"]]); [["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).", assert_prolog_success_with_limit!(&mut wam, "?- length(Xs, N).",
[["N = 0", "Xs = []"], [["N = 0", "Xs = []"],
["N = 1", "Xs = [_3]"], ["N = 1", "Xs = [_4]"],
["N = 2", "Xs = [_3, _6]"], ["N = 2", "Xs = [_4, _8]"],
["N = 3", "Xs = [_3, _6, _9]"], ["N = 3", "Xs = [_4, _8, _12]"],
["N = 4", "Xs = [_3, _6, _9, _12]"], ["N = 4", "Xs = [_4, _8, _12, _16]"],
["N = 5", "Xs = [_3, _6, _9, _12, _15]"]], ["N = 5", "Xs = [_4, _8, _12, _16, _20]"]],
6); 6);
assert_prolog_success!(&mut wam, "?- length(Xs, 3).", [["Xs = [_2, _5, _8]"]]); assert_prolog_success!(&mut wam, "?- length(Xs, 3).", [["Xs = [_4, _8, _12]"]]);
assert_prolog_success!(&mut wam, "?- length([a,b,c], N).", [["N = 3"]]);
assert_prolog_success!(&mut wam, "?- length([], N).", [["N = 0"]]); assert_prolog_success!(&mut wam, "?- length([], N).", [["N = 0"]]);
assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]); assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]);
assert_prolog_success!(&mut wam, "?- length([a,b,[a,b,c]], 3)."); 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_failure!(&mut wam, "?- length([a,b,[a,b,c]], 2).");
assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(integer, E), true).", assert_prolog_success!(&mut wam, "?- catch(length(a, []), error(E, _), true).",
[["E = []"]]); [["E = type_error(integer, [])"]]);
assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).", assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).",
[["Z = 3", "Y = 2", "X = 1"]]); [["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, "?- g(B) = B, g(A) = A, A =@= B.");
assert_prolog_success!(&mut wam, "?- keysort([1-1, 1-1], Sorted).", 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).", 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]).", assert_prolog_success!(&mut wam, "?- keysort([X-1,1-1],[2-1,1-1]).",
[["X = 2"]]); [["X = 2"]]);
assert_prolog_failure!(&mut wam, "?- Pairs = [a-a|Pairs], keysort(Pairs, _)."); 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).", 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).", assert_prolog_success!(&mut wam, "?- keysort([], L).",
[["L = []"]]); [["L = []"]]);
@@ -1514,9 +1491,9 @@ fn test_queries_on_builtins()
assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).", assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).",
[["Pat = type_error(list, [a | a])"]]); [["Pat = type_error(list, [a | a])"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort(_, _), error(E, _), true).", 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).", 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).", assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [a-b,c-d,a]), error(E, _), true).",
[["E = type_error(pair, a)"]]); [["E = type_error(pair, a)"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([a], [a-b]), error(E, _), true).", 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).", assert_prolog_success!(&mut wam, "?- sort([], L).",
[["L = []"]]); [["L = []"]]);
assert_prolog_success!(&mut wam, "?- catch(sort(_, []), error(E, _), true).", 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).", assert_prolog_success!(&mut wam, "?- catch(sort([a,b,c], not_a_list), error(E, _), true).",
[["E = type_error(list, not_a_list)"]]); [["E = type_error(list, not_a_list)"]]);
assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).", assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).",
[["G = 2", "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).", 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"]]); [["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).", 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"]]); [["S = _1", "G = _4", "B = _14", "R = inference_limit_exceeded"]]);
*/
} }
/*
#[test] #[test]
fn test_queries_on_setup_call_cleanup() fn test_queries_on_setup_call_cleanup()
{ {
let mut wam = Machine::new(); 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. // Test examples from the ISO Prolog page for setup_call_catch.
assert_prolog_failure!(&mut wam, "?- setup_call_cleanup(false, _, _)."); 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, true, (true ; throw(x))).");
assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, X = 1, X = 2).", assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, X = 1, X = 2).",
[["X = 1"]]); [["X = 1"]]);
assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, true, X = 2).", assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, true, X = 2).",
[["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"]]); [["E = instantiation_error", "X = _1"]]);
assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(X=throw(ex), true, X), E, true).", assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(X=throw(ex), true, X), E, true).",
[["E = ex", "X = _3"]]); [["E = ex", "X = _3"]]);