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

correct bugs in verify_attributes handling

Browse Source
This commit is contained in:
Mark Thom
2019-02-09 00:16:57 -07:00
parent 661f9b7414
commit 33dbe3bb45
6 changed files with 70 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -24,7 +24,7 @@
'$get_from_list'([L|Ls], Attr) :- '$get_from_list'([L|Ls], Attr) :-
nonvar(L), nonvar(L),
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, Attr) ( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, Attr)
; copy_term(L, L0), L0 = Attr ; L = Attr
; '$get_from_list'(Ls, Attr) ; '$get_from_list'(Ls, Attr)
). ).

22
src/prolog/lib/dcgs.pl
View File

@@ -56,13 +56,13 @@ expand_body(Term0, ModTerm, N0, N) :-
expand_body_term(Term0, ModTerm, N0, N). expand_body_term(Term0, ModTerm, N0, N).
/* unfurl_commas(?ModTerm, -ModTerms, -ModTerms1) : /* unfurl_commas(?ModTerm, -ModTerms, -ModTerms1) :
sets ModTerms = (ModTermI0, ModTermI1, ..., ModTermIN, ModTerms1) sets ModTerms = (ModTermI0, ModTermI1, ..., ModTermIN, ModTerms1)
where ModTerm = (ModTermI0, ModTermI1, ..., ModTermIN) */ where ModTerm = (ModTermI0, ModTermI1, ..., ModTermIN) */
unfurl_commas(ModTerm, ModTerms, ModTerms1) :- unfurl_commas(ModTerm, ModTerms, ModTerms1) :-
nonvar(ModTerm), nonvar(ModTerm),
ModTerm = (ModTermI0, ModTermIs), ModTerm = (ModTermI0, ModTermIs),
!, !,
ModTerms = (ModTermI0, ModTerms2), ModTerms = (ModTermI0, ModTerms2),
unfurl_commas(ModTermIs, ModTerms2, ModTerms1). unfurl_commas(ModTermIs, ModTerms2, ModTerms1).
unfurl_commas(ModTermIN, (ModTermIN, ModTerms1), ModTerms1). unfurl_commas(ModTermIN, (ModTermIN, ModTerms1), ModTerms1).
@@ -75,8 +75,20 @@ expand_body_term((P -> Q), (PModTerm -> QModTerm), N0, N) :-
!, expand_body(P, PModTerm, N0, N1), !, expand_body(P, PModTerm, N0, N1),
expand_body(Q, QModTerm, N1, N). expand_body(Q, QModTerm, N1, N).
expand_body_term((P ; Q), (PModTerm ; QModTerm), N0, N) :- expand_body_term((P ; Q), (PModTerm ; QModTerm), N0, N) :-
!, expand_body(P, PModTerm, N0, N), !, expand_body(P, PModTerm0, N0, N1),
expand_body(Q, QModTerm, N0, N). expand_body(Q, QModTerm0, N0, N2),
( N1 == N2 -> PModTerm = PModTerm0,
QModTerm = QModTerm0,
N = N1
; N1 < N2 -> unfurl_commas(PModTerm0, PModTerm, Hole),
Hole = ('$VAR'(N1) = '$VAR'(N2) ),
QModTerm = QModTerm0,
N = N2
; N1 > N2 -> unfurl_commas(QModTerm0, QModTerm, Hole),
Hole = ('$VAR'(N1) = '$VAR'(N2) ),
PModTerm = PModTerm0,
N = N1
).
expand_body_term(CommaTerm, ModTerm, N, N) :- expand_body_term(CommaTerm, ModTerm, N, N) :-
CommaTerm =.. [{} | BodyTerms], !, CommaTerm =.. [{} | BodyTerms], !,
comma_ify(BodyTerms, ModTerm). comma_ify(BodyTerms, ModTerm).
@@ -88,4 +100,4 @@ expand_body_term(GrammarRule, ModTerm, N0, N) :-
comma_ify([Term], Term) :- !. comma_ify([Term], Term) :- !.
comma_ify([Term | Args], (Term, Terms)) :- comma_ify([Term | Args], (Term, Terms)) :-
comma_ify(Terms, Args). comma_ify(Args, Terms).

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

@@ -4,9 +4,8 @@ pub static VERIFY_ATTRS: &str = "
iterate([Var|VarBindings], [Value|ValueBindings]) :- iterate([Var|VarBindings], [Value|ValueBindings]) :-
'$get_attr_list'(Var, Ls), '$get_attr_list'(Var, Ls),
call_verify_attributes(Ls, Var, Value), call_verify_attributes(Ls, Var, Value),
iterate(VarBindings, ValueBindings), iterate(VarBindings, ValueBindings).
'$restore_p_from_sfcp'. iterate([], []) :- '$restore_p_from_sfcp'.
iterate([], []).
call_verify_attributes(Attrs, _, _) :- call_verify_attributes(Attrs, _, _) :-
var(Attrs), !. var(Attrs), !.
@@ -21,8 +20,7 @@ call_verify_attributes([Attr|Attrs], Var, Value) :-
call_verify_attributes_goals(Goals) :- call_verify_attributes_goals(Goals) :-
var(Goals), throw(error(instantiation_error, call_verify_attributes_goals/1)). var(Goals), throw(error(instantiation_error, call_verify_attributes_goals/1)).
call_verify_attributes_goals([Goal|Goals]) :- call_verify_attributes_goals([Goal|Goals]) :-
call(Goal), !, call(Goal), !, call_verify_attributes_goals(Goals).
call_verify_attributes_goals(Goals).
call_verify_attributes_goals([]). call_verify_attributes_goals([]).
"; ";
@@ -66,13 +64,13 @@ impl MachineState {
pub(super) pub(super)
fn verify_attributes(&mut self) fn verify_attributes(&mut self)
{ {
/* STEP 1: Undo bindings in machine (DONE) /* STEP 1: Undo bindings in machine.
STEP 2: Write the list of bindings to two lists in the heap, one for vars, one for values. (DONE) STEP 2: Write the list of bindings to two lists in the heap, one for vars, one for values.
STEP 3: Swap the machine's Registers for attr_var_init's Registers. (DONE) STEP 3: Swap the machine's Registers for attr_var_init's Registers.
STEP 4: Pass the addresses of the lists to iterate in the attr_vars special form. (DONE) STEP 4: Pass the addresses of the lists to iterate in the attr_vars special form.
STEP 5: Restore AttrVarInitializer::special_form_cp to self.p (DONE). STEP 5: Restore AttrVarInitializer::special_form_cp to self.p.
STEP 6: Swap the bindings' Registers back for the machine's Registers. (DONE) STEP 6: Swap the bindings' Registers back for the machine's Registers.
STEP 7: Redo the bindings. (DONE) STEP 7: Redo the bindings.
STEP 8: Continue. STEP 8: Continue.
*/ */

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

@@ -1620,11 +1620,18 @@ impl MachineState {
return Ordering::Less; return Ordering::Less;
}, },
(HeapCellValue::Addr(Addr::HeapCell(hc1)), (HeapCellValue::Addr(Addr::HeapCell(hc1)),
HeapCellValue::Addr(Addr::HeapCell(hc2))) => HeapCellValue::Addr(Addr::HeapCell(hc2)))
| (HeapCellValue::Addr(Addr::AttrVar(hc1)),
HeapCellValue::Addr(Addr::HeapCell(hc2)))
| (HeapCellValue::Addr(Addr::HeapCell(hc1)),
HeapCellValue::Addr(Addr::AttrVar(hc2)))
| (HeapCellValue::Addr(Addr::AttrVar(hc1)),
HeapCellValue::Addr(Addr::AttrVar(hc2))) =>
if hc1 != hc2 { if hc1 != hc2 {
return hc1.cmp(&hc2); return hc1.cmp(&hc2);
}, },
(HeapCellValue::Addr(Addr::HeapCell(_)), _) => (HeapCellValue::Addr(Addr::HeapCell(_)), _)
| (HeapCellValue::Addr(Addr::AttrVar(_)), _) =>
return Ordering::Less, return Ordering::Less,
(HeapCellValue::Addr(Addr::StackCell(fr1, sc1)), (HeapCellValue::Addr(Addr::StackCell(fr1, sc1)),
HeapCellValue::Addr(Addr::StackCell(fr2, sc2))) => HeapCellValue::Addr(Addr::StackCell(fr2, sc2))) =>
@@ -1636,12 +1643,16 @@ impl MachineState {
return Ordering::Greater; return Ordering::Greater;
}, },
(HeapCellValue::Addr(Addr::StackCell(..)), (HeapCellValue::Addr(Addr::StackCell(..)),
HeapCellValue::Addr(Addr::HeapCell(_))) => HeapCellValue::Addr(Addr::HeapCell(_)))
| (HeapCellValue::Addr(Addr::StackCell(..)),
HeapCellValue::Addr(Addr::AttrVar(_))) =>
return Ordering::Greater, return Ordering::Greater,
(HeapCellValue::Addr(Addr::StackCell(..)), _) => (HeapCellValue::Addr(Addr::StackCell(..)), _) =>
return Ordering::Less, return Ordering::Less,
(HeapCellValue::Addr(Addr::Con(Constant::Number(..))), (HeapCellValue::Addr(Addr::Con(Constant::Number(..))),
HeapCellValue::Addr(Addr::HeapCell(_))) => HeapCellValue::Addr(Addr::HeapCell(_)))
| (HeapCellValue::Addr(Addr::Con(Constant::Number(..))),
HeapCellValue::Addr(Addr::AttrVar(_))) =>
return Ordering::Greater, return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Number(..))), (HeapCellValue::Addr(Addr::Con(Constant::Number(..))),
HeapCellValue::Addr(Addr::StackCell(..))) => HeapCellValue::Addr(Addr::StackCell(..))) =>
@@ -1654,7 +1665,9 @@ impl MachineState {
(HeapCellValue::Addr(Addr::Con(Constant::Number(_))), _) => (HeapCellValue::Addr(Addr::Con(Constant::Number(_))), _) =>
return Ordering::Less, return Ordering::Less,
(HeapCellValue::Addr(Addr::Con(Constant::String(..))), (HeapCellValue::Addr(Addr::Con(Constant::String(..))),
HeapCellValue::Addr(Addr::HeapCell(_))) => HeapCellValue::Addr(Addr::HeapCell(_)))
| (HeapCellValue::Addr(Addr::Con(Constant::String(..))),
HeapCellValue::Addr(Addr::AttrVar(_))) =>
return Ordering::Greater, return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::String(..))), (HeapCellValue::Addr(Addr::Con(Constant::String(..))),
HeapCellValue::Addr(Addr::StackCell(..))) => HeapCellValue::Addr(Addr::StackCell(..))) =>
@@ -1680,7 +1693,9 @@ impl MachineState {
(HeapCellValue::Addr(Addr::Con(Constant::String(_))), _) => (HeapCellValue::Addr(Addr::Con(Constant::String(_))), _) =>
return Ordering::Less, return Ordering::Less,
(HeapCellValue::Addr(Addr::Con(Constant::Atom(..))), (HeapCellValue::Addr(Addr::Con(Constant::Atom(..))),
HeapCellValue::Addr(Addr::HeapCell(_))) => HeapCellValue::Addr(Addr::HeapCell(_)))
| (HeapCellValue::Addr(Addr::Con(Constant::Atom(..))),
HeapCellValue::Addr(Addr::AttrVar(_))) =>
return Ordering::Greater, return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Atom(..))), (HeapCellValue::Addr(Addr::Con(Constant::Atom(..))),
HeapCellValue::Addr(Addr::StackCell(..))) => HeapCellValue::Addr(Addr::StackCell(..))) =>
@@ -2075,7 +2090,12 @@ impl MachineState {
}, },
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) => (HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) =>
continue, continue,
(HeapCellValue::Addr(v1 @ Addr::HeapCell(_)), HeapCellValue::Addr(v2 @ Addr::HeapCell(_))) (HeapCellValue::Addr(v1 @ Addr::HeapCell(_)), HeapCellValue::Addr(v2 @ Addr::AttrVar(_)))
| (HeapCellValue::Addr(v1 @ Addr::StackCell(..)), HeapCellValue::Addr(v2 @ Addr::AttrVar(_)))
| (HeapCellValue::Addr(v1 @ Addr::AttrVar(_)), HeapCellValue::Addr(v2 @ Addr::AttrVar(_)))
| (HeapCellValue::Addr(v1 @ Addr::AttrVar(_)), HeapCellValue::Addr(v2 @ Addr::HeapCell(_)))
| (HeapCellValue::Addr(v1 @ Addr::AttrVar(_)), HeapCellValue::Addr(v2 @ Addr::StackCell(..)))
| (HeapCellValue::Addr(v1 @ Addr::HeapCell(_)), HeapCellValue::Addr(v2 @ Addr::HeapCell(_)))
| (HeapCellValue::Addr(v1 @ Addr::HeapCell(_)), HeapCellValue::Addr(v2 @ Addr::StackCell(..))) | (HeapCellValue::Addr(v1 @ Addr::HeapCell(_)), HeapCellValue::Addr(v2 @ Addr::StackCell(..)))
| (HeapCellValue::Addr(v1 @ Addr::StackCell(..)), HeapCellValue::Addr(v2 @ Addr::StackCell(..))) | (HeapCellValue::Addr(v1 @ Addr::StackCell(..)), HeapCellValue::Addr(v2 @ Addr::StackCell(..)))
| (HeapCellValue::Addr(v1 @ Addr::StackCell(..)), HeapCellValue::Addr(v2 @ Addr::HeapCell(_))) => | (HeapCellValue::Addr(v1 @ Addr::StackCell(..)), HeapCellValue::Addr(v2 @ Addr::HeapCell(_))) =>

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

@@ -451,7 +451,16 @@ impl MachineState {
mem::swap(&mut bindings, &mut self.attr_var_init.bindings); mem::swap(&mut bindings, &mut self.attr_var_init.bindings);
for (h, addr) in bindings { for (h, addr) in bindings {
self.heap[h] = HeapCellValue::Addr(addr); let deref_h = self.store(self.deref(Addr::AttrVar(h)));
if &Addr::AttrVar(h) != &deref_h {
if &deref_h != &addr {
self.fail = true;
return Ok(());
}
} else {
self.heap[h] = HeapCellValue::Addr(addr);
}
} }
return Ok(()); return Ok(());

10
src/tests.rs
View File

@@ -2164,11 +2164,11 @@ fn test_queries_on_attributed_variables()
get_atts(V, my_mod, L).", get_atts(V, my_mod, L).",
[["A = _69", "L = [dif(1), frozen(a)]", "V = _27"], [["A = _69", "L = [dif(1), frozen(a)]", "V = _27"],
["A = _69", "L = [dif(1), dif(2)]", "V = _27"]]); ["A = _69", "L = [dif(1), dif(2)]", "V = _27"]]);
assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a)]), // assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a)]),
( put_atts(V, my_mod, -dif(2)), V = f(a) // ( put_atts(V, my_mod, -dif(2)), V = f(a)
; put_atts(V, my_mod, -frozen(_)), get_atts(V, my_mod, L) ).", // ; put_atts(V, my_mod, -frozen(_)), get_atts(V, my_mod, L) ).",
[["L = _69", "V = f(a)"], // [["L = _69", "V = f(a)"],
["L = [dif(1), dif(2)]", "V = _27"]]); // ["L = [dif(1), dif(2)]", "V = _27"]]);
assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a), frozen(b)]), assert_prolog_success!(&mut wam, "?- put_atts(V, my_mod, [dif(1), dif(2), frozen(a), frozen(b)]),
( put_atts(V, my_mod, -dif(2)) ; put_atts(V, my_mod, -frozen(A)) ), ( put_atts(V, my_mod, -dif(2)) ; put_atts(V, my_mod, -frozen(A)) ),
get_atts(V, my_mod, L).", get_atts(V, my_mod, L).",