Skip to content

Commit

Permalink
improve length/2 (#1325)
Browse files Browse the repository at this point in the history
  • Loading branch information
mthom committed Mar 16, 2022
1 parent d06b5f7 commit 895b02b
Show file tree
Hide file tree
Showing 5 changed files with 84 additions and 7 deletions.
4 changes: 4 additions & 0 deletions build/instructions_template.rs
Original file line number Diff line number Diff line change
Expand Up @@ -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),
}

Expand Down Expand Up @@ -1658,6 +1660,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallInstallNewBlock(_) |
&Instruction::CallMaybe(_) |
&Instruction::CallCpuNow(_) |
&Instruction::CallDeterministicLengthRundown(_) |
&Instruction::CallCurrentTime(_) |
&Instruction::CallQuotedToken(_) |
&Instruction::CallReadTermFromChars(_) |
Expand Down Expand Up @@ -1860,6 +1863,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteInstallNewBlock(_) |
&Instruction::ExecuteMaybe(_) |
&Instruction::ExecuteCpuNow(_) |
&Instruction::ExecuteDeterministicLengthRundown(_) |
&Instruction::ExecuteCurrentTime(_) |
&Instruction::ExecuteQuotedToken(_) |
&Instruction::ExecuteReadTermFromChars(_) |
Expand Down
34 changes: 27 additions & 7 deletions src/lib/lists.pl
Original file line number Diff line number Diff line change
Expand Up @@ -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) :-
Expand All @@ -65,16 +72,29 @@
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).
Expand Down
8 changes: 8 additions & 0 deletions src/machine/dispatch.rs
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
13 changes: 13 additions & 0 deletions src/machine/machine_errors.rs
Original file line number Diff line number Diff line change
Expand Up @@ -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<T: TypeError>(
&mut self,
valid_type: ValidType,
Expand Down
32 changes: 32 additions & 0 deletions src/machine/system_calls.rs
Original file line number Diff line number Diff line change
Expand Up @@ -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());
Expand Down

0 comments on commit 895b02b

Please sign in to comment.