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

preliminary cont work

Browse Source
This commit is contained in:
Mark Thom
2019-12-19 20:02:10 -04:00
parent 3d2c4f0801 5ccd334555
commit 837ae4cb17
15 changed files with 359 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
README.md
View File

@@ -175,7 +175,7 @@ The following predicates are built-in to Scryer.
* `clause/2`
* `compare/3`
* `compound/1`
* `copy_term/2`
* `copy_term/{2,3}`
* `current_predicate/1`
* `current_op/3`
* `cyclic_term/1`
@@ -186,6 +186,7 @@ The following predicates are built-in to Scryer.
* `false/0`
* `findall/{3,4}`
* `float/1`
* `foldl/{4,5}`
* `forall/2`
* `freeze/2`
* `functor/3`
@@ -219,6 +220,7 @@ The following predicates are built-in to Scryer.
* `repeat/{0,1}`
* `retract/1`
* `reverse/2`
* `same_length/2`
* `select/3`
* `setof/3`
* `setup_call_cleanup/3`
@@ -226,6 +228,7 @@ The following predicates are built-in to Scryer.
* `string/1`
* `sub_atom/5`
* `subsumes_term/2`
* `sumlist/2`
* `term_expansion/2`
* `term_variables/2`
* `throw/1`

24
src/prolog/clause_types.rs
View File

@@ -162,10 +162,15 @@ pub enum SystemClauseType {
AtomChars,
AtomCodes,
AtomLength,
BindFromRegister,
CallAttributeGoals,
CharCode,
CharsToNumber,
ClearAttrVarBindings,
ClearAttributeGoals,
CloneAttributeGoals,
CodesToNumber,
CopyTermWithoutAttrVars,
CheckCutPoint,
CopyToLiftedHeap,
DeleteAttribute,
@@ -212,9 +217,10 @@ pub enum SystemClauseType {
REPL(REPLCodePtr),
ReadQueryTerm,
ReadTerm,
RedoAttrVarBindings,
RedoAttrVarBinding,
RemoveCallPolicyCheck,
RemoveInferenceCounter,
ResetContinuationMarker,
ResetGlobalVarAtKey,
ResetGlobalVarAtOffset,
RetractClause,
@@ -260,10 +266,14 @@ impl SystemClauseType {
&SystemClauseType::AtomChars => clause_name!("$atom_chars"),
&SystemClauseType::AtomCodes => clause_name!("$atom_codes"),
&SystemClauseType::AtomLength => clause_name!("$atom_length"),
&SystemClauseType::BindFromRegister => clause_name!("$bind_from_register"),
&SystemClauseType::CallAttributeGoals => clause_name!("$call_attribute_goals"),
&SystemClauseType::CharCode => clause_name!("$char_code"),
&SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"),
&SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"),
&SystemClauseType::CloneAttributeGoals => clause_name!("$clone_attribute_goals"),
&SystemClauseType::CodesToNumber => clause_name!("$codes_to_number"),
&SystemClauseType::CopyTermWithoutAttrVars => clause_name!("$copy_term_without_attr_vars"),
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
&SystemClauseType::REPL(REPLCodePtr::CompileBatch) => clause_name!("$compile_batch"),
&SystemClauseType::REPL(REPLCodePtr::UseModule) => clause_name!("$use_module"),
@@ -276,6 +286,7 @@ impl SystemClauseType {
&SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile) => {
clause_name!("$use_qualified_module_from_file")
}
&SystemClauseType::ClearAttrVarBindings => clause_name!("$clear_attr_var_bindings"),
&SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
&SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
@@ -336,7 +347,7 @@ impl SystemClauseType {
&SystemClauseType::NumberToChars => clause_name!("$number_to_chars"),
&SystemClauseType::NumberToCodes => clause_name!("$number_to_codes"),
&SystemClauseType::RawInputReadChar => clause_name!("$raw_input_read_char"),
&SystemClauseType::RedoAttrVarBindings => clause_name!("$redo_attr_var_bindings"),
&SystemClauseType::RedoAttrVarBinding => clause_name!("$redo_attr_var_binding"),
&SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"),
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
@@ -361,6 +372,7 @@ impl SystemClauseType {
&SystemClauseType::ResetGlobalVarAtOffset => clause_name!("$reset_global_var_at_offset"),
&SystemClauseType::RetractClause => clause_name!("$retract_clause"),
&SystemClauseType::ResetBlock => clause_name!("$reset_block"),
&SystemClauseType::ResetContinuationMarker => clause_name!("$reset_cont_marker"),
&SystemClauseType::ReturnFromVerifyAttr => clause_name!("$return_from_verify_attr"),
&SystemClauseType::SetBall => clause_name!("$set_ball"),
&SystemClauseType::SetCutPointByDefault(_) => clause_name!("$set_cp_by_default"),
@@ -384,6 +396,7 @@ impl SystemClauseType {
("$atom_codes", 2) => Some(SystemClauseType::AtomCodes),
("$atom_length", 2) => Some(SystemClauseType::AtomLength),
("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
("$bind_from_register", 2) => Some(SystemClauseType::BindFromRegister),
("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront),
@@ -391,7 +404,11 @@ impl SystemClauseType {
("$call_attribute_goals", 2) => Some(SystemClauseType::CallAttributeGoals),
("$char_code", 2) => Some(SystemClauseType::CharCode),
("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber),
("$clear_attr_var_bindings", 0) => Some(SystemClauseType::ClearAttrVarBindings),
("$clear_attribute_goals", 0) => Some(SystemClauseType::ClearAttributeGoals),
("$clone_attribute_goals", 1) => Some(SystemClauseType::CloneAttributeGoals),
("$codes_to_number", 2) => Some(SystemClauseType::CodesToNumber),
("$copy_term_without_attr_vars", 2) => Some(SystemClauseType::CopyTermWithoutAttrVars),
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
("$compile_batch", 0) => Some(SystemClauseType::REPL(REPLCodePtr::CompileBatch)),
("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap),
@@ -438,7 +455,7 @@ impl SystemClauseType {
("$number_to_chars", 2) => Some(SystemClauseType::NumberToChars),
("$number_to_codes", 2) => Some(SystemClauseType::NumberToCodes),
("$op", 3) => Some(SystemClauseType::OpDeclaration),
("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings),
("$redo_attr_var_binding", 2) => Some(SystemClauseType::RedoAttrVarBinding),
("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck),
("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter),
("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy),
@@ -457,6 +474,7 @@ impl SystemClauseType {
("$read_query_term", 2) => Some(SystemClauseType::ReadQueryTerm),
("$read_term", 2) => Some(SystemClauseType::ReadTerm),
("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
("$reset_cont_marker", 0) => Some(SystemClauseType::ResetContinuationMarker),
("$reset_global_var_at_key", 1) => Some(SystemClauseType::ResetGlobalVarAtKey),
("$reset_global_var_at_offset", 3) => Some(SystemClauseType::ResetGlobalVarAtOffset),
("$retract_clause", 4) => Some(SystemClauseType::RetractClause),

2
src/prolog/heap_print.rs
View File

@@ -614,7 +614,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
match addr {
Addr::AttrVar(h) => Some(format!("_{}", h + 1)),
Addr::AttrVar(h) => Some(format!("_{}", h)),
Addr::HeapCell(h) | Addr::Lis(h) | Addr::Str(h) => Some(format!("_{}", h)),
Addr::StackCell(fr, sc) => Some(format!("_s_{}_{}", fr, sc)),
_ => None,

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

@@ -28,26 +28,26 @@
'$get_attr_list'(V, Ls),
'$absent_from_list'(Ls, Attr).
'$absent_from_list'(X, _) :-
var(X), !.
'$absent_from_list'([L|Ls], Attr) :-
( L \= Attr -> '$absent_from_list'(Ls, Attr) ).
'$absent_from_list'(X, Attr) :-
( var(X) -> true
; X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, Attr)
).
'$get_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr).
'$get_from_list'([L|Ls], V, Attr) :-
nonvar(L),
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
; L = Attr -> '$enqueue_attr_var'(V)
; '$get_from_list'(Ls, V, Attr)
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
; L = Attr, '$enqueue_attr_var'(V)
).
'$put_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr).
'$add_to_list'(Ls, V, Attr) :-
( var(Ls) -> Ls = [Attr | _], '$enqueue_attr_var'(V)
( var(Ls) ->
Ls = [Attr | _], '$enqueue_attr_var'(V)
; Ls = [_ | Ls0], '$add_to_list'(Ls0, V, Attr)
).
@@ -57,7 +57,8 @@
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$enqueue_attr_var'(V), '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, V, Attr) :-
@@ -67,15 +68,14 @@
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
Ls0 = [_, Att | _],
nonvar(Att),
!,
( 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)
( var(Ls1) -> true
; Ls1 = [Att | Ls2] ->
( Att \= Attr -> '$del_attr_buried'(Ls1, Ls2, 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'(_, _, _, _).
'$copy_attr_list'(L, []) :- var(L), !.
'$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :-
@@ -124,11 +124,19 @@ put_attr(Name, Arity) -->
{ functor(Attr, Name, Arity),
numbervars(Attr, 0, Arity),
V = '$VAR'(Arity) },
[(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)),
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)),
(put_atts(V, -Attr) :- !, functor(Attr, _, _), '$get_attr_list'(V, Ls), '$del_attr'(Ls, V, Attr))].
[(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
'$del_attr'(Ls, V, AttrForm),
'$put_attr'(V, Attr)),
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
'$del_attr'(Ls, V, AttrForm),
'$put_attr'(V, Attr)),
(put_atts(V, -Attr) :- !, functor(Attr, _, _),
'$get_attr_list'(V, Ls),
'$del_attr'(Ls, V, Attr))].
get_attr(Name, Arity) -->
{ functor(Attr, Name, Arity),
@@ -149,3 +157,4 @@ call_residue_vars(Goal, Vars) :-
'$get_attr_var_queue_delim'(B),
call(Goal),
'$get_attr_var_queue_beyond'(B, Vars).

29
src/prolog/lib/cont.pl Normal file
View File

@@ -0,0 +1,29 @@
:- module(cont, [reset/3, shift/1]).
reset(Goal, Cont, Term) :-
call(Goal),
'$reset_cont_marker',
'$bind_from_register'(Cont, 3),
'$bind_from_register'(Term, 4).
shift(Term) :-
'$nextEP'(first, E, P),
get_chunks(E, P, L),
Cont = cont(call_continuation(L)),
'$write_cont_and_term'(_, _, Cont, Term),
'$unwind_environments'.
get_chunks(E, P, L) :-
( '$points_to_cont_reset_marker'(P) ->
L = []
; '$get_chunk'(E,P,TB),
L = [TB|Rest],
'$nextEP'(E, NextE, NextP),
get_chunks(NextE, NextP, Rest)
).
call_continuation(L) :- '$call_continuation'(L).
'$write_cont_and_term'(_, _, _, _).

16
src/prolog/lib/freeze.pl
View File

@@ -21,16 +21,8 @@ freeze(X, Goal) :-
put_atts(Fresh, frozen(Goal)),
Fresh = X.
gather_freeze_goals(Attrs, _) -->
{ var(Attrs) },
!.
gather_freeze_goals([frozen(X) | _], Var) -->
[freeze(Var, X)],
{ put_atts(Var, -frozen(_)) },
!.
gather_freeze_goals([_ | Attrs], Var) -->
gather_freeze_goals(Attrs, Var).
attribute_goals(Var) -->
{ get_atts(Var, frozen(Goals)),
put_atts(Var, -frozen(_)) },
[freeze(Var, Goals)].
attribute_goals(X) -->
{ '$get_attr_list'(X, Attrs) },
gather_freeze_goals(Attrs, X).

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

@@ -1,7 +1,11 @@
:- module(lists, [member/2, select/3, append/3, memberchk/2,
reverse/2, length/2, maplist/2, maplist/3,
maplist/4, maplist/5, maplist/6, maplist/7,
maplist/8, maplist/9]).
:- module(lists, [member/2, select/3, append/3, foldl/4, foldl/5,
memberchk/2, reverse/2, length/2, maplist/2,
maplist/3, maplist/4, maplist/5, maplist/6,
maplist/7, maplist/8, maplist/9, same_length/2,
sumlist/2]).
:- use_module(library(error)).
length(Xs, N) :-
@@ -96,3 +100,37 @@ maplist(_, [], [], [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s], [E8|E8s]) :-
call(Cont, E1, E2, E3, E4, E5, E6, E7),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s, E8s).
sumlist_([], S, S).
sumlist_([N|Ns], S, S0) :-
S1 is S0 + N,
sumlist_(Ns, S, S1).
sumlist(Ns, S) :-
must_be(list, Ns),
sumlist_(Ns, S, 0).
same_length([], []).
same_length([_|As], [_|Bs]) :-
same_length(As, Bs).
foldl(Goal_3, Ls, A0, A) :-
foldl_(Ls, Goal_3, A0, A).
foldl_([], _, A, A).
foldl_([L|Ls], G_3, A0, A) :-
call(G_3, L, A0, A1),
foldl_(Ls, G_3, A1, A).
foldl(Goal_4, Xs, Ys, A0, A) :-
foldl_(Xs, Ys, Goal_4, A0, A).
foldl_([], [], _, A, A).
foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
call(G_4, X, Y, A0, A1),
foldl_(Xs, Ys, G_4, A1, A).

5
src/prolog/machine/attributed_variables.pl
View File

@@ -1,6 +1,6 @@
driver(Vars, Values) :-
iterate(Vars, Values, ListOfListsOfGoalLists),
'$redo_attr_var_bindings', % the bindings list is emptied here.
'$clear_attr_var_bindings',
!,
call_goals(ListOfListsOfGoalLists),
'$return_from_verify_attr'.
@@ -8,6 +8,7 @@ driver(Vars, Values) :-
iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]) :-
'$get_attr_list'(Var, Ls),
call_verify_attributes(Ls, Var, Value, ListOfGoalLists),
'$redo_attr_var_binding'(Var, Value),
iterate(VarBindings, ValueBindings, ListsCubed).
iterate([], [], []).
@@ -28,7 +29,7 @@ call_verify_attributes(Attrs, _, _, []) :-
call_verify_attributes([], _, _, []).
call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :-
gather_modules([Attr|Attrs], Modules0),
sort(Modules0, Modules),
sort(Modules0, Modules),
verify_attrs(Modules, Var, Value, ListOfGoalLists).
call_goals([ListOfGoalLists | ListsCubed]) :-

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

@@ -649,7 +649,8 @@ impl ListingCompiler {
let idx = code_dir
.entry((name.clone(), arity))
.or_insert(CodeIndex::default());
set_code_index!(idx, IndexPtr::Index(p), self.get_module_name());
set_code_index!(idx, IndexPtr::Index(p), self.get_module_name());
self.localize_self_calls(name, arity, &mut decl_code, p);
code.extend(decl_code.into_iter());

143
src/prolog/machine/copier.rs
View File

@@ -5,6 +5,12 @@ use std::ops::IndexMut;
type Trail = Vec<(Ref, HeapCellValue)>;
#[derive(Clone, Copy)]
pub enum AttrVarPolicy {
DeepCopy,
StripAttributes
}
pub(crate) trait CopierTarget: IndexMut<usize, Output = HeapCellValue> {
fn threshold(&self) -> usize;
fn push(&mut self, _: HeapCellValue);
@@ -13,9 +19,10 @@ pub(crate) trait CopierTarget: IndexMut<usize, Output = HeapCellValue> {
fn stack(&mut self) -> &mut Stack;
}
pub(crate) fn copy_term<T: CopierTarget>(target: T, addr: Addr) {
let mut copy_term_state = CopyTermState::new(target);
copy_term_state.copy_term_impl(addr);
pub(crate)
fn copy_term<T: CopierTarget>(target: T, addr: Addr, attr_var_policy: AttrVarPolicy) {
let mut copy_term_state = CopyTermState::new(target, attr_var_policy);
copy_term_state.copy_term_impl(addr);
}
struct CopyTermState<T: CopierTarget> {
@@ -23,15 +30,17 @@ struct CopyTermState<T: CopierTarget> {
scan: usize,
old_h: usize,
target: T,
attr_var_policy: AttrVarPolicy
}
impl<T: CopierTarget> CopyTermState<T> {
fn new(target: T) -> Self {
fn new(target: T, attr_var_policy: AttrVarPolicy) -> Self {
CopyTermState {
trail: vec![],
scan: 0,
old_h: target.threshold(),
target,
attr_var_policy
}
}
@@ -41,40 +50,17 @@ impl<T: CopierTarget> CopyTermState<T> {
&mut self.target[scan]
}
fn reinstantiate_var(&mut self, addr: Addr, threshold: usize) {
match addr {
Addr::HeapCell(h) => {
self.target[threshold] = HeapCellValue::Addr(Addr::HeapCell(threshold));
self.target[h] = HeapCellValue::Addr(Addr::HeapCell(threshold));
self.trail
.push((Ref::HeapCell(h), HeapCellValue::Addr(Addr::HeapCell(h))));
}
Addr::StackCell(fr, sc) => {
self.target[threshold] = HeapCellValue::Addr(Addr::HeapCell(threshold));
self.target.stack().index_and_frame_mut(fr)[sc] = Addr::HeapCell(threshold);
self.trail.push((
Ref::StackCell(fr, sc),
HeapCellValue::Addr(Addr::StackCell(fr, sc)),
));
}
Addr::AttrVar(h) => {
self.target[threshold] = HeapCellValue::Addr(Addr::AttrVar(threshold));
self.target[h] = HeapCellValue::Addr(Addr::AttrVar(threshold));
self.trail
.push((Ref::AttrVar(h), HeapCellValue::Addr(Addr::AttrVar(h))));
fn copied_list(&mut self, addr: usize) -> bool {
match self.target[addr].clone() {
HeapCellValue::Addr(Addr::Lis(addr)) | HeapCellValue::Addr(Addr::HeapCell(addr)) => {
if addr >= self.old_h {
*self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(addr));
self.scan += 1;
return true;
}
}
_ => {}
}
}
fn copied_list(&mut self, addr: usize) -> bool {
if let HeapCellValue::Addr(Addr::Lis(addr)) = self.target[addr].clone() {
if addr >= self.old_h {
*self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(addr));
self.scan += 1;
return true;
}
}
};
false
}
@@ -88,11 +74,15 @@ impl<T: CopierTarget> CopyTermState<T> {
*self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(threshold));
let hcv = self.target[addr].clone();
self.target.push(hcv.clone());
let ra = hcv.as_addr(threshold);
let rd = self.target.store(self.target.deref(ra));
self.target.push(hcv);
let hcv = self.target[addr + 1].clone();
self.target.push(hcv);
match rd.clone() {
Addr::AttrVar(h) | Addr::HeapCell(h) if h >= self.old_h => {
self.target[threshold] = HeapCellValue::Addr(rd)
@@ -100,23 +90,67 @@ impl<T: CopierTarget> CopyTermState<T> {
ra @ Addr::AttrVar(_) | ra @ Addr::HeapCell(..) | ra @ Addr::StackCell(..) => {
if ra == rd {
self.reinstantiate_var(ra, threshold);
if let AttrVarPolicy::StripAttributes = self.attr_var_policy {
self.trail.push((Ref::HeapCell(addr), self.target[addr].clone()));
self.target[addr] = HeapCellValue::Addr(Addr::HeapCell(threshold));
}
} else {
self.target[threshold] = HeapCellValue::Addr(ra);
}
}
_ => {
self.trail
.push((Ref::HeapCell(addr), self.target[addr].clone()));
self.trail.push((Ref::HeapCell(addr), self.target[addr].clone()));
self.target[addr] = HeapCellValue::Addr(Addr::Lis(threshold))
}
};
let hcv = self.target[addr + 1].clone();
self.target.push(hcv);
self.scan += 1;
}
fn reinstantiate_var(&mut self, addr: Addr, frontier: usize) {
match addr {
Addr::HeapCell(h) => {
self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier));
self.target[h] = HeapCellValue::Addr(Addr::HeapCell(frontier));
self.trail.push((
Ref::HeapCell(h),
HeapCellValue::Addr(Addr::HeapCell(h)),
));
}
Addr::StackCell(fr, sc) => {
self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier));
self.target.stack().index_and_frame_mut(fr)[sc] = Addr::HeapCell(frontier);
self.trail.push((
Ref::StackCell(fr, sc),
HeapCellValue::Addr(Addr::StackCell(fr, sc)),
));
}
Addr::AttrVar(h) => {
let threshold = if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
self.target.threshold()
} else {
frontier
};
self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(threshold));
self.target[h] = HeapCellValue::Addr(Addr::HeapCell(threshold));
self.trail.push((
Ref::AttrVar(h),
HeapCellValue::Addr(Addr::AttrVar(h)),
));
if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
self.target.push(HeapCellValue::Addr(Addr::AttrVar(threshold)));
let list_val = self.target[h + 1].clone();
self.target.push(list_val);
}
}
_ => unreachable!()
}
}
fn copy_var(&mut self, addr: Addr) {
let rd = self.target.store(self.target.deref(addr.clone()));
@@ -125,23 +159,13 @@ impl<T: CopierTarget> CopyTermState<T> {
*self.value_at_scan() = HeapCellValue::Addr(rd);
self.scan += 1;
}
Addr::AttrVar(h) if addr == rd => {
let threshold = self.target.threshold();
self.target
.push(HeapCellValue::Addr(Addr::AttrVar(threshold)));
let list_val = self.target[h + 1].clone();
self.target.push(list_val);
self.reinstantiate_var(addr, threshold);
*self.value_at_scan() = HeapCellValue::Addr(Addr::AttrVar(threshold));
}
_ if addr == rd => {
let scan = self.scan;
self.reinstantiate_var(addr, scan);
self.reinstantiate_var(addr, self.scan);
self.scan += 1;
}
_ => *self.value_at_scan() = HeapCellValue::Addr(rd),
_ => {
*self.value_at_scan() = HeapCellValue::Addr(rd);
}
}
}
@@ -158,8 +182,7 @@ impl<T: CopierTarget> CopyTermState<T> {
HeapCellValue::NamedStr(arity, name.clone(), fixity.clone()),
));
self.target
.push(HeapCellValue::NamedStr(arity, name, fixity));
self.target.push(HeapCellValue::NamedStr(arity, name, fixity));
for i in 0..arity {
let hcv = self.target[addr + 1 + i].clone();
@@ -185,8 +208,8 @@ impl<T: CopierTarget> CopyTermState<T> {
HeapCellValue::Addr(addr) => match addr {
Addr::Lis(addr) => self.copy_list(addr),
addr @ Addr::AttrVar(_)
| addr @ Addr::HeapCell(_)
| addr @ Addr::StackCell(..) => self.copy_var(addr),
| addr @ Addr::HeapCell(_)
| addr @ Addr::StackCell(..) => self.copy_var(addr),
Addr::Str(addr) => self.copy_structure(addr),
Addr::Con(_) | Addr::DBRef(_) => self.scan += 1,
},

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

@@ -61,7 +61,7 @@ impl Ball {
});
}
stub
stub
}
}
@@ -444,7 +444,10 @@ pub(crate) trait CallPolicy: Any {
let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b;
let attr_var_init_bindings_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_bindings_b;
machine_st.attr_var_init.backtrack(attr_var_init_queue_b, attr_var_init_bindings_b);
machine_st.attr_var_init.backtrack(
attr_var_init_queue_b,
attr_var_init_bindings_b,
);
machine_st.hb = machine_st.heap.h;
machine_st.p += 1;
@@ -481,7 +484,6 @@ pub(crate) trait CallPolicy: Any {
machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr;
machine_st.pstr_trail.truncate(machine_st.pstr_tr);
machine_st.heap.truncate(machine_st.stack.index_or_frame(b).prelude.h);
let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b;
@@ -502,7 +504,7 @@ pub(crate) trait CallPolicy: Any {
for i in 1 .. n + 1 {
machine_st.registers[i] = machine_st.stack.index_or_frame(b)[i-1].clone();
}
machine_st.num_of_args = n;
machine_st.e = machine_st.stack.index_or_frame(b).prelude.e;
machine_st.cp = machine_st.stack.index_or_frame(b).prelude.cp;
@@ -522,13 +524,14 @@ pub(crate) trait CallPolicy: Any {
machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr;
machine_st.pstr_trail.truncate(machine_st.pstr_tr);
machine_st.heap.truncate(machine_st.stack.index_or_frame(b).prelude.h);
let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b;
let attr_var_init_bindings_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_bindings_b;
machine_st.attr_var_init.backtrack(attr_var_init_queue_b, attr_var_init_bindings_b);
machine_st.attr_var_init.backtrack(
attr_var_init_queue_b,
attr_var_init_bindings_b);
machine_st.b = machine_st.stack.index_or_frame(b).prelude.b;
machine_st.truncate_stack();
@@ -565,6 +568,7 @@ pub(crate) trait CallPolicy: Any {
machine_st.unwind_pstr_trail(old_pstr_tr, curr_pstr_tr);
machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr;
machine_st.pstr_tr = machine_st.stack.index_or_frame(b).prelude.pstr_tr;
machine_st.pstr_trail.truncate(machine_st.pstr_tr);
machine_st.heap.truncate(machine_st.stack.index_or_frame(b).prelude.h);
@@ -572,7 +576,10 @@ pub(crate) trait CallPolicy: Any {
let attr_var_init_queue_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_queue_b;
let attr_var_init_bindings_b = machine_st.stack.index_or_frame(b).prelude.attr_var_init_bindings_b;
machine_st.attr_var_init.backtrack(attr_var_init_queue_b, attr_var_init_bindings_b);
machine_st.attr_var_init.backtrack(
attr_var_init_queue_b,
attr_var_init_bindings_b
);
machine_st.b = machine_st.stack.index_or_frame(b).prelude.b;
machine_st.truncate_stack();
@@ -715,7 +722,7 @@ pub(crate) trait CallPolicy: Any {
return_from_clause!(machine_st.last_call, machine_st)
}
&BuiltInClauseType::CopyTerm => {
machine_st.copy_term();
machine_st.copy_term(AttrVarPolicy::DeepCopy);
return_from_clause!(machine_st.last_call, machine_st)
}
&BuiltInClauseType::Eq => {

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

@@ -2005,11 +2005,15 @@ impl MachineState {
}
pub(super) fn set_ball(&mut self) {
self.ball.reset();
let addr = self[temp_v!(1)].clone();
self.ball.boundary = self.heap.h;
copy_term(
CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut self.ball.stub),
addr,
AttrVarPolicy::DeepCopy,
);
}
@@ -2912,13 +2916,13 @@ impl MachineState {
}
}
pub(super) fn copy_term(&mut self) {
pub(super) fn copy_term(&mut self, attr_var_policy: AttrVarPolicy) {
let old_h = self.heap.h;
let a1 = self[temp_v!(1)].clone();
let a2 = self[temp_v!(2)].clone();
copy_term(CopyTerm::new(self), a1);
copy_term(CopyTerm::new(self), a1, attr_var_policy);
self.unify(Addr::HeapCell(old_h), a2);
}

29
src/prolog/machine/project_attributes.pl
View File

@@ -49,8 +49,8 @@ call_attribute_goals([Module | Modules], GoalCaller, AttrVars) :-
call_query_var_goals([], _, []).
call_query_var_goals([AttrVar|AttrVars], Module, Goals) :-
( catch(( Module:attribute_goals(AttrVar, Goals, RGoals0),
atts:'$default_attr_list'(Module, AttrVar, RGoals0, RGoals)
( catch(( Module:attribute_goals(AttrVar, Goals, RGoals0)
, atts:'$default_attr_list'(Module, AttrVar, RGoals0, RGoals)
),
E,
( '$print_attribute_goals_exception'(Module, E),
@@ -63,7 +63,7 @@ call_query_var_goals([AttrVar|AttrVars], Module, Goals) :-
call_attr_var_goals([], _, []).
call_attr_var_goals([AttrVar|AttrVars], Module, Goals) :-
( catch(Module:attribute_goals(AttrVar, Goals, RGoals),
( catch(Module:attribute_goals(AttrVar, Goals, RGoals),
E,
'$print_attribute_goals_exception'(Module, E)
)
@@ -83,3 +83,26 @@ gather_modules_for_attrs(Attrs, Modules, Modules) :-
gather_modules_for_attrs([Attr|Attrs], [Module|Modules], Modules0) :-
'$module_of'(Module, Attr),
gather_modules_for_attrs(Attrs, Modules, Modules0).
module_prefixed_goals([], _, Gs, Gs).
module_prefixed_goals([G|Gs], Module, [MG|MGs], TailGs) :-
( G = _:_ -> MG = G
; MG = Module:G
),
module_prefixed_goals(Gs, Module, MGs, TailGs).
call_attribute_goals_with_module_prefix([], _, _, []).
call_attribute_goals_with_module_prefix([Module | Modules], GoalCaller, AttrVars, Goals) :-
call(GoalCaller, AttrVars, Module, Goals0),
enqueue_goals(Goals0),
module_prefixed_goals(Goals0, Module, Goals, Gs),
call_attribute_goals_with_module_prefix(Modules, GoalCaller, AttrVars, Gs).
copy_term(Source, Dest, Goals) :-
term_variables(Source, Vars),
gather_modules(Vars, Modules0, _),
sort(Modules0, Modules),
call_attribute_goals_with_module_prefix(Modules, call_query_var_goals, Vars, Goals0),
sort(Goals0, Goals1),
!,
'$copy_term_without_attr_vars'([Source | Goals1], [Dest | Goals]).

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

@@ -353,7 +353,7 @@ impl MachineState {
copy_ball_term.push(HeapCellValue::Addr(Addr::HeapCell(threshold + 3)));
copy_ball_term.push(HeapCellValue::Addr(Addr::HeapCell(threshold + 2)));
copy_term(copy_ball_term, copy_target);
copy_term(copy_ball_term, copy_target, AttrVarPolicy::DeepCopy);
threshold + lh_offset + 2
}
@@ -527,6 +527,16 @@ impl MachineState {
Ok(())
}
fn fetch_attribute_goals(&mut self, mut attr_goals: Vec<Addr>) {
attr_goals.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2));
self.term_dedup(&mut attr_goals);
let attr_goals = Addr::HeapCell(self.heap.to_list(attr_goals.into_iter()));
let target = self[temp_v!(1)].clone();
self.unify(attr_goals, target);
}
fn create_instruction_functors(&mut self, code: &Code, first_idx: usize) -> Vec<Addr> {
let mut queue = VecDeque::new();
let mut functors = vec![];
@@ -594,6 +604,25 @@ impl MachineState {
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
}
&SystemClauseType::BindFromRegister => {
let reg = self.store(self.deref(self[temp_v!(2)].clone()));
let n = match reg {
Addr::Con(Constant::Integer(n)) => n.to_usize(),
_ => unreachable!()
};
if let Some(n) = n {
if n <= MAX_ARITY {
let target = self[temp_v!(n)].clone();
let addr = self[temp_v!(1)].clone();
self.unify(addr, target);
return return_from_clause!(self.last_call, self);
}
}
self.fail = true;
}
&SystemClauseType::AssertDynamicPredicateToFront => {
let p = self.cp;
let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Front);
@@ -874,6 +903,9 @@ impl MachineState {
_ => self.fail = true,
};
}
&SystemClauseType::CopyTermWithoutAttrVars => {
self.copy_term(AttrVarPolicy::StripAttributes);
}
&SystemClauseType::FetchGlobalVar => {
let key = self[temp_v!(1)].clone();
@@ -1109,7 +1141,7 @@ impl MachineState {
for i in (arity + 1 .. arity + narity + 1).rev() {
self.registers[i] = self.registers[i - arity].clone();
}
for i in 1 .. arity + 1 {
self.registers[i] = self.heap[a + i].as_addr(a + i);
}
@@ -1122,7 +1154,7 @@ impl MachineState {
);
}
}
Addr::Con(Constant::Atom(name, _)) => {
Addr::Con(Constant::Atom(name, _)) => {
return self.module_lookup(indices, (name, narity), module_name, true)
}
addr => {
@@ -1370,16 +1402,16 @@ impl MachineState {
&SystemClauseType::TruncateIfNoLiftedHeapGrowth => {
self.truncate_if_no_lifted_heap_diff(|_| Addr::Con(Constant::EmptyList))
}
&SystemClauseType::ClearAttributeGoals => {
self.attr_var_init.attribute_goals.clear();
}
&SystemClauseType::CloneAttributeGoals => {
let attr_goals = self.attr_var_init.attribute_goals.clone();
self.fetch_attribute_goals(attr_goals);
}
&SystemClauseType::FetchAttributeGoals => {
let mut attr_goals = mem::replace(&mut self.attr_var_init.attribute_goals, vec![]);
attr_goals.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2));
self.term_dedup(&mut attr_goals);
let attr_goals = Addr::HeapCell(self.heap.to_list(attr_goals.into_iter()));
let target = self[temp_v!(1)].clone();
self.unify(attr_goals, target);
let attr_goals = mem::replace(&mut self.attr_var_init.attribute_goals, vec![]);
self.fetch_attribute_goals(attr_goals);
}
&SystemClauseType::GetAttributedVariableList => {
let attr_var = self.store(self.deref(self[temp_v!(1)].clone()));
@@ -1643,11 +1675,32 @@ impl MachineState {
}
};
}
&SystemClauseType::RedoAttrVarBindings => {
let bindings = mem::replace(&mut self.attr_var_init.bindings, vec![]);
&SystemClauseType::ClearAttrVarBindings => {
self.attr_var_init.bindings.clear();
}
&SystemClauseType::RedoAttrVarBinding => {
let var = self.store(self.deref(self[temp_v!(1)].clone()));
let value = self.store(self.deref(self[temp_v!(2)].clone()));
for (h, addr) in bindings {
self.heap[h] = HeapCellValue::Addr(addr);
match var {
Addr::AttrVar(h) => {
if let Addr::AttrVar(h1) = value {
self.heap[h] = HeapCellValue::Addr(Addr::AttrVar(h1));
// append h's attributes list to h1's.
let mut l = h1 + 1;
while let Addr::Lis(l1) = self.store(self.deref(self.heap[l].as_addr(l))) {
l = l1 + 1;
}
self.heap[l] = HeapCellValue::Addr(Addr::HeapCell(h + 1));
self.trail(TrailRef::Ref(Ref::HeapCell(l)));
} else {
self.heap[h] = HeapCellValue::Addr(value);
}
}
_ => unreachable!()
}
}
&SystemClauseType::ResetGlobalVarAtKey => {
@@ -1676,6 +1729,7 @@ impl MachineState {
copy_term(
CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut ball.stub),
value,
AttrVarPolicy::DeepCopy,
);
let offset = self[temp_v!(3)].clone();
@@ -1930,11 +1984,13 @@ impl MachineState {
&SystemClauseType::ReadTerm => {
readline::set_prompt(false);
self.read_term(current_input_stream, indices)?;
},
}
&SystemClauseType::ResetBlock => {
let addr = self.deref(self[temp_v!(1)].clone());
self.reset_block(addr);
}
&SystemClauseType::ResetContinuationMarker => {
}
&SystemClauseType::SetBall =>
self.set_ball(),
&SystemClauseType::SetSeed => {
@@ -1981,6 +2037,7 @@ impl MachineState {
copy_term(
CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut ball.stub),
value,
AttrVarPolicy::DeepCopy,
);
indices.global_variables.insert(key, (ball, None));
@@ -2001,6 +2058,7 @@ impl MachineState {
copy_term(
CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut ball.stub),
value.clone(),
AttrVarPolicy::DeepCopy,
);
let stub = ball.copy_and_align(h);

25
src/prolog/toplevel.pl
View File

@@ -32,7 +32,7 @@
; !,
catch(throw(error(type_error(atom, Item), repl/0)),
E,
'$print_exception_with_check'(E))
'$print_exception_with_check'(E))
).
'$instruction_match'(Term, VarList) :-
'$submit_query_and_print_results'(Term, VarList),
@@ -42,10 +42,12 @@
( expand_goals(Term0, Term) -> true
; Term = Term0
),
( '$get_b_value'(B), call(Term), '$write_eqs_and_read_input'(B, VarList), !
; write('false.'), nl
),
'$reset_attr_var_state'.
( '$get_b_value'(B), call(Term), '$write_eqs_and_read_input'(B, VarList),
!
% clear attribute goal lists, which may be populated by
% copy_term/3 prior to failure.
; '$clear_attribute_goals', write('false.'), nl
).
'$needs_bracketing'(Value, Op) :-
catch((functor(Value, F, _),
@@ -80,7 +82,7 @@
( '$needs_bracketing'(Value, (=)) ->
write('('),
write_term(Value, [quoted(true), variable_names(VarList)]),
write(')')
write(')')
; write_term(Value, [quoted(true), variable_names(VarList)]),
( '$trailing_period_is_ambiguous'(Value) ->
write(' ')
@@ -99,7 +101,7 @@
'$write_eq'(G2, VarList).
'$write_eq'(G, VarList) :-
'$write_last_goal'(G, VarList).
'$graphic_token_char'(C) :-
memberchk(C, ['#', '$', '&', '*', '+', '-', '.', ('/'), ':',
'<', '=', '>', '?', '@', '^', '~', ('\\')]).
@@ -144,13 +146,20 @@
).
'$gather_query_vars'([], []).
'$is_a_different_variable'([_ = Binding | Pairs], Value) :-
( Value == Binding, !
; '$is_a_different_variable'(Pairs, Value)
).
'$gather_goals'([], VarList, Goals) :-
'$get_attr_var_queue_beyond'(0, AttrVars),
'$gather_query_vars'(VarList, QueryVars),
'$call_attribute_goals'(QueryVars, AttrVars),
'$fetch_attribute_goals'(Goals).
'$gather_goals'([Var = Value | Pairs], VarList, Goals) :-
( nonvar(Value) ->
( ( nonvar(Value)
; '$is_a_different_variable'(Pairs, Value)
) ->
Goals = [Var = Value | Goals0],
'$gather_goals'(Pairs, VarList, Goals0)
; '$gather_goals'(Pairs, VarList, Goals)