From f9c4a40d6096681f7caa530b9fd789e6b39f72c4 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 15 Mar 2020 23:29:21 -0600 Subject: [PATCH] add set_input/1, set_output/1 --- src/prolog/clause_types.rs | 6 +++ src/prolog/heap_print.rs | 7 +-- src/prolog/lib/builtins.pl | 19 +++++-- src/prolog/machine/machine_errors.rs | 73 +++++++++++++++++++------- src/prolog/machine/system_calls.rs | 78 +++++++++++++++++++++++++++- 5 files changed, 155 insertions(+), 28 deletions(-) diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index 14d2498f..5068ffc2 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -231,6 +231,8 @@ pub enum SystemClauseType { RetractClause, RestoreCutPolicy, SetCutPoint(RegType), + SetInput, + SetOutput, StoreGlobalVar, StoreGlobalVarWithOffset, InferenceLevel, @@ -373,6 +375,8 @@ impl SystemClauseType { &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"), &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"), &SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"), + &SystemClauseType::SetInput => clause_name!("$set_input"), + &SystemClauseType::SetOutput => clause_name!("$set_output"), &SystemClauseType::SetSeed => clause_name!("$set_seed"), &SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"), &SystemClauseType::StoreGlobalVarWithOffset => { @@ -493,6 +497,8 @@ impl SystemClauseType { ("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter), ("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy), ("$set_cp", 1) => Some(SystemClauseType::SetCutPoint(temp_v!(1))), + ("$set_input", 1) => Some(SystemClauseType::SetInput), + ("$set_output", 1) => Some(SystemClauseType::SetOutput), ("$inference_level", 2) => Some(SystemClauseType::InferenceLevel), ("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock), ("$erase_ball", 0) => Some(SystemClauseType::EraseBall), diff --git a/src/prolog/heap_print.rs b/src/prolog/heap_print.rs index d7afc429..c4fd9307 100644 --- a/src/prolog/heap_print.rs +++ b/src/prolog/heap_print.rs @@ -1315,12 +1315,9 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { self.print_atom(alias); } else { if stream.is_stdout() || stream.is_stdin() { - self.append_str("user"); + self.print_atom(&clause_name!("user")); } else { - self.append_str(&format!( - "'$stream'(0x{:x})", - stream.as_ptr() as usize, - )); + self.format_struct(iter, max_depth, 1, clause_name!("$stream")); } } } diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index bf082f35..352a18a9 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -50,9 +50,10 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- findall/3, findall/4, get_char/1, halt/0, max_arity/1, number_chars/2, number_codes/2, once/1, op/3, read_term/2, repeat/0, retract/1, - set_prolog_flag/2, setof/3, sub_atom/5, - subsumes_term/2, term_variables/2, throw/1, - true/0, unify_with_occurs_check/2, write/1, + set_prolog_flag/2, set_input/1, set_output/1, + setof/3, sub_atom/5, subsumes_term/2, + term_variables/2, throw/1, true/0, + unify_with_occurs_check/2, write/1, write_canonical/1, write_term/2, writeq/1]). @@ -1021,3 +1022,15 @@ unify_with_occurs_check(X, Y) :- '$unify_with_occurs_check'(X, Y). current_input(S) :- '$current_input'(S). current_output(S) :- '$current_output'(S). + +set_input(S) :- + ( var(S) -> + throw(error(instantiation_error, set_input/1)) + ; '$set_input'(S) + ). + +set_output(S) :- + ( var(S) -> + throw(error(instantiation_error, set_output/1)) + ; '$set_output'(S) + ). diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index 073b3f3d..f120628f 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -41,7 +41,8 @@ impl MachineError { } } - pub(super) fn type_error(valid_type: ValidType, culprit: Addr) -> Self { + pub(super) + fn type_error(valid_type: ValidType, culprit: Addr) -> Self { let stub = functor!( "type_error", 2, @@ -58,7 +59,8 @@ impl MachineError { } } - pub(super) fn module_resolution_error( + pub(super) + fn module_resolution_error( h: usize, mod_name: ClauseName, name: ClauseName, @@ -97,14 +99,26 @@ impl MachineError { } } - pub(super) fn existence_error(h: usize, err: ExistenceError) -> Self { + pub(super) + fn existence_error(h: usize, err: ExistenceError) -> Self { match err { + ExistenceError::Module(name) => { + let name = HeapCellValue::Addr(Addr::Con(Constant::Atom(name, None))); + let stub = functor!("existence_error", 2, [heap_atom!("module"), name]); + + MachineError { + stub, + location: None, + from: ErrorProvenance::Constructed, + } + } ExistenceError::Procedure(name, arity) => { let mut stub = functor!( "existence_error", 2, [heap_atom!("procedure"), heap_str!(3 + h)] ); + stub.append(&mut Self::functor_stub(name, arity)); MachineError { @@ -113,9 +127,9 @@ impl MachineError { from: ErrorProvenance::Constructed, } } - ExistenceError::Module(name) => { - let name = HeapCellValue::Addr(Addr::Con(Constant::Atom(name, None))); - let stub = functor!("existence_error", 2, [heap_atom!("module"), name]); + ExistenceError::Stream(addr) => { + let culprit = HeapCellValue::Addr(addr); + let stub = functor!("existence_error", 2, [heap_atom!("stream"), culprit]); MachineError { stub, @@ -126,12 +140,17 @@ impl MachineError { } } - pub(super) fn session_error(h: usize, err: SessionError) -> Self { + pub(super) + fn session_error(h: usize, err: SessionError) -> Self { match err { SessionError::ParserError(err) => Self::syntax_error(h, err), SessionError::CannotOverwriteBuiltIn(pred_str) | SessionError::CannotOverwriteImport(pred_str) => { - Self::permission_error(PermissionError::Modify, "private_procedure", pred_str) + Self::permission_error( + PermissionError::Modify, + "private_procedure", + Addr::Con(Constant::Atom(pred_str, None)), + ) } SessionError::InvalidFileName(filename) => { Self::existence_error(h, ExistenceError::Module(filename)) @@ -139,28 +158,33 @@ impl MachineError { SessionError::ModuleDoesNotContainExport(..) => Self::permission_error( PermissionError::Access, "private_procedure", - clause_name!("module_does_not_contain_claimed_export"), + Addr::Con(atom!("module_does_not_contain_claimed_export")), ), SessionError::ModuleNotFound => Self::permission_error( PermissionError::Access, "private_procedure", - clause_name!("module_does_not_exist"), + Addr::Con(atom!("module_does_not_exist")), ), SessionError::OpIsInfixAndPostFix(op) => { - Self::permission_error(PermissionError::Create, "operator", op) + Self::permission_error( + PermissionError::Create, + "operator", + Addr::Con(Constant::Atom(op, None)), + ) } _ => unreachable!(), } } - pub(super) fn permission_error( + pub(super) + fn permission_error( err: PermissionError, index_str: &'static str, - pred_str: ClauseName, + culprit: Addr, ) -> Self { - let pred_str = HeapCellValue::Addr(Addr::Con(Constant::Atom(pred_str, None))); + let culprit = HeapCellValue::Addr(culprit); - let err = vec![heap_atom!(err.as_str()), heap_atom!(index_str), pred_str]; + let err = vec![heap_atom!(err.as_str()), heap_atom!(index_str), culprit]; let mut stub = functor!("permission_error", 3); stub.extend(err.into_iter()); @@ -196,7 +220,8 @@ impl MachineError { } } - pub(super) fn syntax_error(h: usize, err: ParserError) -> Self { + pub(super) + fn syntax_error(h: usize, err: ParserError) -> Self { if let ParserError::Arithmetic(err) = err { return Self::arithmetic_error(h, err); } @@ -219,7 +244,8 @@ impl MachineError { } } - pub(super) fn domain_error(error: DomainError, culprit: Addr) -> Self { + pub(super) + fn domain_error(error: DomainError, culprit: Addr) -> Self { let stub = functor!( "domain_error", 2, @@ -232,7 +258,8 @@ impl MachineError { } } - pub(super) fn instantiation_error() -> Self { + pub(super) + fn instantiation_error() -> Self { let stub = functor!("instantiation_error"); MachineError { stub, @@ -241,7 +268,8 @@ impl MachineError { } } - pub(super) fn representation_error(flag: RepFlag) -> Self { + pub(super) + fn representation_error(flag: RepFlag) -> Self { let stub = functor!("representation_error", 1, [heap_atom!(flag.as_str())]); MachineError { stub, @@ -271,7 +299,9 @@ impl MachineError { pub enum PermissionError { Access, Create, + InputStream, Modify, + OutputStream, } impl PermissionError { @@ -279,7 +309,9 @@ impl PermissionError { match self { PermissionError::Access => "access", PermissionError::Create => "create", + PermissionError::InputStream => "input", PermissionError::Modify => "modify", + PermissionError::OutputStream => "output", } } } @@ -334,6 +366,7 @@ impl ValidType { pub enum DomainError { NotLessThanZero, Stream, + StreamOrAlias, } impl DomainError { @@ -341,6 +374,7 @@ impl DomainError { match self { DomainError::NotLessThanZero => "not_less_than_zero", DomainError::Stream => "stream", + DomainError::StreamOrAlias => "stream_or_alias", } } } @@ -534,6 +568,7 @@ impl MachineState { pub enum ExistenceError { Module(ClauseName), Procedure(ClauseName, usize), + Stream(Addr), } pub enum SessionError { diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 03ec8311..1a007977 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -366,6 +366,46 @@ impl MachineState { Ok(()) } + fn get_stream_or_alias( + &self, + addr: Addr, + indices: &IndexStore, + caller: &'static str, + ) -> Result + { + Ok(match addr { + Addr::Con(Constant::Atom(atom, op_spec)) => { + match indices.stream_aliases.get(&atom) { + Some(stream) => { + stream.clone() + } + None => { + let stub = MachineError::functor_stub(clause_name!(caller), 1); + let addr = Addr::Con(Constant::Atom(atom, op_spec)); + + let h = self.heap.h(); + + return Err(self.error_form( + MachineError::existence_error(h, ExistenceError::Stream(addr)), + stub, + )); + } + } + } + Addr::Stream(stream) => { + stream + } + _ => { + let stub = MachineError::functor_stub(clause_name!(caller), 1); + + return Err(self.error_form( + MachineError::domain_error(DomainError::StreamOrAlias, addr), + stub, + )); + } + }) + } + fn read_term(&mut self, current_input_stream: &mut Stream, indices: &mut IndexStore) @@ -2228,7 +2268,43 @@ impl MachineState { return Ok(()); } } - &SystemClauseType::SetCutPointByDefault(r) => deref_cut(self, r), + &SystemClauseType::SetCutPointByDefault(r) => { + deref_cut(self, r) + } + &SystemClauseType::SetInput => { + let addr = self.store(self.deref(self[temp_v!(1)].clone())); + let stream = self.get_stream_or_alias(addr, indices, "set_input")?; + + if stream.is_output_stream() { + let stub = MachineError::functor_stub(clause_name!("set_input"), 1); + let err = MachineError::permission_error( + PermissionError::InputStream, + "stream", + Addr::Stream(stream), + ); + + return Err(self.error_form(err, stub)); + } + + *current_input_stream = stream; + } + &SystemClauseType::SetOutput => { + let addr = self.store(self.deref(self[temp_v!(1)].clone())); + let stream = self.get_stream_or_alias(addr, indices, "set_output")?; + + if stream.is_input_stream() { + let stub = MachineError::functor_stub(clause_name!("set_input"), 1); + let err = MachineError::permission_error( + PermissionError::OutputStream, + "stream", + Addr::Stream(stream), + ); + + return Err(self.error_form(err, stub)); + } + + *current_output_stream = stream; + } &SystemClauseType::SetDoubleQuotes => match self[temp_v!(1)].clone() { Addr::Con(Constant::Atom(ref atom, _)) if atom.as_str() == "chars" => { self.flags.double_quotes = DoubleQuotes::Chars -- 2.54.0