From e3e6f926c7c1c67fde2ce8fab95dc40079cd5145 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Fri, 5 Apr 2019 23:00:53 -0600 Subject: [PATCH] add atom_length/2, atom_chars/2, atom_codes/2 --- README.md | 3 + src/prolog/clause_types.rs | 15 ++- src/prolog/lib/builtins.pl | 63 +++++++++-- src/prolog/machine/machine_errors.rs | 8 +- src/prolog/machine/machine_state_impl.rs | 4 +- src/prolog/machine/system_calls.rs | 136 ++++++++++++++++++++++- src/tests.rs | 13 +++ 7 files changed, 219 insertions(+), 23 deletions(-) diff --git a/README.md b/README.md index 13393927..ee138175 100644 --- a/README.md +++ b/README.md @@ -159,6 +159,9 @@ The following predicates are built-in to Scryer. * `assertz/1` * `atom/1` * `atomic/1` +* `atom_chars/2` +* `atom_codes/2` +* `atom_length/2` * `bagof/3` * `bb_b_put/2` * `bb_get/2` diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index e60a7a4c..520d2ecb 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -130,7 +130,7 @@ ref_thread_local! { m.insert(("partial_string", 2), ClauseType::BuiltIn(BuiltInClauseType::PartialString)); m.insert(("read", 1), ClauseType::BuiltIn(BuiltInClauseType::Read)); m.insert(("sort", 2), ClauseType::BuiltIn(BuiltInClauseType::Sort)); - + m }; } @@ -159,6 +159,9 @@ pub enum SystemClauseType { AbolishModuleClause, AssertDynamicPredicateToBack, AssertDynamicPredicateToFront, + AtomChars, + AtomCodes, + AtomLength, ModuleAssertDynamicPredicateToFront, ModuleAssertDynamicPredicateToBack, CheckCutPoint, @@ -231,9 +234,12 @@ impl SystemClauseType { pub fn name(&self) -> ClauseName { match self { &SystemClauseType::AbolishClause => clause_name!("$abolish_clause"), - &SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"), + &SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"), &SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"), &SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"), + &SystemClauseType::AtomChars => clause_name!("$atom_chars"), + &SystemClauseType::AtomCodes => clause_name!("$atom_codes"), + &SystemClauseType::AtomLength => clause_name!("$atom_length"), &SystemClauseType::ModuleAssertDynamicPredicateToFront => clause_name!("$module_asserta"), &SystemClauseType::ModuleAssertDynamicPredicateToBack => clause_name!("$module_assertz"), &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), @@ -306,6 +312,9 @@ impl SystemClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { ("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause), + ("$atom_chars", 2) => Some(SystemClauseType::AtomChars), + ("$atom_codes", 2) => Some(SystemClauseType::AtomCodes), + ("$atom_length", 2) => Some(SystemClauseType::AtomLength), ("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause), ("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront), ("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack), @@ -382,7 +391,7 @@ impl SystemClauseType { #[derive(Clone, Eq, PartialEq, Ord, PartialOrd)] pub enum BuiltInClauseType { AcyclicTerm, - Arg, + Arg, Compare, CompareTerm(CompareTermQT), CyclicTerm, diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 271680f8..c8bece28 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -6,14 +6,15 @@ (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, - abolish/1, asserta/1, assertz/1, bagof/3, bb_b_put/2, - bb_get/2, bb_put/2, call_cleanup/2, - call_with_inference_limit/3, catch/3, clause/2, - current_predicate/1, current_op/3, current_prolog_flag/2, - expand_goal/2, expand_term/2, findall/3, findall/4, halt/0, - once/1, op/3, repeat/0, retract/1, set_prolog_flag/2, setof/3, - setup_call_cleanup/3, term_variables/2, throw/1, true/0, - false/0, write/1, write_canonical/1, writeq/1, write_term/2]). + abolish/1, asserta/1, assertz/1, atom_chars/2, atom_codes/2, + atom_length/2, bagof/3, bb_b_put/2, bb_get/2, bb_put/2, + call_cleanup/2, call_with_inference_limit/3, catch/3, + clause/2, current_predicate/1, current_op/3, + current_prolog_flag/2, expand_goal/2, expand_term/2, + findall/3, findall/4, halt/0, once/1, op/3, repeat/0, + retract/1, set_prolog_flag/2, setof/3, setup_call_cleanup/3, + term_variables/2, throw/1, true/0, false/0, write/1, + write_canonical/1, writeq/1, write_term/2]). /* this is an implementation specific declarative operator used to implement call_with_inference_limit/3 and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice @@ -444,7 +445,7 @@ findall_with_existential(Template, Goal, PairedSolutions, Witnesses0, Witnesses) ; Witnesses = Witnesses0, findall(Witnesses-Template, Goal, PairedSolutions) ). - + bagof(Template, Goal, Solution) :- error:can_be(list, Solution), term_variables(Template, TemplateVars0), @@ -751,7 +752,7 @@ op_specifier(OpSpec) :- atom(OpSpec), ). op_specifier(OpSpec) :- throw(error(type_error(atom, OpSpec), op/3)). -valid_op(Op) :- atom(Op), +valid_op(Op) :- atom(Op), ( Op == (,) -> throw(error(permission_error(modify, operator, (,)), op/3)) % 8.14.3.3 j), k). ; Op == {} -> throw(error(permission_error(create, operator, {}), op/3)) ; Op == [] -> throw(error(permission_error(create, operator, []), op/3)) @@ -794,3 +795,45 @@ bb_get(Key, Value) :- atom(Key), !, '$fetch_global_var'(Key, Value). bb_get(Key, _) :- throw(error(type_error(atom, Key), bb_get/2)). halt :- '$halt'. + +atom_length(Atom, Length) :- + ( var(Atom) -> throw(error(instantiation_error, atom_length/2)) % 8.16.1.3 a) + ; atom(Atom) -> ( var(Length) -> '$atom_length'(Atom, Length) + ; integer(Length), Length >= 0 -> '$atom_length'(Atom, Length) + ; integer(Length) -> throw(domain_error(not_less_than_zero, Length), atom_length/2) % 8.16.1.3 d) + ; throw(error(type_error(integer, Length), atom_length/2)) % 8.16.1.3 c) + ) + ; throw(error(type_error(atom, Atom), atom_length/2)) % 8.16.1.3 b) + ). + +no_var_in_list([]). +no_var_in_list([X|Xs]) :- var(X), !, '$fail'. +no_var_in_list([_|Xs]) :- no_var_in_list(Xs). + +atom_chars(Atom, List) :- + ( var(Atom), '$skip_max_list'(_, -1, List, Xs) -> + ( var(Xs) -> throw(error(instantiation_error, atom_chars/2)) + ; Xs == [] -> + ( no_var_in_list(List) -> '$atom_chars'(Atom, List) + ; throw(error(instantiation_error, atom_chars/2)) + ) + ; throw(error(type_error(list, List), atom_chars/2)) + ) + ; atom(Atom) -> '$atom_chars'(Atom, List) + ; Atom == [] -> '$atom_chars'(Atom, List) + ; throw(error(type_error(atom, Atom), atom_chars/2)) + ). + +atom_codes(Atom, List) :- + ( var(Atom), '$skip_max_list'(_, -1, List, Xs) -> + ( var(Xs) -> throw(error(instantiation_error, atom_codes/2)) + ; Xs == [] -> + ( no_var_in_list(List) -> '$atom_codes'(Atom, List) + ; throw(error(instantiation_error, atom_codes/2)) + ) + ; throw(error(type_error(list, List), atom_codes/2)) + ) + ; atom(Atom) -> '$atom_codes'(Atom, List) + ; Atom == [] -> '$atom_codes'(Atom, List) + ; throw(error(type_error(atom, Atom), atom_codes/2)) + ). diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index c7afcbbc..59d67086 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -172,7 +172,7 @@ pub enum ValidType { // Boolean, // Byte, Callable, -// Character, + Character, Compound, // Evaluable, // InByte, @@ -193,7 +193,7 @@ impl ValidType { // ValidType::Boolean => "boolean", // ValidType::Byte => "byte", ValidType::Callable => "callable", -// ValidType::Character => "character", + ValidType::Character => "character", ValidType::Compound => "compound", // ValidType::Evaluable => "evaluable", // ValidType::InByte => "in_byte", @@ -225,7 +225,7 @@ impl DomainError { #[derive(Clone, Copy)] pub enum RepFlag { // Character, -// CharacterCode, + CharacterCode, // InCharacterCode, MaxArity, // MaxInteger, @@ -236,7 +236,7 @@ impl RepFlag { pub fn as_str(self) -> &'static str { match self { // RepFlag::Character => "character", -// RepFlag::CharacterCode => "character_code", + RepFlag::CharacterCode => "character_code", // RepFlag::InCharacterCode => "in_character_code", RepFlag::MaxArity => "max_arity", // RepFlag::MaxInteger => "max_integer", diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 64212b95..5c79e0d0 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -2107,8 +2107,8 @@ impl MachineState { *list = result; } - pub(super) fn try_from_list(&self, r: RegType, caller: MachineStub) - -> Result, MachineStub> + pub(super) + fn try_from_list(&self, r: RegType, caller: MachineStub) -> Result, MachineStub> { let a1 = self.store(self.deref(self[r].clone())); diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 9555c2b2..f23bd730 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -16,6 +16,7 @@ use ref_thread_local::RefThreadLocal; use std::collections::HashSet; use std::io::{stdout, Write}; +use std::iter::once; use std::mem; use std::rc::Rc; @@ -332,6 +333,133 @@ impl MachineState { self.p = CodePtr::DynamicTransaction(trans_type, p); return Ok(()); }, + &SystemClauseType::AtomChars => { + let a1 = self[temp_v!(1)].clone(); + + match self.store(self.deref(a1)) { + Addr::Con(Constant::Char(c)) => { + let iter = once(Addr::Con(Constant::Char(c))); + let list_of_chars = Addr::HeapCell(self.heap.to_list(iter)); + + let a2 = self[temp_v!(2)].clone(); + self.unify(a2, list_of_chars); + }, + Addr::Con(Constant::Atom(name, _)) => { + let iter = name.as_str().chars().map(|c| Addr::Con(Constant::Char(c))); + let list_of_chars = Addr::HeapCell(self.heap.to_list(iter)); + + let a2 = self[temp_v!(2)].clone(); + self.unify(a2, list_of_chars); + }, + Addr::Con(Constant::EmptyList) => { + let a2 = self[temp_v!(2)].clone(); + let chars = vec![Addr::Con(Constant::Char('[')), + Addr::Con(Constant::Char(']'))]; + + let list_of_chars = Addr::HeapCell(self.heap.to_list(chars.into_iter())); + + self.unify(a2, list_of_chars); + }, + ref addr if addr.is_ref() => { + let stub = MachineError::functor_stub(clause_name!("atom_chars"), 2); + + match self.try_from_list(temp_v!(2), stub.clone()) { + Err(e) => return Err(e), + Ok(addrs) => { + let mut chars = String::new(); + + for addr in addrs.iter() { + match addr { + &Addr::Con(Constant::Char(c)) => + chars.push(c), + &Addr::Con(Constant::Atom(ref name, _)) + if name.as_str().len() == 1 => { + chars += name.as_str(); + }, + _ => { + let err = MachineError::type_error(ValidType::Character, + addr.clone()); + return Err(self.error_form(err, stub)); + } + } + } + + let chars = clause_name!(chars, indices.atom_tbl); + self.unify(addr.clone(), Addr::Con(Constant::Atom(chars, None))); + } + } + }, + _ => unreachable!() + }; + }, + &SystemClauseType::AtomCodes => { + let a1 = self[temp_v!(1)].clone(); + + match self.store(self.deref(a1)) { + Addr::Con(Constant::Char(c)) => { + let iter = once(Addr::Con(Constant::CharCode(c as u8))); + let list_of_codes = Addr::HeapCell(self.heap.to_list(iter)); + + let a2 = self[temp_v!(2)].clone(); + self.unify(a2, list_of_codes); + }, + Addr::Con(Constant::Atom(name, _)) => { + let iter = name.as_str().chars().map(|c| Addr::Con(Constant::CharCode(c as u8))); + let list_of_codes = Addr::HeapCell(self.heap.to_list(iter)); + + let a2 = self[temp_v!(2)].clone(); + + self.unify(a2, list_of_codes); + }, + Addr::Con(Constant::EmptyList) => { + let a2 = self[temp_v!(2)].clone(); + let chars = vec![Addr::Con(Constant::CharCode('[' as u8)), + Addr::Con(Constant::CharCode(']' as u8))]; + + let list_of_codes = Addr::HeapCell(self.heap.to_list(chars.into_iter())); + + self.unify(a2, list_of_codes); + }, + ref addr if addr.is_ref() => { + let stub = MachineError::functor_stub(clause_name!("atom_codes"), 2); + + match self.try_from_list(temp_v!(2), stub.clone()) { + Err(e) => return Err(e), + Ok(addrs) => { + let mut chars = String::new(); + + for addr in addrs.iter() { + match addr { + &Addr::Con(Constant::CharCode(c)) => + chars.push(c as char), + _ => { + let err = MachineError::representation_error(RepFlag::CharacterCode); + return Err(self.error_form(err, stub)); + } + } + } + + let chars = clause_name!(chars, indices.atom_tbl); + self.unify(addr.clone(), Addr::Con(Constant::Atom(chars, None))); + } + } + }, + _ => unreachable!() + }; + }, + &SystemClauseType::AtomLength => { + let a1 = self[temp_v!(1)].clone(); + + let atom = match self.store(self.deref(a1)) { + Addr::Con(Constant::Atom(name, _)) => name, + _ => unreachable!() + }; + + let len = Number::Integer(Rc::new(BigInt::from_usize(atom.as_str().len()).unwrap())); + let a2 = self[temp_v!(2)].clone(); + + self.unify(a2, Addr::Con(Constant::Number(len))); + }, &SystemClauseType::ModuleAssertDynamicPredicateToFront => { let p = self.cp; let trans_type = DynamicTransactionType::ModuleAssert(DynamicAssertPlace::Front); @@ -583,13 +711,13 @@ impl MachineState { unossified_op_dir.extend(indices.op_dir.iter().filter_map(|(key, op_dir_val)| { let (name, fixity) = key.clone(); - + let prec = op_dir_val.shared_op_desc().prec(); if prec == 0 { return None; } - + let assoc = op_dir_val.shared_op_desc().assoc(); Some((OrderedOpDirKey(name, fixity), (prec, assoc))) @@ -651,8 +779,8 @@ impl MachineState { Addr::DBRef(db_ref) => match db_ref { DBRef::Op(priority, spec, name, _, shared_op_desc) => { - - + + let prec = self[temp_v!(2)].clone(); let specifier = self[temp_v!(3)].clone(); let op = self[temp_v!(4)].clone(); diff --git a/src/tests.rs b/src/tests.rs index 56287c34..f28ef536 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1952,6 +1952,19 @@ foo(X) :- call(X) -> call(X)."); assert_prolog_success!(&mut wam, "?- catch(abolish(foo(_)), error(type_error(predicate_indicator, foo(_)), abolish/1), true)."); assert_prolog_failure!(&mut wam, "?- abolish(abolish/1)."); assert_prolog_success!(&mut wam, "?- catch(abolish(abolish/1), error(permission_error(modify, static_procedure, abolish/1), abolish/1), true)."); + + assert_prolog_success!(&mut wam, "?- atom_length('enchanted evening', N).", + [["N = 17"]]); + assert_prolog_success!(&mut wam, r"?- atom_length('enchanted\ + evening', N).", + [["N = 17"]]); + assert_prolog_success!(&mut wam, "?- atom_length('', N).", + [["N = 0"]]); + assert_prolog_failure!(&mut wam, "?- atom_length('scarlet', 5)."); + assert_prolog_success!(&mut wam, "?- catch((atom_length(Atom, 4), false), error(instantiation_error, _), true)."); + assert_prolog_success!(&mut wam, "?- catch((atom_length(1.23, 4), false), error(type_error(atom, 1.23), _), true)."); + assert_prolog_success!(&mut wam, "?- catch((atom_length(atom, '4'), false), error(type_error(integer, '4'), _), true)."); + } -- 2.54.0