add set_input/1, set_output/1

This commit is contained in:
Mark Thom
2020-03-15 23:29:21 -06:00
parent 8e318f76a7
commit f9c4a40d60
5 changed files with 166 additions and 39 deletions

View File

@@ -231,6 +231,8 @@ pub enum SystemClauseType {
RetractClause, RetractClause,
RestoreCutPolicy, RestoreCutPolicy,
SetCutPoint(RegType), SetCutPoint(RegType),
SetInput,
SetOutput,
StoreGlobalVar, StoreGlobalVar,
StoreGlobalVarWithOffset, StoreGlobalVarWithOffset,
InferenceLevel, InferenceLevel,
@@ -373,6 +375,8 @@ impl SystemClauseType {
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"), &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"), &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"), &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::SetSeed => clause_name!("$set_seed"),
&SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"), &SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"),
&SystemClauseType::StoreGlobalVarWithOffset => { &SystemClauseType::StoreGlobalVarWithOffset => {
@@ -493,6 +497,8 @@ impl SystemClauseType {
("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter), ("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter),
("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy), ("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy),
("$set_cp", 1) => Some(SystemClauseType::SetCutPoint(temp_v!(1))), ("$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), ("$inference_level", 2) => Some(SystemClauseType::InferenceLevel),
("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock), ("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
("$erase_ball", 0) => Some(SystemClauseType::EraseBall), ("$erase_ball", 0) => Some(SystemClauseType::EraseBall),

View File

@@ -1315,12 +1315,9 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.print_atom(alias); self.print_atom(alias);
} else { } else {
if stream.is_stdout() || stream.is_stdin() { if stream.is_stdout() || stream.is_stdin() {
self.append_str("user"); self.print_atom(&clause_name!("user"));
} else { } else {
self.append_str(&format!( self.format_struct(iter, max_depth, 1, clause_name!("$stream"));
"'$stream'(0x{:x})",
stream.as_ptr() as usize,
));
} }
} }
} }

View File

@@ -50,9 +50,10 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :-
findall/3, findall/4, get_char/1, halt/0, findall/3, findall/4, get_char/1, halt/0,
max_arity/1, number_chars/2, number_codes/2, max_arity/1, number_chars/2, number_codes/2,
once/1, op/3, read_term/2, repeat/0, retract/1, once/1, op/3, read_term/2, repeat/0, retract/1,
set_prolog_flag/2, setof/3, sub_atom/5, set_prolog_flag/2, set_input/1, set_output/1,
subsumes_term/2, term_variables/2, throw/1, setof/3, sub_atom/5, subsumes_term/2,
true/0, unify_with_occurs_check/2, write/1, term_variables/2, throw/1, true/0,
unify_with_occurs_check/2, write/1,
write_canonical/1, write_term/2, writeq/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_input(S) :- '$current_input'(S).
current_output(S) :- '$current_output'(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)
).

View File

@@ -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!( let stub = functor!(
"type_error", "type_error",
2, 2,
@@ -58,7 +59,8 @@ impl MachineError {
} }
} }
pub(super) fn module_resolution_error( pub(super)
fn module_resolution_error(
h: usize, h: usize,
mod_name: ClauseName, mod_name: ClauseName,
name: ClauseName, name: ClauseName,
@@ -97,26 +99,38 @@ impl MachineError {
} }
} }
pub(super) fn existence_error(h: usize, err: ExistenceError) -> Self { pub(super)
fn existence_error(h: usize, err: ExistenceError) -> Self {
match err { match err {
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 {
stub,
location: None,
from: ErrorProvenance::Constructed,
}
}
ExistenceError::Module(name) => { ExistenceError::Module(name) => {
let name = HeapCellValue::Addr(Addr::Con(Constant::Atom(name, None))); let name = HeapCellValue::Addr(Addr::Con(Constant::Atom(name, None)));
let stub = functor!("existence_error", 2, [heap_atom!("module"), name]); 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 {
stub,
location: None,
from: ErrorProvenance::Constructed,
}
}
ExistenceError::Stream(addr) => {
let culprit = HeapCellValue::Addr(addr);
let stub = functor!("existence_error", 2, [heap_atom!("stream"), culprit]);
MachineError { MachineError {
stub, stub,
location: None, location: None,
@@ -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 { match err {
SessionError::ParserError(err) => Self::syntax_error(h, err), SessionError::ParserError(err) => Self::syntax_error(h, err),
SessionError::CannotOverwriteBuiltIn(pred_str) SessionError::CannotOverwriteBuiltIn(pred_str)
| SessionError::CannotOverwriteImport(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) => { SessionError::InvalidFileName(filename) => {
Self::existence_error(h, ExistenceError::Module(filename)) Self::existence_error(h, ExistenceError::Module(filename))
@@ -139,28 +158,33 @@ impl MachineError {
SessionError::ModuleDoesNotContainExport(..) => Self::permission_error( SessionError::ModuleDoesNotContainExport(..) => Self::permission_error(
PermissionError::Access, PermissionError::Access,
"private_procedure", "private_procedure",
clause_name!("module_does_not_contain_claimed_export"), Addr::Con(atom!("module_does_not_contain_claimed_export")),
), ),
SessionError::ModuleNotFound => Self::permission_error( SessionError::ModuleNotFound => Self::permission_error(
PermissionError::Access, PermissionError::Access,
"private_procedure", "private_procedure",
clause_name!("module_does_not_exist"), Addr::Con(atom!("module_does_not_exist")),
), ),
SessionError::OpIsInfixAndPostFix(op) => { SessionError::OpIsInfixAndPostFix(op) => {
Self::permission_error(PermissionError::Create, "operator", op) Self::permission_error(
PermissionError::Create,
"operator",
Addr::Con(Constant::Atom(op, None)),
)
} }
_ => unreachable!(), _ => unreachable!(),
} }
} }
pub(super) fn permission_error( pub(super)
fn permission_error(
err: PermissionError, err: PermissionError,
index_str: &'static str, index_str: &'static str,
pred_str: ClauseName, culprit: Addr,
) -> Self { ) -> 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); let mut stub = functor!("permission_error", 3);
stub.extend(err.into_iter()); 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 { if let ParserError::Arithmetic(err) = err {
return Self::arithmetic_error(h, 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!( let stub = functor!(
"domain_error", "domain_error",
2, 2,
@@ -232,7 +258,8 @@ impl MachineError {
} }
} }
pub(super) fn instantiation_error() -> Self { pub(super)
fn instantiation_error() -> Self {
let stub = functor!("instantiation_error"); let stub = functor!("instantiation_error");
MachineError { MachineError {
stub, 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())]); let stub = functor!("representation_error", 1, [heap_atom!(flag.as_str())]);
MachineError { MachineError {
stub, stub,
@@ -271,7 +299,9 @@ impl MachineError {
pub enum PermissionError { pub enum PermissionError {
Access, Access,
Create, Create,
InputStream,
Modify, Modify,
OutputStream,
} }
impl PermissionError { impl PermissionError {
@@ -279,7 +309,9 @@ impl PermissionError {
match self { match self {
PermissionError::Access => "access", PermissionError::Access => "access",
PermissionError::Create => "create", PermissionError::Create => "create",
PermissionError::InputStream => "input",
PermissionError::Modify => "modify", PermissionError::Modify => "modify",
PermissionError::OutputStream => "output",
} }
} }
} }
@@ -334,6 +366,7 @@ impl ValidType {
pub enum DomainError { pub enum DomainError {
NotLessThanZero, NotLessThanZero,
Stream, Stream,
StreamOrAlias,
} }
impl DomainError { impl DomainError {
@@ -341,6 +374,7 @@ impl DomainError {
match self { match self {
DomainError::NotLessThanZero => "not_less_than_zero", DomainError::NotLessThanZero => "not_less_than_zero",
DomainError::Stream => "stream", DomainError::Stream => "stream",
DomainError::StreamOrAlias => "stream_or_alias",
} }
} }
} }
@@ -534,6 +568,7 @@ impl MachineState {
pub enum ExistenceError { pub enum ExistenceError {
Module(ClauseName), Module(ClauseName),
Procedure(ClauseName, usize), Procedure(ClauseName, usize),
Stream(Addr),
} }
pub enum SessionError { pub enum SessionError {

View File

@@ -366,6 +366,46 @@ impl MachineState {
Ok(()) Ok(())
} }
fn get_stream_or_alias(
&self,
addr: Addr,
indices: &IndexStore,
caller: &'static str,
) -> Result<Stream, MachineStub>
{
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, fn read_term(&mut self,
current_input_stream: &mut Stream, current_input_stream: &mut Stream,
indices: &mut IndexStore) indices: &mut IndexStore)
@@ -2228,7 +2268,43 @@ impl MachineState {
return Ok(()); 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() { &SystemClauseType::SetDoubleQuotes => match self[temp_v!(1)].clone() {
Addr::Con(Constant::Atom(ref atom, _)) if atom.as_str() == "chars" => { Addr::Con(Constant::Atom(ref atom, _)) if atom.as_str() == "chars" => {
self.flags.double_quotes = DoubleQuotes::Chars self.flags.double_quotes = DoubleQuotes::Chars