From: Mark Thom Date: Wed, 6 May 2020 04:42:35 +0000 (-0600) Subject: add put_code/{1,2}, get_code/{1,2}, improve get_* predicates X-Git-Tag: v0.8.123~57^2~7 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=414acda9e0f6bf052450d0e191c34a6afc33f5df;p=scryer-prolog.git add put_code/{1,2}, get_code/{1,2}, improve get_* predicates --- diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index bf0d75a9..d80a01d0 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -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) diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 9848b1e6..6eac4f15 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) :- 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). diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index cb448199..d384185b 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -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( + &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; diff --git a/src/prolog/machine/streams.rs b/src/prolog/machine/streams.rs index 2ac482e7..7a368d1c 100644 --- a/src/prolog/machine/streams.rs +++ b/src/prolog/machine/streams.rs @@ -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 }; diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 7c6c6c88..5e39322e 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -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 { } } - 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); + 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 { - unreachable!() + return Err(self.type_error( + ValidType::InByte, + addr, + clause_name!("get_byte"), + 2, + )); } } - 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); - } - } - _ => { - } + 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, + )); + } } + } + }; - let stub = MachineError::functor_stub(clause_name!("get_byte"), 2); - let err = MachineError::type_error( - self.heap.h(), - ValidType::InByte, - self[temp_v!(2)], - ); + loop { + let mut b = [0u8; 1]; - return Err(self.error_form(err, stub)); + match stream.read(&mut b) { + Ok(1) => { + 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(()); + } } _ => { self.eof_action( @@ -1801,64 +1874,172 @@ impl MachineState { 2, )?; + 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!() + } + } + culprit => { + return Err(self.type_error( + ValidType::InCharacter, + 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(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); + 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)], + &mut stream, + clause_name!("get_char"), + 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::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 { - 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!() - } + return Err(self.representation_error( + RepFlag::InCharacterCode, + clause_name!("get_code"), + 2, + )); } } - Addr::Char(d) => { - if c == d { - 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()) { + Addr::CharCode(c as u32) } else { - self.fail = true; - return Ok(()); + return Err(self.representation_error( + RepFlag::InCharacterCode, + clause_name!("get_code"), + 2, + )); } } - culprit => { - let stub = MachineError::functor_stub(clause_name!("get_char"), 2); - let err = MachineError::type_error( - self.heap.h(), - ValidType::InCharacter, - culprit, - ); - - return Err(self.error_form(err, stub)); + _ => { + 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_char"), + clause_name!("get_coder"), 2, )?;