add atom_length/2, atom_chars/2, atom_codes/2
This commit is contained in:
@@ -159,6 +159,9 @@ The following predicates are built-in to Scryer.
|
|||||||
* `assertz/1`
|
* `assertz/1`
|
||||||
* `atom/1`
|
* `atom/1`
|
||||||
* `atomic/1`
|
* `atomic/1`
|
||||||
|
* `atom_chars/2`
|
||||||
|
* `atom_codes/2`
|
||||||
|
* `atom_length/2`
|
||||||
* `bagof/3`
|
* `bagof/3`
|
||||||
* `bb_b_put/2`
|
* `bb_b_put/2`
|
||||||
* `bb_get/2`
|
* `bb_get/2`
|
||||||
|
|||||||
@@ -159,6 +159,9 @@ pub enum SystemClauseType {
|
|||||||
AbolishModuleClause,
|
AbolishModuleClause,
|
||||||
AssertDynamicPredicateToBack,
|
AssertDynamicPredicateToBack,
|
||||||
AssertDynamicPredicateToFront,
|
AssertDynamicPredicateToFront,
|
||||||
|
AtomChars,
|
||||||
|
AtomCodes,
|
||||||
|
AtomLength,
|
||||||
ModuleAssertDynamicPredicateToFront,
|
ModuleAssertDynamicPredicateToFront,
|
||||||
ModuleAssertDynamicPredicateToBack,
|
ModuleAssertDynamicPredicateToBack,
|
||||||
CheckCutPoint,
|
CheckCutPoint,
|
||||||
@@ -234,6 +237,9 @@ impl SystemClauseType {
|
|||||||
&SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"),
|
&SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"),
|
||||||
&SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"),
|
&SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"),
|
||||||
&SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"),
|
&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::ModuleAssertDynamicPredicateToFront => clause_name!("$module_asserta"),
|
||||||
&SystemClauseType::ModuleAssertDynamicPredicateToBack => clause_name!("$module_assertz"),
|
&SystemClauseType::ModuleAssertDynamicPredicateToBack => clause_name!("$module_assertz"),
|
||||||
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
|
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
|
||||||
@@ -306,6 +312,9 @@ impl SystemClauseType {
|
|||||||
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
|
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
|
||||||
match (name, arity) {
|
match (name, arity) {
|
||||||
("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause),
|
("$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),
|
("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
|
||||||
("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
|
("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
|
||||||
("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
|
("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
|
||||||
|
|||||||
@@ -6,14 +6,15 @@
|
|||||||
(mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2,
|
(mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2,
|
||||||
(=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2,
|
(=<)/2, (,)/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,
|
abolish/1, asserta/1, assertz/1, atom_chars/2, atom_codes/2,
|
||||||
bb_get/2, bb_put/2, call_cleanup/2,
|
atom_length/2, bagof/3, bb_b_put/2, bb_get/2, bb_put/2,
|
||||||
call_with_inference_limit/3, catch/3, clause/2,
|
call_cleanup/2, call_with_inference_limit/3, catch/3,
|
||||||
current_predicate/1, current_op/3, current_prolog_flag/2,
|
clause/2, current_predicate/1, current_op/3,
|
||||||
expand_goal/2, expand_term/2, findall/3, findall/4, halt/0,
|
current_prolog_flag/2, expand_goal/2, expand_term/2,
|
||||||
once/1, op/3, repeat/0, retract/1, set_prolog_flag/2, setof/3,
|
findall/3, findall/4, halt/0, once/1, op/3, repeat/0,
|
||||||
setup_call_cleanup/3, term_variables/2, throw/1, true/0,
|
retract/1, set_prolog_flag/2, setof/3, setup_call_cleanup/3,
|
||||||
false/0, write/1, write_canonical/1, writeq/1, write_term/2]).
|
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
|
/* 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
|
and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice
|
||||||
@@ -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)).
|
bb_get(Key, _) :- throw(error(type_error(atom, Key), bb_get/2)).
|
||||||
|
|
||||||
halt :- '$halt'.
|
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))
|
||||||
|
).
|
||||||
|
|||||||
@@ -172,7 +172,7 @@ pub enum ValidType {
|
|||||||
// Boolean,
|
// Boolean,
|
||||||
// Byte,
|
// Byte,
|
||||||
Callable,
|
Callable,
|
||||||
// Character,
|
Character,
|
||||||
Compound,
|
Compound,
|
||||||
// Evaluable,
|
// Evaluable,
|
||||||
// InByte,
|
// InByte,
|
||||||
@@ -193,7 +193,7 @@ impl ValidType {
|
|||||||
// ValidType::Boolean => "boolean",
|
// ValidType::Boolean => "boolean",
|
||||||
// ValidType::Byte => "byte",
|
// ValidType::Byte => "byte",
|
||||||
ValidType::Callable => "callable",
|
ValidType::Callable => "callable",
|
||||||
// ValidType::Character => "character",
|
ValidType::Character => "character",
|
||||||
ValidType::Compound => "compound",
|
ValidType::Compound => "compound",
|
||||||
// ValidType::Evaluable => "evaluable",
|
// ValidType::Evaluable => "evaluable",
|
||||||
// ValidType::InByte => "in_byte",
|
// ValidType::InByte => "in_byte",
|
||||||
@@ -225,7 +225,7 @@ impl DomainError {
|
|||||||
#[derive(Clone, Copy)]
|
#[derive(Clone, Copy)]
|
||||||
pub enum RepFlag {
|
pub enum RepFlag {
|
||||||
// Character,
|
// Character,
|
||||||
// CharacterCode,
|
CharacterCode,
|
||||||
// InCharacterCode,
|
// InCharacterCode,
|
||||||
MaxArity,
|
MaxArity,
|
||||||
// MaxInteger,
|
// MaxInteger,
|
||||||
@@ -236,7 +236,7 @@ impl RepFlag {
|
|||||||
pub fn as_str(self) -> &'static str {
|
pub fn as_str(self) -> &'static str {
|
||||||
match self {
|
match self {
|
||||||
// RepFlag::Character => "character",
|
// RepFlag::Character => "character",
|
||||||
// RepFlag::CharacterCode => "character_code",
|
RepFlag::CharacterCode => "character_code",
|
||||||
// RepFlag::InCharacterCode => "in_character_code",
|
// RepFlag::InCharacterCode => "in_character_code",
|
||||||
RepFlag::MaxArity => "max_arity",
|
RepFlag::MaxArity => "max_arity",
|
||||||
// RepFlag::MaxInteger => "max_integer",
|
// RepFlag::MaxInteger => "max_integer",
|
||||||
|
|||||||
@@ -2107,8 +2107,8 @@ impl MachineState {
|
|||||||
*list = result;
|
*list = result;
|
||||||
}
|
}
|
||||||
|
|
||||||
pub(super) fn try_from_list(&self, r: RegType, caller: MachineStub)
|
pub(super)
|
||||||
-> Result<Vec<Addr>, MachineStub>
|
fn try_from_list(&self, r: RegType, caller: MachineStub) -> Result<Vec<Addr>, MachineStub>
|
||||||
{
|
{
|
||||||
let a1 = self.store(self.deref(self[r].clone()));
|
let a1 = self.store(self.deref(self[r].clone()));
|
||||||
|
|
||||||
|
|||||||
@@ -16,6 +16,7 @@ use ref_thread_local::RefThreadLocal;
|
|||||||
|
|
||||||
use std::collections::HashSet;
|
use std::collections::HashSet;
|
||||||
use std::io::{stdout, Write};
|
use std::io::{stdout, Write};
|
||||||
|
use std::iter::once;
|
||||||
use std::mem;
|
use std::mem;
|
||||||
use std::rc::Rc;
|
use std::rc::Rc;
|
||||||
|
|
||||||
@@ -332,6 +333,133 @@ impl MachineState {
|
|||||||
self.p = CodePtr::DynamicTransaction(trans_type, p);
|
self.p = CodePtr::DynamicTransaction(trans_type, p);
|
||||||
return Ok(());
|
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 => {
|
&SystemClauseType::ModuleAssertDynamicPredicateToFront => {
|
||||||
let p = self.cp;
|
let p = self.cp;
|
||||||
let trans_type = DynamicTransactionType::ModuleAssert(DynamicAssertPlace::Front);
|
let trans_type = DynamicTransactionType::ModuleAssert(DynamicAssertPlace::Front);
|
||||||
|
|||||||
13
src/tests.rs
13
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_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_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, "?- 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).");
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user