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

improve '$skip_max_list'/4 and length/2 (#1023, #110)

Browse Source
This commit is contained in:
Mark Thom
2022-01-29 00:57:39 -07:00
parent b3006f6fd8
commit 0d653a2ce6
9 changed files with 146 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
src/forms.rs
View File

@@ -649,6 +649,14 @@ impl Number {
&Number::Rational(ref r) => &**r == &0,
}
}
#[inline]
pub(crate) fn is_integer(&self) -> bool {
match self {
Number::Fixnum(_) | Number::Integer(_) => true,
_ => false,
}
}
}
#[derive(Debug, Clone)]

18
src/lib/builtins.pl
View File

@@ -329,7 +329,7 @@ comma_dispatch_call_list([G1]) :-
:- non_counted_backtracking univ_errors/3.
univ_errors(Term, List, N) :-
'$skip_max_list'(N, -1, List, R),
'$skip_max_list'(N, _, List, R),
( var(R) ->
( var(Term),
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
@@ -399,7 +399,7 @@ get_args([Arg|Args], Func, I0, N) :-
:- meta_predicate parse_options_list(?, 0, ?, ?, ?).
parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :-
'$skip_max_list'(_, -1, Options, Tail),
'$skip_max_list'(_, _, Options, Tail),
( Tail == [] ->
true
; var(Tail) ->
@@ -452,7 +452,7 @@ parse_write_options_(max_depth(MaxDepth), max_depth-MaxDepth) :-
).
must_be_var_names_list(VarNames) :-
'$skip_max_list'(_, -1, VarNames, Tail),
'$skip_max_list'(_, _, VarNames, Tail),
( Tail == [] ->
must_be_var_names_list_(VarNames, VarNames)
; var(Tail) ->
@@ -549,7 +549,7 @@ can_be_list(List, _) :-
var(List),
!.
can_be_list(List, _) :-
'$skip_max_list'(_, -1, List, Tail),
'$skip_max_list'(_, _, List, Tail),
( var(Tail) ->
true
; Tail == []
@@ -1196,7 +1196,7 @@ atom_length(Atom, Length) :-
).
atom_chars(Atom, List) :-
'$skip_max_list'(_, -1, List, Tail),
'$skip_max_list'(_, _, List, Tail),
( ( Tail == [] ; var(Tail) ) ->
true
; throw(error(type_error(list, List), atom_chars/2))
@@ -1214,7 +1214,7 @@ atom_chars(Atom, List) :-
).
atom_codes(Atom, List) :-
'$skip_max_list'(_, -1, List, Tail),
'$skip_max_list'(_, _, List, Tail),
( ( Tail == [] ; var(Tail) ) ->
true
; throw(error(type_error(list, List), atom_codes/2))
@@ -1271,9 +1271,9 @@ sub_atom(Atom, Before, Length, After, Sub_atom) :-
; atom_chars(Atom, AtomChars),
lists:append(BeforeChars, LengthAndAfterChars, AtomChars),
lists:append(LengthChars, AfterChars, LengthAndAfterChars),
'$skip_max_list'(Before, -1, BeforeChars, []),
'$skip_max_list'(Length, -1, LengthChars, []),
'$skip_max_list'(After, -1, AfterChars, []),
'$skip_max_list'(Before, _, BeforeChars, []),
'$skip_max_list'(Length, _, LengthChars, []),
'$skip_max_list'(After, _, AfterChars, []),
atom_chars(Sub_atom, LengthChars)
).

2
src/lib/charsio.pl
View File

@@ -118,7 +118,7 @@ read_from_chars(Chars, Term) :-
instantiation_error(read_from_chars/2)
; nonvar(Term) ->
throw(error(uninstantiation_error(Term), read_from_chars/2))
; '$skip_max_list'(_, -1, Chars, Chars0),
; '$skip_max_list'(_, _, Chars, Chars0),
Chars0 == [],
partial_string(Chars) ->
true

4
src/lib/error.pl
View File

@@ -80,7 +80,7 @@ character(C) :-
atom_length(C, 1).
ilist(Ls) :-
'$skip_max_list'(_, -1, Ls, Rs),
'$skip_max_list'(_, _, Ls, Rs),
( var(Rs) ->
instantiation_error(must_be/2)
; Rs == []
@@ -124,7 +124,7 @@ can_(list, Term) :- list_or_partial_list(Term).
can_(boolean, Term) :- boolean(Term).
list_or_partial_list(Ls) :-
'$skip_max_list'(_, -1, Ls, Rs),
'$skip_max_list'(_, _, Ls, Rs),
( var(Rs) -> true
; Rs == []
).

35
src/lib/lists.pl
View File

@@ -50,27 +50,20 @@
:- meta_predicate foldl(3, ?, ?, ?).
:- meta_predicate foldl(4, ?, ?, ?, ?).
length(Xs, N) :-
var(N),
!,
'$skip_max_list'(M, -1, Xs, Xs0),
( Xs0 == [] -> N = M
; var(Xs0) -> length_addendum(Xs0, N, M)
).
length(Xs, N) :-
integer(N),
N >= 0,
!,
'$skip_max_list'(M, N, Xs, Xs0),
( Xs0 == [] -> N = M
; var(Xs0) -> R is N-M, length_rundown(Xs0, R)
).
length(Xs0, N) :-
'$skip_max_list'(M, N, Xs0,Xs),
!,
( Xs == [] -> N = M
; nonvar(Xs) -> var(N), throw(error(resource_error(finite_memory),_))
; nonvar(N) -> R is N-M, length_rundown(Xs, R)
; N == Xs -> throw(error(resource_error(finite_memory),_))
; length_addendum(Xs, N, M)
).
length(_, N) :-
integer(N), !,
domain_error(not_less_than_zero, N, length/2).
integer(N), !,
domain_error(not_less_than_zero, N, length/2).
length(_, N) :-
type_error(integer, N, length/2).
type_error(integer, N, length/2).
length_addendum([], N, N).
length_addendum([_|Xs], N, M) :-
@@ -288,8 +281,8 @@ list_min_(N, Min0, Min) :-
% or partial list.
permutation(Xs, Ys) :-
'$skip_max_list'(Xlen, -1, Xs, XTail),
'$skip_max_list'(Ylen, -1, Ys, YTail),
'$skip_max_list'(Xlen, _, Xs, XTail),
'$skip_max_list'(Ylen, _, Ys, YTail),
( XTail == [], YTail == [] % both proper lists
-> Xlen == Ylen
; var(XTail), YTail == [] % partial, proper

2
src/lib/ordsets.pl
View File

@@ -89,7 +89,7 @@ because the order it relies on may have been changed.
% setof/3.
is_ordset(Term) :-
'$skip_max_list'(_, -1, Term, Tail), Tail == [], %% is_list(Term),
'$skip_max_list'(_, _, Term, Tail), Tail == [], %% is_list(Term),
is_ordset2(Term).
is_ordset2([]).

3
src/machine/machine_errors.rs
View File

@@ -768,12 +768,13 @@ impl EvalError {
// used by '$skip_max_list'.
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
pub enum CycleSearchResult {
Cyclic(usize),
EmptyList,
NotList,
PartialList(usize, Ref), // the list length (up to max), and an offset into the heap.
ProperList(usize), // the list length.
PStrLocation(usize, usize), // list length (up to max), the heap address of the PStrOffset
UntouchedList(usize), // the address of an uniterated Addr::Lis(address).
UntouchedList(usize, usize), // list length (up to max), the address of an uniterated Addr::Lis(address).
UntouchedCStr(Atom, usize),
}

5
src/machine/partial_string.rs
View File

@@ -371,7 +371,10 @@ impl<'a> HeapPStrIter<'a> {
match self.brent_st.step(next_hare) {
Some(cycle_result) => {
debug_assert!(cycle_result == CycleSearchResult::NotList);
debug_assert!(match cycle_result {
CycleSearchResult::Cyclic(_) => true,
_ => false,
});
self.walk_hare_to_cycle_end();
self.stepper = HeapPStrIter::post_cycle_discovery_stepper;

190
src/machine/system_calls.rs
View File

@@ -133,7 +133,7 @@ impl BrentAlgState {
self.lam += 1;
if self.tortoise == self.hare {
return Some(CycleSearchResult::NotList);
return Some(CycleSearchResult::Cyclic(self.lam));
} else {
self.teleport_tortoise();
}
@@ -158,19 +158,22 @@ impl BrentAlgState {
let pstr = cell_as_string!(heap[self.hare]);
self.pstr_chars += pstr.as_str_from(n).chars().count();
CycleSearchResult::PStrLocation(self.num_steps(), n)
return CycleSearchResult::PStrLocation(self.num_steps(), n);
}
(HeapCellValueTag::Atom, (name, arity)) => {
if name == atom!("[]") && arity == 0 {
return if name == atom!("[]") && arity == 0 {
CycleSearchResult::ProperList(self.num_steps())
} else {
CycleSearchResult::NotList
}
};
}
(HeapCellValueTag::Lis, l) => {
return CycleSearchResult::UntouchedList(self.num_steps(), l);
}
_ => {
CycleSearchResult::NotList
return CycleSearchResult::NotList;
}
)
);
}
fn add_pstr_chars_and_step(&mut self, heap: &[HeapCellValue], h: usize) -> Option<CycleSearchResult> {
@@ -218,15 +221,9 @@ impl MachineState {
(HeapCellValueTag::PStrLoc, h) => {
return brent_st.add_pstr_chars_and_step(&self.heap, h);
}
(HeapCellValueTag::PStrOffset) => {
(HeapCellValueTag::CStr | HeapCellValueTag::PStrOffset) => {
return brent_st.add_pstr_chars_and_step(&self.heap, brent_st.hare);
}
(HeapCellValueTag::CStr, cstr_atom) => {
let cstr = PartialString::from(cstr_atom);
brent_st.pstr_chars += cstr.as_str_from(0).chars().count();
return Some(CycleSearchResult::ProperList(brent_st.num_steps()));
}
(HeapCellValueTag::Lis, h) => {
return brent_st.step(h+1);
}
@@ -264,9 +261,7 @@ impl MachineState {
}
pub fn detect_cycles(&self, value: HeapCellValue) -> CycleSearchResult {
let deref_v = self.deref(value);
let store_v = self.store(deref_v);
let store_v = self.store(self.deref(value));
let mut pstr_chars = 0;
let hare = read_heap_cell!(store_v,
@@ -310,11 +305,14 @@ impl MachineState {
}
}
(HeapCellValueTag::Atom, (name, arity)) => {
if name == atom!("[]") && arity == 0 {
return CycleSearchResult::EmptyList;
return if name == atom!("[]") && arity == 0 {
CycleSearchResult::EmptyList
} else {
return CycleSearchResult::NotList;
}
CycleSearchResult::NotList
};
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::StackVar | HeapCellValueTag::Var) => {
return CycleSearchResult::PartialList(0, store_v.as_var().unwrap());
}
_ => {
return CycleSearchResult::NotList;
@@ -334,9 +332,7 @@ impl MachineState {
}
pub fn detect_cycles_with_max(&self, max_steps: usize, value: HeapCellValue) -> CycleSearchResult {
let deref_v = self.deref(value);
let store_v = self.store(deref_v);
let store_v = self.store(self.deref(value));
let mut pstr_chars = 0;
let hare = read_heap_cell!(store_v,
@@ -344,7 +340,7 @@ impl MachineState {
if max_steps > 0 {
offset+1
} else {
return CycleSearchResult::UntouchedList(offset);
return CycleSearchResult::UntouchedList(0, offset);
}
}
(HeapCellValueTag::PStrLoc, h) => {
@@ -398,7 +394,7 @@ impl MachineState {
if max_steps > 0 {
s + 2
} else {
return CycleSearchResult::UntouchedList(s + 1);
return CycleSearchResult::UntouchedList(0, s + 1);
}
} else {
return CycleSearchResult::NotList;
@@ -411,6 +407,9 @@ impl MachineState {
CycleSearchResult::NotList
};
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::StackVar | HeapCellValueTag::Var) => {
return CycleSearchResult::PartialList(0, store_v.as_var().unwrap());
}
_ => {
return CycleSearchResult::NotList;
}
@@ -422,7 +421,7 @@ impl MachineState {
brent_st.pstr_chars = pstr_chars;
loop {
if brent_st.num_steps() == max_steps {
if brent_st.num_steps() >= max_steps {
return brent_st.to_result(&self.heap);
}
@@ -432,9 +431,48 @@ impl MachineState {
}
}
fn finalize_skip_max_list(&mut self, n: usize, value: HeapCellValue) {
let target_n = self.registers[1];
self.unify_fixnum(Fixnum::build_with(n as i64), target_n);
fn skip_max_list_cycle(&mut self, lam: usize) {
fn step(heap: &Heap, mut value: HeapCellValue) -> usize {
loop {
read_heap_cell!(value,
(HeapCellValueTag::PStrLoc, h) => {
let (h_offset, _) = pstr_loc_and_offset(&heap, h);
return h_offset+1;
}
(HeapCellValueTag::Lis, h) => {
return h+1;
}
(HeapCellValueTag::Str, s) => {
return s+2;
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
value = heap[h];
}
_ => {
unreachable!();
}
);
}
}
let mut hare = step(&self.heap, self.registers[3]);
let mut tortoise = hare;
for _ in 0 .. lam {
hare = step(&self.heap, self.heap[hare]);
}
while hare != tortoise {
hare = step(&self.heap, self.heap[hare]);
tortoise = step(&self.heap, self.heap[tortoise]);
}
unify!(self, self.registers[4], self.heap[hare]);
}
fn finalize_skip_max_list(&mut self, n: i64, value: HeapCellValue) {
let target_n = self.store(self.deref(self.registers[1]));
self.unify_fixnum(Fixnum::build_with(n), target_n);
if !self.fail {
let xs = self.registers[4];
@@ -442,94 +480,76 @@ impl MachineState {
}
}
fn skip_max_list_result(&mut self, max_steps: Option<i64>) {
let search_result = if let Some(max_steps) = max_steps {
if max_steps == -1 {
self.detect_cycles(self.registers[3])
} else {
self.detect_cycles_with_max(max_steps as usize, self.registers[3])
}
} else {
fn skip_max_list_result(&mut self, max_steps: i64) {
let search_result = if max_steps == -1 {
self.detect_cycles(self.registers[3])
} else {
self.detect_cycles_with_max(max_steps as usize, self.registers[3])
};
match search_result {
CycleSearchResult::PStrLocation(steps, pstr_loc) => {
self.finalize_skip_max_list(steps, heap_loc_as_cell!(pstr_loc));
self.finalize_skip_max_list(steps as i64, pstr_loc_as_cell!(pstr_loc));
}
CycleSearchResult::UntouchedList(l) => {
self.finalize_skip_max_list(0, list_loc_as_cell!(l));
CycleSearchResult::UntouchedList(n, l) => {
self.finalize_skip_max_list(n as i64, list_loc_as_cell!(l));
}
CycleSearchResult::UntouchedCStr(cstr_atom, n) => {
self.finalize_skip_max_list(n, string_as_cstr_cell!(cstr_atom));
self.finalize_skip_max_list(n as i64, string_as_cstr_cell!(cstr_atom));
}
CycleSearchResult::EmptyList => {
self.finalize_skip_max_list(0, empty_list_as_cell!());
}
CycleSearchResult::PartialList(n, r) => {
self.finalize_skip_max_list(n, r.as_heap_cell_value());
self.finalize_skip_max_list(n as i64, r.as_heap_cell_value());
}
CycleSearchResult::ProperList(steps) => {
self.finalize_skip_max_list(steps, empty_list_as_cell!())
self.finalize_skip_max_list(steps as i64, empty_list_as_cell!())
}
CycleSearchResult::NotList => {
let xs0 = self.registers[3];
self.finalize_skip_max_list(0, xs0);
let n = self.store(self.deref(self.registers[2]));
self.unify_fixnum(Fixnum::build_with(max_steps), n);
self.finalize_skip_max_list(max_steps, self.registers[3]);
}
CycleSearchResult::Cyclic(lam) => {
self.skip_max_list_cycle(lam);
}
};
}
pub fn skip_max_list(&mut self) -> CallResult {
let max_steps = self.store(self.deref(self.registers[2]));
let mut max_old = -1i64;
if max_steps.is_var() {
let stub = functor_stub(atom!("$skip_max_list"), 4);
let err = self.instantiation_error();
if !max_steps.is_var() {
let max_steps = Number::try_from(max_steps);
return Err(self.error_form(err, stub));
}
let max_steps_n = match max_steps {
Ok(Number::Fixnum(n)) => Some(n.get_num()),
Ok(Number::Integer(n)) => n.to_i64(),
_ => None,
};
let max_steps_n = match Number::try_from(max_steps) {
Ok(Number::Fixnum(n)) => Some(n.get_num()),
Ok(Number::Integer(n)) => n.to_i64(),
_ => None,
};
if max_steps_n.map(|i| i >= -1).unwrap_or(false) {
let n = self.store(self.deref(self.registers[1]));
match Number::try_from(n) {
Ok(Number::Integer(n)) => {
if &*n == &0 {
let xs0 = self.registers[3];
let xs = self.registers[4];
unify!(self, xs0, xs);
if let Some(max_steps) = max_steps_n {
if max_steps.abs() as usize <= 1 << 63 {
if max_steps >= 0 {
max_old = max_steps;
} else {
self.skip_max_list_result(max_steps_n);
self.fail = true;
return Ok(());
}
} else if max_steps < 0 {
self.fail = true;
return Ok(());
}
Ok(Number::Fixnum(n)) => {
if n.get_num() == 0 {
let xs0 = self.registers[3];
let xs = self.registers[4];
unify!(self, xs0, xs);
} else {
self.skip_max_list_result(max_steps_n);
}
}
_ => {
self.skip_max_list_result(max_steps_n);
}
} else if !max_steps.map(|n| n.is_integer()).unwrap_or(false) {
self.fail = true;
return Ok(());
}
} else {
let stub = functor_stub(atom!("$skip_max_list"), 4);
let err = self.type_error(ValidType::Integer, max_steps);
return Err(self.error_form(err, stub));
}
self.skip_max_list_result(max_old);
Ok(())
}