From 895b02b64196cf899400401fe0d365e932270cca Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Tue, 15 Mar 2022 18:43:57 -0600 Subject: [PATCH] improve length/2 (#1325) --- build/instructions_template.rs | 4 ++++ src/lib/lists.pl | 34 +++++++++++++++++++++++++++------- src/machine/dispatch.rs | 8 ++++++++ src/machine/machine_errors.rs | 13 +++++++++++++ src/machine/system_calls.rs | 32 ++++++++++++++++++++++++++++++++ 5 files changed, 84 insertions(+), 7 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 774bf40d..7924faa2 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -538,6 +538,8 @@ enum SystemClauseType { PopCount, #[strum_discriminants(strum(props(Arity = "1", Name = "$cpu_now")))] CpuNow, + #[strum_discriminants(strum(props(Arity = "2", Name = "$det_length_rundown")))] + DeterministicLengthRundown, REPL(REPLCodePtr), } @@ -1658,6 +1660,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallInstallNewBlock(_) | &Instruction::CallMaybe(_) | &Instruction::CallCpuNow(_) | + &Instruction::CallDeterministicLengthRundown(_) | &Instruction::CallCurrentTime(_) | &Instruction::CallQuotedToken(_) | &Instruction::CallReadTermFromChars(_) | @@ -1860,6 +1863,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteInstallNewBlock(_) | &Instruction::ExecuteMaybe(_) | &Instruction::ExecuteCpuNow(_) | + &Instruction::ExecuteDeterministicLengthRundown(_) | &Instruction::ExecuteCurrentTime(_) | &Instruction::ExecuteQuotedToken(_) | &Instruction::ExecuteReadTermFromChars(_) | diff --git a/src/lib/lists.pl b/src/lib/lists.pl index 964280d7..52f862bb 100644 --- a/src/lib/lists.pl +++ b/src/lib/lists.pl @@ -50,13 +50,20 @@ :- meta_predicate foldl(3, ?, ?, ?). :- meta_predicate foldl(4, ?, ?, ?, ?). +:- use_module(library(error)). + +:- meta_predicate(resource_error(+,:)). + +resource_error(Resource, Context) :- + throw(error(resource_error(Resource), Context)). + length(Xs0, N) :- '$skip_max_list'(M, N, Xs0,Xs), !, ( Xs == [] -> N = M - ; nonvar(Xs) -> var(N), Xs = [_|_], throw(error(resource_error(finite_memory),length/2)) + ; nonvar(Xs) -> var(N), Xs = [_|_], resource_error(finite_memory,length/2) ; nonvar(N) -> R is N-M, length_rundown(Xs, R) - ; N == Xs -> throw(error(resource_error(finite_memory),length/2)) + ; N == Xs -> failingvarskip(Xs), resource_error(finite_memory,length/2) ; length_addendum(Xs, N, M) ). length(_, N) :- @@ -65,16 +72,29 @@ length(_, N) :- length(_, N) :- type_error(integer, N, length/2). +length_rundown(Xs, 0) :- !, Xs = []. +length_rundown(Vs, N) :- + \+ \+ '$project_atts':copy_term(Vs,Vs,[]), % unconstrained + !, + '$det_length_rundown'(Vs, N). +length_rundown([_|Xs], N) :- % force unification + N1 is N-1, + length(Xs, N1). % maybe some new info on Xs + +failingvarskip(Xs) :- + \+ \+ '$project_atts':copy_term(Xs,Xs,[]), % unconstrained + !. +failingvarskip([_|Xs0]) :- % force unification + '$skip_max_list'(_, _, Xs0,Xs), + ( nonvar(Xs) -> Xs = [_|_] + ; failingvarskip(Xs) + ). + length_addendum([], N, N). length_addendum([_|Xs], N, M) :- M1 is M + 1, length_addendum(Xs, N, M1). -length_rundown(Xs, 0) :- !, Xs = []. -length_rundown([_|Xs], N) :- - N1 is N-1, - length_rundown(Xs, N1). - member(X, [X|_]). member(X, [_|Xs]) :- member(X, Xs). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 53c5d943..aaa22f18 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4119,6 +4119,14 @@ impl Machine { self.cpu_now(); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallDeterministicLengthRundown(_) => { + try_or_throw!(self.machine_st, self.det_length_rundown()); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteDeterministicLengthRundown(_) => { + try_or_throw!(self.machine_st, self.det_length_rundown()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallCurrentTime(_) => { self.current_time(); step_or_fail!(self, self.machine_st.p += 1); diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index 6203a948..3b2ee726 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -257,6 +257,19 @@ impl MachineState { } } + pub(super) fn resource_error(&mut self, value: HeapCellValue) -> MachineError { + let stub = functor!( + atom!("resource_error"), + [atom(atom!("finite_memory")), cell(value)] + ); + + MachineError { + stub, + location: None, + from: ErrorProvenance::Received, + } + } + pub(super) fn type_error( &mut self, valid_type: ValidType, diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 07647ce2..62a52fac 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -3231,6 +3231,38 @@ impl Machine { self.machine_st.unify_f64(secs, self.machine_st.registers[1]); } + #[inline(always)] + pub(crate) fn det_length_rundown(&mut self) -> CallResult { + let stub_gen = || functor_stub(atom!("length"), 2); + let len = self.machine_st.store(self.machine_st.deref(self.machine_st.registers[2])); + + let n = match Number::try_from(len) { + Ok(Number::Fixnum(n)) => n.get_num() as usize, + Ok(Number::Integer(n)) => match n.to_usize() { + Some(n) => n, + None => { + let err = self.machine_st.resource_error(len); + return Err(self.machine_st.error_form(err, stub_gen())); + } + } + _ => { + unreachable!() + } + }; + + let h = self.machine_st.heap.len(); + + iter_to_heap_list( + &mut self.machine_st.heap, + (0 .. n).map(|i| heap_loc_as_cell!(h + 2 * i + 1)), + ); + + let tail = self.machine_st.store(self.machine_st.deref(self.machine_st.registers[1])); + self.machine_st.bind(tail.as_var().unwrap(), heap_loc_as_cell!(h)); + + Ok(()) + } + #[inline(always)] pub(crate) fn current_time(&mut self) { let timestamp = self.systemtime_to_timestamp(SystemTime::now()); -- 2.54.0