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

Merge branch 'master' into ffi

Browse Source
This commit is contained in:
Adrián Arroyo Calle
2023-02-28 22:10:40 +01:00
committed by GitHub
parent 0ac93751d0 400ca21213
commit 7396630627
23 changed files with 1396 additions and 1485 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/forms.rs
View File

@@ -812,8 +812,9 @@ impl PredicateInfo {
}
#[inline]
pub(crate) fn must_retract_local_clauses(&self) -> bool {
self.is_extensible && self.has_clauses && !self.is_discontiguous
pub(crate) fn must_retract_local_clauses(&self, is_cross_module_clause: bool) -> bool {
self.is_extensible && self.has_clauses && !self.is_discontiguous &&
!(self.is_multifile && is_cross_module_clause)
}
}

92
src/lib/atts.pl
View File

@@ -19,74 +19,12 @@
'$default_attr_list'(PGs, Module, AttrVar).
'$default_attr_list'([], _, _) --> [].
'$absent_attr'(V, Attr) :-
'$get_attr_list'(V, Ls),
'$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
).
'$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)
; Ls = [_ | Ls0],
'$add_to_list'(Ls0, V, Attr)
).
'$del_attr'(Ls0, _, _) :-
var(Ls0),
!.
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr ->
'$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$del_attr_head'(V),
'$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, V, Attr) :-
( nonvar(Ls1) ->
Ls1 = [_ | Ls2],
'$del_attr_buried'(Ls1, Ls2, V, Attr)
'$absent_attr'(V, Module, Attr) :-
( '$get_from_attr_list'(V, Module, Attr) ->
false
; true
).
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
( var(Ls1) -> true
; Ls1 = [Att | Ls2] ->
( Att \= Attr ->
'$del_attr_buried'(Ls1, Ls2, V, Attr)
; '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
'$del_attr_step'(Ls1, V, Attr)
)
).
'$copy_attr_list'(L, _Module, []) :- var(L), !.
'$copy_attr_list'([Module0:Att|Atts], Module, CopiedAtts) :-
( Module0 == Module ->
@@ -142,38 +80,28 @@ put_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },
[(put_atts(V, +Attr) :-
!,
functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
(put_atts(V, Attr) :-
'$put_to_attr_list'(V, Module, Attr)),
(put_atts(V, Attr) :-
!,
functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
'$put_to_attr_list'(V, Module, Attr)),
(put_atts(V, -Attr) :-
!,
functor(Attr, _, _),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:Attr))].
'$del_from_attr_list'(V, Module, Attr))].
get_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },
[(get_atts(V, +Attr) :-
!,
functor(Attr, _, _),
atts:'$get_attr'(V, Module:Attr)),
atts:'$get_from_attr_list'(V, Module, Attr)),
(get_atts(V, Attr) :-
!,
functor(Attr, _, _),
atts:'$get_attr'(V, Module:Attr)),
atts:'$get_from_attr_list'(V, Module, Attr)),
(get_atts(V, -Attr) :-
!,
functor(Attr, _, _),
atts:'$absent_attr'(V, Module:Attr))].
atts:'$absent_attr'(V, Module, Attr))].
user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
nonvar(Term),

4
src/lib/clpb.pl
View File

@@ -211,7 +211,7 @@ Here is an example session with a few queries and their answers:
T = 1, clpb:sat(X=:=X*Y), clpb:sat(Y=:=Y*Z).
?- sat(1#X#a#b).
sat(X=:=a#b).
clpb:sat(X=:=a#b).
```
The pending residual goals constrain remaining variables to Boolean
@@ -348,7 +348,7 @@ does compute =|XOR|= as intended:
```
?- xor(x, y, Z).
sat(Z=:=x#y).
clpb:sat(Z=:=x#y).
```
## Acknowledgments

24
src/lib/clpz.pl
View File

@@ -220,31 +220,23 @@ partition_([X|Xs], Pred, Ls0, Es0, Gs0) :-
:- meta_predicate(include(1, ?, ?)).
include(Goal, Ls0, Ls) :-
include_(Ls0, Goal, Ls).
include_([], _, []).
include_([L|Ls0], Goal, Ls) :-
include(_, [], []).
include(Goal, [L|Ls0], Ls) :-
( call(Goal, L) ->
Ls = [L|Rest]
; Ls = Rest
),
include_(Ls0, Goal, Rest).
include(Goal, Ls0, Rest).
:- meta_predicate(exclude(1, ?, ?)).
exclude(Goal, Ls0, Ls) :-
exclude_(Ls0, Goal, Ls).
exclude_([], _, []).
exclude_([L|Ls0], Goal, Ls) :-
exclude(_, [], []).
exclude(Goal, [L|Ls0], Ls) :-
( call(Goal, L) ->
Ls = Rest
; Ls = [L|Rest]
),
exclude_(Ls0, Goal, Rest).
exclude(Goal, Ls0, Rest).
%:- discontiguous clpz:goal_expansion/5.
@@ -7711,7 +7703,7 @@ attributes_goals([]) --> [].
attributes_goals([propagator(P, State)|As]) -->
( { ground(State) } -> []
; { phrase(attribute_goal_(P), Gs) } ->
{ % del_attr(State, clpz_aux), State = processed,
{ del_attr(State, clpz_aux), State = processed,
( monotonic ->
maplist(unwrap_with(bare_integer), Gs, Gs1)
; maplist(unwrap_with(=), Gs, Gs1)
@@ -7822,7 +7814,7 @@ conjunction(A, B, G, D) -->
original_goal(original_goal(State, Goal)) -->
( { var(State) } ->
% { State = processed },
{ State = processed },
[Goal]
; []
).

17
src/lib/dcgs.pl
View File

@@ -75,13 +75,6 @@ phrase(GRBody, S0, S) :-
; call(M:GRBody1, S0, S)
).
module_call_qualified(M, Call, Call1) :-
( nonvar(M) -> Call1 = M:Call
; Call = Call1
).
% The same version of the below two dcg_rule clauses, but with module scoping.
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
dcg_non_terminal(NonTerminal, S0, S, Head),
@@ -127,7 +120,10 @@ dcg_body(NonTerminal, S0, S, Goal1) :-
NonTerminal \= ( \+ _ ),
loader:strip_module(NonTerminal, M, NonTerminal0),
dcg_non_terminal(NonTerminal0, S0, S, Goal0),
module_call_qualified(M, Goal0, Goal1).
( functor(NonTerminal, (:), 2) ->
Goal1 = M:Goal0
; Goal1 = Goal0
).
% The following constructs in a grammar rule body
% are defined in the corresponding subclauses.
@@ -215,6 +211,9 @@ user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
E,
dcgs:error_goal(E, GRBody1)
),
module_call_qualified(M, GRBody1, GRBody2).
( GRBody = (_:_) ->
GRBody2 = M:GRBody1
; GRBody2 = GRBody1
).
user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])).

17
src/lib/dif.pl
View File

@@ -40,9 +40,6 @@ verify_attributes(Var, Value, Goals) :-
; Goals = []
).
% Probably the world's worst dif/2 implementation. I'm open to
% suggestions for improvement.
%% dif(?X, ?Y).
%
% True iff X and Y are different terms. Unlike `\=/2`, `dif/2` is more declarative because if X and Y can
@@ -69,12 +66,16 @@ dif(X, Y) :-
)
).
gather_dif_goals([]) --> [].
gather_dif_goals([(X \== Y) | Goals]) -->
[dif:dif(X, Y)],
gather_dif_goals(Goals).
gather_dif_goals(_, []) --> [].
gather_dif_goals(V, [(X \== Y) | Goals]) -->
( { term_variables(X, [V0 | _]),
V == V0 } ->
[dif:dif(X, Y)]
; []
),
gather_dif_goals(V, Goals).
attribute_goals(X) -->
{ get_atts(X, +dif(Goals)) },
gather_dif_goals(Goals),
gather_dif_goals(X, Goals),
{ put_atts(X, -dif(_)) }.

12
src/lib/error.pl
View File

@@ -1,5 +1,5 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2018-2022 by Markus Triska (triska@metalevel.at)
Written 2018-2023 by Markus Triska (triska@metalevel.at)
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -85,11 +85,11 @@ must_be_(list, Term) :- check_(error:ilist, list, Term).
must_be_(type, Term) :- check_(error:type, type, Term).
must_be_(boolean, Term) :- check_(error:boolean, boolean, Term).
must_be_(term, Term) :-
( \+ ground(Term) ->
instantiation_error(must_be/2)
; \+ acyclic_term(Term) ->
type_error(term, Term, must_be/2)
; true
( acyclic_term(Term) ->
( ground(Term) -> true
; instantiation_error(must_be/2)
)
; type_error(term, Term, must_be/2)
).
% We cannot use maplist(must_be(character), Cs), because library(lists)

2
src/lib/freeze.pl
View File

@@ -38,5 +38,5 @@ freeze(X, Goal) :-
attribute_goals(Var) -->
{ get_atts(Var, frozen(Goals)),
put_atts(Var, -frozen(_)) },
[freeze(Var, Goals)].
[freeze:freeze(Var, Goals)].

10
src/loader.pl
View File

@@ -11,7 +11,6 @@
current_module/1
]).
:- use_module(library(error)).
:- use_module(library(lists)).
:- use_module(library(pairs)).
@@ -221,7 +220,12 @@ complete_partial_goal(N, HeadArg, InnerHeadArgs, SuppArgs, CompleteHeadArg) :-
integer(N),
N >= 0,
HeadArg =.. [Functor | InnerHeadArgs],
length(SuppArgs, N),
% the next two lines are equivalent to length(SuppArgs, N) but
% avoid length/2 so that copy_term/3 (which is invoked by
% length/2) can be bootstrapped without self-reference.
functor(SuppArgsFunctor, '.', N),
SuppArgsFunctor =.. [_ | SuppArgs],
% length(SuppArgs, N),
append(InnerHeadArgs, SuppArgs, InnerHeadArgs0),
CompleteHeadArg =.. [Functor | InnerHeadArgs0].
@@ -620,7 +624,7 @@ strip_module(Goal, M, G) :-
strip_subst_module(Goal, M1, M2, G) :-
'$strip_module'(Goal, M2, G),
( var(M2) ->
( var(M2), \+ functor(Goal, (:), 2) ->
M2 = M1
; true
).

4
src/machine/attributed_variables.rs
View File

@@ -52,6 +52,7 @@ impl MachineState {
self.cp = INSTALL_VERIFY_ATTR_INTERRUPT;
}
debug_assert_eq!(self.heap[h].get_tag(), HeapCellValueTag::AttrVar);
self.attr_var_init.bindings.push((h, addr));
}
@@ -63,10 +64,9 @@ impl MachineState {
.map(|(ref h, _)| attr_var_as_cell!(*h));
let var_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter));
let iter = self.attr_var_init.bindings.drain(0..).map(|(_, ref v)| *v);
let value_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter));
(var_list_addr, value_list_addr)
}

52
src/machine/compile.rs
View File

@@ -2280,14 +2280,17 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.ok_or(SessionError::NamelessEntry)?;
let listing_src_file_name = self.listing_src_file_name();
let payload_compilation_target = self.payload.compilation_target;
let mut predicate_info = self
.wam_prelude
.indices
.get_predicate_skeleton(&self.payload.predicates.compilation_target, &key)
.map(|skeleton| skeleton.predicate_info())
.unwrap_or_default();
// payload_compilation_target describes the compilation context,
// e.g. compiling
//
// table_wrapper:tabled(get_node(A), b).
//
// without a module declaration means self.payload.compilation_target
// is CompilationTarget::User while self.payload.predicates.compilation_target
// is CompilationTarget::Module(atom!("table_wrapper")).
let payload_compilation_target = self.payload.compilation_target;
let local_predicate_info = self
.wam_prelude
@@ -2301,34 +2304,37 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.map(|skeleton| skeleton.predicate_info())
.unwrap_or_default();
if local_predicate_info.must_retract_local_clauses() {
let mut predicate_info = self
.wam_prelude
.indices
.get_predicate_skeleton(&self.payload.predicates.compilation_target, &key)
.map(|skeleton| skeleton.predicate_info())
.unwrap_or_default();
let is_cross_module_clause =
payload_compilation_target != self.payload.predicates.compilation_target;
if local_predicate_info.must_retract_local_clauses(is_cross_module_clause) {
self.retract_local_clauses(&key, predicate_info.is_dynamic);
}
let do_incremental_compile =
if payload_compilation_target == self.payload.predicates.compilation_target {
predicate_info.compile_incrementally()
} else {
local_predicate_info.is_multifile && predicate_info.compile_incrementally()
};
let predicates_len = self.payload.predicates.len();
let non_counted_bt = self.payload.non_counted_bt_preds.contains(&key);
if do_incremental_compile {
if predicate_info.compile_incrementally() {
let predicates = self.payload.predicates.take();
for term in predicates.predicates {
self.incremental_compile_clause(
key,
term,
payload_compilation_target,
self.payload.predicates.compilation_target,
non_counted_bt,
AppendOrPrepend::Append,
)?;
}
} else {
if payload_compilation_target != self.payload.predicates.compilation_target {
if is_cross_module_clause {
if !local_predicate_info.is_extensible {
if predicate_info.is_multifile {
println!(
@@ -2343,9 +2349,11 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.indices
.remove_predicate_skeleton(&self.payload.predicates.compilation_target, &key)
{
let compilation_target = self.payload.predicates.compilation_target;
if predicate_info.is_dynamic {
let clause_clause_compilation_target =
match self.payload.predicates.compilation_target {
match compilation_target {
CompilationTarget::User => {
CompilationTarget::Module(atom!("builtins"))
}
@@ -2364,7 +2372,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
self.payload.retraction_info.push_record(
RetractionRecord::RemovedSkeleton(
payload_compilation_target,
compilation_target,
key,
skeleton,
),
@@ -2415,9 +2423,11 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.clause_clauses.drain(0..std::cmp::min(predicates_len, clause_clauses_len))
.collect();
let compilation_target = self.payload.predicates.compilation_target;
self.compile_clause_clauses(
key,
payload_compilation_target,
compilation_target,
clauses_vec.into_iter(),
AppendOrPrepend::Append,
)?;

70
src/machine/copier.rs
View File

@@ -28,7 +28,10 @@ pub(crate) fn copy_term<T: CopierTarget>(
attr_var_policy: AttrVarPolicy,
) {
let mut copy_term_state = CopyTermState::new(target, attr_var_policy);
copy_term_state.copy_term_impl(addr);
copy_term_state.copy_attr_var_lists();
copy_term_state.unwind_trail();
}
#[derive(Debug)]
@@ -38,6 +41,7 @@ struct CopyTermState<T: CopierTarget> {
old_h: usize,
target: T,
attr_var_policy: AttrVarPolicy,
attr_var_list_locs: Vec<(usize, HeapCellValue)>,
}
impl<T: CopierTarget> CopyTermState<T> {
@@ -48,6 +52,7 @@ impl<T: CopierTarget> CopyTermState<T> {
old_h: target.threshold(),
target,
attr_var_policy,
attr_var_list_locs: vec![],
}
}
@@ -86,16 +91,12 @@ impl<T: CopierTarget> CopyTermState<T> {
self.target.push(hcv);
}
let cdr = self
.target
.store(self.target.deref(heap_loc_as_cell!(addr + 1)));
let cdr = self.target.store(self.target.deref(heap_loc_as_cell!(addr + 1)));
if !cdr.is_var() {
self.trail_list_cell(addr + 1, threshold);
} else {
let car = self
.target
.store(self.target.deref(heap_loc_as_cell!(addr)));
let car = self.target.store(self.target.deref(heap_loc_as_cell!(addr)));
if !car.is_var() {
self.trail_list_cell(addr, threshold);
@@ -167,6 +168,51 @@ impl<T: CopierTarget> CopyTermState<T> {
self.trail.push((Ref::heap_cell(pstr_loc), trail_item));
}
fn copy_attr_var_lists(&mut self) {
while !self.attr_var_list_locs.is_empty() {
let iter = mem::replace(&mut self.attr_var_list_locs, vec![]);
for (threshold, list_loc) in iter {
self.target[threshold] = list_loc_as_cell!(self.target.threshold());
self.copy_attr_var_list(list_loc);
}
}
}
/*
* Attributed variable attribute lists adhere to a particular
* structure which is ensured by this function and not at all by
* the vanilla copier.
*/
fn copy_attr_var_list(&mut self, mut list_addr: HeapCellValue) {
while let HeapCellValueTag::Lis = list_addr.get_tag() {
let threshold = self.target.threshold();
let heap_loc = list_addr.get_value();
let str_loc = self.target[heap_loc].get_value();
self.target.push(heap_loc_as_cell!(threshold+2));
self.target.push(heap_loc_as_cell!(threshold+1));
read_heap_cell!(self.target[str_loc],
(HeapCellValueTag::Atom) => {
self.target.push(self.target[str_loc]);
}
(HeapCellValueTag::Str) => {
self.copy_term_impl(self.target[str_loc]);
}
_ => {
unreachable!();
}
);
list_addr = self.target[heap_loc + 1];
if HeapCellValueTag::Lis == list_addr.get_tag() {
self.target[threshold + 1] = list_loc_as_cell!(self.target.threshold());
}
}
}
fn reinstantiate_var(&mut self, addr: HeapCellValue, frontier: usize) {
read_heap_cell!(addr,
(HeapCellValueTag::Var, h) => {
@@ -195,9 +241,15 @@ impl<T: CopierTarget> CopyTermState<T> {
if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
self.target.push(attr_var_as_cell!(threshold));
self.target.push(heap_loc_as_cell!(threshold + 1));
let list_val = self.target[h + 1];
self.target.push(list_val);
let old_list_link = self.target[h + 1];
self.trail.push((Ref::heap_cell(h + 1), old_list_link));
self.target[h + 1] = heap_loc_as_cell!(threshold + 1);
if old_list_link.get_tag() == HeapCellValueTag::Lis {
self.attr_var_list_locs.push((threshold + 1, old_list_link));
}
}
}
_ => {
@@ -298,8 +350,6 @@ impl<T: CopierTarget> CopyTermState<T> {
}
);
}
self.unwind_trail();
}
fn unwind_trail(&mut self) {

56
src/machine/dispatch.rs
View File

@@ -3570,22 +3570,6 @@ impl Machine {
self.file_time();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallDeleteAttribute(_) => {
self.delete_attribute();
self.machine_st.p += 1;
}
&Instruction::ExecuteDeleteAttribute(_) => {
self.delete_attribute();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallDeleteHeadAttribute(_) => {
self.delete_head_attribute();
self.machine_st.p += 1;
}
&Instruction::ExecuteDeleteHeadAttribute(_) => {
self.delete_head_attribute();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallDynamicModuleResolution(arity, _) => {
let (module_name, key) = try_or_throw!(
self.machine_st,
@@ -3616,14 +3600,6 @@ impl Machine {
self.machine_st.backtrack();
}
}
&Instruction::CallEnqueueAttributedVar(_) => {
self.enqueue_attributed_var();
self.machine_st.p += 1;
}
&Instruction::ExecuteEnqueueAttributedVar(_) => {
self.enqueue_attributed_var();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallFetchGlobalVar(_) => {
self.fetch_global_var();
step_or_fail!(self, self.machine_st.p += 1);
@@ -5231,6 +5207,38 @@ impl Machine {
self.machine_st.execute_at_index(2, p);
}
&Instruction::CallGetFromAttributedVarList(_) => {
self.get_from_attributed_variable_list();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteGetFromAttributedVarList(_) => {
self.get_from_attributed_variable_list();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallPutToAttributedVarList(_) => {
self.put_to_attributed_variable_list();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecutePutToAttributedVarList(_) => {
self.put_to_attributed_variable_list();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallDeleteFromAttributedVarList(_) => {
self.delete_from_attributed_variable_list();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteDeleteFromAttributedVarList(_) => {
self.delete_from_attributed_variable_list();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallDeleteAllAttributesFromVar(_) => {
self.delete_all_attributes_from_var();
self.machine_st.p += 1;
}
&Instruction::ExecuteDeleteAllAttributesFromVar(_) => {
self.delete_all_attributes_from_var();
self.machine_st.p = self.machine_st.cp;
}
}
}

1215
src/machine/machine_state_impl.rs
View File

File diff suppressed because it is too large Load Diff

50
src/machine/mod.rs
View File

@@ -21,6 +21,7 @@ pub mod stack;
pub mod streams;
pub mod system_calls;
pub mod term_stream;
pub mod unify;
use crate::arena::*;
use crate::arithmetic::*;
@@ -257,31 +258,22 @@ impl Machine {
let mut path_buf = current_dir();
path_buf.push("machine/attributed_variables.pl");
bootstrapping_compile(
Stream::from_static_string(
include_str!("attributed_variables.pl"),
&mut self.machine_st.arena,
),
self,
ListingSource::from_file_and_path(
atom!("attributed_variables"),
path_buf,
),
)
.unwrap();
let stream = Stream::from_static_string(
include_str!("attributed_variables.pl"),
&mut self.machine_st.arena,
);
self.load_file(path_buf.to_str().unwrap(), stream);
let mut path_buf = current_dir();
path_buf.push("machine/project_attributes.pl");
bootstrapping_compile(
Stream::from_static_string(
include_str!("project_attributes.pl"),
&mut self.machine_st.arena,
),
self,
ListingSource::from_file_and_path(atom!("project_attributes"), path_buf),
)
.unwrap();
let stream = Stream::from_static_string(
include_str!("project_attributes.pl"),
&mut self.machine_st.arena,
);
self.load_file(path_buf.to_str().unwrap(), stream);
if let Some(module) = self.indices.modules.get(&atom!("$atts")) {
if let Some(code_index) = module.code_dir.get(&(atom!("driver"), 2)) {
@@ -866,14 +858,22 @@ impl Machine {
TrailEntryTag::TrailedAttrVar => {
self.machine_st.heap[h] = attr_var_as_cell!(h);
}
TrailEntryTag::TrailedAttrVarHeapLink => {
self.machine_st.heap[h] = heap_loc_as_cell!(h);
}
TrailEntryTag::TrailedAttrVarListLink => {
let l = self.machine_st.trail[i + 1].get_value() as usize;
if l < self.machine_st.hb {
self.machine_st.heap[h] = list_loc_as_cell!(l);
if h == l {
self.machine_st.heap[h] = heap_loc_as_cell!(h);
} else {
read_heap_cell!(self.machine_st.heap[l],
(HeapCellValueTag::Var) => {
self.machine_st.heap[h] = list_loc_as_cell!(l);
}
_ => {
self.machine_st.heap[h] = heap_loc_as_cell!(l);
}
);
}
} else {
self.machine_st.heap[h] = heap_loc_as_cell!(h);
}

95
src/machine/project_attributes.pl
View File

@@ -1,7 +1,12 @@
:- module('$project_atts', [copy_term/3]).
:- use_module(library(dcgs)).
:- use_module(library(error), [can_be/2]).
:- use_module(library(lambda)).
:- use_module(library(lists), [foldl/4, maplist/2]).
project_attributes(QueryVars, AttrVars) :-
gather_attr_modules(AttrVars, Modules0),
phrase(gather_attr_modules(AttrVars), Modules0),
sort(Modules0, Modules),
call_project_attributes(Modules, QueryVars, AttrVars).
@@ -17,19 +22,14 @@ project_attributes(QueryVars, AttrVars) :-
call_project_attributes([], _, _).
call_project_attributes([Module|Modules], QueryVars, AttrVars) :-
( catch(Module:project_attributes(QueryVars, AttrVars),
E,
'$project_atts':'$print_project_attributes_exception'(Module, E)
)
E,
'$project_atts':'$print_project_attributes_exception'(Module, E)
)
-> true
; true
),
call_project_attributes(Modules, QueryVars, AttrVars).
call_attribute_goals([], _, _).
call_attribute_goals([Module|Modules], GoalCaller, AttrVars) :-
call(GoalCaller, AttrVars, Module, Goals),
call_attribute_goals(Modules, GoalCaller, AttrVars).
'$print_attribute_goals_exception'(Module, E) :-
( E = error(evaluation_error((Module:attribute_goals)/3), attribute_goals/3)
; E = error(existence_error(procedure, attribute_goals/3), attribute_goals/3)
@@ -38,20 +38,6 @@ call_attribute_goals([Module|Modules], GoalCaller, AttrVars) :-
nl
).
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)
),
E,
( '$project_atts':'$print_attribute_goals_exception'(Module, E),
atts:'$default_attr_list'(Module, AttrVar, Goals, RGoals)
))
-> true
; atts:'$default_attr_list'(Module, AttrVar, Goals, RGoals)
),
call_query_var_goals(AttrVars, Module, RGoals).
call_attr_var_goals([], _, []).
call_attr_var_goals([AttrVar|AttrVars], Module, Goals) :-
( catch(Module:attribute_goals(AttrVar, Goals, RGoals),
@@ -77,25 +63,52 @@ call_attribute_goals_with_module_prefix([Module | Modules], GoalCaller, AttrVars
module_prefixed_goals(Goals0, Module, Goals, Gs),
call_attribute_goals_with_module_prefix(Modules, GoalCaller, AttrVars, Gs).
gather_attr_modules([]) --> [].
gather_attr_modules([AttrVar|AttrVars]) -->
{ '$get_attr_list'(AttrVar, Attrs) },
copy_attribute_modules(Attrs),
gather_attr_modules(AttrVars).
gather_attr_modules([], []).
gather_attr_modules([AttrVar|AttrVars], Modules) :-
'$get_attr_list'(AttrVar, Attrs),
copy_attribute_modules(Attrs, Modules, Modules0),
gather_attr_modules(AttrVars, Modules0).
copy_attribute_modules(Attrs) -->
{ var(Attrs) },
!.
copy_attribute_modules([Module:_|Attrs]) -->
[Module],
copy_attribute_modules(Attrs).
copy_attribute_modules(Attrs, Ls, Ls) :-
var(Attrs), !.
copy_attribute_modules([Module:_|Attrs], [Module|Modules0], Modules1) :-
copy_attribute_modules(Attrs, Modules0, Modules1).
gather_residual_goals_(M, V, V0, V1) :-
( catch(M:attribute_goals(V, V0, V1),
E,
('$project_atts':'$print_attribute_goals_exception'(M, E),
V0 = V1)
) ->
true
; V0 = V1
).
gather_residual_goals(M, V) -->
gather_residual_goals_(M, V),
atts:'$default_attr_list'(M, V).
copy_term(Source, Dest, Goals) :-
'$term_attributed_variables'(Source, AttrVars),
gather_attr_modules(AttrVars, Modules0),
sort(Modules0, Modules),
call_attribute_goals_with_module_prefix(Modules, '$project_atts':call_query_var_goals,
AttrVars, Goals0),
sort(Goals0, Goals1),
!,
'$copy_term_without_attr_vars'([Source | Goals1], [Dest | Goals]).
gather_residual_goals([]) --> [].
gather_residual_goals([V|Vs]) -->
{ '$get_attr_list'(V, Attrs),
phrase(copy_attribute_modules(Attrs), Modules0),
sort(Modules0, Modules) },
foldl(V+\M^gather_residual_goals(M, V), Modules),
gather_residual_goals(Vs).
delete_all_attributes_from_var(V) :- '$delete_all_attributes_from_var'(V).
copy_term(Term, Copy, Gs) :-
can_be(list, Gs),
findall(Term-Rs, term_residual_goals(Term,Rs), [Copy-Gs]),
( var(Gs) ->
Gs = []
; true
).
term_residual_goals(Term,Rs) :-
'$term_attributed_variables'(Term, Vs),
phrase(gather_residual_goals(Vs), Rs),
maplist(delete_all_attributes_from_var, Vs).

332
src/machine/system_calls.rs
View File

@@ -458,7 +458,41 @@ impl BrentAlgState {
}
}
#[derive(Debug)]
enum MatchSite {
NoMatchVarTail(usize), // no match, we refer to the location of the uninstantiated tail instead.
Match(usize), // a match
}
#[derive(Debug)]
struct AttrListMatch {
match_site: MatchSite,
prev_tail: Option<usize>,
}
impl MachineState {
pub(crate) fn get_attr_var_list(&mut self, attr_var: HeapCellValue) -> Option<usize> {
read_heap_cell!(attr_var,
(HeapCellValueTag::AttrVar, h) => {
Some(h + 1)
}
(HeapCellValueTag::Var | HeapCellValueTag::StackVar) => {
// create an AttrVar in the heap.
let h = self.heap.len();
self.heap.push(attr_var_as_cell!(h));
self.heap.push(heap_loc_as_cell!(h+1));
self.bind(Ref::attr_var(h), attr_var);
Some(h + 1)
}
_ => {
None
}
)
}
pub(crate) fn name_and_arity_from_heap(&self, cell: HeapCellValue) -> Option<PredicateKey> {
read_heap_cell!(self.store(self.deref(cell)),
(HeapCellValueTag::Str, s) => {
@@ -1004,6 +1038,17 @@ impl MachineState {
}
impl Machine {
#[inline(always)]
pub(crate) fn delete_all_attributes_from_var(&mut self) {
let attr_var = self.deref_register(1);
if let HeapCellValueTag::AttrVar = attr_var.get_tag() {
let attr_var_loc = attr_var.get_value();
self.machine_st.heap[attr_var_loc] = heap_loc_as_cell!(attr_var_loc);
self.machine_st.trail(TrailRef::Ref(Ref::attr_var(attr_var_loc)));
}
}
#[inline(always)]
pub(crate) fn get_clause_p(&self, module_name: Atom) -> (usize, usize) {
use crate::machine::loader::CompilationTarget;
@@ -4467,17 +4512,10 @@ impl Machine {
let attr_var = self.deref_register(1);
let attr_var_list = read_heap_cell!(attr_var,
(HeapCellValueTag::AttrVar, h) => {
h + 1
h+1
}
(HeapCellValueTag::Var | HeapCellValueTag::StackVar) => {
// create an AttrVar in the heap.
let h = self.machine_st.heap.len();
self.machine_st.heap.push(attr_var_as_cell!(h));
self.machine_st.heap.push(heap_loc_as_cell!(h+1));
self.machine_st.bind(Ref::attr_var(h), attr_var);
h + 1
(HeapCellValueTag::Var, h) => {
h
}
_ => {
self.machine_st.fail = true;
@@ -4489,6 +4527,44 @@ impl Machine {
self.machine_st.bind(Ref::heap_cell(attr_var_list), list_addr);
}
#[inline(always)]
pub(crate) fn get_from_attributed_variable_list(&mut self) {
let attr_var = self.deref_register(1);
let attr = self.deref_register(3);
let attr_var_list = read_heap_cell!(attr_var,
(HeapCellValueTag::AttrVar, h) => {
self.machine_st.heap[h+1]
}
_ => {
self.machine_st.fail = true;
return;
}
);
let module = self.deref_register(2);
match self.match_attribute(attr_var_list, module, attr) {
Some(AttrListMatch { match_site: MatchSite::Match(match_site), .. }) => {
let list_head = self.machine_st.heap[match_site];
if list_head.get_value() == match_site {
// at the end of the list, no match found in this case.
self.machine_st.fail = true;
} else {
let (_, qualified_goal) = self.machine_st.strip_module(
list_head,
empty_list_as_cell!(),
);
unify!(self.machine_st, qualified_goal, attr);
}
}
_ => {
self.machine_st.fail = true;
}
}
}
#[inline(always)]
pub(crate) fn get_attr_var_queue_delimiter(&mut self) {
let addr = self.deref_register(1);
@@ -4523,81 +4599,202 @@ impl Machine {
}
#[inline(always)]
pub(crate) fn enqueue_attributed_var(&mut self) {
let addr = self.deref_register(1);
read_heap_cell!(addr,
pub(crate) fn delete_from_attributed_variable_list(&mut self) {
let attr_var = self.deref_register(1);
let attr = self.deref_register(3);
let attr_var_list = read_heap_cell!(attr_var,
(HeapCellValueTag::AttrVar, h) => {
self.machine_st.attr_var_init.attr_var_queue.push(h);
h + 1
}
_ => {
return;
}
);
}
#[inline(always)]
pub(crate) fn delete_attribute(&mut self) {
let ls0 = self.deref_register(1);
let module = self.deref_register(2);
if let HeapCellValueTag::Lis = ls0.get_tag() {
let l1 = ls0.get_value();
let ls1 = self.machine_st.store(self.machine_st.deref(heap_loc_as_cell!(l1 + 1)));
if let HeapCellValueTag::Lis = ls1.get_tag() {
let l2 = ls1.get_value();
let old_addr = self.machine_st.store(self.machine_st.deref(self.machine_st.heap[l1+1]));
let tail = self.machine_st.store(self.machine_st.deref(heap_loc_as_cell!(l2 + 1)));
let tail = if tail.is_var() {
heap_loc_as_cell!(l1 + 1)
match self.match_attribute(self.machine_st.heap[attr_var_list], module, attr) {
Some(AttrListMatch { prev_tail, match_site: MatchSite::Match(match_site) }) => {
let prev_tail = if let Some(prev_tail) = prev_tail {
// not at the head.
prev_tail
} else {
tail
if self.machine_st.heap[match_site + 1].is_var() {
let h = attr_var.get_value();
self.machine_st.heap[h] = heap_loc_as_cell!(h);
self.machine_st.trail(TrailRef::Ref(Ref::attr_var(h)));
}
// at the head.
attr_var_list
};
let trail_ref = read_heap_cell!(old_addr,
(HeapCellValueTag::Var, h) => {
TrailRef::AttrVarHeapLink(h)
}
(HeapCellValueTag::Lis, l) => {
TrailRef::AttrVarListLink(l1 + 1, l)
}
_ => {
unreachable!()
}
);
if self.machine_st.heap[match_site + 1].get_tag() == HeapCellValueTag::Lis {
let prev_tail_value = self.machine_st.heap[match_site + 1].get_value();
self.machine_st.heap[prev_tail].set_value(prev_tail_value);
} else {
self.machine_st.heap[prev_tail] = heap_loc_as_cell!(prev_tail);
}
self.machine_st.heap[l1 + 1] = tail;
self.machine_st.trail(trail_ref);
self.machine_st.trail(TrailRef::AttrVarListLink(prev_tail, match_site));
}
_ => {
}
}
}
#[inline(always)]
pub(crate) fn delete_head_attribute(&mut self) {
let addr = self.deref_register(1);
debug_assert_eq!(addr.get_tag(), HeapCellValueTag::AttrVar);
let h = addr.get_value();
let addr = self.machine_st.store(self.machine_st.deref(self.machine_st.heap[h + 1]));
debug_assert_eq!(addr.get_tag(), HeapCellValueTag::Lis);
let l = addr.get_value();
let tail = self.machine_st.store(self.machine_st.deref(self.machine_st.heap[l + 1]));
let tail = if tail.is_var() {
self.machine_st.heap[h] = heap_loc_as_cell!(h);
self.machine_st.trail(TrailRef::Ref(Ref::attr_var(h)));
heap_loc_as_cell!(h + 1)
} else {
tail
pub(crate) fn put_to_attributed_variable_list(&mut self) {
let attr_var = self.deref_register(1);
let attr = self.deref_register(3);
let attr_var_list = match self.machine_st.get_attr_var_list(attr_var) {
Some(h) => h,
None => {
self.machine_st.fail = true;
return;
}
};
self.machine_st.heap[h + 1] = tail;
self.machine_st.trail(TrailRef::AttrVarListLink(h + 1, l));
let module = self.deref_register(2);
/*
* How to handle attribute trailing using just AttrVarListLink (which
* should be re-named to something more general) in unwind_trail:
*
* Given AttrVarListLink(h, l):
*
* 1. Check cell at offset l.
* 2. If h == l, set heap[h] = heap_loc_as_cell!(h).
* 3. If cell is a Var, set heap[h] = list_loc_as_cell!(l).
* 4. Otherwise, cell points to an element of the list which is therefore
* an atom or str. Set heap[h] accordingly.
*
* For this to work, all elements of attributed variable lists must be
* heap cell locs pointing to later elements in the heap, either atoms (0-arity)
* or str cells (> 0-arity).
*/
let h = self.machine_st.heap.len();
self.machine_st.heap.push(str_loc_as_cell!(h+1));
self.machine_st.heap.extend(functor!(atom!(":"), [cell(module), cell(attr)]));
match self.match_attribute(self.machine_st.heap[attr_var_list], module, attr) {
Some(AttrListMatch { match_site, .. }) => {
let (match_site, l) = match match_site {
MatchSite::NoMatchVarTail(match_site) => {
let l = self.machine_st.heap[match_site].get_value();
// at the end of the (non-empty) list here.
self.machine_st.heap[match_site] = list_loc_as_cell!(h+4);
self.machine_st.heap.push(heap_loc_as_cell!(h));
self.machine_st.heap.push(heap_loc_as_cell!(h+5));
(match_site, l)
}
MatchSite::Match(match_site) => {
let l = self.machine_st.heap[match_site].get_value();
self.machine_st.heap[match_site].set_value(h);
(match_site, l)
}
};
self.machine_st.trail(TrailRef::AttrVarListLink(match_site, l));
}
None => {
// the list is empty.
self.machine_st.heap[attr_var_list] = list_loc_as_cell!(h+4);
self.machine_st.heap.push(heap_loc_as_cell!(h));
self.machine_st.heap.push(heap_loc_as_cell!(h+5));
self.machine_st.attr_var_init.attr_var_queue.push(attr_var_list - 1);
self.machine_st.trail(TrailRef::AttrVarListLink(attr_var_list, attr_var_list));
}
}
}
fn match_attribute(
&self,
mut attrs_list: HeapCellValue,
module: HeapCellValue,
attr: HeapCellValue,
) -> Option<AttrListMatch> {
let (name, arity) = match self.machine_st.name_and_arity_from_heap(attr) {
Some(key) => key,
None => {
return None;
}
};
let mut prev_tail = None;
while let HeapCellValueTag::Lis = attrs_list.get_tag() {
let mut list_head = self.machine_st.heap[attrs_list.get_value()];
loop {
read_heap_cell!(list_head,
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
debug_assert!(list_head != self.machine_st.heap[h]);
list_head = self.machine_st.heap[h];
}
(HeapCellValueTag::Str | HeapCellValueTag::Atom) => {
let (module_loc, qualified_goal) = self.machine_st.strip_module(
list_head,
empty_list_as_cell!(),
);
let (t_name, t_arity) = self.machine_st
.name_and_arity_from_heap(qualified_goal)
.unwrap();
if module == module_loc && name == t_name && arity == t_arity {
return Some(AttrListMatch {
match_site: MatchSite::Match(attrs_list.get_value()),
prev_tail,
});
}
break;
}
_ => {
break;
}
);
}
let tail_loc = attrs_list.get_value() + 1;
prev_tail = Some(tail_loc);
// do the work of self.store(self.deref(...)) but inline it
// for speed and simplify it.
let mut list_tail = self.machine_st.heap[tail_loc];
loop {
read_heap_cell!(list_tail,
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
if list_tail != self.machine_st.heap[h] {
list_tail = self.machine_st.heap[h];
} else {
return Some(AttrListMatch {
match_site: MatchSite::NoMatchVarTail(h),
prev_tail,
});
}
}
(HeapCellValueTag::Lis) => {
attrs_list = list_tail;
break;
}
_ => {
unreachable!()
}
);
}
}
None
}
#[inline(always)]
@@ -7177,4 +7374,3 @@ impl hkdf::KeyType for MyKey<usize> {
self.0
}
}

763
src/machine/unify.rs Normal file
View File

@@ -0,0 +1,763 @@
use crate::arena::*;
use crate::forms::*;
use crate::heap_iter::stackful_preorder_iter;
use crate::machine::*;
use crate::machine::machine_state::*;
use crate::machine::partial_string::*;
use crate::types::*;
use std::cmp::Ordering;
use std::ops::{Deref, DerefMut};
use derive_deref::*;
use fxhash::FxBuildHasher;
use indexmap::IndexSet;
pub(crate) trait Unifier: DerefMut<Target = MachineState> {
fn unify_structure(&mut self, s1: usize, value: HeapCellValue) {
// s1 is the value of a STR cell.
let (n1, a1) = cell_as_atom_cell!(self.heap[s1]).get_name_and_arity();
read_heap_cell!(value,
(HeapCellValueTag::Str, s2) => {
let (n2, a2) = cell_as_atom_cell!(self.heap[s2])
.get_name_and_arity();
if n1 == n2 && a1 == a2 {
for idx in (0..a1).rev() {
self.pdl.push(heap_loc_as_cell!(s2+1+idx));
self.pdl.push(heap_loc_as_cell!(s1+1+idx));
}
} else {
self.fail = true;
}
}
(HeapCellValueTag::Lis, l2) => {
if a1 == 2 && n1 == atom!(".") {
for idx in (0..2).rev() {
self.pdl.push(heap_loc_as_cell!(l2+1+idx));
self.pdl.push(heap_loc_as_cell!(s1+1+idx));
}
} else {
self.fail = true;
}
}
(HeapCellValueTag::Atom, (n2, a2)) => {
self.fail = !(a1 == 0 && a2 == 0 && n1 == n2);
}
(HeapCellValueTag::AttrVar, h) => {
Self::bind(self, Ref::attr_var(h), str_loc_as_cell!(s1));
}
(HeapCellValueTag::Var, h) => {
Self::bind(self, Ref::heap_cell(h), str_loc_as_cell!(s1));
}
(HeapCellValueTag::StackVar, s) => {
Self::bind(self, Ref::stack_cell(s), str_loc_as_cell!(s1));
}
_ => {
self.fail = true;
}
);
}
fn unify_list(&mut self, l1: usize, value: HeapCellValue) {
read_heap_cell!(value,
(HeapCellValueTag::Lis, l2) => {
for idx in (0..2).rev() {
self.pdl.push(heap_loc_as_cell!(l2 + idx));
self.pdl.push(heap_loc_as_cell!(l1 + idx));
}
}
(HeapCellValueTag::Str, s2) => {
let (n2, a2) = cell_as_atom_cell!(self.heap[s2])
.get_name_and_arity();
if a2 == 2 && n2 == atom!(".") {
for idx in (0..2).rev() {
self.pdl.push(heap_loc_as_cell!(s2+1+idx));
self.pdl.push(heap_loc_as_cell!(l1+idx));
}
} else {
self.fail = true;
}
}
(HeapCellValueTag::PStrLoc | HeapCellValueTag::CStr | HeapCellValueTag::PStr) => {
Self::unify_partial_string(self, list_loc_as_cell!(l1), value)
}
(HeapCellValueTag::AttrVar, h) => {
Self::bind(self, Ref::attr_var(h), list_loc_as_cell!(l1));
}
(HeapCellValueTag::Var, h) => {
Self::bind(self, Ref::heap_cell(h), list_loc_as_cell!(l1));
}
(HeapCellValueTag::StackVar, s) => {
Self::bind(self, Ref::stack_cell(s), list_loc_as_cell!(l1));
}
_ => {
self.fail = true;
}
);
}
fn unify_complete_string(&mut self, atom: Atom, value: HeapCellValue) {
if let Some(r) = value.as_var() {
if atom == atom!("") {
Self::bind(self, r, atom_as_cell!(atom!("[]")));
} else {
Self::bind(self, r, atom_as_cstr_cell!(atom));
}
return;
}
read_heap_cell!(value,
(HeapCellValueTag::Atom, (cstr_atom, arity)) if atom == atom!("") => {
debug_assert_eq!(arity, 0);
self.fail = cstr_atom != atom!("[]");
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if arity == 0 {
self.fail = atom == atom!("") && name != atom!("[]");
} else {
// this is intentionally the same policy for
// value.tag() == Lis and PStrLoc. they're not
// grouped together to allow for arity == 0.
Self::unify_partial_string(self, atom_as_cstr_cell!(atom), value);
if !self.pdl.is_empty() {
Self::unify_internal(self);
}
}
}
(HeapCellValueTag::CStr, cstr_atom) => {
self.fail = atom != cstr_atom;
}
(HeapCellValueTag::Lis | HeapCellValueTag::PStrLoc) => {
Self::unify_partial_string(self, atom_as_cstr_cell!(atom), value);
if !self.pdl.is_empty() {
Self::unify_internal(self);
}
}
_ => {
self.fail = true;
}
);
}
// the return value of unify_partial_string is interpreted as
// follows:
//
// Some(None) -- the strings are equal, nothing to unify
// Some(Some(f2,f1)) -- prefixes equal, try to unify focus values f2, f1
// None -- prefixes not equal, unification fails
//
// d1's tag is assumed to be one of LIS, STR or PSTRLOC.
fn unify_partial_string(&mut self, value_1: HeapCellValue, value_2: HeapCellValue) {
if let Some(r) = value_2.as_var() {
Self::bind(self, r, value_1);
return;
}
let machine_st = self.deref_mut();
let s1 = machine_st.heap.len();
machine_st.heap.push(value_1);
machine_st.heap.push(value_2);
let mut pstr_iter1 = HeapPStrIter::new(&machine_st.heap, s1);
let mut pstr_iter2 = HeapPStrIter::new(&machine_st.heap, s1 + 1);
match compare_pstr_prefixes(&mut pstr_iter1, &mut pstr_iter2) {
PStrCmpResult::Ordered(Ordering::Equal) => {}
PStrCmpResult::Ordered(Ordering::Less) => {
if pstr_iter2.focus.as_var().is_none() {
machine_st.fail = true;
} else {
machine_st.pdl.push(empty_list_as_cell!());
machine_st.pdl.push(pstr_iter2.focus);
}
}
PStrCmpResult::Ordered(Ordering::Greater) => {
if pstr_iter1.focus.as_var().is_none() {
machine_st.fail = true;
} else {
machine_st.pdl.push(empty_list_as_cell!());
machine_st.pdl.push(pstr_iter1.focus);
}
}
continuable @ PStrCmpResult::FirstIterContinuable(iteratee) |
continuable @ PStrCmpResult::SecondIterContinuable(iteratee) => {
if continuable.is_second_iter() {
std::mem::swap(&mut pstr_iter1, &mut pstr_iter2);
}
let mut chars_iter = PStrCharsIter {
iter: pstr_iter1,
item: Some(iteratee),
};
let mut focus = pstr_iter2.focus;
'outer: loop {
while let Some(c) = chars_iter.peek() {
read_heap_cell!(focus,
(HeapCellValueTag::Lis, l) => {
let val = pstr_iter2.heap[l];
machine_st.pdl.push(val);
machine_st.pdl.push(char_as_cell!(c));
focus = pstr_iter2.heap[l+1];
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(pstr_iter2.heap[s])
.get_name_and_arity();
if name == atom!(".") && arity == 2 {
machine_st.pdl.push(pstr_iter2.heap[s+1]);
machine_st.pdl.push(char_as_cell!(c));
focus = pstr_iter2.heap[s+2];
} else {
machine_st.fail = true;
break 'outer;
}
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
match chars_iter.item.unwrap() {
PStrIteratee::Char(focus, _) => {
machine_st.pdl.push(machine_st.heap[focus]);
machine_st.pdl.push(heap_loc_as_cell!(h));
}
PStrIteratee::PStrSegment(focus, _, n) => {
read_heap_cell!(machine_st.heap[focus],
(HeapCellValueTag::CStr | HeapCellValueTag::PStr, pstr_atom) => {
if focus < machine_st.heap.len() - 2 {
machine_st.heap.pop();
machine_st.heap.pop();
}
if n == 0 {
let target_cell = match machine_st.heap[focus].get_tag() {
HeapCellValueTag::CStr => {
atom_as_cstr_cell!(pstr_atom)
}
HeapCellValueTag::PStr => {
pstr_loc_as_cell!(focus)
}
_ => {
unreachable!()
}
};
machine_st.pdl.push(target_cell);
machine_st.pdl.push(heap_loc_as_cell!(h));
} else {
let h_len = machine_st.heap.len();
machine_st.heap.push(pstr_offset_as_cell!(focus));
machine_st.heap.push(fixnum_as_cell!(
Fixnum::build_with(n as i64)
));
machine_st.pdl.push(pstr_loc_as_cell!(h_len));
machine_st.pdl.push(heap_loc_as_cell!(h));
}
return;
}
(HeapCellValueTag::PStrOffset, pstr_loc) => {
let n0 = cell_as_fixnum!(machine_st.heap[focus+1])
.get_num() as usize;
if pstr_loc < machine_st.heap.len() - 2 {
machine_st.heap.pop();
machine_st.heap.pop();
}
if n == n0 {
machine_st.pdl.push(pstr_loc_as_cell!(focus));
machine_st.pdl.push(heap_loc_as_cell!(h));
} else {
let h_len = machine_st.heap.len();
machine_st.heap.push(pstr_offset_as_cell!(pstr_loc));
machine_st.heap.push(fixnum_as_cell!(
Fixnum::build_with(n as i64)
));
machine_st.pdl.push(pstr_loc_as_cell!(h_len));
machine_st.pdl.push(heap_loc_as_cell!(h));
}
return;
}
_ => {
}
);
if focus < machine_st.heap.len() - 2 {
machine_st.heap.pop();
machine_st.heap.pop();
}
machine_st.pdl.push(machine_st.heap[focus]);
machine_st.pdl.push(heap_loc_as_cell!(h));
return;
}
}
break 'outer;
}
_ => {
machine_st.fail = true;
break 'outer;
}
);
chars_iter.next();
}
chars_iter.iter.next();
machine_st.pdl.push(focus);
machine_st.pdl.push(chars_iter.iter.focus);
break;
}
}
PStrCmpResult::Unordered => {
machine_st.pdl.push(pstr_iter1.focus);
machine_st.pdl.push(pstr_iter2.focus);
}
}
machine_st.heap.pop();
machine_st.heap.pop();
}
fn unify_atom(&mut self, atom: Atom, value: HeapCellValue) {
read_heap_cell!(value,
(HeapCellValueTag::Atom, (name, arity)) => {
self.fail = !(arity == 0 && name == atom);
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
self.fail = !(arity == 0 && name == atom);
}
(HeapCellValueTag::CStr, cstr_atom) if atom == atom!("[]") => {
self.fail = cstr_atom != atom!("");
}
(HeapCellValueTag::Char, c1) => {
if let Some(c2) = atom.as_char() {
self.fail = c1 != c2;
} else {
self.fail = true;
}
}
(HeapCellValueTag::AttrVar, h) => {
Self::bind(self, Ref::attr_var(h), atom_as_cell!(atom));
}
(HeapCellValueTag::Var, h) => {
Self::bind(self, Ref::heap_cell(h), atom_as_cell!(atom));
}
(HeapCellValueTag::StackVar, s) => {
Self::bind(self, Ref::stack_cell(s), atom_as_cell!(atom));
}
_ => {
self.fail = true;
}
);
}
fn unify_char(&mut self, c: char, value: HeapCellValue) {
read_heap_cell!(value,
(HeapCellValueTag::Atom, (name, arity)) => {
if let Some(c2) = name.as_char() {
self.fail = !(c == c2 && arity == 0);
} else {
self.fail = true;
}
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if let Some(c2) = name.as_char() {
self.fail = !(c == c2 && arity == 0);
} else {
self.fail = true;
}
}
(HeapCellValueTag::Char, c2) => {
if c != c2 {
self.fail = true;
}
}
(HeapCellValueTag::AttrVar, h) => {
Self::bind(self, Ref::attr_var(h), char_as_cell!(c));
}
(HeapCellValueTag::Var, h) => {
Self::bind(self, Ref::heap_cell(h), char_as_cell!(c));
}
(HeapCellValueTag::StackVar, s) => {
Self::bind(self, Ref::stack_cell(s), char_as_cell!(c));
}
_ => {
self.fail = true;
}
);
}
fn unify_fixnum(&mut self, n1: Fixnum, value: HeapCellValue) {
if let Some(r) = value.as_var() {
Self::bind(self, r, fixnum_as_cell!(n1));
return;
}
match Number::try_from(value) {
Ok(n2) => match n2 {
Number::Fixnum(n2) if n1.get_num() == n2.get_num() => {}
Number::Integer(n2) if n1.get_num() == *n2 => {}
Number::Rational(n2) if n1.get_num() == *n2 => {}
_ => {
self.fail = true;
}
},
Err(_) => {
self.fail = true;
}
}
}
fn unify_big_num<N>(&mut self, n1: TypedArenaPtr<N>, value: HeapCellValue)
where N: PartialEq<Rational>
+ PartialEq<Integer>
+ PartialEq<i64>
+ ArenaAllocated
{
if let Some(r) = value.as_var() {
Self::bind(self, r, typed_arena_ptr_as_cell!(n1));
return;
}
match Number::try_from(value) {
Ok(n2) => match n2 {
Number::Fixnum(n2) if *n1 == n2.get_num() => {}
Number::Integer(n2) if *n1 == *n2 => {}
Number::Rational(n2) if *n1 == *n2 => {}
_ => {
self.fail = true;
}
},
Err(_) => {
self.fail = true;
}
}
}
fn unify_f64(&mut self, f1: F64Ptr, value: HeapCellValue) {
if let Some(r) = value.as_var() {
Self::bind(self, r, HeapCellValue::from(f1));
return;
}
read_heap_cell!(value,
(HeapCellValueTag::F64, f2) => {
self.fail = **f1 != **f2;
}
_ => {
self.fail = true;
}
);
}
fn unify_constant(&mut self, ptr: UntypedArenaPtr, value: HeapCellValue) {
if let Some(ptr2) = value.to_untyped_arena_ptr() {
if ptr.get_ptr() == ptr2.get_ptr() {
return;
}
}
match_untyped_arena_ptr!(ptr,
(ArenaHeaderTag::Integer, int_ptr) => {
Self::unify_big_num(self, int_ptr, value);
}
(ArenaHeaderTag::Rational, rat_ptr) => {
Self::unify_big_num(self, rat_ptr, value);
}
_ => {
if let Some(r) = value.as_var() {
Self::bind(self, r, untyped_arena_ptr_as_cell!(ptr));
} else {
self.fail = true;
}
}
);
}
fn unify_internal(&mut self) {
let mut tabu_list = IndexSet::with_hasher(FxBuildHasher::default());
while !(self.pdl.is_empty() || self.fail) {
let s1 = self.pdl.pop().unwrap();
let s1 = (self.deref() as &MachineState).deref(s1);
let s2 = self.pdl.pop().unwrap();
let s2 = (self.deref() as &MachineState).deref(s2);
if s1 != s2 {
let d1 = self.store(s1);
let d2 = self.store(s2);
read_heap_cell!(d1,
(HeapCellValueTag::AttrVar, h) => {
Self::bind(self, Ref::attr_var(h), d2);
}
(HeapCellValueTag::Var, h) => {
Self::bind(self, Ref::heap_cell(h), d2);
}
(HeapCellValueTag::StackVar, s) => {
Self::bind(self, Ref::stack_cell(s), d2);
}
(HeapCellValueTag::Atom, (name, arity)) => {
debug_assert_eq!(arity, 0);
Self::unify_atom(self, name, d2);
}
(HeapCellValueTag::Str, s1) => {
if tabu_list.contains(&(d1, d2)) {
continue;
}
Self::unify_structure(self, s1, d2);
if !self.fail {
let d2 = self.store(d2);
tabu_list.insert((d1, d2));
}
}
(HeapCellValueTag::Lis, l1) => {
if d2.is_ref() {
if tabu_list.contains(&(d1, d2)) {
continue;
}
}
Self::unify_list(self, l1, d2);
if !self.fail {
let d2 = self.store(d2);
tabu_list.insert((d1, d2));
}
}
(HeapCellValueTag::PStrLoc) => {
read_heap_cell!(d2,
(HeapCellValueTag::PStrLoc |
HeapCellValueTag::Lis |
HeapCellValueTag::Str) => {
if tabu_list.contains(&(d1, d2)) {
continue;
}
}
(HeapCellValueTag::CStr |
HeapCellValueTag::AttrVar |
HeapCellValueTag::Var |
HeapCellValueTag::StackVar) => {
}
_ => {
self.fail = true;
break;
}
);
Self::unify_partial_string(self, d1, d2);
if !self.fail && !d2.is_constant() {
let d2 = self.store(d2);
tabu_list.insert((d1, d2));
}
}
(HeapCellValueTag::CStr) => {
read_heap_cell!(d2,
(HeapCellValueTag::AttrVar, h) => {
Self::bind(self, Ref::attr_var(h), d1);
continue;
}
(HeapCellValueTag::Var, h) => {
Self::bind(self, Ref::heap_cell(h), d1);
continue;
}
(HeapCellValueTag::StackVar, s) => {
Self::bind(self, Ref::stack_cell(s), d1);
continue;
}
(HeapCellValueTag::Str |
HeapCellValueTag::Lis |
HeapCellValueTag::PStrLoc) => {
}
(HeapCellValueTag::CStr) => {
self.fail = d1 != d2;
continue;
}
_ => {
self.fail = true;
return;
}
);
Self::unify_partial_string(self, d2, d1);
}
(HeapCellValueTag::F64, f1) => {
Self::unify_f64(self, f1, d2);
}
(HeapCellValueTag::Fixnum, n1) => {
Self::unify_fixnum(self, n1, d2);
}
(HeapCellValueTag::Char, c1) => {
Self::unify_char(self, c1, d2);
}
(HeapCellValueTag::Cons, ptr_1) => {
Self::unify_constant(self, ptr_1, d2);
}
_ => {
unreachable!();
}
);
}
}
}
fn bind(&mut self, r: Ref, value: HeapCellValue);
}
#[inline]
fn bind_with_occurs_check<U: Unifier>(unifier: &mut U, r: Ref, value: HeapCellValue) -> bool {
if let RefTag::StackCell = r.get_tag() {
// local variable optimization -- r cannot occur in the
// heap structure bound to value, so don't bother
// traversing value.
U::bind(unifier, r, value);
return false;
}
let mut occurs_triggered = false;
if !value.is_constant() {
for addr in stackful_preorder_iter(&mut unifier.heap, value) {
let addr = unmark_cell_bits!(addr);
if let Some(inner_r) = addr.as_var() {
if r == inner_r {
occurs_triggered = true;
break;
}
}
}
}
if occurs_triggered {
unifier.fail = true;
} else {
U::bind(unifier, r, value);
}
return occurs_triggered;
}
#[derive(Deref, DerefMut)]
pub(crate) struct DefaultUnifier<'a> {
machine_st: &'a mut MachineState,
}
impl<'a> From<&'a mut MachineState> for DefaultUnifier<'a> {
#[inline(always)]
fn from(machine_st: &'a mut MachineState) -> Self {
Self { machine_st }
}
}
impl<'a> Unifier for DefaultUnifier<'a> {
fn bind(&mut self, r: Ref, value: HeapCellValue) {
self.machine_st.bind(r, value);
}
}
pub(crate) struct CompositeUnifierForOccursCheck<U> {
unifier: U,
}
impl<U: Unifier> Deref for CompositeUnifierForOccursCheck<U> {
type Target = MachineState;
#[inline(always)]
fn deref(&self) -> &Self::Target {
self.unifier.deref()
}
}
impl<U: Unifier> DerefMut for CompositeUnifierForOccursCheck<U> {
#[inline(always)]
fn deref_mut(&mut self) -> &mut Self::Target {
self.unifier.deref_mut()
}
}
impl<U: Unifier> From<U> for CompositeUnifierForOccursCheck<U> {
#[inline(always)]
fn from(unifier: U) -> Self {
Self { unifier }
}
}
impl<U: Unifier> Unifier for CompositeUnifierForOccursCheck<U> {
fn bind(&mut self, r: Ref, value: HeapCellValue) {
bind_with_occurs_check(&mut self.unifier, r, value);
}
}
pub(crate) struct CompositeUnifierForOccursCheckWithError<U: Unifier> {
unifier: U,
}
impl<U: Unifier> Deref for CompositeUnifierForOccursCheckWithError<U> {
type Target = MachineState;
#[inline(always)]
fn deref(&self) -> &Self::Target {
self.unifier.deref()
}
}
impl<U: Unifier> DerefMut for CompositeUnifierForOccursCheckWithError<U> {
#[inline(always)]
fn deref_mut(&mut self) -> &mut Self::Target {
self.unifier.deref_mut()
}
}
impl<U: Unifier> From<U> for CompositeUnifierForOccursCheckWithError<U> {
#[inline(always)]
fn from(unifier: U) -> Self {
Self { unifier }
}
}
impl<U: Unifier> Unifier for CompositeUnifierForOccursCheckWithError<U> {
fn bind(&mut self, r: Ref, value: HeapCellValue) {
if bind_with_occurs_check(&mut self.unifier, r, value) {
let err = self.representation_error(RepFlag::Term);
let stub = functor_stub(atom!("unify_with_occurs_check"), 2);
let err = self.error_form(err, stub);
self.throw_exception(err);
}
}
}

3
src/types.rs
View File

@@ -53,7 +53,6 @@ pub enum HeapCellValueView {
// trail elements.
TrailedHeapVar = 0b011101,
TrailedStackVar = 0b011111,
TrailedAttrVarHeapLink = 0b100001,
TrailedAttrVarListLink = 0b100011,
TrailedAttachedValue = 0b100101,
TrailedBlackboardEntry = 0b100111,
@@ -182,7 +181,6 @@ impl Ref {
#[derive(Debug, Clone, Copy)]
pub enum TrailRef {
Ref(Ref),
AttrVarHeapLink(usize),
AttrVarListLink(usize, usize),
BlackboardEntry(Atom),
BlackboardOffset(Atom, HeapCellValue), // key atom, key value
@@ -194,7 +192,6 @@ pub(crate) enum TrailEntryTag {
TrailedHeapVar = 0b011110,
TrailedStackVar = 0b011111,
TrailedAttrVar = 0b101110,
TrailedAttrVarHeapLink = 0b100010,
TrailedAttrVarListLink = 0b100011,
TrailedAttachedValue = 0b101010,
TrailedBlackboardEntry = 0b100110,