From d51cbd67e0a000928da6dd4af9441e3a09e7a5d0 Mon Sep 17 00:00:00 2001
From: Markus Triska <triska@metalevel.at>
Date: Fri, 25 Apr 2025 22:16:44 +0200
Subject: [PATCH] ENHANCED: partial_string/3 no longer creates atoms

As a consequence, resulting strings are now quickly reclaimed on
backtracking.

This addresses #2912.

Test case:

    :- use_module(library(iso_ext)).
    :- use_module(library(lists)).

    ab(a).
    ab(b).

Sample query:

    ?- length(Ls, 1_000_000),
       maplist(ab, Ls),
       partial_string(Ls, Es0, []),
       Es0 == Ls.
       Ls = "aaaaaaaaaaaaaaaaaaa ...", Es0 = "aaaaaaaaaaaaaaaaaaa ..."
    ;  Ls = "aaaaaaaaaaaaaaaaaaa ...", Es0 = "aaaaaaaaaaaaaaaaaaa ..."
    ;  Ls = "aaaaaaaaaaaaaaaaaaa ...", Es0 = "aaaaaaaaaaaaaaaaaaa ..."
    ;  Ls = "aaaaaaaaaaaaaaaaaaa ...", Es0 = "aaaaaaaaaaaaaaaaaaa ..."
    ;  Ls = "aaaaaaaaaaaaaaaaaaa ...", Es0 = "aaaaaaaaaaaaaaaaaaa ..."
    ;  ... .

running in constant memory.
---
 src/lib/iso_ext.pl          | 13 ++++++-------
 src/machine/system_calls.rs | 38 +++++++++++++++++++------------------
 2 files changed, 26 insertions(+), 25 deletions(-)

diff --git a/src/lib/iso_ext.pl b/src/lib/iso_ext.pl
index 5c779b10..fc36f5dd 100644
--- a/src/lib/iso_ext.pl
+++ b/src/lib/iso_ext.pl
@@ -22,6 +22,7 @@ but they're not part of the ISO Prolog standard at the moment.
 		    copy_term/3]).
 
 :- use_module(library(error), [can_be/2,
+                               must_be/2,
                                domain_error/3,
                                instantiation_error/1,
                                type_error/3]).
@@ -275,17 +276,15 @@ call_with_inference_limit(_, _, R, Bb, B) :-
     ;  nonvar(R)
     ).
 
-%% partial_string(String, L, L0)
+%% partial_string(String, Ls0, Ls)
 %
 % Explicitly construct a partial string "manually". It can be used as an optimized append/3.
 % It's not recommended to use this predicate in application code.
-partial_string(String, L, L0) :-
+partial_string(String, Ls0, Ls) :-
+    must_be(chars, String),
     (  String == [] ->
-       L = L0
-    ;  catch(atom_chars(Atom, String),
-             error(E, _),
-             throw(error(E, partial_string/3))),
-       '$create_partial_string'(Atom, L, L0)
+       Ls0 = Ls
+    ;  '$create_partial_string'(String, Ls0, Ls)
     ).
 
 %% partial_string(+String)
diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index 43bd632a..0570e1e3 100644
--- a/src/machine/system_calls.rs
+++ b/src/machine/system_calls.rs
@@ -2479,30 +2479,32 @@ impl Machine {
 
     #[inline(always)]
     pub(crate) fn create_partial_string(&mut self) {
-        let atom = cell_as_atom!(self.deref_register(1));
+        let a1 = self.deref_register(1);
 
-        if atom == atom!("") {
-            self.machine_st.fail = true;
-            return;
-        }
+        if let Some(str_like) = self.machine_st.value_to_str_like(a1) {
+            let str = match str_like {
+                AtomOrString::String(string) => string,
+                _ => {
+                    unreachable!()
+                }
+            };
 
-        let pstr_loc_cell = step_or_resource_error!(
-            self.machine_st,
-            self.machine_st.heap.allocate_pstr(&*atom.as_str())
-        );
+            let pstr_loc_cell =
+                step_or_resource_error!(self.machine_st, self.machine_st.heap.allocate_pstr(&str));
 
-        let tail_loc = self.machine_st.heap.cell_len();
+            let tail_loc = self.machine_st.heap.cell_len();
 
-        step_or_resource_error!(
-            self.machine_st,
-            self.machine_st.heap.push_cell(heap_loc_as_cell!(tail_loc))
-        );
+            step_or_resource_error!(
+                self.machine_st,
+                self.machine_st.heap.push_cell(heap_loc_as_cell!(tail_loc))
+            );
 
-        unify!(self.machine_st, self.machine_st.registers[2], pstr_loc_cell);
+            unify!(self.machine_st, self.machine_st.registers[2], pstr_loc_cell);
 
-        if !self.machine_st.fail {
-            let tail = self.machine_st.registers[3];
-            unify!(self.machine_st, tail, heap_loc_as_cell!(tail_loc));
+            if !self.machine_st.fail {
+                let tail = self.machine_st.registers[3];
+                unify!(self.machine_st, tail, heap_loc_as_cell!(tail_loc));
+            }
         }
     }
 
-- 
2.54.0