improve length/2 (#1325)

diff --git a/build/instructions_template.rs b/build/instructions_template.rs
index 774bf40dec508ee42bd6c3f163bc80abc27e64ea..7924faa214834b431870761a1c226ddddcabcc74 100644 (file)
--- 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 964280d7eb9e7b6194f4917e6a6c0678a53779c5..52f862bb12c691f79f31e7b2ede3d7ac747982bb 100644 (file)
--- 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 53c5d9439d81bcba094de1ecde972e6c984e9c52..aaa22f1839604bb3aa1131a5b0de8c2218b85371 100644 (file)
--- 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 6203a9485772149b73c33fa25435d4a2efb779b3..3b2ee726a6563473c4b178a93985514a0736d5f6 100644 (file)
--- 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<T: TypeError>(
         &mut self,
         valid_type: ValidType,

diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index 07647ce22782d21d02a0f01a6a8a32f85a2ff991..62a52fac203791b709a0627e0ef2b37d5b6d0ec9 100644 (file)
--- 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());