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

add call_residue_vars/2

Browse Source
This commit is contained in:
Mark Thom
2019-02-18 21:13:56 -07:00
parent a460e84c57
commit 2467f6c711
9 changed files with 122 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/prolog/instructions.rs
View File

@@ -242,9 +242,12 @@ pub enum SystemClauseType {
DeleteHeadAttribute,
DynamicModuleResolution,
EnqueueAttributeGoal,
EnqueueAttributedVar,
ExpandGoal,
ExpandTerm,
GetAttributedVariableList,
GetAttrVarQueueDelimiter,
GetAttrVarQueueBeyond,
GetBValue,
GetSCCCleaner,
InstallSCCCleaner,
@@ -285,9 +288,12 @@ impl SystemClauseType {
&SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
&SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"),
&SystemClauseType::EnqueueAttributeGoal => clause_name!("$enqueue_attribute_goal"),
&SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"),
&SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
&SystemClauseType::ExpandGoal => clause_name!("$expand_goal"),
&SystemClauseType::GetAttributedVariableList => clause_name!("$get_attr_list"),
&SystemClauseType::GetAttrVarQueueDelimiter => clause_name!("$get_attr_var_queue_delim"),
&SystemClauseType::GetAttrVarQueueBeyond => clause_name!("$get_attr_var_queue_beyond"),
&SystemClauseType::GetBValue => clause_name!("$get_b_value"),
&SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"),
&SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"),
@@ -325,9 +331,10 @@ impl SystemClauseType {
match (name, arity) {
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute),
("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution),
("$enqueue_attribute_goal", 1) => Some(SystemClauseType::EnqueueAttributeGoal),
("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar),
("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),
("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal),
("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList),
@@ -346,6 +353,8 @@ impl SystemClauseType {
("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
("$erase_ball", 0) => Some(SystemClauseType::EraseBall),
("$fail", 0) => Some(SystemClauseType::Fail),
("$get_attr_var_queue_beyond", 2) => Some(SystemClauseType::GetAttrVarQueueBeyond),
("$get_attr_var_queue_delim", 1) => Some(SystemClauseType::GetAttrVarQueueDelimiter),
("$get_ball", 1) => Some(SystemClauseType::GetBall),
("$get_current_block", 1) => Some(SystemClauseType::GetCurrentBlock),
("$get_cp", 1) => Some(SystemClauseType::GetCutPoint),

51
src/prolog/lib/atts.pl
View File

@@ -1,7 +1,8 @@
:- module(atts, [attribute/1, '$absent_attr'/2, '$copy_attr_list'/2,
'$get_attr'/2, '$put_attr'/2, '$absent_from_list'/2,
'$get_from_list'/2, '$add_to_list'/2, '$del_attr'/3,
'$del_attr_step'/2, '$del_attr_buried'/3]).
:- module(atts, [attribute/1, call_residue_vars/2, '$absent_attr'/2,
'$copy_attr_list'/2, '$get_attr'/2, '$put_attr'/2,
'$absent_from_list'/2, '$get_from_list'/3,
'$add_to_list'/3, '$del_attr'/3, '$del_attr_step'/3,
'$del_attr_buried'/4]).
:- use_module(library(control)).
:- use_module(library(dcgs)).
@@ -19,21 +20,21 @@
( L \= Attr -> '$absent_from_list'(Ls, Attr) ).
'$get_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, Attr).
'$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr).
'$get_from_list'([L|Ls], Attr) :-
'$get_from_list'([L|Ls], V, Attr) :-
nonvar(L),
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, Attr)
; L = Attr
; '$get_from_list'(Ls, Attr)
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
; L = Attr, '$enqueue_attr_var'(V)
; '$get_from_list'(Ls, V, Attr)
).
'$put_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), '$add_to_list'(Ls, Attr).
'$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr).
'$add_to_list'(Ls, Attr) :-
( var(Ls) -> Ls = [Attr | _]
; Ls = [_ | Ls0] -> '$add_to_list'(Ls0, Attr)
'$add_to_list'(Ls, V, Attr) :-
( var(Ls) -> Ls = [Attr | _], '$enqueue_attr_var'(V)
; Ls = [_ | Ls0] -> '$add_to_list'(Ls0, V, Attr)
).
'$del_attr'(Ls0, _, _) :-
@@ -41,25 +42,26 @@
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, Attr)
; '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$enqueue_attr_var'(V), '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, Attr) :-
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, Attr)
'$del_attr_step'(Ls1, V, Attr) :-
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr)
; true ).
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.
'$del_attr_buried'(Ls0, Ls1, Attr) :-
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
Ls0 = [_, Att | _],
nonvar(Att),
!,
( Att \= Attr -> '$del_attr_step'(Ls1, Attr)
; '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
'$del_attr_step'(Ls1, Attr)
( Att \= Attr -> '$del_attr_step'(Ls1, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
'$del_attr_step'(Ls1, V, Attr)
).
'$del_attr_buried'(_, _, _).
'$del_attr_buried'(_, _, _, _).
'$copy_attr_list'(L, []) :- var(L), !.
'$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :-
@@ -123,3 +125,8 @@ user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
user:goal_expansion(Term, M:get_atts(Var, Attr)) :-
nonvar(Term),
Term = get_atts(Var, M, Attr).
call_residue_vars(Goal, Vars) :-
'$get_attr_var_queue_delim'(B),
call(Goal),
'$get_attr_var_queue_beyond'(B, Vars).

26
src/prolog/lib/dif.pl
View File

@@ -9,25 +9,27 @@ dif_set_variables([Var|Vars], X, Y) :-
put_atts(Var, dif(X, Y)),
dif_set_variables(Vars, X, Y).
verify_dif_attrs([dif(X, Y) | Attrs], Var, [X \== Y | Goals]) :-
( get_atts(Var, +dif(X, Y)) -> true
; put_atts(Var, +dif(X, Y))
verify_dif_attrs([dif(X, Y) | Attrs], Value, [X \== Y | Goals]) :-
( get_atts(Value, +dif(X, Y)) -> true
; put_atts(Value, +dif(X, Y))
),
verify_dif_attrs(Attrs, Var, Goals).
verify_dif_attrs([_ | Attrs], Var, Goals) :-
verify_dif_attrs(Attrs, Var, Goals).
verify_dif_attrs(Attrs, Value, Goals).
verify_dif_attrs([_ | Attrs], Value, Goals) :-
verify_dif_attrs(Attrs, Value, Goals).
verify_dif_attrs([], _, []).
verify_dif_attrs_no_var([dif(X, Y) | Attrs], [X \== Y | Goals]) :-
verify_dif_attrs_no_var(Attrs, Goals).
verify_dif_attrs_no_var([_ | Attrs], Goals) :-
verify_dif_attrs_no_var(Attrs, Goals).
verify_dif_attrs_no_var([], []).
verify_dif_attrs_no_var([dif(X, Y) | Attrs], Value, [X \== Y | Goals]) :-
term_variables(Value, ValueVars),
dif_set_variables(ValueVars, X, Y),
verify_dif_attrs_no_var(Attrs, Value, Goals).
verify_dif_attrs_no_var([_ | Attrs], Value, Goals) :-
verify_dif_attrs_no_var(Attrs, Value, Goals).
verify_dif_attrs_no_var([], _, []).
verify_attributes(Var, Value, Goals) :-
( get_atts(Var, Attrs) ->
( var(Value) -> verify_dif_attrs(Attrs, Value, Goals)
; verify_dif_attrs_no_var(Attrs, Goals)
; verify_dif_attrs_no_var(Attrs, Value, Goals)
)
).

3
src/prolog/machine/attributed_variables.rs
View File

@@ -11,6 +11,7 @@ pub(super) type Bindings = Vec<(usize, Addr)>;
pub(super) struct AttrVarInitializer {
pub(super) attribute_goals: Vec<Addr>,
pub(super) attr_var_queue: Vec<usize>,
pub(super) bindings: Bindings,
pub(super) cp: LocalCodePtr,
pub(super) verify_attrs_loc: usize,
@@ -21,6 +22,7 @@ impl AttrVarInitializer {
pub(super) fn new(verify_attrs_loc: usize, project_attrs_loc: usize) -> Self {
AttrVarInitializer {
attribute_goals: vec![],
attr_var_queue: vec![],
bindings: vec![],
cp: LocalCodePtr::default(),
verify_attrs_loc,
@@ -30,6 +32,7 @@ impl AttrVarInitializer {
#[inline]
pub(super) fn reset(&mut self) {
self.attr_var_queue.clear();
self.bindings.clear();
}
}

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

@@ -341,6 +341,9 @@ pub(crate) trait CallPolicy: Any {
machine_st.heap.truncate(machine_st.or_stack[b].h);
let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b;
machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b);
machine_st.hb = machine_st.heap.h;
machine_st.p += 1;
@@ -379,6 +382,9 @@ pub(crate) trait CallPolicy: Any {
machine_st.heap.truncate(machine_st.or_stack[b].h);
let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b;
machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b);
machine_st.hb = machine_st.heap.h;
machine_st.p += offset;
@@ -414,8 +420,11 @@ pub(crate) trait CallPolicy: Any {
machine_st.pstr_trail.truncate(machine_st.pstr_tr);
machine_st.heap.truncate(machine_st.or_stack[b].h);
machine_st.b = machine_st.or_stack[b].b;
let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b;
machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b);
machine_st.b = machine_st.or_stack[b].b;
machine_st.or_stack.truncate(machine_st.b);
machine_st.hb = machine_st.heap.h;
@@ -454,8 +463,10 @@ pub(crate) trait CallPolicy: Any {
machine_st.heap.truncate(machine_st.or_stack[b].h);
machine_st.b = machine_st.or_stack[b].b;
let attr_var_init_b = machine_st.or_stack[b].attr_var_init_b;
machine_st.attr_var_init.attr_var_queue.truncate(attr_var_init_b);
machine_st.b = machine_st.or_stack[b].b;
machine_st.or_stack.truncate(machine_st.b);
machine_st.hb = machine_st.heap.h;

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

@@ -2256,6 +2256,7 @@ impl MachineState {
self.or_stack.push(gi,
self.e,
self.cp.clone(),
self.attr_var_init.attr_var_queue.len(),
self.b,
self.p.clone() + 1,
self.tr,
@@ -2288,10 +2289,11 @@ impl MachineState {
&ChoiceInstruction::TryMeElse(offset) => {
let n = self.num_of_args;
let gi = self.next_global_index();
self.or_stack.push(gi,
self.e,
self.cp.clone(),
self.attr_var_init.attr_var_queue.len(),
self.b,
self.p.clone() + offset,
self.tr,

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

@@ -31,7 +31,7 @@ impl MachineState {
// a step in Brent's algorithm.
fn brents_alg_step(&self, brent_st: &mut BrentAlgState) -> Option<CycleSearchResult>
{
match self.heap[brent_st.hare].clone() {
match self.heap[brent_st.hare].clone() {
HeapCellValue::NamedStr(..) =>
Some(CycleSearchResult::NotList),
HeapCellValue::Addr(addr) =>
@@ -43,14 +43,14 @@ impl MachineState {
Addr::Lis(l) => {
brent_st.hare = l + 1;
brent_st.steps += 1;
if brent_st.tortoise == brent_st.hare {
return Some(CycleSearchResult::NotList);
} else if brent_st.steps == brent_st.power {
brent_st.tortoise = brent_st.hare;
brent_st.power <<= 1;
}
None
},
_ =>
@@ -204,7 +204,7 @@ impl MachineState {
Addr::Con(Constant::Usize(old_b)) if self.b <= old_b + 2 => {},
_ => self.fail = true
};
},
},
&SystemClauseType::DeleteAttribute => {
let ls0 = self.store(self.deref(self[temp_v!(1)].clone()));
@@ -265,6 +265,15 @@ impl MachineState {
let addr = self[temp_v!(1)].clone();
self.attr_var_init.attribute_goals.push(addr);
},
&SystemClauseType::EnqueueAttributedVar => {
let addr = self[temp_v!(1)].clone();
match self.store(self.deref(addr)) {
Addr::AttrVar(h) =>
self.attr_var_init.attr_var_queue.push(h),
_ => {}
}
},
&SystemClauseType::ExpandGoal => {
self.p = CodePtr::Local(LocalCodePtr::UserGoalExpansion(0));
return Ok(());
@@ -296,6 +305,35 @@ impl MachineState {
let list_addr = self[temp_v!(2)].clone();
self.unify(Addr::HeapCell(attr_var_list), list_addr);
},
&SystemClauseType::GetAttrVarQueueDelimiter => {
let addr = self[temp_v!(1)].clone();
let value = Addr::Con(Constant::Usize(self.attr_var_init.attr_var_queue.len()));
self.unify(addr, value);
},
&SystemClauseType::GetAttrVarQueueBeyond => {
let addr = self[temp_v!(1)].clone();
match self.store(self.deref(addr)) {
Addr::Con(Constant::Usize(b)) => {
let mut attr_vars: Vec<_> = self.attr_var_init.attr_var_queue[b ..]
.iter().filter_map(|h|
match self.store(self.deref(Addr::HeapCell(*h))) {
Addr::AttrVar(h) => Some(Addr::AttrVar(h)),
_ => None
}).collect();
attr_vars.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2));
self.term_dedup(&mut attr_vars);
let var_list_addr = Addr::HeapCell(self.heap.to_list(attr_vars.into_iter()));
let list_addr = self[temp_v!(2)].clone();
self.unify(var_list_addr, list_addr);
},
_ => self.fail = true
}
},
&SystemClauseType::GetDoubleQuotes => {
let a1 = self[temp_v!(1)].clone();
@@ -410,7 +448,7 @@ impl MachineState {
for (h, addr) in bindings {
self.heap[h] = HeapCellValue::Addr(addr);
}
},
},
&SystemClauseType::RemoveCallPolicyCheck => {
let restore_default =
match call_policy.downcast_mut::<CWILCallPolicy>().ok() {

6
src/prolog/or_stack.rs
View File

@@ -7,6 +7,7 @@ pub struct Frame {
pub global_index: usize,
pub e: usize,
pub cp: LocalCodePtr,
pub attr_var_init_b: usize,
pub b: usize,
pub bp: CodePtr,
pub tr: usize,
@@ -20,6 +21,7 @@ impl Frame {
fn new(global_index: usize,
e: usize,
cp: LocalCodePtr,
attr_var_init_b: usize,
b: usize,
bp: CodePtr,
tr: usize,
@@ -33,6 +35,7 @@ impl Frame {
global_index,
e,
cp,
attr_var_init_b,
b,
bp,
tr,
@@ -59,6 +62,7 @@ impl OrStack {
global_index: usize,
e: usize,
cp: LocalCodePtr,
attr_var_init_b: usize,
b: usize,
bp: CodePtr,
tr: usize,
@@ -67,7 +71,7 @@ impl OrStack {
b0: usize,
n: usize)
{
self.0.push(Frame::new(global_index, e, cp, b, bp, tr, pstr_tr, h, b0, n));
self.0.push(Frame::new(global_index, e, cp, attr_var_init_b, b, bp, tr, pstr_tr, h, b0, n));
}
pub fn len(&self) -> usize {