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,
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),

View File

@@ -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"));
}
}
}

View File

@@ -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)
).

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!(
"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,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 {
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) => {
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 {
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 {
stub,
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 {
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 {

View File

@@ -366,6 +366,46 @@ impl MachineState {
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,
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