rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add put_code/{1,2}, get_code/{1,2}, improve get_* predicates

Browse Source
This commit is contained in:
Mark Thom
2020-05-05 22:42:35 -06:00
parent 47e3a5e75a
commit 414acda9e0
5 changed files with 340 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/prolog/clause_types.rs
View File

@@ -184,6 +184,7 @@ pub enum SystemClauseType {
FlushOutput,
GetByte,
GetChar,
GetCode,
GetSingleChar,
ResetAttrVarState,
TruncateIfNoLiftedHeapGrowthDiff,
@@ -224,6 +225,7 @@ pub enum SystemClauseType {
PointsToContinuationResetMarker,
PutByte,
PutChar,
PutCode,
REPL(REPLCodePtr),
ReadQueryTerm,
ReadTerm,
@@ -332,6 +334,7 @@ impl SystemClauseType {
&SystemClauseType::FlushOutput => clause_name!("$flush_output"),
&SystemClauseType::GetByte => clause_name!("$get_byte"),
&SystemClauseType::GetChar => clause_name!("$get_char"),
&SystemClauseType::GetCode => clause_name!("$get_code"),
&SystemClauseType::GetSingleChar => clause_name!("$get_single_char"),
&SystemClauseType::ResetAttrVarState => clause_name!("$reset_attr_var_state"),
&SystemClauseType::TruncateIfNoLiftedHeapGrowth => {
@@ -393,6 +396,9 @@ impl SystemClauseType {
&SystemClauseType::PutChar => {
clause_name!("$put_char")
}
&SystemClauseType::PutCode => {
clause_name!("$put_code")
}
&SystemClauseType::QuotedToken => {
clause_name!("$quoted_token")
}
@@ -499,6 +505,7 @@ impl SystemClauseType {
("$file_to_chars", 2) => Some(SystemClauseType::FileToChars),
("$get_byte", 2) => Some(SystemClauseType::GetByte),
("$get_char", 2) => Some(SystemClauseType::GetChar),
("$get_code", 2) => Some(SystemClauseType::GetCode),
("$get_single_char", 1) => Some(SystemClauseType::GetSingleChar),
("$points_to_cont_reset_marker", 1) => {
Some(SystemClauseType::PointsToContinuationResetMarker)
@@ -509,6 +516,9 @@ impl SystemClauseType {
("$put_char", 2) => {
Some(SystemClauseType::PutChar)
}
("$put_code", 2) => {
Some(SystemClauseType::PutCode)
}
("$reset_attr_var_state", 0) => Some(SystemClauseType::ResetAttrVarState),
("$truncate_if_no_lh_growth", 1) => {
Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth)

25
src/prolog/lib/builtins.pl
View File

@@ -50,9 +50,10 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :-
expand_term/2, fail/0, false/0, findall/3,
findall/4, flush_output/0, flush_output/1,
get_byte/1, get_byte/2, get_char/1, get_char/2,
halt/0, max_arity/1, number_chars/2,
number_codes/2, once/1, op/3, open/3, open/4,
put_byte/1, put_byte/2, put_char/1, put_char/2,
get_code/1, get_code/2, halt/0, max_arity/1,
number_chars/2, number_codes/2, once/1, op/3,
open/3, open/4, put_byte/1, put_byte/2,
put_code/1, put_code/2, put_char/1, put_char/2,
read_term/2, read_term/3, repeat/0, retract/1,
set_prolog_flag/2, set_input/1, set_output/1,
setof/3, sub_atom/5, subsumes_term/2,
@@ -1197,7 +1198,7 @@ flush_output :-
get_byte(S, B) :-
'$get_byte'(S, B).
get_byte(S) :-
get_byte(B) :-
current_input(S),
'$get_byte'(S, B).
@@ -1216,3 +1217,19 @@ put_byte(C) :-
put_byte(S, C) :-
'$put_byte'(S, C).
put_code(C) :-
current_output(S),
'$put_code'(S, C).
put_code(S, C) :-
'$put_code'(S, C).
get_code(C) :-
current_input(S),
'$get_code'(S, C).
get_code(S, C) :-
'$get_code'(S, C).

41
src/prolog/machine/machine_errors.rs
View File

@@ -23,7 +23,7 @@ pub(crate) struct MachineError {
from: ErrorProvenance,
}
pub(super)
pub(crate)
trait TypeError {
fn type_error(self, h: usize, valid_type: ValidType) -> MachineError;
}
@@ -557,7 +557,7 @@ impl DomainErrorType {
pub enum RepFlag {
// Character,
CharacterCode,
// InCharacterCode,
InCharacterCode,
MaxArity,
// MaxInteger,
// MinInteger
@@ -568,7 +568,7 @@ impl RepFlag {
match self {
// RepFlag::Character => "character",
RepFlag::CharacterCode => "character_code",
// RepFlag::InCharacterCode => "in_character_code",
RepFlag::InCharacterCode => "in_character_code",
RepFlag::MaxArity => "max_arity",
// RepFlag::MaxInteger => "max_integer",
// RepFlag::MinInteger => "min_integer"
@@ -699,6 +699,41 @@ impl MachineState {
self.check_for_list_pairs(sorted)
}
#[inline]
pub(crate)
fn type_error<T: TypeError>(
&self,
valid_type: ValidType,
culprit: T,
caller: ClauseName,
arity: usize,
) -> MachineStub {
let stub = MachineError::functor_stub(caller, arity);
let err = MachineError::type_error(
self.heap.h(),
valid_type,
culprit,
);
return self.error_form(err, stub);
}
#[inline]
pub(crate)
fn representation_error(
&self,
rep_flag: RepFlag,
caller: ClauseName,
arity: usize,
) -> MachineStub {
let stub = MachineError::functor_stub(caller, arity);
let err = MachineError::representation_error(
rep_flag,
);
return self.error_form(err, stub);
}
pub(super)
fn error_form(&self, err: MachineError, src: MachineStub) -> MachineStub {
let location = err.location;

11
src/prolog/machine/streams.rs
View File

@@ -30,6 +30,15 @@ impl StreamType {
StreamType::Text => "text_stream",
}
}
#[inline]
pub(crate)
fn other(self) -> StreamType {
match self {
StreamType::Binary => StreamType::Text,
StreamType::Text => StreamType::Binary,
}
}
}
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
@@ -662,7 +671,7 @@ impl MachineState {
} else if input.is_none() && stream.is_input_stream() {
Some("stream") // 8.14.2.3 g)
} else if stream.options.stream_type != expected_type {
Some(expected_type.as_str()) // 8.14.2.3 h)
Some(expected_type.other().as_str()) // 8.14.2.3 h)
} else {
None
};

341
src/prolog/machine/system_calls.rs
View File

@@ -1592,6 +1592,64 @@ impl MachineState {
self.unify(complete_string, a2);
}
&SystemClauseType::PutCode => {
let mut stream =
self.get_stream_or_alias(self[temp_v!(1)], indices, "put_code", 2)?;
self.check_stream_properties(
&mut stream,
StreamType::Text,
None,
clause_name!("put_code"),
2,
)?;
match self.store(self.deref(self[temp_v!(2)])) {
addr if addr.is_ref() => {
let stub = MachineError::functor_stub(clause_name!("put_code"), 2);
let err = MachineError::instantiation_error();
return Err(self.error_form(err, stub));
}
Addr::CharCode(c) => {
let c = char::try_from(c).unwrap();
write!(&mut stream, "{}", c).unwrap();
}
addr => {
match Number::try_from((addr, &self.heap)) {
Ok(Number::Integer(n)) => {
if let Some(c) = n.to_u32().and_then(|c| char::try_from(c).ok()) {
write!(&mut stream, "{}", c).unwrap();
return return_from_clause!(self.last_call, self);
}
}
Ok(Number::Fixnum(n)) => {
if let Some(c) = u32::try_from(n).ok().and_then(|c| char::try_from(c).ok()) {
write!(&mut stream, "{}", c).unwrap();
return return_from_clause!(self.last_call, self);
}
}
_ => {
let stub = MachineError::functor_stub(clause_name!("put_code"), 2);
let err = MachineError::type_error(
self.heap.h(),
ValidType::Integer,
self[temp_v!(2)],
);
return Err(self.error_form(err, stub));
}
}
let stub = MachineError::functor_stub(clause_name!("put_code"), 2);
let err = MachineError::representation_error(
RepFlag::CharacterCode,
);
return Err(self.error_form(err, stub));
}
}
}
&SystemClauseType::PutChar => {
let mut stream =
self.get_stream_or_alias(self[temp_v!(1)], indices, "put_char", 2)?;
@@ -1715,48 +1773,63 @@ impl MachineState {
}
}
let addr =
match self.store(self.deref(self[temp_v!(2)])) {
addr if addr.is_ref() => {
addr
}
addr => {
match Number::try_from((addr, &self.heap)) {
Ok(Number::Integer(n)) => {
if let Some(nb) = n.to_u8() {
Addr::Usize(nb as usize)
} else {
return Err(self.type_error(
ValidType::InByte,
addr,
clause_name!("get_byte"),
2,
));
}
}
Ok(Number::Fixnum(n)) => {
if let Ok(nb) = u8::try_from(n) {
Addr::Usize(nb as usize)
} else {
return Err(self.type_error(
ValidType::InByte,
addr,
clause_name!("get_byte"),
2,
));
}
}
_ => {
return Err(self.type_error(
ValidType::InByte,
addr,
clause_name!("get_byte"),
2,
));
}
}
}
};
loop {
let mut b = [0u8; 1];
match stream.read(&mut b) {
Ok(1) => {
match self.store(self.deref(self[temp_v!(2)])) {
addr if addr.is_ref() => {
if let Some(var) = addr.as_var() {
self.bind(var, Addr::Usize(b[0] as usize));
return return_from_clause!(self.last_call, self);
} else {
unreachable!()
}
}
addr => {
match Number::try_from((addr, &self.heap)) {
Ok(Number::Integer(n)) => {
if let Some(nb) = n.to_u8() {
self.fail = b[0] != nb;
return return_from_clause!(self.last_call, self);
}
}
Ok(Number::Fixnum(n)) => {
if let Ok(nb) = u8::try_from(n) {
self.fail = b[0] != nb;
return return_from_clause!(self.last_call, self);
}
}
_ => {
}
}
}
if let Some(var) = addr.as_var() {
self.bind(var, Addr::Usize(b[0] as usize));
break;
} else if addr == Addr::Usize(b[0] as usize) {
break;
} else {
self.fail = true;
return Ok(());
}
let stub = MachineError::functor_stub(clause_name!("get_byte"), 2);
let err = MachineError::type_error(
self.heap.h(),
ValidType::InByte,
self[temp_v!(2)],
);
return Err(self.error_form(err, stub));
}
_ => {
self.eof_action(
@@ -1801,59 +1874,58 @@ impl MachineState {
2,
)?;
loop {
let result = iter.next();
match result {
Some(Ok(c)) => {
match self.store(self.deref(self[temp_v!(2)])) {
addr if addr.is_ref() => {
if let Some(var) = addr.as_var() {
self.bind(var, Addr::Char(c));
return return_from_clause!(self.last_call, self);
let addr =
match self.store(self.deref(self[temp_v!(2)])) {
addr if addr.is_ref() => {
addr
}
Addr::Con(h) if self.heap.atom_at(h) => {
match &self.heap[h] {
HeapCellValue::Atom(ref atom, _) if atom.is_char() => {
if let Some(c) = atom.as_str().chars().next() {
Addr::Char(c)
} else {
unreachable!()
}
}
Addr::Con(h) if self.heap.atom_at(h) => {
match &self.heap[h] {
HeapCellValue::Atom(ref atom, _) if atom.is_char() => {
if let Some(d) = atom.as_str().chars().next() {
if c == d {
return return_from_clause!(self.last_call, self);
} else {
self.fail = true;
return Ok(());
}
} else {
unreachable!()
}
}
_ => {
unreachable!()
}
}
}
Addr::Char(d) => {
if c == d {
return return_from_clause!(self.last_call, self);
} else {
self.fail = true;
return Ok(());
}
}
culprit => {
let stub = MachineError::functor_stub(clause_name!("get_char"), 2);
let err = MachineError::type_error(
self.heap.h(),
return Err(self.type_error(
ValidType::InCharacter,
culprit,
);
return Err(self.error_form(err, stub));
culprit.as_addr(h),
clause_name!("get_char"),
2,
));
}
}
}
Addr::Char(d) => {
Addr::Char(d)
}
culprit => {
return Err(self.type_error(
ValidType::InCharacter,
culprit,
clause_name!("get_char"),
2,
));
}
};
loop {
let result = iter.next();
match result {
Some(Ok(d)) => {
if let Some(var) = addr.as_var() {
self.bind(var, Addr::Char(d));
break;
} else if addr == Addr::Char(d) {
break;
} else {
self.fail = true;
return Ok(());
}
}
_ => {
self.eof_action(
self[temp_v!(2)],
@@ -1878,6 +1950,115 @@ impl MachineState {
}
}
}
&SystemClauseType::GetCode => {
let mut stream =
self.get_stream_or_alias(self[temp_v!(1)], indices, "get_code", 2)?;
self.check_stream_properties(
&mut stream,
StreamType::Text,
Some(self[temp_v!(2)]),
clause_name!("get_code"),
2,
)?;
if stream.past_end_of_stream {
if EOFAction::Reset != stream.options.eof_action {
return return_from_clause!(self.last_call, self);
} else if self.fail {
return Ok(());
}
}
let addr =
match self.store(self.deref(self[temp_v!(2)])) {
addr if addr.is_ref() => {
addr
}
Addr::CharCode(d) => {
Addr::CharCode(d)
}
addr => {
match Number::try_from((addr, &self.heap)) {
Ok(Number::Integer(n)) => {
if let Some(c) = n.to_u32().and_then(|c| char::try_from(c).ok()) {
Addr::CharCode(c as u32)
} else {
return Err(self.representation_error(
RepFlag::InCharacterCode,
clause_name!("get_code"),
2,
));
}
}
Ok(Number::Fixnum(n)) => {
if let Some(c) = u32::try_from(n).ok().and_then(|c| char::try_from(c).ok()) {
Addr::CharCode(c as u32)
} else {
return Err(self.representation_error(
RepFlag::InCharacterCode,
clause_name!("get_code"),
2,
));
}
}
_ => {
return Err(self.type_error(
ValidType::Integer,
self[temp_v!(2)],
clause_name!("get_code"),
2,
));
}
}
}
};
let mut iter = self.open_parsing_stream(
stream.clone(),
"get_code",
2,
)?;
loop {
let result = iter.next();
match result {
Some(Ok(c)) => {
if let Some(var) = addr.as_var() {
self.bind(var, Addr::CharCode(c as u32));
break;
} else if addr == Addr::CharCode(c as u32) {
break;
} else {
self.fail = true;
return Ok(());
}
}
_ => {
self.eof_action(
self[temp_v!(2)],
&mut stream,
clause_name!("get_coder"),
2,
)?;
if EOFAction::Reset != stream.options.eof_action {
return return_from_clause!(self.last_call, self);
} else if self.fail {
return Ok(());
}
}/*
_ => {
let stub = MachineError::functor_stub(clause_name!("get_char"), 2);
let err = MachineError::representation_error(RepFlag::Character);
let err = self.error_form(err, stub);
return Err(err);
}*/
}
}
}
&SystemClauseType::FlushOutput => {
let mut stream =
self.get_stream_or_alias(self[temp_v!(1)], indices, "flush_output", 1)?;