From ae0baf489354cd01cb54d855ccab1921d3a0dd38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 19 Jul 2025 20:50:53 +0200 Subject: [PATCH 01/36] [WIP] add support to spawn new processes --- .github/workflows/ci.yml | 2 +- Cargo.toml | 2 +- build/instructions_template.rs | 4 + src/arena.rs | 10 ++ src/lib/error.pl | 14 ++- src/lib/process.pl | 52 ++++++++++ src/machine/dispatch.rs | 8 ++ src/machine/streams.rs | 81 ++++++++++++++-- src/machine/system_calls.rs | 168 +++++++++++++++++++++++++++++++++ 9 files changed, 326 insertions(+), 15 deletions(-) create mode 100644 src/lib/process.pl diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 47f5050d..0b3071ad 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -48,7 +48,7 @@ jobs: # FIXME(issue #2138): run wasm tests, failing to run since https://github.com/mthom/scryer-prolog/pull/2137 removed wasm-pack - { os: ubuntu-22.04, rust-version: nightly, target: 'wasm32-unknown-unknown', publish: true, args: '--no-default-features' , test-args: '--no-run --no-default-features', use_swap: true } # Cargo.toml rust-version - - { os: ubuntu-22.04, rust-version: "1.85", target: 'x86_64-unknown-linux-gnu'} + - { os: ubuntu-22.04, rust-version: "1.87", target: 'x86_64-unknown-linux-gnu'} - { os: ubuntu-22.04, rust-version: beta, target: 'x86_64-unknown-linux-gnu'} - { os: ubuntu-22.04, rust-version: nightly, target: 'x86_64-unknown-linux-gnu', miri: true, components: "miri"} defaults: diff --git a/Cargo.toml b/Cargo.toml index 3087a3a2..67f65bc9 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -11,7 +11,7 @@ keywords = ["prolog", "prolog-interpreter", "prolog-system"] categories = ["command-line-utilities"] build = "build/main.rs" # Remember to check CI -rust-version = "1.85" +rust-version = "1.87" [lib] crate-type = ["cdylib", "rlib"] diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 31c329b9..6ea7a5a5 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -537,6 +537,8 @@ enum SystemClauseType { UnsetEnv, #[strum_discriminants(strum(props(Arity = "2", Name = "$shell")))] Shell, + #[strum_discriminants(strum(props(Arity = "8", Name = "$process_create")))] + ProcessCreate, #[strum_discriminants(strum(props(Arity = "1", Name = "$pid")))] Pid, #[strum_discriminants(strum(props(Arity = "4", Name = "$chars_base64")))] @@ -1825,6 +1827,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallSetEnv | &Instruction::CallUnsetEnv | &Instruction::CallShell | + &Instruction::CallProcessCreate | &Instruction::CallPid | &Instruction::CallCharsBase64 | &Instruction::CallDevourWhitespace | @@ -2063,6 +2066,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteSetEnv | &Instruction::ExecuteUnsetEnv | &Instruction::ExecuteShell | + &Instruction::ExecuteProcessCreate | &Instruction::ExecutePid | &Instruction::ExecuteCharsBase64 | &Instruction::ExecuteDevourWhitespace | diff --git a/src/arena.rs b/src/arena.rs index 2a3fc8b9..2b312070 100644 --- a/src/arena.rs +++ b/src/arena.rs @@ -14,6 +14,8 @@ use ordered_float::OrderedFloat; use std::fmt; use std::fmt::Debug; use std::hash::{Hash, Hasher}; +use std::io::PipeReader; +use std::io::PipeWriter; use std::mem; use std::mem::ManuallyDrop; use std::net::TcpListener; @@ -71,7 +73,9 @@ pub enum ArenaHeaderTag { TcpListener = 0b1000000, HttpListener = 0b1000001, HttpResponse = 0b1000010, + PipeWriter = 0b1000011, Dropped = 0b1000100, + PipeReader = 0b1000101, } #[bitfield] @@ -546,6 +550,12 @@ unsafe fn drop_slab_in_place(value: NonNull, tag: ArenaHeaderTag) { ArenaHeaderTag::StandardErrorStream => { drop_typed_slab_in_place!(StandardErrorStream, value); } + ArenaHeaderTag::PipeReader => { + drop_typed_slab_in_place!(PipeReader, value); + } + ArenaHeaderTag::PipeWriter => { + drop_typed_slab_in_place!(PipeWriter, value); + } ArenaHeaderTag::NullStream => { unreachable!("NullStream is never arena allocated!"); } diff --git a/src/lib/error.pl b/src/lib/error.pl index 67df8a32..0eb2a6d4 100644 --- a/src/lib/error.pl +++ b/src/lib/error.pl @@ -82,6 +82,9 @@ must_be_(octet_chars, Cs) :- ; true ). must_be_(list, Term) :- check_(error:ilist, list, Term). +must_be_(list(Elem), Term) :- + must_be_(list, Term), + check_all(Elem, Term). must_be_(type, Term) :- check_(error:type, type, Term). must_be_(boolean, Term) :- check_(error:boolean, boolean, Term). must_be_(pair, Term) :- check_(error:pair, pair, Term). @@ -96,10 +99,12 @@ must_be_(term, Term) :- % We cannot use maplist(must_be(character), Cs), because library(lists) % uses library(error), so importing it would create a cyclic dependency. -all_characters([]). -all_characters([C|Cs]) :- - must_be(character, C), - all_characters(Cs). +check_all(_, []). +check_all(Type, [Head| Tail]) :- + must_be(Type, Head), + check_all(Type, Tail). + +all_characters(Cs) :- check_all(character, Cs). check_(Pred, Type, Term) :- ( var(Term) -> instantiation_error(must_be/2) @@ -141,6 +146,7 @@ type(octet_character). type(octet_chars). type(chars). type(list). +type(list(Type)) :- type(Type). type(var). type(boolean). type(term). diff --git a/src/lib/process.pl b/src/lib/process.pl new file mode 100644 index 00000000..e712bd69 --- /dev/null +++ b/src/lib/process.pl @@ -0,0 +1,52 @@ +:- module(process, [process_create/3]). + +:- use_module(library(error)). +:- use_module(library(iso_ext)). +:- use_module(library(lists), [append/3, member/2]). + +process_create(Exe, Args, Options) :- + must_be(chars, Exe), + must_be(list(chars), Args), + must_be(list, Options), + check_option(Sin, find_stdio(Sin, stdin, Options), valid_stdio, [std], Stdin), + check_option(Sout, find_stdio(Sout, stdout, Options), valid_stdio, [std], Stdout), + check_option(Serr, find_stdio(Serr, stderr, Options), valid_stdio, [std], Stderr), + check_option(Envs, find_env(Envs, Options), valid_env, [environment, []], EnvVars), + check_option(P, member(process(P), Options), valid_pid, _, Pid), + check_option(C, member(cwd(C), Options), valid_cwd, _, Cwd), + '$process_create'(Exe, Args, Stdin, Stdout, Stderr, EnvVars, Cwd, Pid). + + +check_option(Template, Goal, Pred, Default, Choice) :- + findall(Template, Goal, Solutions), + check_option_(Solutions, Pred, Default, Choice). + +check_option_([] , Pred , Default , Default ) :- call(Pred, Default). +check_option_([Choice] , Pred , _ , Choice ) :- call(Pred, Choice). +check_option_([X1,X2|Xs], _ , _ , _ ) :- throw(error(duplicate_option, process_create/3, [X1, X2 | Xs])). + +find_stdio([std], Kind, Options ) :- Elem =.. [Kind, std], member(Elem, Options). +find_stdio([null], Kind, Options ) :- Elem =.. [Kind, null], member(Elem, Options). +find_stdio([pipe, Stream], Kind, Options) :- Elem =.. [Kind, pipe(Stream)], member(Elem, Options). +find_stdio([file, Path], Kind, Options ) :- Elem =.. [Kind, file(Path)], member(Elem, Options). + +valid_stdio([std]). +valid_stdio([null]). +valid_stdio([pipe, Stream]) :- must_be(var, Stream). +valid_stdio([file, Path]) :- must_be(chars, Path). + +find_env([env, E], Options) :- member(env(E), Options). +find_env([environment, E], Options) :- member(environment(E), Options). + +valid_cwd(Cwd) :- must_be(chars, Cwd). + +valid_env([env, E]) :- valid_env_(E). +valid_env([environment, E]) :- valid_env_(E). + +valid_env_([]). +valid_env_([N=V|Es]) :- + must_be(chars, N), + must_be(chars, V), + valid_env_(Es). + +valid_pid(Pid) :- must_be(var, Pid). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index af34bcd7..36068ca2 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4787,6 +4787,14 @@ impl Machine { self.shell(); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallProcessCreate => { + try_or_throw!(self.machine_st, self.process_create()); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteProcessCreate => { + try_or_throw!(self.machine_st, self.process_create()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallPid => { self.pid(); step_or_fail!(self, self.machine_st.p += 1); diff --git a/src/machine/streams.rs b/src/machine/streams.rs index 25e9a75a..871ea617 100644 --- a/src/machine/streams.rs +++ b/src/machine/streams.rs @@ -23,6 +23,8 @@ use std::fmt::Debug; use std::fs::{File, OpenOptions}; use std::hash::Hash; use std::io; +use std::io::PipeReader; +use std::io::PipeWriter; use std::io::{Cursor, ErrorKind, Read, Seek, SeekFrom, Write}; use std::mem::ManuallyDrop; use std::net::{Shutdown, TcpStream}; @@ -588,6 +590,8 @@ arena_allocated_impl_for_stream!(StandardOutputStream, StandardOutputStream); arena_allocated_impl_for_stream!(StandardErrorStream, StandardErrorStream); arena_allocated_impl_for_stream!(CharReader, CallbackStream); arena_allocated_impl_for_stream!(CharReader, InputChannelStream); +arena_allocated_impl_for_stream!(CharReader, PipeReader); +arena_allocated_impl_for_stream!(CharReader, PipeWriter); #[derive(Debug, Copy, Clone)] pub enum Stream { @@ -608,6 +612,8 @@ pub enum Stream { StandardError(TypedArenaPtr), Callback(TypedArenaPtr), InputChannel(TypedArenaPtr), + PipeReader(TypedArenaPtr), + PipeWriter(TypedArenaPtr), } impl From> for Stream { @@ -726,6 +732,8 @@ impl Stream { Stream::StandardError(ptr) => ptr.header_ptr(), Stream::Callback(ptr) => ptr.header_ptr(), Stream::InputChannel(ptr) => ptr.header_ptr(), + Stream::PipeReader(ptr) => ptr.header_ptr(), + Stream::PipeWriter(ptr) => ptr.header_ptr(), } } @@ -748,6 +756,8 @@ impl Stream { Stream::StandardError(ref ptr) => &ptr.options, Stream::Callback(ref ptr) => &ptr.options, Stream::InputChannel(ref ptr) => &ptr.options, + Stream::PipeReader(ref ptr) => &ptr.options, + Stream::PipeWriter(ref ptr) => &ptr.options, } } @@ -770,6 +780,8 @@ impl Stream { Stream::StandardError(ref mut ptr) => &mut ptr.options, Stream::Callback(ref mut ptr) => &mut ptr.options, Stream::InputChannel(ref mut ptr) => &mut ptr.options, + Stream::PipeReader(ref mut ptr) => &mut ptr.options, + Stream::PipeWriter(ref mut ptr) => &mut ptr.options, } } @@ -793,6 +805,8 @@ impl Stream { Stream::StandardError(ptr) => ptr.lines_read += incr_num_lines_read, Stream::Callback(ptr) => ptr.lines_read += incr_num_lines_read, Stream::InputChannel(ptr) => ptr.lines_read += incr_num_lines_read, + Stream::PipeReader(ptr) => ptr.lines_read += incr_num_lines_read, + Stream::PipeWriter(_) => {} } } @@ -816,6 +830,8 @@ impl Stream { Stream::StandardError(ptr) => ptr.lines_read = value, Stream::Callback(ptr) => ptr.lines_read = value, Stream::InputChannel(ptr) => ptr.lines_read = value, + Stream::PipeReader(ptr) => ptr.lines_read = value, + Stream::PipeWriter(_) => {} } } @@ -839,6 +855,8 @@ impl Stream { Stream::StandardError(ptr) => ptr.lines_read, Stream::Callback(ptr) => ptr.lines_read, Stream::InputChannel(ptr) => ptr.lines_read, + Stream::PipeReader(ptr) => ptr.lines_read, + Stream::PipeWriter(_) => 0, } } } @@ -856,6 +874,8 @@ impl CharRead for Stream { Stream::StaticString(src) => (*src).peek_char(), Stream::Byte(cursor) => (*cursor).peek_char(), Stream::InputChannel(cursor) => (*cursor).peek_char(), + Stream::PipeReader(cursor) => (*cursor).peek_char(), + #[cfg(feature = "http")] Stream::HttpWrite(_) => Some(Err(std::io::Error::new( ErrorKind::PermissionDenied, @@ -865,7 +885,8 @@ impl CharRead for Stream { | Stream::StandardError(_) | Stream::StandardOutput(_) | Stream::Null(_) - | Stream::Callback(_) => Some(Err(std::io::Error::new( + | Stream::Callback(_) + | Stream::PipeWriter(_) => Some(Err(std::io::Error::new( ErrorKind::PermissionDenied, StreamError::ReadFromOutputStream, ))), @@ -884,6 +905,7 @@ impl CharRead for Stream { Stream::StaticString(src) => (*src).read_char(), Stream::Byte(cursor) => (*cursor).read_char(), Stream::InputChannel(cursor) => (*cursor).read_char(), + Stream::PipeReader(cursor) => (*cursor).read_char(), #[cfg(feature = "http")] Stream::HttpWrite(_) => Some(Err(std::io::Error::new( ErrorKind::PermissionDenied, @@ -893,7 +915,8 @@ impl CharRead for Stream { | Stream::StandardError(_) | Stream::StandardOutput(_) | Stream::Null(_) - | Stream::Callback(_) => Some(Err(std::io::Error::new( + | Stream::Callback(_) + | Stream::PipeWriter(_) => Some(Err(std::io::Error::new( ErrorKind::PermissionDenied, StreamError::ReadFromOutputStream, ))), @@ -911,13 +934,15 @@ impl CharRead for Stream { Stream::Readline(rl_stream) => rl_stream.put_back_char(c), Stream::StaticString(src) => src.put_back_char(c), Stream::Byte(cursor) => cursor.put_back_char(c), + Stream::PipeReader(cursor) => cursor.put_back_char(c), #[cfg(feature = "http")] Stream::HttpWrite(_) => {} Stream::OutputFile(_) | Stream::StandardError(_) | Stream::StandardOutput(_) | Stream::Null(_) - | Stream::Callback(_) => {} + | Stream::Callback(_) + | Stream::PipeWriter(_) => {} Stream::InputChannel(_) => {} } } @@ -934,13 +959,15 @@ impl CharRead for Stream { Stream::StaticString(ref mut src) => src.consume(nread), Stream::Byte(ref mut cursor) => cursor.consume(nread), Stream::InputChannel(ref mut cursor) => cursor.consume(nread), + Stream::PipeReader(ref mut cursor) => cursor.consume(nread), #[cfg(feature = "http")] Stream::HttpWrite(_) => {} Stream::OutputFile(_) | Stream::StandardError(_) | Stream::StandardOutput(_) | Stream::Null(_) - | Stream::Callback(_) => {} + | Stream::Callback(_) + | Stream::PipeWriter(_) => {} } } } @@ -959,6 +986,7 @@ impl Read for Stream { Stream::StaticString(src) => (*src).read(buf), Stream::Byte(cursor) => (*cursor).read(buf), Stream::InputChannel(cursor) => (*cursor).read(buf), + Stream::PipeReader(cursor) => (*cursor).read(buf), #[cfg(feature = "http")] Stream::HttpWrite(_) => Err(std::io::Error::new( ErrorKind::PermissionDenied, @@ -967,7 +995,8 @@ impl Read for Stream { Stream::OutputFile(_) | Stream::StandardError(_) | Stream::StandardOutput(_) - | Stream::Callback(_) => Err(std::io::Error::new( + | Stream::Callback(_) + | Stream::PipeWriter(_) => Err(std::io::Error::new( ErrorKind::PermissionDenied, StreamError::ReadFromOutputStream, )), @@ -989,6 +1018,7 @@ impl Write for Stream { Stream::StandardError(stream) => stream.write(buf), #[cfg(feature = "http")] Stream::HttpWrite(ref mut stream) => stream.get_mut().write(buf), + Stream::PipeWriter(ref mut stream) => stream.get_mut().write(buf), #[cfg(feature = "http")] Stream::HttpRead(_) => Err(std::io::Error::new( ErrorKind::PermissionDenied, @@ -998,7 +1028,8 @@ impl Write for Stream { Stream::StaticString(_) | Stream::InputChannel(_) | Stream::Readline(_) - | Stream::InputFile(..) => Err(std::io::Error::new( + | Stream::InputFile(..) + | Stream::PipeReader(_) => Err(std::io::Error::new( ErrorKind::PermissionDenied, StreamError::WriteToInputStream, )), @@ -1015,6 +1046,7 @@ impl Write for Stream { Stream::Callback(ref mut callback_stream) => callback_stream.stream.get_mut().flush(), Stream::StandardError(stream) => stream.stream.flush(), Stream::StandardOutput(stream) => stream.stream.flush(), + Stream::PipeWriter(ref mut stream) => stream.stream.get_mut().flush(), #[cfg(feature = "http")] Stream::HttpWrite(ref mut stream) => stream.stream.get_mut().flush(), #[cfg(feature = "http")] @@ -1026,7 +1058,8 @@ impl Write for Stream { Stream::StaticString(_) | Stream::InputChannel(_) | Stream::Readline(_) - | Stream::InputFile(_) => Err(std::io::Error::new( + | Stream::InputFile(_) + | Stream::PipeReader(_) => Err(std::io::Error::new( ErrorKind::PermissionDenied, StreamError::FlushToInputStream, )), @@ -1192,6 +1225,8 @@ impl Stream { Stream::StandardError(stream) => stream.past_end_of_stream, Stream::Callback(stream) => stream.past_end_of_stream, Stream::InputChannel(stream) => stream.past_end_of_stream, + Stream::PipeReader(stream) => stream.past_end_of_stream, + Stream::PipeWriter(stream) => stream.past_end_of_stream, } } @@ -1220,6 +1255,8 @@ impl Stream { Stream::StandardError(stream) => stream.past_end_of_stream = value, Stream::Callback(stream) => stream.past_end_of_stream = value, Stream::InputChannel(stream) => stream.past_end_of_stream = value, + Stream::PipeReader(stream) => stream.past_end_of_stream = value, + Stream::PipeWriter(stream) => stream.past_end_of_stream = value, } } @@ -1330,7 +1367,8 @@ impl Stream { | Stream::InputChannel(_) | Stream::Readline(_) | Stream::StaticString(_) - | Stream::InputFile(..) => atom!("read"), + | Stream::InputFile(..) + | Stream::PipeReader(_) => atom!("read"), Stream::NamedTcp(..) => atom!("read_append"), Stream::OutputFile(file) if file.is_append => atom!("append"), #[cfg(feature = "http")] @@ -1338,7 +1376,8 @@ impl Stream { Stream::OutputFile(_) | Stream::StandardError(_) | Stream::StandardOutput(_) - | Stream::Callback(_) => { + | Stream::Callback(_) + | Stream::PipeWriter(_) => { atom!("write") } Stream::Null(_) => atom!(""), @@ -1372,6 +1411,20 @@ impl Stream { )) } + pub(crate) fn from_pipe_writer(writer: io::PipeWriter, arena: &mut Arena) -> Stream { + Stream::PipeWriter(arena_alloc!( + ManuallyDrop::new(StreamLayout::new(CharReader::new(writer))), + arena + )) + } + + pub(crate) fn from_pipe_reader(reader: io::PipeReader, arena: &mut Arena) -> Stream { + Stream::PipeReader(arena_alloc!( + ManuallyDrop::new(StreamLayout::new(CharReader::new(reader))), + arena + )) + } + #[inline] pub(crate) fn from_tcp_stream(address: Atom, tcp_stream: TcpStream, arena: &mut Arena) -> Self { tcp_stream.set_read_timeout(None).unwrap(); @@ -1512,6 +1565,16 @@ impl Stream { Ok(()) } + Stream::PipeReader(mut stream) => { + stream.drop_payload(); + Ok(()) + } + + Stream::PipeWriter(mut stream) => { + stream.drop_payload(); + Ok(()) + } + Stream::Null(_) => Ok(()), Stream::Readline(_) | Stream::StandardOutput(_) | Stream::StandardError(_) => { diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 8c0eee0a..7e448e03 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -56,6 +56,7 @@ use std::net::{SocketAddr, ToSocketAddrs}; use std::net::{TcpListener, TcpStream}; use std::num::NonZeroU32; use std::process; +use std::process::Stdio; #[cfg(feature = "http")] use std::str::FromStr; #[cfg(feature = "http")] @@ -8393,6 +8394,173 @@ impl Machine { }; } + pub(crate) fn process_create(&mut self) -> CallResult { + fn stub_gen() -> Vec { + functor_stub(atom!("process_create"), 3) + } + + let exe_r = self.deref_register(1); + let args_r = self.deref_register(2); + let stdin_r = self.deref_register(3); + let stdout_r = self.deref_register(4); + let stderr_r = self.deref_register(5); + let env_r = self.deref_register(6); + let cwd_r = self.deref_register(7); + let pid_r = self.deref_register(8); + + let exe = self.machine_st.value_to_str_like(exe_r).unwrap(); + + let args = self + .machine_st + .try_from_list(args_r, stub_gen) + .unwrap() + .into_iter() + .map(|arg| { + self.machine_st + .value_to_str_like(arg) + .unwrap() + .as_str() + .to_string() + }) + .collect::>(); + + let stdin_args = self.machine_st.try_from_list(stdin_r, stub_gen)?; + let stdin = self.handle_input_stream(stdin_args)?; + + let stdout_args = self.machine_st.try_from_list(stdout_r, stub_gen)?; + let stdout = self.handle_output_stream(stdout_args)?; + + let stderr_args = self.machine_st.try_from_list(stderr_r, stub_gen)?; + let stderr = self.handle_output_stream(stderr_args)?; + + let env_args = self.machine_st.try_from_list(env_r, stub_gen)?; + + let clear_env = match env_args[0].to_atom() { + Some(atom!("env")) => true, + Some(atom!("environment")) => false, + _ => panic!("Invalid value for clear_env"), + }; + + let env_names = self.machine_st.try_from_list(env_args[1], stub_gen)?; + let env_values = self.machine_st.try_from_list(env_args[2], stub_gen)?; + + let envs = env_names + .into_iter() + .zip(env_values) + .map(|(name, value)| { + let name = self + .machine_st + .value_to_str_like(name) + .unwrap() + .as_str() + .to_string(); + let value = self + .machine_st + .value_to_str_like(value) + .unwrap() + .as_str() + .to_string(); + (name, value) + }) + .collect::>(); + + let cwd = self.machine_st.value_to_str_like(cwd_r); + + let mut command = std::process::Command::new(&*exe.as_str()); + command.args(args); + + if let Some(cwd) = cwd { + command.current_dir(&*cwd.as_str()); + } + + if clear_env { + command.env_clear(); + } + + command + .envs(envs) + .stdin(stdin) + .stdout(stdout) + .stderr(stderr); + + match command.spawn() { + Ok(child) => { + self.machine_st + .unify_fixnum(Fixnum::build_with(child.id()), pid_r); + Ok(()) + } + Err(_) => { + self.machine_st.fail = true; + Ok(()) + } + } + } + + fn handle_output_stream(&mut self, args: Vec) -> Result { + Ok(match args[0].to_atom() { + Some(atom!("std")) => Stdio::inherit(), + Some(atom!("null")) => Stdio::null(), + Some(atom!("pipe")) => { + // TODO handler Err + let (reader, writer) = std::io::pipe().unwrap(); + + let stream = Stream::from_pipe_reader(reader, &mut self.machine_st.arena); + + self.indices + .add_stream(stream, atom!("process_create"), 3) + .map_err(|stub_gen| stub_gen(&mut self.machine_st))?; + + self.machine_st + .bind(args[2].as_var().unwrap(), stream.into()); + + Stdio::from(writer) + } + Some(atom!("file")) => { + let path = self.machine_st.value_to_str_like(args[1]).unwrap(); + + // TODO handler Err + let file = std::fs::File::open(&*path.as_str()).unwrap(); + Stdio::from(file) + } + _ => { + panic!("Invalid stdin tag") + } + }) + } + + fn handle_input_stream(&mut self, args: Vec) -> Result { + Ok(match args[0].to_atom() { + Some(atom!("std")) => Stdio::inherit(), + Some(atom!("null")) => Stdio::null(), + Some(atom!("pipe")) => { + // TODO handler Err + let (reader, writer) = std::io::pipe().unwrap(); + + let stream = Stream::from_pipe_writer(writer, &mut self.machine_st.arena); + + self.indices + .add_stream(stream, atom!("process_create"), 3) + .map_err(|stub_gen| stub_gen(&mut self.machine_st)) + .unwrap(); + + self.machine_st + .bind(args[2].as_var().unwrap(), stream.into()); + + Stdio::from(reader) + } + Some(atom!("file")) => { + let path = self.machine_st.value_to_str_like(args[1]).unwrap(); + + // TODO handler Err + let file = std::fs::File::open(&*path.as_str()).unwrap(); + Stdio::from(file) + } + _ => { + panic!("Invalid stdin tag") + } + }) + } + #[inline(always)] pub(crate) fn chars_base64(&mut self) -> CallResult { let padding = cell_as_atom!(self.deref_register(3)); From d79ece24974ab2a175d4af1aab5870055686829a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 19 Jul 2025 21:00:36 +0200 Subject: [PATCH 02/36] fix indices --- src/machine/system_calls.rs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 7e448e03..51092f64 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8441,8 +8441,8 @@ impl Machine { _ => panic!("Invalid value for clear_env"), }; - let env_names = self.machine_st.try_from_list(env_args[1], stub_gen)?; - let env_values = self.machine_st.try_from_list(env_args[2], stub_gen)?; + let env_names = self.machine_st.try_from_list(env_args[0], stub_gen)?; + let env_values = self.machine_st.try_from_list(env_args[1], stub_gen)?; let envs = env_names .into_iter() From 003e9d461008b4d7249639694c657e4faa0c3e00 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 19 Jul 2025 21:33:19 +0200 Subject: [PATCH 03/36] get it working --- src/lib/process.pl | 9 +++++---- src/machine/system_calls.rs | 19 +++++++++---------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index e712bd69..f0a0a819 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -6,7 +6,6 @@ process_create(Exe, Args, Options) :- must_be(chars, Exe), - must_be(list(chars), Args), must_be(list, Options), check_option(Sin, find_stdio(Sin, stdin, Options), valid_stdio, [std], Stdin), check_option(Sout, find_stdio(Sout, stdout, Options), valid_stdio, [std], Stdout), @@ -35,10 +34,12 @@ valid_stdio([null]). valid_stdio([pipe, Stream]) :- must_be(var, Stream). valid_stdio([file, Path]) :- must_be(chars, Path). -find_env([env, E], Options) :- member(env(E), Options). -find_env([environment, E], Options) :- member(environment(E), Options). +find_env([env, ME], Options) :- member(env(E), Options), maplist(assign_to_list, E, ME). +find_env([environment, ME], Options) :- member(environment(E), Options), maplist(assign_to_list, E, ME). -valid_cwd(Cwd) :- must_be(chars, Cwd). +assign_to_list(N=V, [N,v]). + +valid_cwd(Cwd). valid_env([env, E]) :- valid_env_(E). valid_env([environment, E]) :- valid_env_(E). diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 51092f64..63aabd8b 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8441,28 +8441,27 @@ impl Machine { _ => panic!("Invalid value for clear_env"), }; - let env_names = self.machine_st.try_from_list(env_args[0], stub_gen)?; - let env_values = self.machine_st.try_from_list(env_args[1], stub_gen)?; - - let envs = env_names + let envs = self + .machine_st + .try_from_list(env_args[1], stub_gen)? .into_iter() - .zip(env_values) - .map(|(name, value)| { + .map(|entry| { + let entry = self.machine_st.try_from_list(entry, stub_gen)?; let name = self .machine_st - .value_to_str_like(name) + .value_to_str_like(entry[0]) .unwrap() .as_str() .to_string(); let value = self .machine_st - .value_to_str_like(value) + .value_to_str_like(entry[1]) .unwrap() .as_str() .to_string(); - (name, value) + Ok((name, value)) }) - .collect::>(); + .collect::, MachineStub>>()?; let cwd = self.machine_st.value_to_str_like(cwd_r); From 2b052bf8dd8aa2b00396e9e1244627b3bbfa916d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 19 Jul 2025 21:44:28 +0200 Subject: [PATCH 04/36] fix more things --- src/lib/process.pl | 5 +++-- src/machine/system_calls.rs | 7 +++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index f0a0a819..f20e225a 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -6,6 +6,7 @@ process_create(Exe, Args, Options) :- must_be(chars, Exe), + must_be(list(chars), Args), must_be(list, Options), check_option(Sin, find_stdio(Sin, stdin, Options), valid_stdio, [std], Stdin), check_option(Sout, find_stdio(Sout, stdout, Options), valid_stdio, [std], Stdout), @@ -37,9 +38,9 @@ valid_stdio([file, Path]) :- must_be(chars, Path). find_env([env, ME], Options) :- member(env(E), Options), maplist(assign_to_list, E, ME). find_env([environment, ME], Options) :- member(environment(E), Options), maplist(assign_to_list, E, ME). -assign_to_list(N=V, [N,v]). +assign_to_list(N=V, [N,V]). -valid_cwd(Cwd). +valid_cwd(Cwd) :- var(Cwd) -> true ; must_be(chars). valid_env([env, E]) :- valid_env_(E). valid_env([environment, E]) :- valid_env_(E). diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 63aabd8b..d48ad555 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8510,7 +8510,7 @@ impl Machine { .map_err(|stub_gen| stub_gen(&mut self.machine_st))?; self.machine_st - .bind(args[2].as_var().unwrap(), stream.into()); + .bind(args[1].as_var().unwrap(), stream.into()); Stdio::from(writer) } @@ -8539,11 +8539,10 @@ impl Machine { self.indices .add_stream(stream, atom!("process_create"), 3) - .map_err(|stub_gen| stub_gen(&mut self.machine_st)) - .unwrap(); + .map_err(|stub_gen| stub_gen(&mut self.machine_st))?; self.machine_st - .bind(args[2].as_var().unwrap(), stream.into()); + .bind(args[1].as_var().unwrap(), stream.into()); Stdio::from(reader) } From 82e989f63142fbbe19a8b772f5123b18aba0e7e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 19 Jul 2025 22:56:51 +0200 Subject: [PATCH 05/36] add comments and try to fix binding the child process pid --- src/machine/system_calls.rs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index d48ad555..ecffbdb7 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8399,13 +8399,19 @@ impl Machine { functor_stub(atom!("process_create"), 3) } + // String let exe_r = self.deref_register(1); + // [String,...] let args_r = self.deref_register(2); + // [std] | [null] | [pipe, Var] | [file, String] let stdin_r = self.deref_register(3); let stdout_r = self.deref_register(4); let stderr_r = self.deref_register(5); + // [env | environment, [[String, String],...]] let env_r = self.deref_register(6); + // Var | String let cwd_r = self.deref_register(7); + // Var let pid_r = self.deref_register(8); let exe = self.machine_st.value_to_str_like(exe_r).unwrap(); @@ -8484,11 +8490,16 @@ impl Machine { match command.spawn() { Ok(child) => { - self.machine_st - .unify_fixnum(Fixnum::build_with(child.id()), pid_r); + let pid = child.id(); + self.machine_st.bind( + pid_r.as_var().unwrap(), + fixnum_as_cell!(Fixnum::build_with(pid)), + ); Ok(()) } - Err(_) => { + Err(err) => { + // TODO give better error indication + dbg!(err); self.machine_st.fail = true; Ok(()) } From 6c7833b9c7452eef4fd854b379eb2a8a0556bedd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 00:51:50 +0200 Subject: [PATCH 06/36] restructure option parsing --- src/lib/process.pl | 102 +++++++++++++++++++++++++++++---------------- 1 file changed, 66 insertions(+), 36 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index f20e225a..6215355f 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -2,53 +2,83 @@ :- use_module(library(error)). :- use_module(library(iso_ext)). -:- use_module(library(lists), [append/3, member/2]). +:- use_module(library(lists), [append/3, member/2, maplist/2, maplist/3, select/3]). process_create(Exe, Args, Options) :- must_be(chars, Exe), - must_be(list(chars), Args), + must_be(list, Args), + maplist(must_be(chars), Args), must_be(list, Options), - check_option(Sin, find_stdio(Sin, stdin, Options), valid_stdio, [std], Stdin), - check_option(Sout, find_stdio(Sout, stdout, Options), valid_stdio, [std], Stdout), - check_option(Serr, find_stdio(Serr, stderr, Options), valid_stdio, [std], Stderr), - check_option(Envs, find_env(Envs, Options), valid_env, [environment, []], EnvVars), - check_option(P, member(process(P), Options), valid_pid, _, Pid), - check_option(C, member(cwd(C), Options), valid_cwd, _, Cwd), - '$process_create'(Exe, Args, Stdin, Stdout, Stderr, EnvVars, Cwd, Pid). + must_be_known_options([stdin, stdout, stderr, env, environment, pid, cwd], [], Options), + check_options( + [ + ([stdin], valid_stdio, stdin(std), stdin(Stdin)), + ([stdout], valid_stdio, stdout(std), stdout(Stdout)), + ([stderr], valid_stdio, stderr(std), stderr(Stderr)), + ([env, environment], valid_env, environment([]), Env), + ([pid], valid_pid, pid(_), pid(Pid)), + ([cwd], valid_cwd, cwd(_), cwd(Cwd)) + ], + Options + ), + Stdin =.. Stdin1, + Stdout =.. Stdout1, + Stderr =.. Stderr1, + simplify_env(Env, Env1), + '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Pid). +must_be_known_options(_, _, []). +must_be_known_options(Valid, Found, [X|XS]) :- + X =.. [Option|_], + ( + member(Option, Found) -> throw(error(duplicate_option, process_create/3, Option)) ; + member(Option, Valid) -> true ; + throw(error(invalid_option, process_create/3, Option)) + ), + must_be_known_options(Valid, [Option | Found], XS). -check_option(Template, Goal, Pred, Default, Choice) :- - findall(Template, Goal, Solutions), - check_option_(Solutions, Pred, Default, Choice). - -check_option_([] , Pred , Default , Default ) :- call(Pred, Default). -check_option_([Choice] , Pred , _ , Choice ) :- call(Pred, Choice). -check_option_([X1,X2|Xs], _ , _ , _ ) :- throw(error(duplicate_option, process_create/3, [X1, X2 | Xs])). +check_options([], _). +check_options([X | XS], Options) :- + (Kinds, Pred, Default, Choice) = X, + findall(P, find_option(Kinds, P, Options), Solutions), + ( + Solutions = [] -> Choice = Default; + Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ; + throw(error(duplicate_option, process_create/3, Solutions)) + ), + check_options(XS, Options). -find_stdio([std], Kind, Options ) :- Elem =.. [Kind, std], member(Elem, Options). -find_stdio([null], Kind, Options ) :- Elem =.. [Kind, null], member(Elem, Options). -find_stdio([pipe, Stream], Kind, Options) :- Elem =.. [Kind, pipe(Stream)], member(Elem, Options). -find_stdio([file, Path], Kind, Options ) :- Elem =.. [Kind, file(Path)], member(Elem, Options). +find_option([Kind|_], Found, Options) :- Found =.. [Kind,_], member(Found, Options). +find_option([_|Kinds], Found, Options) :- find_option(Kinds, Found, Options). -valid_stdio([std]). -valid_stdio([null]). -valid_stdio([pipe, Stream]) :- must_be(var, Stream). -valid_stdio([file, Path]) :- must_be(chars, Path). +valid_stdio(IO) :- IO =.. [_, Arg], + ( + valid_stdio_(Arg) -> true ; + throw(error(invalid_stdio, process_create/3, Arg)) + ). -find_env([env, ME], Options) :- member(env(E), Options), maplist(assign_to_list, E, ME). -find_env([environment, ME], Options) :- member(environment(E), Options), maplist(assign_to_list, E, ME). +valid_stdio_(std). +valid_stdio_(null). +valid_stdio_(pipe(Stream)) :- must_be(var, Stream). +valid_stdio_(file(Path)) :- must_be(chars, Path). -assign_to_list(N=V, [N,V]). - -valid_cwd(Cwd) :- var(Cwd) -> true ; must_be(chars). - -valid_env([env, E]) :- valid_env_(E). -valid_env([environment, E]) :- valid_env_(E). +valid_env(env(E)) :- valid_env_(E). +valid_env(environment(E)) :- valid_env_(E). valid_env_([]). -valid_env_([N=V|Es]) :- - must_be(chars, N), +valid_env_([E| ES]) :- + ( + E =.. [=, N, V] -> true ; + throw(error(invalid_env_entry, process_create/3, E)) + ), + must_be(chars, N), must_be(chars, V), - valid_env_(Es). + valid_env_(ES). -valid_pid(Pid) :- must_be(var, Pid). +valid_pid(pid(Pid)) :- must_be(var, Pid). +valid_cwd(cwd(Cwd)) :- must_be(chars, Cwd). + +simplify_env(E, [Kind, Envs1]) :- E =.. [Kind, Envs], simplify_env_(Envs, Envs1). + +simplify_env_([],[]). +simplify_env_([N=V|E],[[N, V]|E1]) :- simplify_env_(E, E1). From 183761eba4b12b9f352655014bdc7b87d479ac24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 01:25:16 +0200 Subject: [PATCH 07/36] adjust default cwd --- src/lib/process.pl | 2 +- src/machine/system_calls.rs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 6215355f..06e82a29 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -17,7 +17,7 @@ process_create(Exe, Args, Options) :- ([stderr], valid_stdio, stderr(std), stderr(Stderr)), ([env, environment], valid_env, environment([]), Env), ([pid], valid_pid, pid(_), pid(Pid)), - ([cwd], valid_cwd, cwd(_), cwd(Cwd)) + ([cwd], valid_cwd, cwd("."), cwd(Cwd)) ], Options ), diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index ecffbdb7..1ec6c988 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8409,7 +8409,7 @@ impl Machine { let stderr_r = self.deref_register(5); // [env | environment, [[String, String],...]] let env_r = self.deref_register(6); - // Var | String + // String ("." for keep current cwd) let cwd_r = self.deref_register(7); // Var let pid_r = self.deref_register(8); @@ -8469,12 +8469,12 @@ impl Machine { }) .collect::, MachineStub>>()?; - let cwd = self.machine_st.value_to_str_like(cwd_r); + let cwd = self.machine_st.value_to_str_like(cwd_r).unwrap(); let mut command = std::process::Command::new(&*exe.as_str()); command.args(args); - if let Some(cwd) = cwd { + if &*cwd.as_str() != "." { command.current_dir(&*cwd.as_str()); } From 129c80bf16b3a20237b8bfb0952a15d932b98020 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 01:52:34 +0200 Subject: [PATCH 08/36] undo changes to error.pl --- src/lib/error.pl | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/src/lib/error.pl b/src/lib/error.pl index 0eb2a6d4..67df8a32 100644 --- a/src/lib/error.pl +++ b/src/lib/error.pl @@ -82,9 +82,6 @@ must_be_(octet_chars, Cs) :- ; true ). must_be_(list, Term) :- check_(error:ilist, list, Term). -must_be_(list(Elem), Term) :- - must_be_(list, Term), - check_all(Elem, Term). must_be_(type, Term) :- check_(error:type, type, Term). must_be_(boolean, Term) :- check_(error:boolean, boolean, Term). must_be_(pair, Term) :- check_(error:pair, pair, Term). @@ -99,12 +96,10 @@ must_be_(term, Term) :- % We cannot use maplist(must_be(character), Cs), because library(lists) % uses library(error), so importing it would create a cyclic dependency. -check_all(_, []). -check_all(Type, [Head| Tail]) :- - must_be(Type, Head), - check_all(Type, Tail). - -all_characters(Cs) :- check_all(character, Cs). +all_characters([]). +all_characters([C|Cs]) :- + must_be(character, C), + all_characters(Cs). check_(Pred, Type, Term) :- ( var(Term) -> instantiation_error(must_be/2) @@ -146,7 +141,6 @@ type(octet_character). type(octet_chars). type(chars). type(list). -type(list(Type)) :- type(Type). type(var). type(boolean). type(term). From e321f29b9c54bf7ee8e7eb4cddc6d406ec52ba92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 18:34:45 +0200 Subject: [PATCH 09/36] rename pid to process --- src/lib/process.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 06e82a29..52fc2b2a 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -16,7 +16,7 @@ process_create(Exe, Args, Options) :- ([stdout], valid_stdio, stdout(std), stdout(Stdout)), ([stderr], valid_stdio, stderr(std), stderr(Stderr)), ([env, environment], valid_env, environment([]), Env), - ([pid], valid_pid, pid(_), pid(Pid)), + ([process], valid_pid, process(_), process(Pid)), ([cwd], valid_cwd, cwd("."), cwd(Cwd)) ], Options From 8971809c838ca5deb782af63a4c073598b0fc137 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 18:47:44 +0200 Subject: [PATCH 10/36] adjust errors --- src/lib/process.pl | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 52fc2b2a..645841ff 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -31,9 +31,9 @@ must_be_known_options(_, _, []). must_be_known_options(Valid, Found, [X|XS]) :- X =.. [Option|_], ( - member(Option, Found) -> throw(error(duplicate_option, process_create/3, Option)) ; + member(Option, Found) -> error(evaluation_error(duplicate_options), process_create/3); member(Option, Valid) -> true ; - throw(error(invalid_option, process_create/3, Option)) + domain_error(process_create_option, Option, process_create/3) ), must_be_known_options(Valid, [Option | Found], XS). @@ -44,7 +44,7 @@ check_options([X | XS], Options) :- ( Solutions = [] -> Choice = Default; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ; - throw(error(duplicate_option, process_create/3, Solutions)) + error(evaluation_error(confliction_options), process_create/3) ), check_options(XS, Options). @@ -54,7 +54,7 @@ find_option([_|Kinds], Found, Options) :- find_option(Kinds, Found, Options). valid_stdio(IO) :- IO =.. [_, Arg], ( valid_stdio_(Arg) -> true ; - throw(error(invalid_stdio, process_create/3, Arg)) + domain_error(process_create_option, Arg, process_create/3) ). valid_stdio_(std). @@ -62,14 +62,19 @@ valid_stdio_(null). valid_stdio_(pipe(Stream)) :- must_be(var, Stream). valid_stdio_(file(Path)) :- must_be(chars, Path). -valid_env(env(E)) :- valid_env_(E). -valid_env(environment(E)) :- valid_env_(E). +valid_env(env(E)) :- ( + valid_env_(E) -> true ; + domain_error(process_create_option, env(E), process_create/3) + ). +valid_env(environment(E)) :- ( + valid_env_(E) -> true ; + domain_error(process_create_option, environment(E), process_create/3) + ). valid_env_([]). valid_env_([E| ES]) :- ( E =.. [=, N, V] -> true ; - throw(error(invalid_env_entry, process_create/3, E)) ), must_be(chars, N), must_be(chars, V), From 43dd1587fbba71a12da27dbe19407c02119c2abf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 20:11:12 +0200 Subject: [PATCH 11/36] handle some error cases and replace unwrap with expect --- src/machine/system_calls.rs | 84 +++++++++++++++++++++++++++---------- 1 file changed, 63 insertions(+), 21 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 1ec6c988..d09344b0 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8414,17 +8414,20 @@ impl Machine { // Var let pid_r = self.deref_register(8); - let exe = self.machine_st.value_to_str_like(exe_r).unwrap(); + let exe = self + .machine_st + .value_to_str_like(exe_r) + .expect("invalid values should have been rejected on the prolog side"); let args = self .machine_st .try_from_list(args_r, stub_gen) - .unwrap() + .expect("invalid values should have been rejected on the prolog side") .into_iter() .map(|arg| { self.machine_st .value_to_str_like(arg) - .unwrap() + .expect("invalid values should have been rejected on the prolog side") .as_str() .to_string() }) @@ -8456,20 +8459,23 @@ impl Machine { let name = self .machine_st .value_to_str_like(entry[0]) - .unwrap() + .expect("invalid values should have been rejected on the prolog side") .as_str() .to_string(); let value = self .machine_st .value_to_str_like(entry[1]) - .unwrap() + .expect("invalid values should have been rejected on the prolog side") .as_str() .to_string(); Ok((name, value)) }) .collect::, MachineStub>>()?; - let cwd = self.machine_st.value_to_str_like(cwd_r).unwrap(); + let cwd = self + .machine_st + .value_to_str_like(cwd_r) + .expect("invalid values should have been rejected on the prolog side"); let mut command = std::process::Command::new(&*exe.as_str()); command.args(args); @@ -8492,16 +8498,20 @@ impl Machine { Ok(child) => { let pid = child.id(); self.machine_st.bind( - pid_r.as_var().unwrap(), + pid_r + .as_var() + .expect("invalid values should have been rejected on the prolog side"), fixnum_as_cell!(Fixnum::build_with(pid)), ); Ok(()) } - Err(err) => { - // TODO give better error indication - dbg!(err); - self.machine_st.fail = true; - Ok(()) + Err(_) => { + let perm_error = self.machine_st.permission_error( + Permission::Create, + atom!("process"), + stub_gen(), + ); + Err(self.machine_st.error_form(perm_error, stub_gen())) } } } @@ -8511,8 +8521,16 @@ impl Machine { Some(atom!("std")) => Stdio::inherit(), Some(atom!("null")) => Stdio::null(), Some(atom!("pipe")) => { - // TODO handler Err - let (reader, writer) = std::io::pipe().unwrap(); + let (reader, writer) = match std::io::pipe() { + Ok(pipe_pair) => pipe_pair, + Err(_) => { + return Err(self.machine_st.open_permission_error( + atom!("anonymous_pipe"), + atom!("process_create"), + 3, + )); + } + }; let stream = Stream::from_pipe_reader(reader, &mut self.machine_st.arena); @@ -8528,12 +8546,20 @@ impl Machine { Some(atom!("file")) => { let path = self.machine_st.value_to_str_like(args[1]).unwrap(); - // TODO handler Err - let file = std::fs::File::open(&*path.as_str()).unwrap(); + let file = match std::fs::File::open(&*path.as_str()) { + Ok(file) => file, + Err(_) => { + return Err(self.machine_st.open_permission_error( + args[1], + atom!("process_create"), + 3, + )); + } + }; Stdio::from(file) } _ => { - panic!("Invalid stdin tag") + panic!("Invalid stdout tag") } }) } @@ -8543,8 +8569,16 @@ impl Machine { Some(atom!("std")) => Stdio::inherit(), Some(atom!("null")) => Stdio::null(), Some(atom!("pipe")) => { - // TODO handler Err - let (reader, writer) = std::io::pipe().unwrap(); + let (reader, writer) = match std::io::pipe() { + Ok(pipe_pair) => pipe_pair, + Err(_) => { + return Err(self.machine_st.open_permission_error( + atom!("anonymous_pipe"), + atom!("process_create"), + 3, + )); + } + }; let stream = Stream::from_pipe_writer(writer, &mut self.machine_st.arena); @@ -8560,8 +8594,16 @@ impl Machine { Some(atom!("file")) => { let path = self.machine_st.value_to_str_like(args[1]).unwrap(); - // TODO handler Err - let file = std::fs::File::open(&*path.as_str()).unwrap(); + let file = match std::fs::File::open(&*path.as_str()) { + Ok(file) => file, + Err(_) => { + return Err(self.machine_st.open_permission_error( + args[1], + atom!("process_create"), + 3, + )); + } + }; Stdio::from(file) } _ => { From 1ee4f7a55f966afb54dbd2598c4c18be6f887c71 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 21:08:44 +0200 Subject: [PATCH 12/36] store child process in machine state --- src/machine/machine_state.rs | 3 +++ src/machine/machine_state_impl.rs | 2 ++ src/machine/system_calls.rs | 4 ++++ 3 files changed, 9 insertions(+) diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs index 7663c952..6d583b00 100644 --- a/src/machine/machine_state.rs +++ b/src/machine/machine_state.rs @@ -20,9 +20,11 @@ use crate::parser::dashu::Integer; use indexmap::IndexMap; +use std::collections::BTreeMap; use std::convert::TryFrom; use std::fmt; use std::ops::{Index, IndexMut, Range}; +use std::process::Child; use std::sync::Arc; pub(crate) type Registers = [HeapCellValue; MAX_ARITY + 1]; @@ -97,6 +99,7 @@ pub struct MachineState { pub(crate) unify_fn: fn(&mut MachineState), pub(crate) bind_fn: fn(&mut MachineState, Ref, HeapCellValue), pub(crate) run_cleaners_fn: fn(&mut Machine) -> bool, + pub(crate) child_processes: BTreeMap, } impl fmt::Debug for MachineState { diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs index 3f14253d..e8b9d644 100644 --- a/src/machine/machine_state_impl.rs +++ b/src/machine/machine_state_impl.rs @@ -19,6 +19,7 @@ use crate::types::*; use indexmap::IndexSet; use std::cmp::Ordering; +use std::collections::BTreeMap; use std::convert::TryFrom; impl MachineState { @@ -67,6 +68,7 @@ impl MachineState { unify_fn: MachineState::unify, bind_fn: MachineState::bind, run_cleaners_fn: |_| false, + child_processes: BTreeMap::new(), } } diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index d09344b0..ff95d22b 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8497,12 +8497,16 @@ impl Machine { match command.spawn() { Ok(child) => { let pid = child.id(); + + self.machine_st.child_processes.insert(pid, child); + self.machine_st.bind( pid_r .as_var() .expect("invalid values should have been rejected on the prolog side"), fixnum_as_cell!(Fixnum::build_with(pid)), ); + Ok(()) } Err(_) => { From 97e2e5d7f0259fcd066269fd37a46f0b9f9c9dbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 22:57:06 +0200 Subject: [PATCH 13/36] implement process_release/1, process_wait/2, process_wait/3, and process_kill/1 --- build/instructions_template.rs | 8 ++ src/lib/process.pl | 35 ++++++++- src/machine/dispatch.rs | 16 ++++ src/machine/machine_errors.rs | 12 +++ src/machine/system_calls.rs | 136 +++++++++++++++++++++++++++++++++ 5 files changed, 203 insertions(+), 4 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 6ea7a5a5..0c1320b1 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -539,6 +539,10 @@ enum SystemClauseType { Shell, #[strum_discriminants(strum(props(Arity = "8", Name = "$process_create")))] ProcessCreate, + #[strum_discriminants(strum(props(Arity = "3", Name = "$process_wait")))] + ProcessWait, + #[strum_discriminants(strum(props(Arity = "1", Name = "$process_kill")))] + ProcessKill, #[strum_discriminants(strum(props(Arity = "1", Name = "$pid")))] Pid, #[strum_discriminants(strum(props(Arity = "4", Name = "$chars_base64")))] @@ -1828,6 +1832,8 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallUnsetEnv | &Instruction::CallShell | &Instruction::CallProcessCreate | + &Instruction::CallProcessWait | + &Instruction::CallProcessKill | &Instruction::CallPid | &Instruction::CallCharsBase64 | &Instruction::CallDevourWhitespace | @@ -2067,6 +2073,8 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteUnsetEnv | &Instruction::ExecuteShell | &Instruction::ExecuteProcessCreate | + &Instruction::ExecuteProcessWait | + &Instruction::ExecuteProcessKill | &Instruction::ExecutePid | &Instruction::ExecuteCharsBase64 | &Instruction::ExecuteDevourWhitespace | diff --git a/src/lib/process.pl b/src/lib/process.pl index 645841ff..d7bd15f9 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -1,4 +1,10 @@ -:- module(process, [process_create/3]). +:- module(process, [ + process_create/3, + process_release/1, + process_wait/2, + process_wait/3, + process_kill/1 +]). :- use_module(library(error)). :- use_module(library(iso_ext)). @@ -27,6 +33,29 @@ process_create(Exe, Args, Options) :- simplify_env(Env, Env1), '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Pid). +process_wait(Pid, Status) :- process_wait(Pid, Status, []). + +process_wait(Pid, Status, Options) :- + must_be(integer, Pid), + must_be_known_options([timeout], [], Options),check_options( + [ + ([timeout], valid_timeout, infinite, timeout(Timeout)) + ], + Options + ), + '$process_wait'(Pid, Exit, Timeout), + Exit = Status. + +valid_timeout(timeout(infinite)). +valid_timeout(timeout(0)). + +process_kill(Pid) :- + must_be(integer, Pid), + '$process_kill'(Pid). + +process_release(Pid) :- process_wait(Pid, _). + + must_be_known_options(_, _, []). must_be_known_options(Valid, Found, [X|XS]) :- X =.. [Option|_], @@ -73,9 +102,7 @@ valid_env(environment(E)) :- ( valid_env_([]). valid_env_([E| ES]) :- - ( - E =.. [=, N, V] -> true ; - ), + E =.. [=, N, V], must_be(chars, N), must_be(chars, V), valid_env_(ES). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 36068ca2..66133c3c 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4795,6 +4795,22 @@ impl Machine { try_or_throw!(self.machine_st, self.process_create()); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallProcessWait => { + try_or_throw!(self.machine_st, self.process_wait()); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteProcessWait => { + try_or_throw!(self.machine_st, self.process_wait()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } + &Instruction::CallProcessKill => { + try_or_throw!(self.machine_st, self.process_kill()); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteProcessKill => { + try_or_throw!(self.machine_st, self.process_kill()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallPid => { self.pid(); step_or_fail!(self, self.machine_st.p += 1); diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index 4551991e..fec32ddd 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -405,6 +405,17 @@ impl MachineState { [atom_as_cell((atom!("stream"))), cell(culprit)] ); + MachineError { + stub, + location: None, + } + } + ExistenceError::Process(culprit) => { + let stub = functor!( + atom!("existence_error"), + [atom_as_cell((atom!("process"))), cell(culprit)] + ); + MachineError { stub, location: None, @@ -1003,6 +1014,7 @@ pub enum ExistenceError { }, SourceSink(HeapCellValue), Stream(HeapCellValue), + Process(HeapCellValue), } #[derive(Debug)] diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index ff95d22b..f40a6cbc 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8616,6 +8616,142 @@ impl Machine { }) } + pub(crate) fn process_wait(&mut self) -> CallResult { + fn stub_gen() -> Vec { + functor_stub(atom!("process_wait"), 2) + } + + // Pid + let pid_r = self.deref_register(1); + // Var | Status + let status_r = self.deref_register(2); + // timeout | 0 + let timeout_r = self.deref_register(3); + + let Some(pid) = pid_r + .to_fixnum() + .and_then(|elem| elem.get_num().try_into().ok()) + else { + let err = self + .machine_st + .existence_error(ExistenceError::Process(pid_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + }; + let Some(mut child) = self.machine_st.child_processes.remove(&pid) else { + let err = self + .machine_st + .existence_error(ExistenceError::Process(pid_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + }; + + let status = if let Some(atom) = timeout_r.to_atom() { + match atom { + atom!("infinite") => child.wait().map(Some), + _ => { + panic!("Invalid Timeout value") + } + } + } else if let Some(timeout) = timeout_r.to_fixnum() { + if timeout.get_num() == 0 { + child.try_wait() + } else { + panic!("Invalid Timeout value") + } + } else { + panic!("Invalid Timeout value") + }; + + match status { + Ok(None) => { + unify!(self.machine_st, status_r, atom_as_cell!(atom!("timeout"))); + Ok(()) + } + Ok(Some(exit_status)) => { + if let Some(exit_code) = exit_status.code() { + let mut writer = + Heap::functor_writer(functor!(atom!("exit"), [fixnum(exit_code)])); + + match writer(&mut self.machine_st.heap) { + Ok(loc) => { + unify!(self.machine_st, status_r, loc); + } + Err(resource_err_loc) => { + self.machine_st.throw_resource_error(resource_err_loc); + } + } + Ok(()) + } else { + #[cfg(unix)] + { + use std::os::unix::process::ExitStatusExt; + + if let Some(signal) = ExitStatusExt::signal(&exit_status) { + let mut writer = + Heap::functor_writer(functor!(atom!("signal"), [fixnum(signal)])); + + match writer(&mut self.machine_st.heap) { + Ok(loc) => { + unify!(self.machine_st, status_r, loc); + } + Err(resource_err_loc) => { + self.machine_st.throw_resource_error(resource_err_loc); + } + }; + Ok(()) + } else { + unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); + Ok(()) + } + } + #[cfg(not(unix))] + { + unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); + Ok(()) + } + } + } + Err(_) => { + let perm_error = self.machine_st.permission_error( + Permission::Modify, + atom!("process"), + stub_gen(), + ); + Err(self.machine_st.error_form(perm_error, stub_gen())) + } + } + } + + pub(crate) fn process_kill(&mut self) -> CallResult { + fn stub_gen() -> Vec { + functor_stub(atom!("process_kill"), 1) + } + + // Pid + let pid_r = self.deref_register(1); + let Some(pid) = pid_r + .to_fixnum() + .and_then(|elem| elem.get_num().try_into().ok()) + else { + let err = self + .machine_st + .existence_error(ExistenceError::Process(pid_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + }; + let Some(mut child) = self.machine_st.child_processes.remove(&pid) else { + let err = self + .machine_st + .existence_error(ExistenceError::Process(pid_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + }; + if child.kill().is_err() { + let perm_error = + self.machine_st + .permission_error(Permission::Modify, atom!("process"), stub_gen()); + return Err(self.machine_st.error_form(perm_error, stub_gen())); + } + Ok(()) + } + #[inline(always)] pub(crate) fn chars_base64(&mut self) -> CallResult { let padding = cell_as_atom!(self.deref_register(3)); From 746d4fd10663ce612b12b4727dfe331a348c5cce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 23:04:01 +0200 Subject: [PATCH 14/36] make atom!() with a new value less annoying --- build/static_string_indexing.rs | 1 + 1 file changed, 1 insertion(+) diff --git a/build/static_string_indexing.rs b/build/static_string_indexing.rs index a577a517..7309f1cf 100644 --- a/build/static_string_indexing.rs +++ b/build/static_string_indexing.rs @@ -194,6 +194,7 @@ pub fn index_static_strings(instruction_rs_path: &std::path::Path) -> TokenStrea macro_rules! atom { #((#static_str_keys) => { Atom { index: #indices } };)* + ($name:literal) => {compile_error!(concat!("unknown static atom ", $name))}; } pub static STATIC_ATOMS_MAP: phf::Map<&'static str, Atom> = phf::phf_map! { From ff546a0f9ad39e7d3561063a081ada67833de32e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 23:52:25 +0200 Subject: [PATCH 15/36] incorporate suggestion by triska --- src/lib/process.pl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index d7bd15f9..7a595c0b 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -101,8 +101,7 @@ valid_env(environment(E)) :- ( ). valid_env_([]). -valid_env_([E| ES]) :- - E =.. [=, N, V], +valid_env_([N=V|ES]) :- must_be(chars, N), must_be(chars, V), valid_env_(ES). From 7f233da10c6fef0b91de1d21e390e4165e55c9ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 20 Jul 2025 23:53:01 +0200 Subject: [PATCH 16/36] fix timeout default value in process_wait/3 --- src/lib/process.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 7a595c0b..b17b3224 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -39,7 +39,7 @@ process_wait(Pid, Status, Options) :- must_be(integer, Pid), must_be_known_options([timeout], [], Options),check_options( [ - ([timeout], valid_timeout, infinite, timeout(Timeout)) + ([timeout], valid_timeout, timeout(infinite), timeout(Timeout)) ], Options ), From ca52c65902987b47d1fd392a2f81cd4529c5a431 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Mon, 21 Jul 2025 00:06:03 +0200 Subject: [PATCH 17/36] don't remove the child on wait/kill - important for wait with timout(0) as we may want to try again until the process has realy exited. - make process_release release the process instead --- build/instructions_template.rs | 4 ++++ src/lib/process.pl | 4 +++- src/machine/dispatch.rs | 8 +++++++ src/machine/system_calls.rs | 43 ++++++++++++++++++++++++---------- 4 files changed, 45 insertions(+), 14 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 0c1320b1..346e68af 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -543,6 +543,8 @@ enum SystemClauseType { ProcessWait, #[strum_discriminants(strum(props(Arity = "1", Name = "$process_kill")))] ProcessKill, + #[strum_discriminants(strum(props(Arity = "1", Name = "$process_release")))] + ProcessRelease, #[strum_discriminants(strum(props(Arity = "1", Name = "$pid")))] Pid, #[strum_discriminants(strum(props(Arity = "4", Name = "$chars_base64")))] @@ -1834,6 +1836,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallProcessCreate | &Instruction::CallProcessWait | &Instruction::CallProcessKill | + &Instruction::CallProcessRelease | &Instruction::CallPid | &Instruction::CallCharsBase64 | &Instruction::CallDevourWhitespace | @@ -2075,6 +2078,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteProcessCreate | &Instruction::ExecuteProcessWait | &Instruction::ExecuteProcessKill | + &Instruction::ExecuteProcessRelease | &Instruction::ExecutePid | &Instruction::ExecuteCharsBase64 | &Instruction::ExecuteDevourWhitespace | diff --git a/src/lib/process.pl b/src/lib/process.pl index b17b3224..358484c5 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -53,7 +53,9 @@ process_kill(Pid) :- must_be(integer, Pid), '$process_kill'(Pid). -process_release(Pid) :- process_wait(Pid, _). +process_release(Pid) :- + process_wait(Pid, _), + '$process_release'(Pid). must_be_known_options(_, _, []). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 66133c3c..00396e23 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4811,6 +4811,14 @@ impl Machine { try_or_throw!(self.machine_st, self.process_kill()); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallProcessRelease => { + try_or_throw!(self.machine_st, self.process_release()); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteProcessRelease => { + try_or_throw!(self.machine_st, self.process_release()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallPid => { self.pid(); step_or_fail!(self, self.machine_st.p += 1); diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index f40a6cbc..a1eb15be 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8498,13 +8498,14 @@ impl Machine { Ok(child) => { let pid = child.id(); + dbg!(pid); + self.machine_st.child_processes.insert(pid, child); - self.machine_st.bind( - pid_r - .as_var() - .expect("invalid values should have been rejected on the prolog side"), - fixnum_as_cell!(Fixnum::build_with(pid)), + unify!( + self.machine_st, + pid_r, + fixnum_as_cell!(Fixnum::build_with(pid)) ); Ok(()) @@ -8637,7 +8638,7 @@ impl Machine { .existence_error(ExistenceError::Process(pid_r)); return Err(self.machine_st.error_form(err, stub_gen())); }; - let Some(mut child) = self.machine_st.child_processes.remove(&pid) else { + let Some(child) = self.machine_st.child_processes.get_mut(&pid) else { let err = self .machine_st .existence_error(ExistenceError::Process(pid_r)); @@ -8679,7 +8680,6 @@ impl Machine { self.machine_st.throw_resource_error(resource_err_loc); } } - Ok(()) } else { #[cfg(unix)] { @@ -8687,7 +8687,7 @@ impl Machine { if let Some(signal) = ExitStatusExt::signal(&exit_status) { let mut writer = - Heap::functor_writer(functor!(atom!("signal"), [fixnum(signal)])); + Heap::functor_writer(functor!(atom!("killed"), [fixnum(signal)])); match writer(&mut self.machine_st.heap) { Ok(loc) => { @@ -8696,19 +8696,17 @@ impl Machine { Err(resource_err_loc) => { self.machine_st.throw_resource_error(resource_err_loc); } - }; - Ok(()) + } } else { unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); - Ok(()) } } #[cfg(not(unix))] { unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); - Ok(()) } } + Ok(()) } Err(_) => { let perm_error = self.machine_st.permission_error( @@ -8737,7 +8735,7 @@ impl Machine { .existence_error(ExistenceError::Process(pid_r)); return Err(self.machine_st.error_form(err, stub_gen())); }; - let Some(mut child) = self.machine_st.child_processes.remove(&pid) else { + let Some(child) = self.machine_st.child_processes.get_mut(&pid) else { let err = self .machine_st .existence_error(ExistenceError::Process(pid_r)); @@ -8752,6 +8750,25 @@ impl Machine { Ok(()) } + pub(crate) fn process_release(&mut self) -> CallResult { + fn stub_gen() -> Vec { + functor_stub(atom!("process_release"), 1) + } + + let pid_r = self.deref_register(1); + let Some(pid) = pid_r + .to_fixnum() + .and_then(|elem| elem.get_num().try_into().ok()) + else { + let err = self + .machine_st + .existence_error(ExistenceError::Process(pid_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + }; + self.machine_st.child_processes.remove(&pid); + Ok(()) + } + #[inline(always)] pub(crate) fn chars_base64(&mut self) -> CallResult { let padding = cell_as_atom!(self.deref_register(3)); From 87dbad2294641c2a4951f62add343128b142ae57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Mon, 21 Jul 2025 00:06:46 +0200 Subject: [PATCH 18/36] fix rename pid to process --- src/lib/process.pl | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 358484c5..157aa520 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -15,14 +15,14 @@ process_create(Exe, Args, Options) :- must_be(list, Args), maplist(must_be(chars), Args), must_be(list, Options), - must_be_known_options([stdin, stdout, stderr, env, environment, pid, cwd], [], Options), + must_be_known_options([stdin, stdout, stderr, env, environment, process, cwd], [], Options), check_options( [ ([stdin], valid_stdio, stdin(std), stdin(Stdin)), ([stdout], valid_stdio, stdout(std), stdout(Stdout)), ([stderr], valid_stdio, stderr(std), stderr(Stderr)), ([env, environment], valid_env, environment([]), Env), - ([process], valid_pid, process(_), process(Pid)), + ([process], valid_process, process(_), process(Pid)), ([cwd], valid_cwd, cwd("."), cwd(Cwd)) ], Options @@ -108,7 +108,8 @@ valid_env_([N=V|ES]) :- must_be(chars, V), valid_env_(ES). -valid_pid(pid(Pid)) :- must_be(var, Pid). +valid_process(process(Pid)) :- must_be(var, Pid). + valid_cwd(cwd(Cwd)) :- must_be(chars, Cwd). simplify_env(E, [Kind, Envs1]) :- E =.. [Kind, Envs], simplify_env_(Envs, Envs1). From d2ffd4f4bf2bd82dbfcc3e378fd8a9da158ed299 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Mon, 21 Jul 2025 00:25:34 +0200 Subject: [PATCH 19/36] adjust error for duplicate options --- src/lib/process.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 157aa520..54707b7c 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -62,7 +62,7 @@ must_be_known_options(_, _, []). must_be_known_options(Valid, Found, [X|XS]) :- X =.. [Option|_], ( - member(Option, Found) -> error(evaluation_error(duplicate_options), process_create/3); + member(Option, Found) -> domain_error(non_duplicate_process_create_options, process_create/3); member(Option, Valid) -> true ; domain_error(process_create_option, Option, process_create/3) ), From dc495f10f8469700bc90e9f8ab30b2a8c5f9cc0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 13:14:29 +0200 Subject: [PATCH 20/36] change behaviour in supposedly unreachable cases --- src/machine/machine_errors.rs | 9 +++++++++ src/machine/system_calls.rs | 9 ++++++--- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index fec32ddd..084c8a83 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -601,6 +601,15 @@ impl MachineState { } } + pub(super) fn unreachable_error(&self) -> MachineError { + let stub = functor!(atom!("system_error")); + + MachineError { + stub, + location: None, + } + } + #[cfg(feature = "ffi")] pub(super) fn ffi_error(&self, err: FFIError) -> MachineError { let error_atom = match err { diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index a1eb15be..214c6d3a 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8680,6 +8680,7 @@ impl Machine { self.machine_st.throw_resource_error(resource_err_loc); } } + Ok(()) } else { #[cfg(unix)] { @@ -8697,16 +8698,18 @@ impl Machine { self.machine_st.throw_resource_error(resource_err_loc); } } + Ok(()) } else { - unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); + let err = self.machine_st.unreachable_error(); + Err(self.machine_st.error_form(err, stub_gen())) } } #[cfg(not(unix))] { - unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); + let err = self.machine_st.unreachable_error(); + Err(self.machine_st.error_form(err, stub_gen())) } } - Ok(()) } Err(_) => { let perm_error = self.machine_st.permission_error( From 1120bcde29ef331e00c83bb13072b0ce71c18754 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 13:30:56 +0200 Subject: [PATCH 21/36] add documentation --- src/lib/process.pl | 71 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) diff --git a/src/lib/process.pl b/src/lib/process.pl index 54707b7c..603a3260 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -10,6 +10,37 @@ :- use_module(library(iso_ext)). :- use_module(library(lists), [append/3, member/2, maplist/2, maplist/3, select/3]). + +%% process_create(+Exe, +Args:list, +Options). +% +% Create a new process by executing the executable Exe and passing it the Arguments Args. +% +% Note: On windows please take note of [windows argument splitting](https://doc.rust-lang.org/std/process/index.html#windows-argument-splitting). +% +% Options is a list consisting of the following options: +% +% * `cwd(+Path)` Set the processes working directory to `Path` +% * `process(-Pid)` `Pid` will be assigned the spawned processes process id +% * `env(+List)` Don't inherit environment variables and set the variables defined in `List` +% * `environment(+List)` Inherit environment variables and set/override the variables defined in `List` +% * `stdin(Spec)`, `stdout(Spec)` or `stderr(Spec)` defines how to redirect the spawned processes io streams +% +% The elements of `List` in `env(List)`/`environment(List)` List must be string pairs using `=/2`. +% `env/1` and `environment/1` may not be both specified. +% +% The following stdio `Spec` are available: +% +% * `std` inherit the current processes original stdio streams (does currently not account for stdio being changed by `set_input` or `set_output`) +% * `file(+Path)` attach the strea to the file at `Path` +% * `null` discards writes and behaves as eof for read. Equivalent to using `file(/dev/null)` +% * `pipe(-Steam)` create a new pipe and assigne one end to the created process and the other end to `Stream` +% +% Specifying an option multiple times is an error, when an option is not specified the following defaults apply: +% +% - `cwd(".")` +% - `environment([])` +% - `stdin(std)`, `stdout(std)`, `stderr(std)` +% process_create(Exe, Args, Options) :- must_be(chars, Exe), must_be(list, Args), @@ -33,8 +64,32 @@ process_create(Exe, Args, Options) :- simplify_env(Env, Env1), '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Pid). + +%% process_wait(+Pid, Status). +% +% See `process_create/3` with `Options = []` +% process_wait(Pid, Status) :- process_wait(Pid, Status, []). + +%% process_wait(+Pid, Status, Options). +% +% Wait for the child process with `Pid` to exit. +% +% Only works for processes spawned with `process_create/3` that have not yet been release with `process_release/1` +% +% When the process exits regulary `Status` will be unified with `exit(Exit)` where `Exit` is the processes exit code. +% When the process exits was killed `Status` will be unified with `killed(Signal)` where `Signal` is the signal number that killed the process. +% When the process doesn't exit before the timeout `Status` will be unified with `timeout`. +% +% `Options` is a a list of the following options +% +% * timeout(Timeout) supported values for `Timeout` are 0 or `infinite` +% +% Each options may be specified at most once, when an option is not specified the following defaults apply: +% +% - timeout(infinite) +% process_wait(Pid, Status, Options) :- must_be(integer, Pid), must_be_known_options([timeout], [], Options),check_options( @@ -49,10 +104,26 @@ process_wait(Pid, Status, Options) :- valid_timeout(timeout(infinite)). valid_timeout(timeout(0)). + +%% process_kill(+Pid). +% +% Kill the child process identified by `Pid`. +% On Unix this sends SIGKILL. +% +% Only works for processes spawned with `process_create/3` that have not yet been release with `process_release/1` +% process_kill(Pid) :- must_be(integer, Pid), '$process_kill'(Pid). +%% process_release(+Pid) +% +% release child process object of the process identified by `Pid` +% +% It's an error if +% * the `Pid` is not associated with a child process created by `process_create/3`, +% * the child project object has already been released +% process_release(Pid) :- process_wait(Pid, _), '$process_release'(Pid). From dc08a4ab11fcd9ee052215d4dae341e3346b91d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 18:21:00 +0200 Subject: [PATCH 22/36] get process_create working and add tests --- build/instructions_template.rs | 4 + src/arena.rs | 20 +++- src/heap_print.rs | 17 ++++ src/lib/lists.pl | 10 +- src/lib/process.pl | 70 +++++++------ src/machine/dispatch.rs | 8 ++ src/machine/machine_errors.rs | 2 + src/machine/machine_state.rs | 3 - src/machine/machine_state_impl.rs | 2 - src/machine/system_calls.rs | 148 ++++++++++++++++++---------- src/macros.rs | 6 ++ tests/scryer/cli/unix/process.md | 4 + tests/scryer/cli/windows/process.md | 4 + tests/scryer/main.rs | 16 ++- 14 files changed, 223 insertions(+), 91 deletions(-) create mode 100644 tests/scryer/cli/unix/process.md create mode 100644 tests/scryer/cli/windows/process.md diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 346e68af..1cf004b1 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -539,6 +539,8 @@ enum SystemClauseType { Shell, #[strum_discriminants(strum(props(Arity = "8", Name = "$process_create")))] ProcessCreate, + #[strum_discriminants(strum(props(Arity = "2", Name = "$process_id")))] + ProcessId, #[strum_discriminants(strum(props(Arity = "3", Name = "$process_wait")))] ProcessWait, #[strum_discriminants(strum(props(Arity = "1", Name = "$process_kill")))] @@ -1834,6 +1836,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallUnsetEnv | &Instruction::CallShell | &Instruction::CallProcessCreate | + &Instruction::CallProcessId | &Instruction::CallProcessWait | &Instruction::CallProcessKill | &Instruction::CallProcessRelease | @@ -2076,6 +2079,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteUnsetEnv | &Instruction::ExecuteShell | &Instruction::ExecuteProcessCreate | + &Instruction::ExecuteProcessId | &Instruction::ExecuteProcessWait | &Instruction::ExecuteProcessKill | &Instruction::ExecuteProcessRelease | diff --git a/src/arena.rs b/src/arena.rs index 2b312070..ee9dda20 100644 --- a/src/arena.rs +++ b/src/arena.rs @@ -20,6 +20,7 @@ use std::mem; use std::mem::ManuallyDrop; use std::net::TcpListener; use std::ops::{Deref, DerefMut}; +use std::process::Child; use std::ptr; use std::ptr::addr_of_mut; use std::ptr::NonNull; @@ -75,7 +76,8 @@ pub enum ArenaHeaderTag { HttpResponse = 0b1000010, PipeWriter = 0b1000011, Dropped = 0b1000100, - PipeReader = 0b1000101, + PipeReader = 0b1001001, + ChildProcess = 0b1001010, } #[bitfield] @@ -391,6 +393,19 @@ impl ArenaAllocated for HttpResponse { } } +impl ArenaAllocated for Child { + type Payload = ManuallyDrop; + #[inline] + fn tag() -> ArenaHeaderTag { + ArenaHeaderTag::ChildProcess + } +} +impl AllocateInArena for Child { + fn arena_allocate(self, arena: &mut Arena) -> TypedArenaPtr { + Child::alloc(arena, ManuallyDrop::new(self)) + } +} + #[repr(C)] #[derive(Debug)] pub struct AllocSlab { @@ -556,6 +571,9 @@ unsafe fn drop_slab_in_place(value: NonNull, tag: ArenaHeaderTag) { ArenaHeaderTag::PipeWriter => { drop_typed_slab_in_place!(PipeWriter, value); } + ArenaHeaderTag::ChildProcess => { + drop_typed_slab_in_place!(Child, value); + } ArenaHeaderTag::NullStream => { unreachable!("NullStream is never arena allocated!"); } diff --git a/src/heap_print.rs b/src/heap_print.rs index 57fef895..2186c8ed 100644 --- a/src/heap_print.rs +++ b/src/heap_print.rs @@ -1789,6 +1789,23 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { (ArenaHeaderTag::Dropped, _value) => { self.print_impromptu_atom(atom!("$dropped_value")); } + (ArenaHeaderTag::ChildProcess, process) => { + + let process_atom = atom!("$process"); + + if self.format_struct(max_depth, 1, process_atom) { + let atom = TokenOrRedirect::NumberFocus(max_depth, NumberFocus::Unfocused(Number::Fixnum(Fixnum::build_with(process.id()))), op); + + let process_root = self.state_stack.pop().unwrap(); + + self.state_stack.pop(); + self.state_stack.pop(); + + self.state_stack.push(atom); + self.state_stack.push(TokenOrRedirect::Open); + self.state_stack.push(process_root); + } + } _ => { } ); diff --git a/src/lib/lists.pl b/src/lib/lists.pl index 3d1cc6a2..9c972f01 100644 --- a/src/lib/lists.pl +++ b/src/lib/lists.pl @@ -7,7 +7,7 @@ List manipulation predicates maplist/3, maplist/4, maplist/5, maplist/6, maplist/7, maplist/8, maplist/9, same_length/2, nth0/3, nth0/4, nth1/3, nth1/4, sum_list/2, transpose/2, list_to_set/2, list_max/2, - list_min/2, permutation/2]). + list_min/2, permutation/2, filter/3]). /* Author: Mark Thom, Jan Wielemaker, and Richard O'Keefe Copyright (c) 2018-2021, Mark Thom @@ -538,3 +538,11 @@ perm([], []). perm(List, [First|Perm]) :- select(First, List, Rest), perm(Rest, Perm). + + +%% filter(+Predicate, ?Xs1 ?Xs2). +% +% Succeeds if Xs2 is the list of elements X from Xs1 for which call(Pred, X) succeeds. +% +filter(_, [], []). +filter(Pred, [X1|XS1], XS) :- call(Pred, X1) -> filter(Pred, XS1, XS2), XS = [X1|XS2] ; filter(Pred, XS1, XS). \ No newline at end of file diff --git a/src/lib/process.pl b/src/lib/process.pl index 603a3260..d66c2ea4 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -1,5 +1,6 @@ :- module(process, [ process_create/3, + process_id/2, process_release/1, process_wait/2, process_wait/3, @@ -8,7 +9,7 @@ :- use_module(library(error)). :- use_module(library(iso_ext)). -:- use_module(library(lists), [append/3, member/2, maplist/2, maplist/3, select/3]). +:- use_module(library(lists), [member/2, maplist/2, filter/3]). %% process_create(+Exe, +Args:list, +Options). @@ -20,7 +21,7 @@ % Options is a list consisting of the following options: % % * `cwd(+Path)` Set the processes working directory to `Path` -% * `process(-Pid)` `Pid` will be assigned the spawned processes process id +% * `process(-Process)` `Process` will be assigned a process handle for the spawned process % * `env(+List)` Don't inherit environment variables and set the variables defined in `List` % * `environment(+List)` Inherit environment variables and set/override the variables defined in `List` % * `stdin(Spec)`, `stdout(Spec)` or `stderr(Spec)` defines how to redirect the spawned processes io streams @@ -53,7 +54,7 @@ process_create(Exe, Args, Options) :- ([stdout], valid_stdio, stdout(std), stdout(Stdout)), ([stderr], valid_stdio, stderr(std), stderr(Stderr)), ([env, environment], valid_env, environment([]), Env), - ([process], valid_process, process(_), process(Pid)), + ([process], valid_uninit_process, process(_), process(Process)), ([cwd], valid_cwd, cwd("."), cwd(Cwd)) ], Options @@ -62,21 +63,27 @@ process_create(Exe, Args, Options) :- Stdout =.. Stdout1, Stderr =.. Stderr1, simplify_env(Env, Env1), - '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Pid). + '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Process). +%% process_id(+Process, -Pid). +% +process_id(Process, Pid) :- + valid_process(Process, process_id/2), + write(valid), nl, + must_be(var, Pid), + write(var), nl, + '$process_id'(Process, Pid). -%% process_wait(+Pid, Status). +%% process_wait(+Process, Status). % % See `process_create/3` with `Options = []` % -process_wait(Pid, Status) :- process_wait(Pid, Status, []). +process_wait(Process, Status) :- process_wait(Process, Status, []). -%% process_wait(+Pid, Status, Options). +%% process_wait(+Process, Status, Options). % -% Wait for the child process with `Pid` to exit. -% -% Only works for processes spawned with `process_create/3` that have not yet been release with `process_release/1` +% Wait for the process behind the process handle `Process` to exit. % % When the process exits regulary `Status` will be unified with `exit(Exit)` where `Exit` is the processes exit code. % When the process exits was killed `Status` will be unified with `killed(Signal)` where `Signal` is the signal number that killed the process. @@ -90,43 +97,42 @@ process_wait(Pid, Status) :- process_wait(Pid, Status, []). % % - timeout(infinite) % -process_wait(Pid, Status, Options) :- - must_be(integer, Pid), +process_wait(Process, Status, Options) :- + valid_process(Process, process_wait/3), must_be_known_options([timeout], [], Options),check_options( [ ([timeout], valid_timeout, timeout(infinite), timeout(Timeout)) ], Options ), - '$process_wait'(Pid, Exit, Timeout), + '$process_wait'(Process, Exit, Timeout), Exit = Status. valid_timeout(timeout(infinite)). valid_timeout(timeout(0)). -%% process_kill(+Pid). +%% process_kill(+Process). % -% Kill the child process identified by `Pid`. +% Kill the process using the process handle `Process`. % On Unix this sends SIGKILL. % % Only works for processes spawned with `process_create/3` that have not yet been release with `process_release/1` % -process_kill(Pid) :- - must_be(integer, Pid), - '$process_kill'(Pid). +process_kill(Process) :- + valid_process(Process, process_kill/1), + '$process_kill'(Process). -%% process_release(+Pid) +%% process_release(+Process) % -% release child process object of the process identified by `Pid` +% wait for the process to exit (if not already) and release process handle `Process` % -% It's an error if -% * the `Pid` is not associated with a child process created by `process_create/3`, -% * the child project object has already been released +% It's an error if `Process` is not a valid process handle % -process_release(Pid) :- - process_wait(Pid, _), - '$process_release'(Pid). +process_release(Process) :- + valid_process(Process, process_release/1), + process_wait(Process, _), + '$process_release'(Process). must_be_known_options(_, _, []). @@ -142,16 +148,16 @@ must_be_known_options(Valid, Found, [X|XS]) :- check_options([], _). check_options([X | XS], Options) :- (Kinds, Pred, Default, Choice) = X, - findall(P, find_option(Kinds, P, Options), Solutions), + filter(process:find_option(Kinds), Options, Solutions), ( Solutions = [] -> Choice = Default; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ; - error(evaluation_error(confliction_options), process_create/3) + error(evaluation_error(confliction_options, Solutions), process_create/3) ), check_options(XS, Options). -find_option([Kind|_], Found, Options) :- Found =.. [Kind,_], member(Found, Options). -find_option([_|Kinds], Found, Options) :- find_option(Kinds, Found, Options). +find_option([Kind|_], Found) :- Found =.. [Kind,_]. +find_option([_|Kinds], Found) :- find_option(Kinds, Found). valid_stdio(IO) :- IO =.. [_, Arg], ( @@ -179,7 +185,9 @@ valid_env_([N=V|ES]) :- must_be(chars, V), valid_env_(ES). -valid_process(process(Pid)) :- must_be(var, Pid). +valid_uninit_process(process(Process)) :- must_be(var, Process). + +valid_process(Process, Context) :- var(Process) -> instantiation_error(Context) ; true. valid_cwd(cwd(Cwd)) :- must_be(chars, Cwd). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 00396e23..8a8921e6 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4795,6 +4795,14 @@ impl Machine { try_or_throw!(self.machine_st, self.process_create()); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallProcessId => { + try_or_throw!(self.machine_st, self.process_id()); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteProcessId => { + try_or_throw!(self.machine_st, self.process_id()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallProcessWait => { try_or_throw!(self.machine_st, self.process_wait()); step_or_fail!(self, self.machine_st.p += 1); diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index 084c8a83..c6836709 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -44,6 +44,7 @@ pub(crate) enum ValidType { // PredicateIndicator, // Variable TcpListener, + Process, } impl ValidType { @@ -67,6 +68,7 @@ impl ValidType { // ValidType::PredicateIndicator => atom!("predicate_indicator"), // ValidType::Variable => atom!("variable") ValidType::TcpListener => atom!("tcp_listener"), + ValidType::Process => atom!("process"), } } } diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs index 6d583b00..7663c952 100644 --- a/src/machine/machine_state.rs +++ b/src/machine/machine_state.rs @@ -20,11 +20,9 @@ use crate::parser::dashu::Integer; use indexmap::IndexMap; -use std::collections::BTreeMap; use std::convert::TryFrom; use std::fmt; use std::ops::{Index, IndexMut, Range}; -use std::process::Child; use std::sync::Arc; pub(crate) type Registers = [HeapCellValue; MAX_ARITY + 1]; @@ -99,7 +97,6 @@ pub struct MachineState { pub(crate) unify_fn: fn(&mut MachineState), pub(crate) bind_fn: fn(&mut MachineState, Ref, HeapCellValue), pub(crate) run_cleaners_fn: fn(&mut Machine) -> bool, - pub(crate) child_processes: BTreeMap, } impl fmt::Debug for MachineState { diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs index e8b9d644..3f14253d 100644 --- a/src/machine/machine_state_impl.rs +++ b/src/machine/machine_state_impl.rs @@ -19,7 +19,6 @@ use crate::types::*; use indexmap::IndexSet; use std::cmp::Ordering; -use std::collections::BTreeMap; use std::convert::TryFrom; impl MachineState { @@ -68,7 +67,6 @@ impl MachineState { unify_fn: MachineState::unify, bind_fn: MachineState::bind, run_cleaners_fn: |_| false, - child_processes: BTreeMap::new(), } } diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 214c6d3a..0fc6e35d 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -56,6 +56,7 @@ use std::net::{SocketAddr, ToSocketAddrs}; use std::net::{TcpListener, TcpStream}; use std::num::NonZeroU32; use std::process; +use std::process::Child; use std::process::Stdio; #[cfg(feature = "http")] use std::str::FromStr; @@ -8496,16 +8497,13 @@ impl Machine { match command.spawn() { Ok(child) => { - let pid = child.id(); - - dbg!(pid); - - self.machine_st.child_processes.insert(pid, child); + let child_process_alloc: TypedArenaPtr = + arena_alloc!(child, &mut self.machine_st.arena); unify!( self.machine_st, pid_r, - fixnum_as_cell!(Fixnum::build_with(pid)) + typed_arena_ptr_as_cell!(child_process_alloc) ); Ok(()) @@ -8617,44 +8615,84 @@ impl Machine { }) } + pub(crate) fn process_id(&mut self) -> CallResult { + fn stub_gen() -> Vec { + functor_stub(atom!("process_id"), 2) + } + + // Process + let process_r = self.deref_register(1); + // Pid + let pid_r = self.deref_register(2); + + let Some(ptr) = process_r.to_untyped_arena_ptr() else { + let err = self.machine_st.type_error(ValidType::Process, process_r); + return Err(self.machine_st.error_form(err, stub_gen())); + }; + + let process = match_untyped_arena_ptr!(ptr, + (ArenaHeaderTag::ChildProcess, child_process) => { + child_process + } + (ArenaHeaderTag::Dropped, _dropped) => { + let err = self.machine_st.existence_error(ExistenceError::Process(process_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + } + _ => { + let err = self.machine_st.type_error(ValidType::Process, process_r); + return Err(self.machine_st.error_form(err, stub_gen())); + } + ); + + self.machine_st.bind( + pid_r.as_var().unwrap(), + fixnum_as_cell!(Fixnum::build_with(process.id())), + ); + + Ok(()) + } + pub(crate) fn process_wait(&mut self) -> CallResult { fn stub_gen() -> Vec { functor_stub(atom!("process_wait"), 2) } - // Pid - let pid_r = self.deref_register(1); + // Process + let process_r = self.deref_register(1); // Var | Status let status_r = self.deref_register(2); // timeout | 0 let timeout_r = self.deref_register(3); - let Some(pid) = pid_r - .to_fixnum() - .and_then(|elem| elem.get_num().try_into().ok()) - else { - let err = self - .machine_st - .existence_error(ExistenceError::Process(pid_r)); - return Err(self.machine_st.error_form(err, stub_gen())); - }; - let Some(child) = self.machine_st.child_processes.get_mut(&pid) else { - let err = self - .machine_st - .existence_error(ExistenceError::Process(pid_r)); + let Some(ptr) = process_r.to_untyped_arena_ptr() else { + let err = self.machine_st.type_error(ValidType::Process, process_r); return Err(self.machine_st.error_form(err, stub_gen())); }; + let mut process = match_untyped_arena_ptr!(ptr, + (ArenaHeaderTag::ChildProcess, child_process) => { + child_process + } + (ArenaHeaderTag::Dropped, _dropped) => { + let err = self.machine_st.existence_error(ExistenceError::Process(process_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + } + _ => { + let err = self.machine_st.type_error(ValidType::Process, process_r); + return Err(self.machine_st.error_form(err, stub_gen())); + } + ); + let status = if let Some(atom) = timeout_r.to_atom() { match atom { - atom!("infinite") => child.wait().map(Some), + atom!("infinite") => process.wait().map(Some), _ => { panic!("Invalid Timeout value") } } } else if let Some(timeout) = timeout_r.to_fixnum() { if timeout.get_num() == 0 { - child.try_wait() + process.try_wait() } else { panic!("Invalid Timeout value") } @@ -8728,23 +8766,28 @@ impl Machine { } // Pid - let pid_r = self.deref_register(1); - let Some(pid) = pid_r - .to_fixnum() - .and_then(|elem| elem.get_num().try_into().ok()) - else { - let err = self - .machine_st - .existence_error(ExistenceError::Process(pid_r)); + let process_r = self.deref_register(1); + + let Some(ptr) = process_r.to_untyped_arena_ptr() else { + let err = self.machine_st.type_error(ValidType::Process, process_r); return Err(self.machine_st.error_form(err, stub_gen())); }; - let Some(child) = self.machine_st.child_processes.get_mut(&pid) else { - let err = self - .machine_st - .existence_error(ExistenceError::Process(pid_r)); - return Err(self.machine_st.error_form(err, stub_gen())); - }; - if child.kill().is_err() { + + let mut process = match_untyped_arena_ptr!(ptr, + (ArenaHeaderTag::ChildProcess, child_process) => { + child_process + } + (ArenaHeaderTag::Dropped, _dropped) => { + let err = self.machine_st.existence_error(ExistenceError::Process(process_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + } + _ => { + let err = self.machine_st.type_error(ValidType::Process, process_r); + return Err(self.machine_st.error_form(err, stub_gen())); + } + ); + + if process.kill().is_err() { let perm_error = self.machine_st .permission_error(Permission::Modify, atom!("process"), stub_gen()); @@ -8758,18 +8801,23 @@ impl Machine { functor_stub(atom!("process_release"), 1) } - let pid_r = self.deref_register(1); - let Some(pid) = pid_r - .to_fixnum() - .and_then(|elem| elem.get_num().try_into().ok()) - else { - let err = self - .machine_st - .existence_error(ExistenceError::Process(pid_r)); - return Err(self.machine_st.error_form(err, stub_gen())); - }; - self.machine_st.child_processes.remove(&pid); - Ok(()) + let process = self.deref_register(1); + + if let Some(ptr) = process.to_untyped_arena_ptr() { + match_untyped_arena_ptr!(ptr, + (ArenaHeaderTag::ChildProcess, child_process) => { + child_process.drop_payload(); + + return Ok(()); + } + _ => { + } + ); + } + + let err = self.machine_st.type_error(ValidType::Process, process); + + Err(self.machine_st.error_form(err, stub_gen())) } #[inline(always)] diff --git a/src/macros.rs b/src/macros.rs index e301832b..10467419 100644 --- a/src/macros.rs +++ b/src/macros.rs @@ -218,6 +218,12 @@ macro_rules! match_untyped_arena_ptr_pat_body { #[allow(unused_braces)] $code }}; + ($ptr:ident, ChildProcess, $listener:ident, $code:expr) => {{ + #[allow(unused_mut)] + let mut $listener = unsafe { $ptr.as_typed_ptr::() }; + #[allow(unused_braces)] + $code + }}; ($ptr:ident, $($tags:tt)|+, $s:ident, $code:expr) => {{ let $s = Stream::from_tag($ptr.get_tag(), $ptr); #[allow(unused_braces)] diff --git a/tests/scryer/cli/unix/process.md b/tests/scryer/cli/unix/process.md new file mode 100644 index 00000000..8a1aef06 --- /dev/null +++ b/tests/scryer/cli/unix/process.md @@ -0,0 +1,4 @@ +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("false", [], [process(P)]), process_wait(P, exit(1)), halt' + +``` diff --git a/tests/scryer/cli/windows/process.md b/tests/scryer/cli/windows/process.md new file mode 100644 index 00000000..c83520cc --- /dev/null +++ b/tests/scryer/cli/windows/process.md @@ -0,0 +1,4 @@ +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("cmd", ["/C", "exit", "1"], [process(P)]), process_wait(P, exit(1)), halt' + +``` diff --git a/tests/scryer/main.rs b/tests/scryer/main.rs index a501bd42..19c78c59 100644 --- a/tests/scryer/main.rs +++ b/tests/scryer/main.rs @@ -19,9 +19,19 @@ mod src_tests; ignore = "miri isolation, unsupported operation: can't call foreign function" )] fn cli_tests() { - trycmd::TestCases::new() + let cases = trycmd::TestCases::new(); + cases .default_bin_name("scryer-prolog") .case("tests/scryer/cli/issues/*.toml") - .case("tests/scryer/cli/src_tests/*.toml") - .case("tests/scryer/cli/src_tests/*.md"); + .case("tests/scryer/cli/src_tests/*.toml"); + + #[cfg(windows)] + { + cases.case("tests/scryer/cli/windows/*.md"); + } + + #[cfg(unix)] + { + cases.case("tests/scryer/cli/unix/*.md"); + } } From ab675e071a2b16522424dceee0196b0451c94ade Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 18:46:47 +0200 Subject: [PATCH 23/36] adjust error kind --- src/lib/process.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index d66c2ea4..6f682ac8 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -152,7 +152,7 @@ check_options([X | XS], Options) :- ( Solutions = [] -> Choice = Default; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ; - error(evaluation_error(confliction_options, Solutions), process_create/3) + error(domain_error(non_confliction_process_options, Solutions), process_create/3) ), check_options(XS, Options). From 25edde2eb4f65e5d798a39499978e70baa200d98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 21:02:42 +0200 Subject: [PATCH 24/36] replace filter by tfiltert and fix Pipe{Reader,Writer} streams --- src/lib/lists.pl | 10 +--------- src/lib/process.pl | 19 ++++++++++++------- src/machine/streams.rs | 4 ++++ src/macros.rs | 14 ++++++++++++++ 4 files changed, 31 insertions(+), 16 deletions(-) diff --git a/src/lib/lists.pl b/src/lib/lists.pl index 9c972f01..3d1cc6a2 100644 --- a/src/lib/lists.pl +++ b/src/lib/lists.pl @@ -7,7 +7,7 @@ List manipulation predicates maplist/3, maplist/4, maplist/5, maplist/6, maplist/7, maplist/8, maplist/9, same_length/2, nth0/3, nth0/4, nth1/3, nth1/4, sum_list/2, transpose/2, list_to_set/2, list_max/2, - list_min/2, permutation/2, filter/3]). + list_min/2, permutation/2]). /* Author: Mark Thom, Jan Wielemaker, and Richard O'Keefe Copyright (c) 2018-2021, Mark Thom @@ -538,11 +538,3 @@ perm([], []). perm(List, [First|Perm]) :- select(First, List, Rest), perm(Rest, Perm). - - -%% filter(+Predicate, ?Xs1 ?Xs2). -% -% Succeeds if Xs2 is the list of elements X from Xs1 for which call(Pred, X) succeeds. -% -filter(_, [], []). -filter(Pred, [X1|XS1], XS) :- call(Pred, X1) -> filter(Pred, XS1, XS2), XS = [X1|XS2] ; filter(Pred, XS1, XS). \ No newline at end of file diff --git a/src/lib/process.pl b/src/lib/process.pl index 6f682ac8..d02713e9 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -9,7 +9,8 @@ :- use_module(library(error)). :- use_module(library(iso_ext)). -:- use_module(library(lists), [member/2, maplist/2, filter/3]). +:- use_module(library(lists), [member/2, maplist/2]). +:- use_module(library(reif), [tfilter/3]). %% process_create(+Exe, +Args:list, +Options). @@ -148,7 +149,7 @@ must_be_known_options(Valid, Found, [X|XS]) :- check_options([], _). check_options([X | XS], Options) :- (Kinds, Pred, Default, Choice) = X, - filter(process:find_option(Kinds), Options, Solutions), + tfilter(process:find_option(Kinds), Options, Solutions), ( Solutions = [] -> Choice = Default; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ; @@ -156,11 +157,11 @@ check_options([X | XS], Options) :- ), check_options(XS, Options). -find_option([Kind|_], Found) :- Found =.. [Kind,_]. -find_option([_|Kinds], Found) :- find_option(Kinds, Found). +find_option(Names, Found, T) :- (functor(Found, Name, 1), member(Name, Names)) -> T = true ; T = false. -valid_stdio(IO) :- IO =.. [_, Arg], +valid_stdio(IO) :- arg(1, IO, Arg), ( + var(Arg) -> instantiation_error(process_create/3) ; valid_stdio_(Arg) -> true ; domain_error(process_create_option, Arg, process_create/3) ). @@ -170,11 +171,15 @@ valid_stdio_(null). valid_stdio_(pipe(Stream)) :- must_be(var, Stream). valid_stdio_(file(Path)) :- must_be(chars, Path). -valid_env(env(E)) :- ( +valid_env(env(E)) :- + must_be(list, E), + ( valid_env_(E) -> true ; domain_error(process_create_option, env(E), process_create/3) ). -valid_env(environment(E)) :- ( +valid_env(environment(E)) :- + must_be(list, E), + ( valid_env_(E) -> true ; domain_error(process_create_option, environment(E), process_create/3) ). diff --git a/src/machine/streams.rs b/src/machine/streams.rs index 871ea617..596b09de 100644 --- a/src/machine/streams.rs +++ b/src/machine/streams.rs @@ -694,6 +694,8 @@ impl Stream { ArenaHeaderTag::InputChannelStream => { Stream::InputChannel(unsafe { ptr.as_typed_ptr() }) } + ArenaHeaderTag::PipeReader => Stream::PipeReader(unsafe { ptr.as_typed_ptr() }), + ArenaHeaderTag::PipeWriter => Stream::PipeWriter(unsafe { ptr.as_typed_ptr() }), _ => unreachable!(), } } @@ -1601,6 +1603,7 @@ impl Stream { | Stream::Readline(_) | Stream::StaticString(_) | Stream::InputFile(..) + | Stream::PipeReader(_) | Stream::Null(_) => true, _ => false, } @@ -1619,6 +1622,7 @@ impl Stream { | Stream::Byte(_) | Stream::OutputFile(..) | Stream::Callback(_) + | Stream::PipeWriter(_) | Stream::Null(_) => true, _ => false, } diff --git a/src/macros.rs b/src/macros.rs index 10467419..79470f18 100644 --- a/src/macros.rs +++ b/src/macros.rs @@ -218,6 +218,18 @@ macro_rules! match_untyped_arena_ptr_pat_body { #[allow(unused_braces)] $code }}; + ($ptr:ident, PipeReader, $listener:ident, $code:expr) => {{ + #[allow(unused_mut)] + let mut $listener = unsafe { $ptr.as_typed_ptr::() }; + #[allow(unused_braces)] + $code + }}; + ($ptr:ident, PipeWriter, $listener:ident, $code:expr) => {{ + #[allow(unused_mut)] + let mut $listener = unsafe { $ptr.as_typed_ptr::() }; + #[allow(unused_braces)] + $code + }}; ($ptr:ident, ChildProcess, $listener:ident, $code:expr) => {{ #[allow(unused_mut)] let mut $listener = unsafe { $ptr.as_typed_ptr::() }; @@ -246,6 +258,8 @@ macro_rules! match_untyped_arena_ptr_pat { | ArenaHeaderTag::InputChannelStream | ArenaHeaderTag::StandardOutputStream | ArenaHeaderTag::StandardErrorStream + | ArenaHeaderTag::PipeReader + | ArenaHeaderTag::PipeWriter }; ($tag:ident) => { ArenaHeaderTag::$tag From 70d65bcea841d8c2e2b8f16d34d2f9ea53683917 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 21:18:15 +0200 Subject: [PATCH 25/36] add another test and remove unecessary module qualification --- src/lib/process.pl | 2 +- tests/scryer/cli/windows/process.md | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index d02713e9..878b295d 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -149,7 +149,7 @@ must_be_known_options(Valid, Found, [X|XS]) :- check_options([], _). check_options([X | XS], Options) :- (Kinds, Pred, Default, Choice) = X, - tfilter(process:find_option(Kinds), Options, Solutions), + tfilter(find_option(Kinds), Options, Solutions), ( Solutions = [] -> Choice = Default; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ; diff --git a/tests/scryer/cli/windows/process.md b/tests/scryer/cli/windows/process.md index c83520cc..2b3fdbf5 100644 --- a/tests/scryer/cli/windows/process.md +++ b/tests/scryer/cli/windows/process.md @@ -2,3 +2,8 @@ $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("cmd", ["/C", "exit", "1"], [process(P)]), process_wait(P, exit(1)), halt' ``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), use_module(library(format)), process_create("cmd", [], [process(P), stdout(null), stdin(pipe(S))]), format(S, "exit 1~n", []), process_wait(P, Status), halt' + +``` \ No newline at end of file From eb82d1b6d40aa3aaf4f1eec7b071ad1a000c05a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 21:39:44 +0200 Subject: [PATCH 26/36] reformat ; --- src/lib/process.pl | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 878b295d..0d457d6d 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -139,10 +139,9 @@ process_release(Process) :- must_be_known_options(_, _, []). must_be_known_options(Valid, Found, [X|XS]) :- X =.. [Option|_], - ( - member(Option, Found) -> domain_error(non_duplicate_process_create_options, process_create/3); - member(Option, Valid) -> true ; - domain_error(process_create_option, Option, process_create/3) + ( member(Option, Found) -> domain_error(non_duplicate_process_create_options, process_create/3) + ; member(Option, Valid) -> true + ; domain_error(process_create_option, Option, process_create/3) ), must_be_known_options(Valid, [Option | Found], XS). @@ -150,20 +149,18 @@ check_options([], _). check_options([X | XS], Options) :- (Kinds, Pred, Default, Choice) = X, tfilter(find_option(Kinds), Options, Solutions), - ( - Solutions = [] -> Choice = Default; - Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ; - error(domain_error(non_confliction_process_options, Solutions), process_create/3) + ( Solutions = [] -> Choice = Default + ; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided + ; error(domain_error(non_confliction_process_options, Solutions), process_create/3) ), check_options(XS, Options). find_option(Names, Found, T) :- (functor(Found, Name, 1), member(Name, Names)) -> T = true ; T = false. valid_stdio(IO) :- arg(1, IO, Arg), - ( - var(Arg) -> instantiation_error(process_create/3) ; - valid_stdio_(Arg) -> true ; - domain_error(process_create_option, Arg, process_create/3) + ( var(Arg) -> instantiation_error(process_create/3) + ; valid_stdio_(Arg) -> true + ; domain_error(process_create_option, Arg, process_create/3) ). valid_stdio_(std). @@ -173,15 +170,13 @@ valid_stdio_(file(Path)) :- must_be(chars, Path). valid_env(env(E)) :- must_be(list, E), - ( - valid_env_(E) -> true ; - domain_error(process_create_option, env(E), process_create/3) + ( valid_env_(E) -> true + ; domain_error(process_create_option, env(E), process_create/3) ). valid_env(environment(E)) :- must_be(list, E), - ( - valid_env_(E) -> true ; - domain_error(process_create_option, environment(E), process_create/3) + ( valid_env_(E) -> true + ; domain_error(process_create_option, environment(E), process_create/3) ). valid_env_([]). From 62e43a3ab0364dfa1f372f055279903356f08dc3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 21:55:18 +0200 Subject: [PATCH 27/36] use functor/3 for must_be_known_options --- src/lib/process.pl | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 0d457d6d..2f8ceec1 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -10,7 +10,7 @@ :- use_module(library(error)). :- use_module(library(iso_ext)). :- use_module(library(lists), [member/2, maplist/2]). -:- use_module(library(reif), [tfilter/3]). +:- use_module(library(reif), [tfilter/3, memberd_t/3]). %% process_create(+Exe, +Args:list, +Options). @@ -138,7 +138,7 @@ process_release(Process) :- must_be_known_options(_, _, []). must_be_known_options(Valid, Found, [X|XS]) :- - X =.. [Option|_], + functor(X, Option, 1), ( member(Option, Found) -> domain_error(non_duplicate_process_create_options, process_create/3) ; member(Option, Valid) -> true ; domain_error(process_create_option, Option, process_create/3) @@ -155,7 +155,9 @@ check_options([X | XS], Options) :- ), check_options(XS, Options). -find_option(Names, Found, T) :- (functor(Found, Name, 1), member(Name, Names)) -> T = true ; T = false. +find_option(Names, Found, T) :- + functor(Found, Name, 1), + memberd_t(Name, Names, T). valid_stdio(IO) :- arg(1, IO, Arg), ( var(Arg) -> instantiation_error(process_create/3) From d0a6dc9df2b2a33bef002f34a19ec079537c4452 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 22:08:58 +0200 Subject: [PATCH 28/36] address comment by triska https://github.com/mthom/scryer-prolog/pull/3009#discussion_r2233221091 --- src/lib/process.pl | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 2f8ceec1..fcc17491 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -51,12 +51,12 @@ process_create(Exe, Args, Options) :- must_be_known_options([stdin, stdout, stderr, env, environment, process, cwd], [], Options), check_options( [ - ([stdin], valid_stdio, stdin(std), stdin(Stdin)), - ([stdout], valid_stdio, stdout(std), stdout(Stdout)), - ([stderr], valid_stdio, stderr(std), stderr(Stderr)), - ([env, environment], valid_env, environment([]), Env), - ([process], valid_uninit_process, process(_), process(Process)), - ([cwd], valid_cwd, cwd("."), cwd(Cwd)) + option([stdin], valid_stdio, stdin(std), stdin(Stdin)), + option([stdout], valid_stdio, stdout(std), stdout(Stdout)), + option([stderr], valid_stdio, stderr(std), stderr(Stderr)), + option([env, environment], valid_env, environment([]), Env), + option([process], valid_uninit_process, process(_), process(Process)), + option([cwd], valid_cwd, cwd("."), cwd(Cwd)) ], Options ), @@ -102,7 +102,7 @@ process_wait(Process, Status, Options) :- valid_process(Process, process_wait/3), must_be_known_options([timeout], [], Options),check_options( [ - ([timeout], valid_timeout, timeout(infinite), timeout(Timeout)) + option([timeout], valid_timeout, timeout(infinite), timeout(Timeout)) ], Options ), @@ -147,7 +147,7 @@ must_be_known_options(Valid, Found, [X|XS]) :- check_options([], _). check_options([X | XS], Options) :- - (Kinds, Pred, Default, Choice) = X, + option(Kinds, Pred, Default, Choice) = X, tfilter(find_option(Kinds), Options, Solutions), ( Solutions = [] -> Choice = Default ; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided From 143f32be233e8e19ad771b937c1a6d01db58af47 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 23:10:29 +0200 Subject: [PATCH 29/36] adjust options checking and add more tests --- src/lib/process.pl | 49 +++++++++++++++++---------- tests/scryer/cli/src_tests/process.md | 29 ++++++++++++++++ tests/scryer/main.rs | 3 +- 3 files changed, 62 insertions(+), 19 deletions(-) create mode 100644 tests/scryer/cli/src_tests/process.md diff --git a/src/lib/process.pl b/src/lib/process.pl index fcc17491..6f293179 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -9,7 +9,7 @@ :- use_module(library(error)). :- use_module(library(iso_ext)). -:- use_module(library(lists), [member/2, maplist/2]). +:- use_module(library(lists), [member/2, maplist/2, maplist/3, append/2]). :- use_module(library(reif), [tfilter/3, memberd_t/3]). @@ -48,7 +48,6 @@ process_create(Exe, Args, Options) :- must_be(list, Args), maplist(must_be(chars), Args), must_be(list, Options), - must_be_known_options([stdin, stdout, stderr, env, environment, process, cwd], [], Options), check_options( [ option([stdin], valid_stdio, stdin(std), stdin(Stdin)), @@ -58,7 +57,9 @@ process_create(Exe, Args, Options) :- option([process], valid_uninit_process, process(_), process(Process)), option([cwd], valid_cwd, cwd("."), cwd(Cwd)) ], - Options + Options, + process_create_option, + process_create/3 ), Stdin =.. Stdin1, Stdout =.. Stdout1, @@ -100,11 +101,13 @@ process_wait(Process, Status) :- process_wait(Process, Status, []). % process_wait(Process, Status, Options) :- valid_process(Process, process_wait/3), - must_be_known_options([timeout], [], Options),check_options( + check_options( [ option([timeout], valid_timeout, timeout(infinite), timeout(Timeout)) ], - Options + Options, + process_wait_option, + process_wait/3 ), '$process_wait'(Process, Exit, Timeout), Exit = Status. @@ -136,24 +139,34 @@ process_release(Process) :- '$process_release'(Process). -must_be_known_options(_, _, []). -must_be_known_options(Valid, Found, [X|XS]) :- - functor(X, Option, 1), - ( member(Option, Found) -> domain_error(non_duplicate_process_create_options, process_create/3) - ; member(Option, Valid) -> true - ; domain_error(process_create_option, Option, process_create/3) - ), - must_be_known_options(Valid, [Option | Found], XS). +must_be_known_options(Valid, Options, Domain, Context) :- must_be_known_options_(Valid, [], Options, Domain, Context). -check_options([], _). -check_options([X | XS], Options) :- +must_be_known_options_(_, _, [], _, _). +must_be_known_options_(Valid, Found, [X|XS], Domain, Context) :- + functor(X, Option, 1), + ( member(Option, Found) -> domain_error(non_duplicate_options, Option , Context) + ; member(Option, Valid) -> true + ; domain_error(Domain, Option, Context) + ), + must_be_known_options_(Valid, [Option | Found], XS, Domain, Context). + +check_options(KnownOptions, Options, Domain, Context) :- + maplist(option_names, KnownOptions, Namess), + append(Namess, Names), + must_be_known_options(Names, Options, Domain, Context), + check_options_(KnownOptions, Options, Context). + +option_names(option(Names,_,_,_), Names). + +check_options_([], _, _). +check_options_([X | XS], Options, Context) :- option(Kinds, Pred, Default, Choice) = X, tfilter(find_option(Kinds), Options, Solutions), ( Solutions = [] -> Choice = Default ; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided - ; error(domain_error(non_confliction_process_options, Solutions), process_create/3) + ; domain_error(non_conflicting_options, Solutions, Context) ), - check_options(XS, Options). + check_options_(XS, Options, Context). find_option(Names, Found, T) :- functor(Found, Name, 1), @@ -162,7 +175,7 @@ find_option(Names, Found, T) :- valid_stdio(IO) :- arg(1, IO, Arg), ( var(Arg) -> instantiation_error(process_create/3) ; valid_stdio_(Arg) -> true - ; domain_error(process_create_option, Arg, process_create/3) + ; domain_error(stdio_spec, Arg, process_create/3) ). valid_stdio_(std). diff --git a/tests/scryer/cli/src_tests/process.md b/tests/scryer/cli/src_tests/process.md new file mode 100644 index 00000000..76f8b3e4 --- /dev/null +++ b/tests/scryer/cli/src_tests/process.md @@ -0,0 +1,29 @@ +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid(_), process(P)]), process_kill(P, _), halt' +use_module(library(process)),process_create([],[],[invalid(_[..]),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(process_create_option,invalid),process_create/3) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(null), stdin(null), process(P)]), process_kill(P, _), halt' +use_module(library(process)),process_create([],[],[stdin(null),stdin(null),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(non_duplicate_options,stdin),process_create/3) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [env([]), environment([]), process(P)]), process_kill(P, _), halt' +use_module(library(process)),process_create([],[],[env([]),environment([]),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(non_conflicting_options,[env([]),environment([])]),process_create/3) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(pid, _, [invalid(_), timeout(0)]), halt' +use_module(library(process)),process_wait(pid,_[..],[invalid(_[..]),timeout(0)]),halt causes: error(domain_error(process_wait_option,invalid),process_wait/3) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(invalid), process(P)]), process_kill(P, _), halt' +use_module(library(process)),process_create([],[],[stdin(invalid),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(stdio_spec,invalid),process_create/3) + +``` diff --git a/tests/scryer/main.rs b/tests/scryer/main.rs index 19c78c59..c46ced24 100644 --- a/tests/scryer/main.rs +++ b/tests/scryer/main.rs @@ -23,7 +23,8 @@ fn cli_tests() { cases .default_bin_name("scryer-prolog") .case("tests/scryer/cli/issues/*.toml") - .case("tests/scryer/cli/src_tests/*.toml"); + .case("tests/scryer/cli/src_tests/*.toml") + .case("tests/scryer/cli/src_tests/*.md"); #[cfg(windows)] { From 409159d68dc6110b80f6668d1b32b429830c476a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 23:59:58 +0200 Subject: [PATCH 30/36] adjust/add tests --- tests/scryer/cli/unix/process.md | 10 ++++++++++ tests/scryer/cli/windows/process.md | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/tests/scryer/cli/unix/process.md b/tests/scryer/cli/unix/process.md index 8a1aef06..6bb174e4 100644 --- a/tests/scryer/cli/unix/process.md +++ b/tests/scryer/cli/unix/process.md @@ -2,3 +2,13 @@ $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("false", [], [process(P)]), process_wait(P, exit(1)), halt' ``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), use_module(library(format)), process_create("sh", [], [process(P), stdout(null), stdin(pipe(S))]), format(S, "exit 1~n", []), process_wait(P, exit(1)), halt' + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("sh", ["-c", "sleep 5"], [process(P), stdout(null)]), process_kill(P), process_wait(P, killed(9)), halt' + +``` \ No newline at end of file diff --git a/tests/scryer/cli/windows/process.md b/tests/scryer/cli/windows/process.md index 2b3fdbf5..da27656b 100644 --- a/tests/scryer/cli/windows/process.md +++ b/tests/scryer/cli/windows/process.md @@ -4,6 +4,6 @@ $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_cr ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), use_module(library(format)), process_create("cmd", [], [process(P), stdout(null), stdin(pipe(S))]), format(S, "exit 1~n", []), process_wait(P, Status), halt' +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), use_module(library(format)), process_create("cmd", [], [process(P), stdout(null), stdin(pipe(S))]), format(S, "exit 1~n", []), process_wait(P, exit(1)), halt' ``` \ No newline at end of file From 3a6b92d227bf682b41a0380e4d4ef3ec795f5e92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Sun, 27 Jul 2025 20:36:07 +0200 Subject: [PATCH 31/36] more tests --- src/lib/process.pl | 6 ++-- tests/scryer/cli/src_tests/process.md | 46 ++++++++++++++++++++++----- 2 files changed, 41 insertions(+), 11 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 6f293179..b754c331 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -71,9 +71,7 @@ process_create(Exe, Args, Options) :- % process_id(Process, Pid) :- valid_process(Process, process_id/2), - write(valid), nl, must_be(var, Pid), - write(var), nl, '$process_id'(Process, Pid). %% process_wait(+Process, Status). @@ -143,7 +141,9 @@ must_be_known_options(Valid, Options, Domain, Context) :- must_be_known_options_ must_be_known_options_(_, _, [], _, _). must_be_known_options_(Valid, Found, [X|XS], Domain, Context) :- - functor(X, Option, 1), + ( functor(X, Option, 1) -> true + ; domain_error(Domain, Option , Context) + ) , ( member(Option, Found) -> domain_error(non_duplicate_options, Option , Context) ; member(Option, Valid) -> true ; domain_error(Domain, Option, Context) diff --git a/tests/scryer/cli/src_tests/process.md b/tests/scryer/cli/src_tests/process.md index 76f8b3e4..39a955da 100644 --- a/tests/scryer/cli/src_tests/process.md +++ b/tests/scryer/cli/src_tests/process.md @@ -1,18 +1,24 @@ ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid(_), process(P)]), process_kill(P, _), halt' -use_module(library(process)),process_create([],[],[invalid(_[..]),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(process_create_option,invalid),process_create/3) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid, process(P)]), process_kill(P), halt' +use_module(library(process)),process_create([],[],[invalid,process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,_[..]),process_create/3) ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(null), stdin(null), process(P)]), process_kill(P, _), halt' -use_module(library(process)),process_create([],[],[stdin(null),stdin(null),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(non_duplicate_options,stdin),process_create/3) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid(_), process(P)]), process_kill(P), halt' +use_module(library(process)),process_create([],[],[invalid(_[..]),process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),process_create/3) ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [env([]), environment([]), process(P)]), process_kill(P, _), halt' -use_module(library(process)),process_create([],[],[env([]),environment([]),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(non_conflicting_options,[env([]),environment([])]),process_create/3) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(null), stdin(null), process(P)]), process_kill(P), halt' +use_module(library(process)),process_create([],[],[stdin(null),stdin(null),process(P)]),process_kill(P),halt causes: error(domain_error(non_duplicate_options,stdin),process_create/3) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [env([]), environment([]), process(P)]), process_kill(P), halt' +use_module(library(process)),process_create([],[],[env([]),environment([]),process(P)]),process_kill(P),halt causes: error(domain_error(non_conflicting_options,[env([]),environment([])]),process_create/3) ``` @@ -23,7 +29,31 @@ use_module(library(process)),process_wait(pid,_[..],[invalid(_[..]),timeout(0)]) ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(invalid), process(P)]), process_kill(P, _), halt' -use_module(library(process)),process_create([],[],[stdin(invalid),process(P)]),process_kill(P,_[..]),halt causes: error(domain_error(stdio_spec,invalid),process_create/3) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(invalid), process(P)]), process_kill(P), halt' +use_module(library(process)),process_create([],[],[stdin(invalid),process(P)]),process_kill(P),halt causes: error(domain_error(stdio_spec,invalid),process_create/3) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(50, _), halt' +use_module(library(process)),process_wait(50,_[..]),halt causes: error(type_error(process,50),process_wait/2) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_kill(50), halt' +use_module(library(process)),process_kill(50),halt causes: error(type_error(process,50),process_kill/1) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_id(50,_), halt' +use_module(library(process)),process_id(50,_[..]),halt causes: error(type_error(process,50),process_id/2) + +``` + +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_release(50), halt' +use_module(library(process)),process_release(50),halt causes: error(type_error(process,50),process_wait/2) ``` From b2d639b159dd9bbda24896dce24231206f892700 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Wed, 30 Jul 2025 21:22:37 +0200 Subject: [PATCH 32/36] fix arity of prcess_wait builtin errors --- src/machine/system_calls.rs | 2 +- tests/scryer/cli/src_tests/process.md | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 0fc6e35d..3f367a39 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8654,7 +8654,7 @@ impl Machine { pub(crate) fn process_wait(&mut self) -> CallResult { fn stub_gen() -> Vec { - functor_stub(atom!("process_wait"), 2) + functor_stub(atom!("process_wait"), 3) } // Process diff --git a/tests/scryer/cli/src_tests/process.md b/tests/scryer/cli/src_tests/process.md index 39a955da..59e8de10 100644 --- a/tests/scryer/cli/src_tests/process.md +++ b/tests/scryer/cli/src_tests/process.md @@ -36,7 +36,7 @@ use_module(library(process)),process_create([],[],[stdin(invalid),process(P)]),p ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(50, _), halt' -use_module(library(process)),process_wait(50,_[..]),halt causes: error(type_error(process,50),process_wait/2) +use_module(library(process)),process_wait(50,_[..]),halt causes: error(type_error(process,50),process_wait/3) ``` @@ -54,6 +54,6 @@ use_module(library(process)),process_id(50,_[..]),halt causes: error(type_error( ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_release(50), halt' -use_module(library(process)),process_release(50),halt causes: error(type_error(process,50),process_wait/2) +use_module(library(process)),process_release(50),halt causes: error(type_error(process,50),process_wait/3) ``` From 45041be336cd052f605cb8dc74d72830cb666dcb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Wed, 30 Jul 2025 22:14:43 +0200 Subject: [PATCH 33/36] fix culprit --- src/lib/process.pl | 2 +- tests/scryer/cli/src_tests/process.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index b754c331..12650416 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -142,7 +142,7 @@ must_be_known_options(Valid, Options, Domain, Context) :- must_be_known_options_ must_be_known_options_(_, _, [], _, _). must_be_known_options_(Valid, Found, [X|XS], Domain, Context) :- ( functor(X, Option, 1) -> true - ; domain_error(Domain, Option , Context) + ; domain_error(Domain, X , Context) ) , ( member(Option, Found) -> domain_error(non_duplicate_options, Option , Context) ; member(Option, Valid) -> true diff --git a/tests/scryer/cli/src_tests/process.md b/tests/scryer/cli/src_tests/process.md index 59e8de10..bb198d23 100644 --- a/tests/scryer/cli/src_tests/process.md +++ b/tests/scryer/cli/src_tests/process.md @@ -1,6 +1,6 @@ ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid, process(P)]), process_kill(P), halt' -use_module(library(process)),process_create([],[],[invalid,process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,_[..]),process_create/3) +use_module(library(process)),process_create([],[],[invalid,process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),process_create/3) ``` From fadd3a0839ef437c37f8a82e33e436ec2b953787 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Wed, 30 Jul 2025 22:19:03 +0200 Subject: [PATCH 34/36] use named vars instead of wildcards makes updating tests easier as globs are sometimes lost when using TRYCMD=overwrite --- tests/scryer/cli/src_tests/process.md | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/scryer/cli/src_tests/process.md b/tests/scryer/cli/src_tests/process.md index bb198d23..03ba7802 100644 --- a/tests/scryer/cli/src_tests/process.md +++ b/tests/scryer/cli/src_tests/process.md @@ -5,8 +5,8 @@ use_module(library(process)),process_create([],[],[invalid,process(P)]),process_ ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid(_), process(P)]), process_kill(P), halt' -use_module(library(process)),process_create([],[],[invalid(_[..]),process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),process_create/3) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid(_Var), process(P)]), process_kill(P), halt' +use_module(library(process)),process_create([],[],[invalid(_Var),process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),process_create/3) ``` @@ -23,8 +23,8 @@ use_module(library(process)),process_create([],[],[env([]),environment([]),proce ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(pid, _, [invalid(_), timeout(0)]), halt' -use_module(library(process)),process_wait(pid,_[..],[invalid(_[..]),timeout(0)]),halt causes: error(domain_error(process_wait_option,invalid),process_wait/3) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(pid, _Status, [invalid(_Var), timeout(0)]), halt' +use_module(library(process)),process_wait(pid,_Status,[invalid(_Var),timeout(0)]),halt causes: error(domain_error(process_wait_option,invalid),process_wait/3) ``` @@ -35,8 +35,8 @@ use_module(library(process)),process_create([],[],[stdin(invalid),process(P)]),p ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(50, _), halt' -use_module(library(process)),process_wait(50,_[..]),halt causes: error(type_error(process,50),process_wait/3) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(50, _Status), halt' +use_module(library(process)),process_wait(50,_Status),halt causes: error(type_error(process,50),process_wait/3) ``` @@ -47,8 +47,8 @@ use_module(library(process)),process_kill(50),halt causes: error(type_error(proc ``` ```trycmd -$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_id(50,_), halt' -use_module(library(process)),process_id(50,_[..]),halt causes: error(type_error(process,50),process_id/2) +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_id(50,_Pid), halt' +use_module(library(process)),process_id(50,_Pid),halt causes: error(type_error(process,50),process_id/2) ``` From d907f86c8d3bf5b5429c9f53187b65473fcbfce0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Wed, 30 Jul 2025 22:21:00 +0200 Subject: [PATCH 35/36] use call_with_error_context --- src/lib/process.pl | 80 +++++++++++++++------------ tests/scryer/cli/src_tests/process.md | 20 +++---- 2 files changed, 56 insertions(+), 44 deletions(-) diff --git a/src/lib/process.pl b/src/lib/process.pl index 12650416..57c71426 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -43,7 +43,9 @@ % - `environment([])` % - `stdin(std)`, `stdout(std)`, `stderr(std)` % -process_create(Exe, Args, Options) :- +process_create(Exe, Args, Options) :- call_with_error_context(process_create_(Exe, Args, Options), predicate-process_create/3). + +process_create_(Exe, Args, Options) :- must_be(chars, Exe), must_be(list, Args), maplist(must_be(chars), Args), @@ -58,8 +60,7 @@ process_create(Exe, Args, Options) :- option([cwd], valid_cwd, cwd("."), cwd(Cwd)) ], Options, - process_create_option, - process_create/3 + process_create_option ), Stdin =.. Stdin1, Stdout =.. Stdout1, @@ -69,8 +70,10 @@ process_create(Exe, Args, Options) :- %% process_id(+Process, -Pid). % -process_id(Process, Pid) :- - valid_process(Process, process_id/2), +process_id(Process, Pid) :- call_with_error_context(process_id_(Process, Pid), predicate-process_id/2). + +process_id_(Process, Pid) :- + valid_process(Process), must_be(var, Pid), '$process_id'(Process, Pid). @@ -78,7 +81,7 @@ process_id(Process, Pid) :- % % See `process_create/3` with `Options = []` % -process_wait(Process, Status) :- process_wait(Process, Status, []). +process_wait(Process, Status) :- call_with_error_context(process_wait(Process, Status, []), predicate-process_wait/2). %% process_wait(+Process, Status, Options). @@ -97,15 +100,16 @@ process_wait(Process, Status) :- process_wait(Process, Status, []). % % - timeout(infinite) % -process_wait(Process, Status, Options) :- - valid_process(Process, process_wait/3), +process_wait(Process, Status, Options) :- call_with_error_context(process_wait_(Process, Status, Options), predicate-process_wait/3). + +process_wait_(Process, Status, Options) :- + valid_process(Process), check_options( [ option([timeout], valid_timeout, timeout(infinite), timeout(Timeout)) ], Options, - process_wait_option, - process_wait/3 + process_wait_option ), '$process_wait'(Process, Exit, Timeout), Exit = Status. @@ -121,8 +125,10 @@ valid_timeout(timeout(0)). % % Only works for processes spawned with `process_create/3` that have not yet been release with `process_release/1` % -process_kill(Process) :- - valid_process(Process, process_kill/1), +process_kill(Process) :- call_with_error_context(process_kill_(Process), predicate-process_kill/1). + +process_kill_(Process) :- + valid_process(Process), '$process_kill'(Process). %% process_release(+Process) @@ -131,51 +137,57 @@ process_kill(Process) :- % % It's an error if `Process` is not a valid process handle % -process_release(Process) :- - valid_process(Process, process_release/1), +process_release(Process) :- call_with_error_context(process_release_(Process), predicate-process_release/1). + +process_release_(Process) :- + valid_process(Process), process_wait(Process, _), '$process_release'(Process). -must_be_known_options(Valid, Options, Domain, Context) :- must_be_known_options_(Valid, [], Options, Domain, Context). +must_be_known_options(Valid, Options, Domain) :- call_with_error_context(must_be_known_options_(Valid, [], Options, Domain),predicate-must_be_known_options/3). -must_be_known_options_(_, _, [], _, _). -must_be_known_options_(Valid, Found, [X|XS], Domain, Context) :- +must_be_known_options_(_, _, [], _). +must_be_known_options_(Valid, Found, [X|XS], Domain) :- ( functor(X, Option, 1) -> true - ; domain_error(Domain, X , Context) + ; domain_error(Domain, X, []) ) , - ( member(Option, Found) -> domain_error(non_duplicate_options, Option , Context) + ( member(Option, Found) -> domain_error(non_duplicate_options, Option , []) ; member(Option, Valid) -> true - ; domain_error(Domain, Option, Context) + ; domain_error(Domain, Option, []) ), - must_be_known_options_(Valid, [Option | Found], XS, Domain, Context). + must_be_known_options_(Valid, [Option | Found], XS, Domain). -check_options(KnownOptions, Options, Domain, Context) :- +check_options(KnownOptions, Options, Domain) :- call_with_error_context(check_options_(KnownOptions, Options, Domain), predicate-check_options/3). + +check_options_(KnownOptions, Options, Domain) :- maplist(option_names, KnownOptions, Namess), append(Namess, Names), - must_be_known_options(Names, Options, Domain, Context), - check_options_(KnownOptions, Options, Context). + must_be_known_options(Names, Options, Domain), + extract_options(KnownOptions, Options). option_names(option(Names,_,_,_), Names). -check_options_([], _, _). -check_options_([X | XS], Options, Context) :- +extract_options(KnownOptions, Options) :- call_with_error_context(extract_options_(KnownOptions, Options), predicate-extract_options/2). + +extract_options_([], _). +extract_options_([X | XS], Options) :- option(Kinds, Pred, Default, Choice) = X, tfilter(find_option(Kinds), Options, Solutions), ( Solutions = [] -> Choice = Default - ; Solutions = [Provided] -> call(Pred, Provided), Choice = Provided - ; domain_error(non_conflicting_options, Solutions, Context) + ; Solutions = [Provided] -> functor(Pred, Name, Arity), ArityP1 is Arity+1, call_with_error_context(call(Pred, Provided),predicate-Name/ArityP1), Choice = Provided + ; domain_error(non_conflicting_options, Solutions, []) ), - check_options_(XS, Options, Context). + extract_options_(XS, Options). find_option(Names, Found, T) :- functor(Found, Name, 1), memberd_t(Name, Names, T). valid_stdio(IO) :- arg(1, IO, Arg), - ( var(Arg) -> instantiation_error(process_create/3) + ( var(Arg) -> instantiation_error([]) ; valid_stdio_(Arg) -> true - ; domain_error(stdio_spec, Arg, process_create/3) + ; domain_error(stdio_spec, Arg, []) ). valid_stdio_(std). @@ -186,12 +198,12 @@ valid_stdio_(file(Path)) :- must_be(chars, Path). valid_env(env(E)) :- must_be(list, E), ( valid_env_(E) -> true - ; domain_error(process_create_option, env(E), process_create/3) + ; domain_error(process_create_option, env(E), []) ). valid_env(environment(E)) :- must_be(list, E), ( valid_env_(E) -> true - ; domain_error(process_create_option, environment(E), process_create/3) + ; domain_error(process_create_option, environment(E), []) ). valid_env_([]). @@ -202,7 +214,7 @@ valid_env_([N=V|ES]) :- valid_uninit_process(process(Process)) :- must_be(var, Process). -valid_process(Process, Context) :- var(Process) -> instantiation_error(Context) ; true. +valid_process(Process) :- var(Process) -> instantiation_error([]) ; true. valid_cwd(cwd(Cwd)) :- must_be(chars, Cwd). diff --git a/tests/scryer/cli/src_tests/process.md b/tests/scryer/cli/src_tests/process.md index 03ba7802..fb0dccd8 100644 --- a/tests/scryer/cli/src_tests/process.md +++ b/tests/scryer/cli/src_tests/process.md @@ -1,59 +1,59 @@ ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid, process(P)]), process_kill(P), halt' -use_module(library(process)),process_create([],[],[invalid,process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),process_create/3) +use_module(library(process)),process_create([],[],[invalid,process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),[predicate-process_create/3,predicate-check_options/3,predicate-must_be_known_options/3]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [invalid(_Var), process(P)]), process_kill(P), halt' -use_module(library(process)),process_create([],[],[invalid(_Var),process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),process_create/3) +use_module(library(process)),process_create([],[],[invalid(_Var),process(P)]),process_kill(P),halt causes: error(domain_error(process_create_option,invalid),[predicate-process_create/3,predicate-check_options/3,predicate-must_be_known_options/3]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(null), stdin(null), process(P)]), process_kill(P), halt' -use_module(library(process)),process_create([],[],[stdin(null),stdin(null),process(P)]),process_kill(P),halt causes: error(domain_error(non_duplicate_options,stdin),process_create/3) +use_module(library(process)),process_create([],[],[stdin(null),stdin(null),process(P)]),process_kill(P),halt causes: error(domain_error(non_duplicate_options,stdin),[predicate-process_create/3,predicate-check_options/3,predicate-must_be_known_options/3]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [env([]), environment([]), process(P)]), process_kill(P), halt' -use_module(library(process)),process_create([],[],[env([]),environment([]),process(P)]),process_kill(P),halt causes: error(domain_error(non_conflicting_options,[env([]),environment([])]),process_create/3) +use_module(library(process)),process_create([],[],[env([]),environment([]),process(P)]),process_kill(P),halt causes: error(domain_error(non_conflicting_options,[env([]),environment([])]),[predicate-process_create/3,predicate-check_options/3,predicate-extract_options/2]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(pid, _Status, [invalid(_Var), timeout(0)]), halt' -use_module(library(process)),process_wait(pid,_Status,[invalid(_Var),timeout(0)]),halt causes: error(domain_error(process_wait_option,invalid),process_wait/3) +use_module(library(process)),process_wait(pid,_Status,[invalid(_Var),timeout(0)]),halt causes: error(domain_error(process_wait_option,invalid),[predicate-process_wait/3,predicate-check_options/3,predicate-must_be_known_options/3]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("", [], [stdin(invalid), process(P)]), process_kill(P), halt' -use_module(library(process)),process_create([],[],[stdin(invalid),process(P)]),process_kill(P),halt causes: error(domain_error(stdio_spec,invalid),process_create/3) +use_module(library(process)),process_create([],[],[stdin(invalid),process(P)]),process_kill(P),halt causes: error(domain_error(stdio_spec,invalid),[predicate-process_create/3,predicate-check_options/3,predicate-extract_options/2,predicate-valid_stdio/1]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_wait(50, _Status), halt' -use_module(library(process)),process_wait(50,_Status),halt causes: error(type_error(process,50),process_wait/3) +use_module(library(process)),process_wait(50,_Status),halt causes: error(type_error(process,50),[predicate-process_wait/2,predicate-process_wait/3|process_wait/3]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_kill(50), halt' -use_module(library(process)),process_kill(50),halt causes: error(type_error(process,50),process_kill/1) +use_module(library(process)),process_kill(50),halt causes: error(type_error(process,50),[predicate-process_kill/1|process_kill/1]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_id(50,_Pid), halt' -use_module(library(process)),process_id(50,_Pid),halt causes: error(type_error(process,50),process_id/2) +use_module(library(process)),process_id(50,_Pid),halt causes: error(type_error(process,50),[predicate-process_id/2|process_id/2]) ``` ```trycmd $ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_release(50), halt' -use_module(library(process)),process_release(50),halt causes: error(type_error(process,50),process_wait/3) +use_module(library(process)),process_release(50),halt causes: error(type_error(process,50),[predicate-process_release/1,predicate-process_wait/2,predicate-process_wait/3|process_wait/3]) ``` From a2e19bd483dd900ba29e2b900bee7f2457623b3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bennet=20Ble=C3=9Fmann?= Date: Fri, 1 Aug 2025 21:19:52 +0200 Subject: [PATCH 36/36] add process module to all_modules test --- tests/scryer/cli/src_tests/all_modules.stdin | 1 + tests/scryer/cli/src_tests/all_modules.stdout | 1 + 2 files changed, 2 insertions(+) diff --git a/tests/scryer/cli/src_tests/all_modules.stdin b/tests/scryer/cli/src_tests/all_modules.stdin index c61818fe..24338cf0 100644 --- a/tests/scryer/cli/src_tests/all_modules.stdin +++ b/tests/scryer/cli/src_tests/all_modules.stdin @@ -27,6 +27,7 @@ use_module(library(ordsets)). use_module(library(os)). use_module(library(pairs)). use_module(library(pio)). +use_module(library(process)). use_module(library(queues)). use_module(library(random)). use_module(library(reif)). diff --git a/tests/scryer/cli/src_tests/all_modules.stdout b/tests/scryer/cli/src_tests/all_modules.stdout index 4e32a715..5ae49ac4 100644 --- a/tests/scryer/cli/src_tests/all_modules.stdout +++ b/tests/scryer/cli/src_tests/all_modules.stdout @@ -45,3 +45,4 @@ true. true. true. + true.