Merge branch 'master' into interrupt_test

build/instructions_template.rs

@@ -599,6 +599,8 @@ enum SystemClauseType {
     HttpOpen,
     #[strum_discriminants(strum(props(Arity = "5", Name = "$http_listen")))]
     HttpListen,
+    #[strum_discriminants(strum(props(Arity = "1", Name = "$http_listen_stop")))]
+    HttpListenStop,
     #[strum_discriminants(strum(props(Arity = "7", Name = "$http_accept")))]
     HttpAccept,
     #[strum_discriminants(strum(props(Arity = "4", Name = "$http_answer")))]

src/heap_iter.rs

@@ -26,7 +26,7 @@ use std::vec::Vec;
 // None's and pairs of variables as the Iterator Item.
 
 pub struct ParallelHeapIter<'a> {
-    stack: Vec<HeapCellValue>,
+    stack: Vec<(HeapCellValue, HeapCellValue)>,
     heap: &'a Heap,
     arena: &'a Arena,
     tabu_list: IndexSet<(usize, usize), FxBuildHasher>,
@@ -35,7 +35,7 @@ pub struct ParallelHeapIter<'a> {
 impl<'a> ParallelHeapIter<'a> {
     pub fn from(machine_st: &'a MachineState, h1: HeapCellValue, h2: HeapCellValue) -> Self {
         Self {
-            stack: vec![h2, h1],
+            stack: vec![(h1, h2)],
             heap: &machine_st.heap,
             arena: &machine_st.arena,
             tabu_list: IndexSet::with_hasher(FxBuildHasher::new()),
@@ -89,10 +89,8 @@ impl Iterator for ParallelHeapIter<'_> {
     fn next(&mut self) -> Option<Self::Item> {
         use crate::offset_table::F64Offset;
 
-        while let Some(s1) = self.stack.pop() {
+        while let Some((s1, s2)) = self.stack.pop() {
             let s1 = heap_bound_deref(self.heap, s1);
-
-            let s2 = self.stack.pop().unwrap();
             let s2 = heap_bound_deref(self.heap, s2);
 
             let v1 = heap_bound_store(self.heap, s1);
@@ -183,11 +181,8 @@ impl Iterator for ParallelHeapIter<'_> {
                                     // correctness) different.
                                     let (c, succ_cell) = self.heap.last_str_char_and_tail(l2);
 
-                                    self.stack.push(succ_cell);
+                                    self.stack.push((heap_loc_as_cell!(l1 + 1), succ_cell));
-                                    self.stack.push(heap_loc_as_cell!(l1 + 1));
+                                    self.stack.push((heap_loc_as_cell!(l1), char_as_cell!(c)));
-
-                                    self.stack.push(char_as_cell!(c));
-                                    self.stack.push(heap_loc_as_cell!(l1));
                                 }
                                 (HeapCellValueTag::Lis, l2) => {
                                     if self.tabu_list.contains(&(l1, l2)) {
@@ -196,11 +191,8 @@ impl Iterator for ParallelHeapIter<'_> {
 
                                     self.tabu_list.insert((l1, l2));
 
-                                    self.stack.push(self.heap[l2 + 1]);
+                                    self.stack.push((self.heap[l1 + 1], self.heap[l2 + 1]));
-                                    self.stack.push(self.heap[l1 + 1]);
+                                    self.stack.push((self.heap[l1], self.heap[l2]));
-
-                                    self.stack.push(self.heap[l2]);
-                                    self.stack.push(self.heap[l1]);
                                 }
                                 (HeapCellValueTag::Str, s2) => {
                                     if self.tabu_list.contains(&(l1, s2)) {
@@ -214,11 +206,8 @@ impl Iterator for ParallelHeapIter<'_> {
 
                                     self.tabu_list.insert((l1, s2));
 
-                                    self.stack.push(self.heap[s2 + 2]);
+                                    self.stack.push((self.heap[l1 + 1], self.heap[s2 + 2]));
-                                    self.stack.push(self.heap[l1 + 1]);
+                                    self.stack.push((self.heap[l1], self.heap[s2 + 1]));
-
-                                    self.stack.push(self.heap[s2 + 1]);
-                                    self.stack.push(self.heap[l1]);
                                 }
                                 _ => {
                                     unreachable!();
@@ -236,8 +225,7 @@ impl Iterator for ParallelHeapIter<'_> {
                                         PStrSegmentCmpResult::Continue(v1, v2) => {
                                             self.tabu_list.insert((l1, l2));
 
-                                            self.stack.push(v1.offset_by(l1));
+                                            self.stack.push((v1.offset_by(l1), v2.offset_by(l2)));
-                                            self.stack.push(v2.offset_by(l2));
                                         }
                                         PStrSegmentCmpResult::Less => {
                                             self.stack.clear();
@@ -258,11 +246,8 @@ impl Iterator for ParallelHeapIter<'_> {
 
                                     let (c, succ_cell) = self.heap.last_str_char_and_tail(l1);
 
-                                    self.stack.push(succ_cell);
+                                    self.stack.push((succ_cell, heap_loc_as_cell!(l2 + 1)));
-                                    self.stack.push(heap_loc_as_cell!(l2 + 1));
+                                    self.stack.push((char_as_cell!(c), heap_loc_as_cell!(l2)));
-
-                                    self.stack.push(char_as_cell!(c));
-                                    self.stack.push(heap_loc_as_cell!(l2));
                                 }
                                 (HeapCellValueTag::Str, s2) => {
                                     if self.tabu_list.contains(&(l1, s2)) {
@@ -278,11 +263,8 @@ impl Iterator for ParallelHeapIter<'_> {
 
                                     let (c, succ_cell) = self.heap.last_str_char_and_tail(l1);
 
-                                    self.stack.push(heap_loc_as_cell!(s2+2));
+                                    self.stack.push((succ_cell, heap_loc_as_cell!(s2+2)));
-                                    self.stack.push(succ_cell);
+                                    self.stack.push((char_as_cell!(c), heap_loc_as_cell!(s2+1)));
-
-                                    self.stack.push(heap_loc_as_cell!(s2+1));
-                                    self.stack.push(char_as_cell!(c));
                                 }
                                 _ => {
                                     unreachable!()
@@ -307,8 +289,7 @@ impl Iterator for ParallelHeapIter<'_> {
                                     self.tabu_list.insert((s1, s2));
 
                                     for idx in (1 .. a1+1).rev() {
-                                        self.stack.push(self.heap[s2+idx]);
+                                        self.stack.push((self.heap[s1+idx], self.heap[s2+idx]));
-                                        self.stack.push(self.heap[s1+idx]);
                                     }
                                 }
                                 (HeapCellValueTag::Lis, l2) => {
@@ -321,11 +302,9 @@ impl Iterator for ParallelHeapIter<'_> {
 
                                     some_or_return!(self.parallel_cmp((a1, n1), (2, atom!(".")), v1, v2));
 
-                                    self.stack.push(self.heap[l2]);
+                                    self.stack.push((self.heap[s1+1], self.heap[l2]));
-                                    self.stack.push(self.heap[s1+1]);
 
-                                    self.stack.push(self.heap[l2+1]);
+                                    self.stack.push((self.heap[s1+2], self.heap[l2+1]));
-                                    self.stack.push(self.heap[s1+2]);
                                 }
                                 (HeapCellValueTag::PStrLoc, l2) => {
                                     if self.tabu_list.contains(&(s1, l2)) {
@@ -341,11 +320,8 @@ impl Iterator for ParallelHeapIter<'_> {
 
                                     let (c, succ_cell) = self.heap.last_str_char_and_tail(l2);
 
-                                    self.stack.push(succ_cell);
+                                    self.stack.push((heap_loc_as_cell!(s1+2), succ_cell));
-                                    self.stack.push(heap_loc_as_cell!(s1+2));
+                                    self.stack.push((heap_loc_as_cell!(s1+1), char_as_cell!(c)));
-
-                                    self.stack.push(char_as_cell!(c));
-                                    self.stack.push(heap_loc_as_cell!(s1+1));
                                 }
                                 _ => {
                                     unreachable!()

src/http.rs

@@ -1,10 +1,12 @@
 use bytes::{buf::Reader, Bytes};
 use std::sync::{Arc, Condvar, Mutex};
+use tokio::sync::Notify;
 
 use warp::http;
 
 pub struct HttpListener {
     pub incoming: std::sync::mpsc::Receiver<HttpRequest>,
+    pub warp_shutdown: Arc<Notify>,
 }
 
 pub struct HttpRequest {

src/instructions.rs

@@ -803,6 +803,7 @@ impl Instruction {
             | &Instruction::CallDeterministicLengthRundown
             | &Instruction::CallHttpOpen
             | &Instruction::CallHttpListen
+            | &Instruction::CallHttpListenStop
             | &Instruction::CallHttpAccept
             | &Instruction::CallHttpAnswer
             | &Instruction::CallLoadForeignLib
@@ -1062,6 +1063,7 @@ impl Instruction {
             | &Instruction::ExecuteDeterministicLengthRundown
             | &Instruction::ExecuteHttpOpen
             | &Instruction::ExecuteHttpListen
+            | &Instruction::ExecuteHttpListenStop
             | &Instruction::ExecuteHttpAccept
             | &Instruction::ExecuteHttpAnswer
             | &Instruction::ExecuteLoadForeignLib

src/lib/http/http_server.pl

@@ -112,12 +112,29 @@ module_qualification(M, H0, H) :-
     H0 =.. [Method, Path, Goal],
     H =.. [Method, Path, M:Goal].
 
+http_listen__(Addr, HttpListener, TLSKey, TLSCert, ContentLengthLimit) :-
+    '$http_listen'(Addr, HttpListener, TLSKey, TLSCert, ContentLengthLimit).
+
+http_listen_stop_(HttpListener) :-
+    '$http_listen_stop'(HttpListener).
+
+http_accept_(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle) :-
+    '$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle).
+
+http_answer_(ResponseHandle, Code, Headers, ResponseStream) :-
+    '$http_answer'(ResponseHandle, Code, Headers, ResponseStream).
+
 http_listen_(Port, Handlers, Options) :-
     parse_options(Options, TLSKey, TLSCert, ContentLengthLimit),
     phrase(format_("0.0.0.0:~d", [Port]), Addr),
-    '$http_listen'(Addr, HttpListener, TLSKey, TLSCert, ContentLengthLimit),!,
+    setup_call_cleanup(
-    format("Listening at ~s\n", [Addr]),
+        (
-    http_loop(HttpListener, Handlers).
+            http_listen__(Addr, HttpListener, TLSKey, TLSCert, ContentLengthLimit),
+            format("Listening at http://~s\n", [Addr])
+        ),
+        http_loop(HttpListener, Handlers),
+        http_listen_stop_(HttpListener)
+    ).
 
 parse_options(Options, TLSKey, TLSCert, ContentLengthLimit) :-
     member_option_default(tls_key, Options, "", TLSKey),
@@ -131,37 +148,56 @@ member_option_default(Key, List, _Default, Value) :-
 member_option_default(Key, List, Default, Default) :-
     X =.. [Key, _],
     \+ member(X, List).
-	
 
 http_loop(HttpListener, Handlers) :-
-    '$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle),
+    time((
-    current_time(Time),
+        http_accept_(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle),
-    phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString),
+        current_time(Time),
-    format("~s ~w ~s\n", [TimeString, RequestMethod, RequestPath]),
+        phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString),
-    maplist(map_header_kv, RequestHeaders, RequestHeadersKV),
+        format("~s ~w ~s", [TimeString, RequestMethod, RequestPath]),
-    phrase(parse_queries(RequestQueries), RequestQuery),
+        maplist(map_header_kv, RequestHeaders, RequestHeadersKV),
-    (
+        phrase(parse_queries(RequestQueries), RequestQuery),
-	match_handler(Handlers, RequestMethod, RequestPath, Handler) ->
+        (
-	(
+            match_handler(Handlers, RequestMethod, RequestPath, Handler) ->
-	    HttpRequest = http_request(RequestHeadersKV, stream(RequestStream), RequestQueries),
+            (
-	    HttpResponse = http_response(_, _, _),
+                HttpRequest = http_request(RequestHeadersKV, stream(RequestStream), RequestQueries),
-	    (call(Handler, HttpRequest, HttpResponse) ->
+                HttpResponse = http_response(_, _, _),
-		 send_response(ResponseHandle, HttpResponse)
+                catch(
-	    ;    (
+                    (call(Handler, HttpRequest, HttpResponse) ->
-		'$http_answer'(ResponseHandle, 500, [], ResponseStream),
+                        send_response(ResponseHandle, HttpResponse)
-		call_cleanup(format(ResponseStream, "Internal Server Error", []), close(ResponseStream)))
+                    ;
-	    )
+                        setup_call_cleanup(
-	)
+                            http_answer_(ResponseHandle, 500, [], ResponseStream),
-    ; (
+                            format(ResponseStream, "Internal Server Error", []),
-	'$http_answer'(ResponseHandle, 404, [], ResponseStream),
+                            close(ResponseStream)
-	call_cleanup(format(ResponseStream, "Not Found", []), close(ResponseStream)))
+                        ),
-    ),
+                        throw(handler_not_available(Handler, RequestMethod, RequestPath, RequestQuery, RequestHeaders))
+                    ),
+                    HandlerError,
+                    (
+                        setup_call_cleanup(
+                            http_answer_(ResponseHandle, 500, [], ResponseStream),
+                            format(ResponseStream, "Internal Server Error", []),
+                            close(ResponseStream)
+                        ),
+                        throw(HandlerError)
+                    )
+                )
+            )
+            ;
+            setup_call_cleanup(
+                http_answer_(ResponseHandle, 404, [], ResponseStream),
+                format(ResponseStream, "Not Found", []),
+                close(ResponseStream)
+            )
+        )
+    )),
     http_loop(HttpListener, Handlers).
 
 send_response(ResponseHandle, http_response(StatusCode0, text(ResponseText), ResponseHeaders0)) :-
     default(StatusCode0, 200, StatusCode),
     maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
-    '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream0),
+    http_answer_(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream0),
     open(stream(ResponseStream0), write, ResponseStream, [type(text)]),
     catch(
 	call_cleanup(format(ResponseStream, "~s", [ResponseText]),close(ResponseStream)),
@@ -172,9 +208,9 @@ send_response(ResponseHandle, http_response(StatusCode0, text(ResponseText), Res
 send_response(ResponseHandle, http_response(StatusCode0, bytes(ResponseBytes), ResponseHeaders0)) :-
     default(StatusCode0, 200, StatusCode),
     maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
-    '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
+    http_answer_(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
     catch(
-        call_cleanup(format(ResponseStream, "~s", [ResponseBytes]),close(ResponseStream)),
+    call_cleanup(format(ResponseStream, "~s", [ResponseBytes]),close(ResponseStream)),
 	error(existence_error(stream, _), _),
 	true
     ).
@@ -182,7 +218,7 @@ send_response(ResponseHandle, http_response(StatusCode0, bytes(ResponseBytes), R
 send_response(ResponseHandle, http_response(StatusCode0, file(Filename), ResponseHeaders0)) :-
     default(StatusCode0, 200, StatusCode),
     maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
-    '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
+    http_answer_(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
     catch(
 	call_cleanup(
 	    setup_call_cleanup(

src/machine/dispatch.rs

@@ -4690,6 +4690,16 @@ impl Machine {
                         try_or_throw!(self.machine_st, self.http_listen(), continue);
                         step_or_fail!(self.machine_st, self.machine_st.p = self.machine_st.cp);
                     }
+                    &Instruction::CallHttpListenStop => {
+                        #[cfg(feature = "http")]
+                        try_or_throw!(self.machine_st, self.http_listen_stop(), continue);
+                        step_or_fail!(self.machine_st, self.machine_st.p += 1);
+                    }
+                    &Instruction::ExecuteHttpListenStop => {
+                        #[cfg(feature = "http")]
+                        try_or_throw!(self.machine_st, self.http_listen_stop(), continue);
+                        step_or_fail!(self.machine_st, self.machine_st.p = self.machine_st.cp);
+                    }
                     &Instruction::CallHttpAccept => {
                         #[cfg(feature = "http")]
                         try_or_throw!(self.machine_st, self.http_accept(), continue);

src/machine/system_calls.rs

@@ -61,6 +61,7 @@ use std::str::FromStr;
 use std::sync::LazyLock;
 #[cfg(feature = "http")]
 use std::sync::{Arc, Condvar, Mutex};
+use tokio::sync::Notify;
 
 use chrono::{offset::Local, DateTime};
 #[cfg(not(target_arch = "wasm32"))]
@@ -4593,6 +4594,9 @@ impl Machine {
 
             let (tx, rx) = std::sync::mpsc::sync_channel(1024);
 
+            // warp shutdown channel
+            let warp_shutdown = Arc::new(Notify::new());
+
             let runtime = tokio::runtime::Handle::current();
             let _guard = runtime.enter();
 
@@ -4654,16 +4658,35 @@ impl Machine {
                     },
                 );
 
+            let warp_shutdown_clone = warp_shutdown.clone();
             runtime.spawn(async move {
                 match ssl_server {
                     Some((key, cert)) => {
-                        warp::serve(serve).tls().key(key).cert(cert).run(addr).await
+                        let (_addr, server) = warp::serve(serve)
+                            .tls()
+                            .key(key)
+                            .cert(cert)
+                            .bind_with_graceful_shutdown(addr, async move {
+                                warp_shutdown_clone.notified().await;
+                            });
+
+                        tokio::task::spawn(server);
+                    }
+                    None => {
+                        let (_addr, server) =
+                            warp::serve(serve).bind_with_graceful_shutdown(addr, async move {
+                                warp_shutdown_clone.notified().await;
+                            });
+
+                        tokio::task::spawn(server);
                     }
-                    None => warp::serve(serve).run(addr).await,
                 }
             });
 
-            let http_listener = HttpListener { incoming: rx };
+            let http_listener = HttpListener {
+                incoming: rx,
+                warp_shutdown: warp_shutdown,
+            };
             let http_listener: TypedArenaPtr<HttpListener> =
                 arena_alloc!(http_listener, &mut self.machine_st.arena);
 
@@ -4676,6 +4699,60 @@ impl Machine {
         Ok(())
     }
 
+    #[cfg(feature = "http")]
+    #[inline(always)]
+    pub(crate) fn http_listen_stop(&mut self) -> CallResult {
+        let culprit = self.deref_register(1);
+
+        read_heap_cell!(culprit,
+            (HeapCellValueTag::Cons, cons_ptr) => {
+                match_untyped_arena_ptr!(cons_ptr,
+                    (ArenaHeaderTag::HttpListener, http_listener) => {
+                        http_listener.warp_shutdown.notify_one();
+                    }
+                    _ => {
+                            unreachable!();
+                        }
+                    );
+            }
+            _ => {
+                unreachable!();
+            }
+        );
+
+        Ok(())
+    }
+
+    #[inline(always)]
+    fn interrupt_occured(&mut self) -> bool {
+        let interrupted = machine::INTERRUPT.load(std::sync::atomic::Ordering::Relaxed);
+
+        match machine::INTERRUPT.compare_exchange(
+            interrupted,
+            false,
+            std::sync::atomic::Ordering::Relaxed,
+            std::sync::atomic::Ordering::Relaxed,
+        ) {
+            Ok(interruption) => {
+                if interruption {
+                    self.machine_st.throw_interrupt_exception();
+                    self.machine_st.backtrack();
+                    // We have extracted control over the Tokio runtime to the calling context for enabling library use case
+                    // (see https://github.com/mthom/scryer-prolog/pull/1880)
+                    // So we only have access to a runtime handle in here and can't shut it down.
+                    // Since I'm not aware of the consequences of deactivating this new code which came in while PR 1880
+                    // was not merged, I'm only deactivating it for now.
+                    //let old_runtime = std::mem::replace(&mut self.runtime, tokio::runtime::Runtime::new().unwrap());
+                    //old_runtime.shutdown_background();
+                    return true;
+                }
+            }
+            Err(_) => unreachable!(),
+        }
+
+        return false;
+    }
+
     #[cfg(feature = "http")]
     #[inline(always)]
     pub(crate) fn http_accept(&mut self) -> CallResult {
@@ -4775,29 +4852,8 @@ impl Machine {
                         break
                     }
                     Err(std::sync::mpsc::RecvTimeoutError::Timeout) => {
-                        let interrupted = machine::INTERRUPT.load(std::sync::atomic::Ordering::Relaxed);
+                        if self.interrupt_occured() {
-
+                            break;
-                        match machine::INTERRUPT.compare_exchange(
-                            interrupted,
-                            false,
-                            std::sync::atomic::Ordering::Relaxed,
-                            std::sync::atomic::Ordering::Relaxed,
-                        ) {
-                            Ok(interruption) => {
-                                if interruption {
-                                    self.machine_st.throw_interrupt_exception();
-                                    self.machine_st.backtrack();
-                                    // We have extracted control over the Tokio runtime to the calling context for enabling library use case
-                                    // (see https://github.com/mthom/scryer-prolog/pull/1880)
-                                    // So we only have access to a runtime handle in here and can't shut it down.
-                                    // Since I'm not aware of the consequences of deactivating this new code which came in while PR 1880
-                                    // was not merged, I'm only deactivating it for now.
-                                    //let old_runtime = std::mem::replace(&mut self.runtime, tokio::runtime::Runtime::new().unwrap());
-                                    //old_runtime.shutdown_background();
-                                    break
-                                }
-                            }
-                            Err(_) => unreachable!(),
                         }
                     }
                   Err(_) => {
@@ -7058,6 +7114,7 @@ impl Machine {
         let (tcp_listener, port): (TypedArenaPtr<TcpListener>, _) =
             match TcpListener::bind(server_addr).map_err(|e| e.kind()) {
                 Ok(tcp_listener) => {
+                    let _ = tcp_listener.set_nonblocking(true);
                     let port = tcp_listener.local_addr().map(|addr| addr.port()).ok();
 
                     if let Some(port) = port {
@@ -7123,12 +7180,14 @@ impl Machine {
 
         let culprit = self.deref_register(1);
 
+        use std::io::ErrorKind;
         read_heap_cell!(culprit,
             (HeapCellValueTag::Cons, cons_ptr) => {
                 match_untyped_arena_ptr!(cons_ptr,
                      (ArenaHeaderTag::TcpListener, tcp_listener) => {
-                         match tcp_listener.accept().ok() {
+                        loop {
-                             Some((tcp_stream, socket_addr)) => {
+                         match tcp_listener.accept() {
+                             Ok((tcp_stream, socket_addr)) => {
                                  let client = AtomTable::build_with(&self.machine_st.atom_tbl, &socket_addr.to_string());
 
                                  let mut tcp_stream = Stream::from_tcp_stream(
@@ -7151,11 +7210,22 @@ impl Machine {
 
                                  self.machine_st.bind(client_addr.as_var().unwrap(), client);
                                  self.machine_st.bind(stream_addr.as_var().unwrap(), tcp_stream.into());
+
+                                 break;
                              }
-                             None => {
+                            Err(ref e) if e.kind() == ErrorKind::WouldBlock => {
-                                 self.machine_st.fail = true;
+                                std::thread::sleep(std::time::Duration::from_millis(200));
-                             }
+                                if self.interrupt_occured() {
+                                    break;
+                                }
+                            }
+                            Err(_) => {
+                                println!("IO error");
+                                self.machine_st.fail = true;
+                                break;
+                            }
                          }
+                        }
                      }
                      _ => {
                      }

src/machine/unify.rs

@@ -15,9 +15,8 @@ impl MachineState {
     pub(crate) fn partial_string_to_pdl(&mut self, pstr_loc: usize, l: usize) {
         let (c, succ_cell) = self.heap.last_str_char_and_tail(pstr_loc);
 
-        self.pdl.push((heap_loc_as_cell!(l + 1), succ_cell));
+        self.pdl.push((succ_cell, heap_loc_as_cell!(l + 1)));
-
+        self.pdl.push((char_as_cell!(c), heap_loc_as_cell!(l)));
-        self.pdl.push((heap_loc_as_cell!(l), char_as_cell!(c)));
     }
 }
 
@@ -33,7 +32,7 @@ pub(crate) trait Unifier: DerefMut<Target = MachineState> {
 
                 if n1 == n2 && a1 == a2 {
                     for idx in (0..a1).rev() {
-                        self.pdl.push((heap_loc_as_cell!(s2+1+idx), heap_loc_as_cell!(s1+1+idx)));
+                        self.pdl.push((heap_loc_as_cell!(s1+1+idx), heap_loc_as_cell!(s2+1+idx)));
                     }
                 } else {
                     self.fail = true;
@@ -42,7 +41,7 @@ pub(crate) trait Unifier: DerefMut<Target = MachineState> {
             (HeapCellValueTag::Lis, l2) => {
                 if a1 == 2 && n1 == atom!(".") {
                     for idx in (0..2).rev() {
-                        self.pdl.push((heap_loc_as_cell!(l2+1+idx), heap_loc_as_cell!(s1+1+idx)));
+                        self.pdl.push((heap_loc_as_cell!(s1+1+idx), heap_loc_as_cell!(l2+1+idx)));
                     }
                 } else {
                     self.fail = true;
@@ -70,7 +69,7 @@ pub(crate) trait Unifier: DerefMut<Target = MachineState> {
         read_heap_cell!(value,
             (HeapCellValueTag::Lis, l2) => {
                 for idx in (0..2).rev() {
-                    self.pdl.push((heap_loc_as_cell!(l2 + idx), heap_loc_as_cell!(l1 + idx)));
+                    self.pdl.push((heap_loc_as_cell!(l1 + idx), heap_loc_as_cell!(l2 + idx)));
                 }
             }
             (HeapCellValueTag::Str, s2) => {
@@ -79,7 +78,7 @@ pub(crate) trait Unifier: DerefMut<Target = MachineState> {
 
                 if a2 == 2 && n2 == atom!(".") {
                     for idx in (0..2).rev() {
-                        self.pdl.push((heap_loc_as_cell!(s2+1+idx), heap_loc_as_cell!(l1+idx)));
+                        self.pdl.push((heap_loc_as_cell!(l1+idx), heap_loc_as_cell!(s2+1+idx)));
                     }
                 } else {
                     self.fail = true;
@@ -128,7 +127,7 @@ pub(crate) trait Unifier: DerefMut<Target = MachineState> {
             (HeapCellValueTag::PStrLoc, other_pstr_loc) => {
                 match machine_st.heap.compare_pstr_segments(pstr_loc, other_pstr_loc) {
                     PStrSegmentCmpResult::Continue(v1, v2) => {
-                        machine_st.pdl.push((v1.offset_by(pstr_loc), v2.offset_by(other_pstr_loc)));
+                        machine_st.pdl.push((v2.offset_by(other_pstr_loc), v1.offset_by(pstr_loc)));
                     }
                     _ => {
                         machine_st.fail = true;

src/macros.rs

@@ -402,21 +402,21 @@ macro_rules! index_store {
 
 macro_rules! unify {
     ($machine_st:expr, $($v1:expr, $v2:expr),*) => {{
-        $($machine_st.pdl.push(($v1, $v2));)*
+        $($machine_st.pdl.push(($v2, $v1));)*
         $machine_st.unify()
     }};
 }
 
 macro_rules! unify_fn {
     ($machine_st:expr, $($v1:expr, $v2: expr),*) => {{
-        $($machine_st.pdl.push(($v1, $v2));)*
+        $($machine_st.pdl.push(($v2, $v1));)*
         $machine_st.occurs_check.unify(&mut $machine_st)
     }};
 }
 
 macro_rules! unify_with_occurs_check {
     ($machine_st:expr, $($v1:expr, $v2:expr),*) => {{
-        $($machine_st.pdl.push(($v1, $v2));)*
+        $($machine_st.pdl.push(($v2, $v1));)*
         $machine_st.unify_with_occurs_check()
     }};
 }

tests-pl/discussion3359.pl

@@ -0,0 +1,11 @@
+:- use_module(library(clpz)).
+:- use_module(library(tabling)).
+
+:- table expr//0.
+
+expr --> "1".
+expr --> expr, "+", expr.
+
+run :- phrase(expr, "1+1+1+1+1").
+
+:- initialization(run).

tests/scryer/issues.rs

@@ -182,4 +182,17 @@ async fn sigint_interrupts_nonterminating_goals() {
         format!("PROLOG={:?}.", env!("CARGO_BIN_EXE_scryer-prolog")),
         "ok\n",
     );
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+#[cfg_attr(
+    all(
+        target_arch = "x86",
+        target_os = "linux",
+        target_vendor = "unknown",
+        target_env = "gnu"
+    ),
+    ignore = "FIXME was already broken before d50d42509903dc3cc1841eb757a703753de84754"
+)]
+fn discussion3359() {
+    load_module_test("tests-pl/discussion3359.pl", "");
 }