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

add catch/throw support, make exceptions and arithmetic tests pass.

Browse Source
This commit is contained in:
Mark Thom
2018-05-10 01:43:36 -06:00
parent bae107f8cd
commit 954c29b103
9 changed files with 314 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
src/prolog/ast.rs
View File

@@ -711,13 +711,31 @@ pub struct Rule {
#[derive(Copy, Clone, PartialEq)]
pub enum SystemClauseType {
SkipMaxList
CleanUpBlock,
EraseBall,
Fail,
GetBall,
GetCurrentBlock,
InstallNewBlock,
ResetBlock,
SetBall,
SkipMaxList,
UnwindStack
}
impl SystemClauseType {
pub fn arity(&self) -> usize {
match self {
&SystemClauseType::SkipMaxList => 4
&SystemClauseType::CleanUpBlock => 1,
&SystemClauseType::EraseBall => 0,
&SystemClauseType::Fail => 0,
&SystemClauseType::GetBall => 1,
&SystemClauseType::GetCurrentBlock => 1,
&SystemClauseType::InstallNewBlock => 1,
&SystemClauseType::ResetBlock => 1,
&SystemClauseType::SetBall => 1,
&SystemClauseType::SkipMaxList => 4,
&SystemClauseType::UnwindStack => 0
}
}
@@ -727,13 +745,31 @@ impl SystemClauseType {
pub fn name(&self) -> ClauseName {
match self {
&SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"),
&SystemClauseType::EraseBall => clause_name!("$erase_ball"),
&SystemClauseType::Fail => clause_name!("$fail"),
&SystemClauseType::GetBall => clause_name!("$get_ball"),
&SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"),
&SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
&SystemClauseType::ResetBlock => clause_name!("$reset_block"),
&SystemClauseType::SetBall => clause_name!("$set_ball"),
&SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"),
&SystemClauseType::UnwindStack => clause_name!("$unwind_stack"),
}
}
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
match (name, arity) {
("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
("$erase_ball", 0) => Some(SystemClauseType::EraseBall),
("$fail", 0) => Some(SystemClauseType::Fail),
("$get_ball", 1) => Some(SystemClauseType::GetBall),
("$get_current_block", 1) => Some(SystemClauseType::GetCurrentBlock),
("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
("$set_ball", 1) => Some(SystemClauseType::SetBall),
("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
("$unwind_stack", 0) => Some(SystemClauseType::UnwindStack),
_ => None
}
}

16
src/prolog/io.rs
View File

@@ -601,6 +601,22 @@ pub fn compile_packet(wam: &mut Machine, tl: TopLevelPacket) -> EvalSession
}
}
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 {

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

@@ -1,8 +1,9 @@
:- op(400, yfx, /).
:- module(builtins, [(+)/2, (*)/2, (-)/2, (/)/2, (/\)/2, (\/)/2, (is)/2,
(xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2,
(rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, (=<)/2]).
:- module(builtins, [(=)/2, (+)/2, (*)/2, (-)/2, (/)/2, (/\)/2,
(\/)/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, catch/3, throw/1, true/0, false/0]).
% arithmetic operators.
:- op(700, xfx, is).
@@ -19,6 +20,7 @@
:- op(400, yfx, >>).
:- op(400, yfx, mod).
:- op(400, yfx, rem).
:- op(200, fy, -).
% arithmetic comparison operators.
:- op(700, xfx, >).
@@ -27,3 +29,57 @@
:- op(700, xfx, =:=).
:- op(700, xfx, >=).
:- op(700, xfx, =<).
% conditional operators.
:- op(1050, xfy, ->).
:- op(1100, xfy, ;).
% unify.
:- op(700, xfx, =).
% unify.
X = X.
true.
false :- '$fail'.
% conditions.
/*
','(G1, G2) :- get_cp(B), ','(G1, G2, B).
','(!, ','(G1, G2), B) :- set_cp(B), ','(G1, G2, B).
','(!, !, B) :- set_cp(B).
','(!, G, B) :- set_cp(B), G.
','(G, ','(G2, G3), B) :- !, G, ','(G2, G3, B).
','(G, !, B) :- !, G, set_cp(B).
','(G1, G2, _) :- G1, G2.
;(G1, G2) :- get_cp(B), ;(G1, G2, B).
;(G1 -> G2, _, B) :- ->(G1, G2, B).
;(_ -> _ , G, B) :- set_cp(B), G.
;(!, _, B) :- set_cp(B).
;(_, !, B) :- set_cp(B).
;(G, _, _) :- G.
;(_, G, _) :- G.
G1 -> G2 :- get_cp(B), ->(G1, G2, B).
->(G1, !, B) :- call(G1), set_cp(B).
->(G1, G2, B) :- call(G1), set_cp(B), call(G2).
*/
% exceptions.
catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb).
catch(G,C,R,Bb) :- '$install_new_block'(NBb), call(G), end_block(Bb, NBb).
catch(G,C,R,Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), handle_ball(Ball, C, R).
end_block(Bb, NBb) :- '$clean_up_block'(NBb), '$reset_block'(Bb).
end_block(Bb, NBb) :- '$reset_block'(NBb), '$fail'.
handle_ball(Ball, C, R) :- Ball = C, !, '$erase_ball', call(R).
handle_ball(_, _, _) :- '$unwind_stack'.
throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'.

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

@@ -400,37 +400,35 @@ pub(crate) trait CallPolicy: Any {
Ok(())
}
fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize,
fn call_n<'a>(&mut self, machine_st: &mut MachineState, mut arity: usize,
code_dirs: CodeDirs<'a>, lco: bool)
-> CallResult
{
loop {
if let Some((name, mut arity)) = machine_st.setup_call_n(arity) {
let user = clause_name!("user");
while let Some((name, inner_arity)) = machine_st.setup_call_n(arity) {
let user = clause_name!("user");
if machine_st.fail {
return Ok(());
}
match ClauseType::from(name.clone(), arity, None) {
ClauseType::CallN => {
machine_st.num_of_args = arity;
machine_st.handle_internal_call_n();
continue;
},
ClauseType::BuiltIn(built_in) =>
machine_st.setup_built_in_call(built_in, lco),
ClauseType::Inlined(inlined) =>
machine_st.execute_inlined(&inlined),
ClauseType::Op(..) | ClauseType::Named(..) =>
if let Some(idx) = code_dirs.get(name.clone(), arity, user) {
self.context_call(machine_st, name, arity, idx, lco)?;
} else {
return Err(machine_st.existence_error(name, arity));
}
};
}
match ClauseType::from(name.clone(), inner_arity, None) {
ClauseType::CallN => {
machine_st.handle_internal_call_n(inner_arity);
if machine_st.fail {
return Ok(());
}
arity = inner_arity;
continue;
},
ClauseType::BuiltIn(built_in) =>
machine_st.setup_built_in_call(built_in, lco),
ClauseType::Inlined(inlined) =>
machine_st.execute_inlined(&inlined),
ClauseType::Op(..) | ClauseType::Named(..) =>
if let Some(idx) = code_dirs.get(name.clone(), inner_arity, user) {
self.context_call(machine_st, name, inner_arity, idx, lco)?;
} else {
return Err(machine_st.existence_error(name, inner_arity));
}
};
break;
}
@@ -441,10 +439,82 @@ pub(crate) trait CallPolicy: Any {
fn system_call(&mut self, machine_st: &mut MachineState, ct: &SystemClauseType) -> CallResult
{
match ct {
&SystemClauseType::CleanUpBlock => {
let nb = machine_st.store(machine_st.deref(machine_st[temp_v!(1)].clone()));
match nb {
Addr::Con(Constant::Usize(nb)) => {
let b = machine_st.b - 1;
if nb > 0 && machine_st.or_stack[b].b == nb {
machine_st.b = machine_st.or_stack[nb - 1].b;
machine_st.or_stack.truncate(machine_st.b);
}
},
_ => machine_st.fail = true
};
Ok(())
},
&SystemClauseType::EraseBall => {
machine_st.ball.reset();
Ok(())
},
&SystemClauseType::Fail => {
machine_st.fail = true;
Ok(())
},
&SystemClauseType::GetBall => {
let addr = machine_st.store(machine_st.deref(machine_st[temp_v!(1)].clone()));
let h = machine_st.heap.h;
if machine_st.ball.stub.len() > 0 {
machine_st.copy_and_align_ball_to_heap();
} else {
machine_st.fail = true;
return Ok(());
}
let ball = machine_st.heap[h].as_addr(h);
match addr.as_var() {
Some(r) => machine_st.bind(r, ball),
_ => machine_st.fail = true
};
Ok(())
},
&SystemClauseType::GetCurrentBlock => {
let c = Constant::Usize(machine_st.block);
let addr = machine_st[temp_v!(1)].clone();
machine_st.write_constant_to_var(addr, c);
Ok(())
},
&SystemClauseType::InstallNewBlock => {
machine_st.block = machine_st.b;
let c = Constant::Usize(machine_st.block);
let addr = machine_st[temp_v!(1)].clone();
machine_st.write_constant_to_var(addr, c);
Ok(())
},
&SystemClauseType::ResetBlock => {
let addr = machine_st.deref(machine_st[temp_v!(1)].clone());
machine_st.reset_block(addr);
Ok(())
},
&SystemClauseType::SetBall => {
machine_st.set_ball();
Ok(())
},
&SystemClauseType::SkipMaxList => {
machine_st.skip_max_list()?;
machine_st.p += 1;
Ok(())
},
&SystemClauseType::UnwindStack => {
machine_st.unwind_stack();
Ok(())
}
}
@@ -549,7 +619,7 @@ pub(crate) trait CallPolicy: Any {
let key_pairs = key_pairs.into_iter().map(|kp| kp.1);
let heap_addr = Addr::HeapCell(machine_st.to_list(key_pairs));
let r2 = machine_st[temp_v!(2)].clone();
machine_st.unify(r2, heap_addr);
@@ -564,8 +634,10 @@ pub(crate) trait CallPolicy: Any {
Ok(())
},
&BuiltInClauseType::System(ref ct) =>
self.system_call(machine_st, ct),
&BuiltInClauseType::System(ref ct) => {
self.system_call(machine_st, ct)?;
return_from_clause!(lco, machine_st)
}
}
}
}

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

@@ -80,7 +80,7 @@ impl MachineState {
};
}
fn bind(&mut self, r1: Ref, a2: Addr) {
pub(super) fn bind(&mut self, r1: Ref, a2: Addr) {
let t2 = self.store(a2);
match r1 {
@@ -273,7 +273,7 @@ impl MachineState {
}
}
fn write_constant_to_var(&mut self, addr: Addr, c: Constant) {
pub(super) fn write_constant_to_var(&mut self, addr: Addr, c: Constant) {
let addr = self.deref(addr);
match self.store(addr) {
@@ -1011,9 +1011,9 @@ impl MachineState {
}
}
pub(super) fn handle_internal_call_n(&mut self)
pub(super) fn handle_internal_call_n(&mut self, arity: usize)
{
let arity = self.num_of_args + 1;
let arity = arity + 1;
let pred = self.registers[1].clone();
for i in 2 .. arity {
@@ -1310,12 +1310,9 @@ impl MachineState {
Ordering::Equal
}
fn reset_block(&mut self, addr: Addr) {
pub(super) fn reset_block(&mut self, addr: Addr) {
match self.store(addr) {
Addr::Con(Constant::Usize(b)) => {
self.block = b;
self.p += 1;
},
Addr::Con(Constant::Usize(b)) => self.block = b,
_ => self.fail = true
};
}

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

@@ -152,11 +152,5 @@ impl MachineState {
};
Ok(())
}
pub(super) fn execute_system(&mut self, ct: &SystemClauseType) -> Result<(), MachineError> {
match ct {
&SystemClauseType::SkipMaxList => self.skip_max_list()
}
}
}
}

2
src/prolog/toplevel.rs
View File

@@ -393,7 +393,7 @@ impl RelationWorker {
if name.as_str() == "!" || name.as_str() == "blocked_!" {
Ok(QueryTerm::BlockedCut)
} else {
Ok(QueryTerm::Clause(r, ClauseType::Named(name, CodeIndex::default()), vec![]))
Ok(QueryTerm::Clause(r, ClauseType::from(name, 0, None), vec![]))
},
Term::Var(_, ref v) if v.as_str() == "!" =>
Ok(QueryTerm::UnblockedCut(Cell::default())),