From: Mark Thom Date: Sat, 29 Jan 2022 07:57:39 +0000 (-0700) Subject: improve '$skip_max_list'/4 and length/2 (#1023, #110) X-Git-Tag: v0.9.0^2~37^2~1 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=0d653a2ce6e7afe3f4cca38b6205ebb636c721fc;p=scryer-prolog.git improve '$skip_max_list'/4 and length/2 (#1023, #110) --- diff --git a/src/forms.rs b/src/forms.rs index 3ccb7575..db9b36dc 100644 --- a/src/forms.rs +++ b/src/forms.rs @@ -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)] diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 6a70423e..94ff77d0 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -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) ). diff --git a/src/lib/charsio.pl b/src/lib/charsio.pl index 3ef732db..33e6e422 100644 --- a/src/lib/charsio.pl +++ b/src/lib/charsio.pl @@ -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 diff --git a/src/lib/error.pl b/src/lib/error.pl index d5827495..c5af6d7c 100644 --- a/src/lib/error.pl +++ b/src/lib/error.pl @@ -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 == [] ). diff --git a/src/lib/lists.pl b/src/lib/lists.pl index 752e8271..f5a62edb 100644 --- a/src/lib/lists.pl +++ b/src/lib/lists.pl @@ -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 diff --git a/src/lib/ordsets.pl b/src/lib/ordsets.pl index ff080962..b5886d38 100644 --- a/src/lib/ordsets.pl +++ b/src/lib/ordsets.pl @@ -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([]). diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index d2f589df..cd6cb982 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -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), } diff --git a/src/machine/partial_string.rs b/src/machine/partial_string.rs index 42184297..cb26ab1e 100644 --- a/src/machine/partial_string.rs +++ b/src/machine/partial_string.rs @@ -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; diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index f6ec376d..a9f1b91f 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -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 { @@ -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) { - 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(); - - return Err(self.error_form(err, stub)); - } - - 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.is_var() { + let max_steps = Number::try_from(max_steps); - 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); - } else { - self.skip_max_list_result(max_steps_n); - } - } - Ok(Number::Fixnum(n)) => { - if n.get_num() == 0 { - let xs0 = self.registers[3]; - let xs = self.registers[4]; + let max_steps_n = match max_steps { + Ok(Number::Fixnum(n)) => Some(n.get_num()), + Ok(Number::Integer(n)) => n.to_i64(), + _ => None, + }; - 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(()); } - _ => { - 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(()) }