add number_chars/2

This commit is contained in:
Mark Thom
2019-04-28 14:36:38 -06:00
parent e135063325
commit 6be03a7f7a
6 changed files with 136 additions and 16 deletions

View File

@@ -1,6 +1,6 @@
[package] [package]
name = "scryer-prolog" name = "scryer-prolog"
version = "0.8.70" version = "0.8.71"
authors = ["Mark Thom <markjordanthom@gmail.com>"] authors = ["Mark Thom <markjordanthom@gmail.com>"]
repository = "https://github.com/mthom/scryer-prolog" repository = "https://github.com/mthom/scryer-prolog"
description = "A modern Prolog implementation written mostly in Rust." description = "A modern Prolog implementation written mostly in Rust."
@@ -14,7 +14,7 @@ cfg-if = "0.1.7"
downcast = "0.10.0" downcast = "0.10.0"
num = "0.2" num = "0.2"
ordered-float = "0.5.0" ordered-float = "0.5.0"
prolog_parser = "0.8.22" prolog_parser = "0.8.23"
readline_rs_compat = { version = "0.1.9", optional = true } readline_rs_compat = { version = "0.1.9", optional = true }
ref_thread_local = "0.0.0" ref_thread_local = "0.0.0"

View File

@@ -206,6 +206,7 @@ The following predicates are built-in to Scryer.
* `must_be/2` * `must_be/2`
* `nl/0` * `nl/0`
* `nonvar/1` * `nonvar/1`
* `number_chars/2`
* `numbervars/2` * `numbervars/2`
* `numlist/{2,3}` * `numlist/{2,3}`
* `once/1` * `once/1`

View File

@@ -165,6 +165,7 @@ pub enum SystemClauseType {
ModuleAssertDynamicPredicateToFront, ModuleAssertDynamicPredicateToFront,
ModuleAssertDynamicPredicateToBack, ModuleAssertDynamicPredicateToBack,
CharCode, CharCode,
CharsToNumber,
CheckCutPoint, CheckCutPoint,
CopyToLiftedHeap, CopyToLiftedHeap,
DeleteAttribute, DeleteAttribute,
@@ -200,6 +201,7 @@ pub enum SystemClauseType {
ModuleOf, ModuleOf,
ModuleRetractClause, ModuleRetractClause,
NoSuchPredicate, NoSuchPredicate,
NumberToChars,
OpDeclaration, OpDeclaration,
REPL(REPLCodePtr), REPL(REPLCodePtr),
ReadTerm, ReadTerm,
@@ -246,7 +248,8 @@ impl SystemClauseType {
&SystemClauseType::AtomLength => clause_name!("$atom_length"), &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::CharCode => clause_name!("char_code"), &SystemClauseType::CharCode => clause_name!("$char_code"),
&SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"),
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
&SystemClauseType::REPL(REPLCodePtr::CompileBatch) => clause_name!("$compile_batch"), &SystemClauseType::REPL(REPLCodePtr::CompileBatch) => clause_name!("$compile_batch"),
&SystemClauseType::REPL(REPLCodePtr::SubmitQueryAndPrintResults) => &SystemClauseType::REPL(REPLCodePtr::SubmitQueryAndPrintResults) =>
@@ -286,6 +289,7 @@ impl SystemClauseType {
&SystemClauseType::ModuleHeadIsDynamic => clause_name!("$module_head_is_dynamic"), &SystemClauseType::ModuleHeadIsDynamic => clause_name!("$module_head_is_dynamic"),
&SystemClauseType::ModuleOf => clause_name!("$module_of"), &SystemClauseType::ModuleOf => clause_name!("$module_of"),
&SystemClauseType::NoSuchPredicate => clause_name!("$no_such_predicate"), &SystemClauseType::NoSuchPredicate => clause_name!("$no_such_predicate"),
&SystemClauseType::NumberToChars => clause_name!("$number_to_chars"),
&SystemClauseType::RedoAttrVarBindings => clause_name!("$redo_attr_var_bindings"), &SystemClauseType::RedoAttrVarBindings => clause_name!("$redo_attr_var_bindings"),
&SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"), &SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"),
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"), &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
@@ -331,6 +335,7 @@ impl SystemClauseType {
("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront), ("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront),
("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack), ("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack),
("$char_code", 2) => Some(SystemClauseType::CharCode), ("$char_code", 2) => Some(SystemClauseType::CharCode),
("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber),
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
("$compile_batch", 0) => Some(SystemClauseType::REPL(REPLCodePtr::CompileBatch)), ("$compile_batch", 0) => Some(SystemClauseType::REPL(REPLCodePtr::CompileBatch)),
("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap), ("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap),
@@ -366,6 +371,7 @@ impl SystemClauseType {
("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause), ("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause),
("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic), ("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic),
("$no_such_predicate", 1) => Some(SystemClauseType::NoSuchPredicate), ("$no_such_predicate", 1) => Some(SystemClauseType::NoSuchPredicate),
("$number_to_chars", 2) => Some(SystemClauseType::NumberToChars),
("$op", 3) => Some(SystemClauseType::OpDeclaration), ("$op", 3) => Some(SystemClauseType::OpDeclaration),
("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings), ("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings),
("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck), ("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck),

View File

@@ -15,10 +15,10 @@
atom_length/2, bagof/3, catch/3, char_code/2, clause/2, atom_length/2, bagof/3, catch/3, char_code/2, clause/2,
current_op/3, current_predicate/1, current_prolog_flag/2, current_op/3, current_predicate/1, current_prolog_flag/2,
expand_goal/2, expand_term/2, false/0, findall/3, findall/4, expand_goal/2, expand_term/2, false/0, findall/3, findall/4,
get_char/1, halt/0, once/1, op/3, read_term/2, repeat/0, get_char/1, halt/0, number_chars/2, once/1, op/3, read_term/2,
retract/1, set_prolog_flag/2, setof/3, term_variables/2, repeat/0, retract/1, set_prolog_flag/2, setof/3,
throw/1, true/0, write/1, write_canonical/1, write_term/2, term_variables/2, throw/1, true/0, write/1, write_canonical/1,
writeq/1]). write_term/2, writeq/1]).
% module resolution operator. % module resolution operator.
:- op(600, xfy, :). :- op(600, xfy, :).
@@ -773,3 +773,45 @@ get_char(C) :-
; atom_length(C, 1) -> '$get_char'(C) ; atom_length(C, 1) -> '$get_char'(C)
; throw(error(type_error(in_character, C), get_char/1)) ; throw(error(type_error(in_character, C), get_char/1))
). ).
can_be_number(N, PI) :-
( var(N) -> true
; must_be_number(N, PI)
).
must_be_number(N, _) :-
( integer(N)
; float(N)
),
!.
must_be_number(N, PI) :-
( nonvar(N) -> throw(error(type_error(number, N), PI))
; throw(error(instantiation_error, PI))
).
must_be_chars([], _).
must_be_chars([C|Cs], PI) :-
( nonvar(C) ->
( atom_length(C, 1) ->
( nonvar(Cs) -> must_be_chars(Cs, PI)
; false %% throw(error(type_error(list, Cs), PI))
)
; throw(error(type_error(character, C), PI))
)
; must_be_chars(Cs, PI)
).
number_chars(N, Chs) :-
( ground(Chs)
-> can_be_number(N, number_chars/2),
can_be_list(Chs, number_chars/2),
'$chars_to_number'(Chs, Nx),
Nx = N
; must_be_number(N, number_chars/2),
( var(Chs) -> true
; can_be_list(Chs, number_chars/2)
, must_be_chars(Chs, number_chars/2)
),
'$number_to_chars'(N, Chsx),
Chsx = Chs
).

View File

@@ -320,7 +320,8 @@ fn try_in_situ(machine_st: &mut MachineState, name: ClauseName, arity: usize,
} }
} }
pub(super) fn try_char_list(addrs: Vec<Addr>) -> Result<String, MachineError> pub(super)
fn try_char_list(addrs: Vec<Addr>) -> Result<String, MachineError>
{ {
let mut chars = String::new(); let mut chars = String::new();

View File

@@ -1,5 +1,5 @@
use prolog_parser::ast::*; use prolog_parser::ast::*;
use prolog_parser::parser::{get_desc, get_clause_spec}; use prolog_parser::parser::*;
use prolog_parser::tabled_rc::*; use prolog_parser::tabled_rc::*;
use prolog::clause_types::*; use prolog::clause_types::*;
@@ -12,6 +12,7 @@ use prolog::machine::machine_state::*;
use prolog::machine::toplevel::{to_op_decl}; use prolog::machine::toplevel::{to_op_decl};
use prolog::num::{FromPrimitive, ToPrimitive, Zero}; use prolog::num::{FromPrimitive, ToPrimitive, Zero};
use prolog::num::bigint::{BigInt}; use prolog::num::bigint::{BigInt};
use prolog::ordered_float::OrderedFloat;
use prolog::read::{PrologStream, readline}; use prolog::read::{PrologStream, readline};
use ref_thread_local::RefThreadLocal; use ref_thread_local::RefThreadLocal;
@@ -35,7 +36,7 @@ impl BrentAlgState {
} }
} }
impl MachineState { impl MachineState {
// a step in Brent's algorithm. // a step in Brent's algorithm.
fn brents_alg_step(&self, brent_st: &mut BrentAlgState) -> Option<CycleSearchResult> fn brents_alg_step(&self, brent_st: &mut BrentAlgState) -> Option<CycleSearchResult>
{ {
@@ -329,7 +330,7 @@ impl MachineState {
indices: &mut IndexStore, indices: &mut IndexStore,
call_policy: &mut Box<CallPolicy>, call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>, cut_policy: &mut Box<CutPolicy>,
parsing_stream: &mut PrologStream) current_input_stream: &mut PrologStream)
-> CallResult -> CallResult
{ {
match ct { match ct {
@@ -399,9 +400,9 @@ impl MachineState {
let chars = clause_name!(string, indices.atom_tbl); let chars = clause_name!(string, indices.atom_tbl);
self.unify(addr.clone(), Addr::Con(Constant::Atom(chars, None))); self.unify(addr.clone(), Addr::Con(Constant::Atom(chars, None)));
}, },
Err(err) => Err(err) =>
return Err(self.error_form(err, stub)) return Err(self.error_form(err, stub))
} }
} }
}, },
_ => unreachable!() _ => unreachable!()
@@ -481,6 +482,75 @@ impl MachineState {
self.unify(a2, Addr::Con(Constant::Number(len))); self.unify(a2, Addr::Con(Constant::Number(len)));
}, },
&SystemClauseType::CharsToNumber => {
let nx = self[temp_v!(2)].clone();
let stub = MachineError::functor_stub(clause_name!("number_chars"), 2);
match self.try_from_list(temp_v!(1), stub.clone()) {
Err(e) => return Err(e),
Ok(addrs) =>
match try_char_list(addrs) {
Ok(mut string) => {
if let Some(c) = string.chars().last() {
if layout_char!(c) {
let err = ParserError::UnexpectedChar(c);
let h = self.heap.h;
let err = MachineError::syntax_error(h, err);
return Err(self.error_form(err, stub));
}
}
string.push('.');
let mut stream = parsing_stream(std::io::Cursor::new(string));
let mut parser = Parser::new(&mut stream, indices.atom_tbl.clone(),
self.machine_flags());
match parser.read_term(composite_op!(&indices.op_dir)) {
Err(err) => {
let h = self.heap.h;
let err = MachineError::syntax_error(h, err);
return Err(self.error_form(err, stub));
},
Ok(Term::Constant(_, Constant::Number(n))) =>
self.unify(nx, Addr::Con(Constant::Number(n))),
Ok(Term::Constant(_, Constant::CharCode(c))) =>
self.unify(nx, Addr::Con(Constant::CharCode(c))),
_ => {
let err = ParserError::ParseBigInt;
let h = self.heap.h;
let err = MachineError::syntax_error(h, err);
return Err(self.error_form(err, stub));
}
}
},
Err(err) =>
return Err(self.error_form(err, stub))
}
}
},
&SystemClauseType::NumberToChars => {
let n = self[temp_v!(1)].clone();
let chs = self[temp_v!(2)].clone();
let string = match self.store(self.deref(n)) {
Addr::Con(Constant::Number(Number::Float(OrderedFloat(n)))) =>
format!("{0:<20?}", n),
Addr::Con(Constant::Number(Number::Integer(n))) =>
n.to_string(),
_ => unreachable!()
};
let chars = string.trim().chars().map(|c| Addr::Con(Constant::Char(c)));
let char_list = Addr::HeapCell(self.heap.to_list(chars));
self.unify(char_list, chs);
},
&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);
@@ -555,7 +625,7 @@ impl MachineState {
}; };
}, },
&SystemClauseType::GetChar => { &SystemClauseType::GetChar => {
let result = parsing_stream.next(); let result = current_input_stream.next();
let a1 = self[temp_v!(1)].clone(); let a1 = self[temp_v!(1)].clone();
match result { match result {
@@ -1409,7 +1479,7 @@ impl MachineState {
self.install_new_block(temp_v!(1)); self.install_new_block(temp_v!(1));
}, },
&SystemClauseType::ReadTerm => { &SystemClauseType::ReadTerm => {
match self.read(parsing_stream, indices.atom_tbl.clone(), &indices.op_dir) { match self.read(current_input_stream, indices.atom_tbl.clone(), &indices.op_dir) {
Ok(term_write_result) => { Ok(term_write_result) => {
let a1 = self[temp_v!(1)].clone(); let a1 = self[temp_v!(1)].clone();
self.unify(Addr::HeapCell(term_write_result.heap_loc), a1); self.unify(Addr::HeapCell(term_write_result.heap_loc), a1);
@@ -1441,7 +1511,7 @@ impl MachineState {
}, },
Err(err) => { Err(err) => {
// reset the input stream after an input failure. // reset the input stream after an input failure.
*parsing_stream = readline::input_stream(); *current_input_stream = readline::input_stream();
let h = self.heap.h; let h = self.heap.h;
let syntax_error = MachineError::syntax_error(h, err); let syntax_error = MachineError::syntax_error(h, err);