Compare commits
4 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ab9a14cc6a | ||
|
|
a641822a1b | ||
|
|
145fee0d36 | ||
|
|
567af2648c |
@@ -1,6 +1,6 @@
|
||||
[package]
|
||||
name = "scryer-prolog"
|
||||
version = "0.8.112"
|
||||
version = "0.8.113"
|
||||
authors = ["Mark Thom <markjordanthom@gmail.com>"]
|
||||
build = "build.rs"
|
||||
repository = "https://github.com/mthom/scryer-prolog"
|
||||
|
||||
@@ -2,6 +2,7 @@ use prolog_parser::ast::*;
|
||||
|
||||
use crate::prolog::forms::Number;
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
use crate::prolog::rug::rand::RandState;
|
||||
|
||||
use ref_thread_local::RefThreadLocal;
|
||||
|
||||
@@ -81,6 +82,10 @@ pub enum InlinedClauseType {
|
||||
IsVar(RegType),
|
||||
}
|
||||
|
||||
ref_thread_local! {
|
||||
pub static managed RANDOM_STATE: RandState<'static> = RandState::new();
|
||||
}
|
||||
|
||||
ref_thread_local! {
|
||||
pub static managed CLAUSE_TYPE_FORMS: BTreeMap<(&'static str, usize), ClauseType> = {
|
||||
let mut m = BTreeMap::new();
|
||||
@@ -223,12 +228,14 @@ pub enum SystemClauseType {
|
||||
GetCutPoint,
|
||||
GetDoubleQuotes,
|
||||
InstallNewBlock,
|
||||
Maybe,
|
||||
ResetBlock,
|
||||
ReturnFromAttributeGoals,
|
||||
ReturnFromVerifyAttr,
|
||||
SetBall,
|
||||
SetCutPointByDefault(RegType),
|
||||
SetDoubleQuotes,
|
||||
SetSeed,
|
||||
SkipMaxList,
|
||||
Succeed,
|
||||
TermVariables,
|
||||
@@ -319,6 +326,7 @@ impl SystemClauseType {
|
||||
clause_name!("$install_inference_counter")
|
||||
}
|
||||
&SystemClauseType::LiftedHeapLength => clause_name!("$lh_length"),
|
||||
&SystemClauseType::Maybe => clause_name!("maybe"),
|
||||
&SystemClauseType::ModuleHeadIsDynamic => clause_name!("$module_head_is_dynamic"),
|
||||
&SystemClauseType::ModuleOf => clause_name!("$module_of"),
|
||||
&SystemClauseType::NoSuchPredicate => clause_name!("$no_such_predicate"),
|
||||
@@ -329,6 +337,7 @@ impl SystemClauseType {
|
||||
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
|
||||
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
|
||||
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
|
||||
&SystemClauseType::SetSeed => clause_name!("$set_seed"),
|
||||
&SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"),
|
||||
&SystemClauseType::StoreGlobalVarWithOffset => {
|
||||
clause_name!("$store_global_var_with_offset")
|
||||
@@ -417,6 +426,7 @@ impl SystemClauseType {
|
||||
("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner),
|
||||
("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter),
|
||||
("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength),
|
||||
("$maybe", 0) => Some(SystemClauseType::Maybe),
|
||||
("$module_of", 2) => Some(SystemClauseType::ModuleOf),
|
||||
("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause),
|
||||
("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic),
|
||||
@@ -450,6 +460,7 @@ impl SystemClauseType {
|
||||
("$set_ball", 1) => Some(SystemClauseType::SetBall),
|
||||
("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
|
||||
("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes),
|
||||
("$set_seed", 1) => Some(SystemClauseType::SetSeed),
|
||||
("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
|
||||
("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar),
|
||||
("$store_global_var_with_offset", 2) => Some(SystemClauseType::StoreGlobalVarWithOffset),
|
||||
|
||||
@@ -34,7 +34,7 @@
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(non_iso)).
|
||||
:- use_module(library(dcgs)).
|
||||
%:- use_module(library(types)).
|
||||
:- use_module(library(error), []).
|
||||
|
||||
:- attribute
|
||||
clpb/1,
|
||||
@@ -77,8 +77,8 @@ must_be(list(What), Where, Term) :- !,
|
||||
must_be(ground, _, Term) :- !,
|
||||
functor(Term, _, _).
|
||||
|
||||
must_be(Type, Goal-Arg, Term) :-
|
||||
must_be(Term, Type, Goal, Arg).
|
||||
must_be(Type, _, Term) :-
|
||||
error:must_be(Type, Term).
|
||||
|
||||
clpz_list(Nil, _) :- Nil == [].
|
||||
clpz_list(Ls, Where) :-
|
||||
@@ -89,7 +89,6 @@ clpz_list(Ls, Where) :-
|
||||
).
|
||||
|
||||
|
||||
|
||||
instantiation_error(Term) :- instantiation_error(Term, unknown(Term)-1).
|
||||
|
||||
instantiation_error(_, Goal-Arg) :-
|
||||
@@ -139,7 +138,10 @@ partition(Pred, Ls0, As, Bs) :-
|
||||
include(Pred, Ls0, As),
|
||||
exclude(Pred, Ls0, Bs).
|
||||
|
||||
sum_list(Ls, S) :- sumlist(Ls, S).
|
||||
sum_list(Ls, S) :-
|
||||
foldl(sum_, Ls, 0, S).
|
||||
|
||||
sum_(L, S0, S) :- S is S0 + L.
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Pairs.
|
||||
|
||||
@@ -33,6 +33,10 @@ must_be(Type, Term) :-
|
||||
must_be_(Type, _) :-
|
||||
var(Type),
|
||||
instantiation_error(Type).
|
||||
must_be_(var, Term) :-
|
||||
( var(Term) -> true
|
||||
; throw(error(uninstantiation_error, _))
|
||||
).
|
||||
must_be_(integer, Term) :- check_(integer, integer, Term).
|
||||
must_be_(atom, Term) :- check_(atom, atom, Term).
|
||||
must_be_(list, Term) :- check_(ilist, list, Term).
|
||||
@@ -52,6 +56,7 @@ type(type).
|
||||
type(integer).
|
||||
type(atom).
|
||||
type(list).
|
||||
type(var).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
can_be(Type, Term)
|
||||
|
||||
@@ -4,8 +4,8 @@
|
||||
%% ?- use_module(library(non_iso)).
|
||||
|
||||
:- module(non_iso, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
|
||||
call_with_inference_limit/3, forall/2,
|
||||
setup_call_cleanup/3, variant/2]).
|
||||
call_with_inference_limit/3, forall/2, maybe/0,
|
||||
set_random/1, setup_call_cleanup/3, variant/2]).
|
||||
|
||||
forall(Generate, Test) :-
|
||||
\+ (Generate, \+ Test).
|
||||
@@ -125,3 +125,16 @@ call_with_inference_limit(_, _, R, Bb, B) :-
|
||||
'$call_with_default_policy'(handle_ile(B, Ball, R)).
|
||||
|
||||
variant(X, Y) :- '$variant'(X, Y).
|
||||
|
||||
% succeeds with probability 0.5.
|
||||
maybe :- '$maybe'.
|
||||
|
||||
set_random(Seed) :-
|
||||
( nonvar(Seed) ->
|
||||
( Seed = seed(S) ->
|
||||
( integer(S) -> '$set_seed'(S)
|
||||
; throw(error(type_error(integer(S), set_random/1)))
|
||||
)
|
||||
)
|
||||
; throw(error(instantiation_error, set_random/1))
|
||||
).
|
||||
|
||||
@@ -178,10 +178,11 @@ impl From<Ref> for Addr {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum TrailRef {
|
||||
Ref(Ref),
|
||||
AttrVarLink(usize, Addr),
|
||||
AttrVarHeapLink(usize),
|
||||
AttrVarListLink(usize, usize),
|
||||
}
|
||||
|
||||
impl From<Ref> for TrailRef {
|
||||
|
||||
@@ -648,9 +648,15 @@ impl MachineState {
|
||||
self.tr += 1;
|
||||
}
|
||||
}
|
||||
TrailRef::AttrVarLink(h, prev_addr) => {
|
||||
TrailRef::AttrVarHeapLink(h) => {
|
||||
if h < self.hb {
|
||||
self.trail.push(TrailRef::AttrVarLink(h, prev_addr));
|
||||
self.trail.push(TrailRef::AttrVarHeapLink(h));
|
||||
self.tr += 1;
|
||||
}
|
||||
}
|
||||
TrailRef::AttrVarListLink(h, l) => {
|
||||
if h < self.hb {
|
||||
self.trail.push(TrailRef::AttrVarListLink(h, l));
|
||||
self.tr += 1;
|
||||
}
|
||||
}
|
||||
@@ -680,7 +686,7 @@ impl MachineState {
|
||||
// additions, now that deleted attributes can be undeleted by
|
||||
// backtracking.
|
||||
for i in (a1..a2).rev() {
|
||||
match self.trail[i].clone() {
|
||||
match self.trail[i] {
|
||||
TrailRef::Ref(Ref::HeapCell(h)) => {
|
||||
self.heap[h] = HeapCellValue::Addr(Addr::HeapCell(h))
|
||||
}
|
||||
@@ -690,8 +696,11 @@ impl MachineState {
|
||||
TrailRef::Ref(Ref::StackCell(fr, sc)) => {
|
||||
self.and_stack[fr][sc] = Addr::StackCell(fr, sc)
|
||||
}
|
||||
TrailRef::AttrVarLink(h, prev_addr) => {
|
||||
self.heap[h] = HeapCellValue::Addr(prev_addr)
|
||||
TrailRef::AttrVarHeapLink(h) => {
|
||||
self.heap[h] = HeapCellValue::Addr(Addr::HeapCell(h));
|
||||
}
|
||||
TrailRef::AttrVarListLink(h, l) => {
|
||||
self.heap[h] = HeapCellValue::Addr(Addr::Lis(l));
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -735,13 +744,14 @@ impl MachineState {
|
||||
let mut i = self.or_stack[b].tr;
|
||||
|
||||
while i < self.tr {
|
||||
let tr_i = self.trail[i].clone();
|
||||
let tr_i = self.trail[i];
|
||||
let hb = self.hb;
|
||||
|
||||
match tr_i {
|
||||
TrailRef::Ref(Ref::AttrVar(tr_i))
|
||||
| TrailRef::Ref(Ref::HeapCell(tr_i))
|
||||
| TrailRef::AttrVarLink(tr_i, _) => {
|
||||
| TrailRef::AttrVarHeapLink(tr_i)
|
||||
| TrailRef::AttrVarListLink(tr_i, _) => {
|
||||
if tr_i < hb {
|
||||
i += 1;
|
||||
} else {
|
||||
@@ -765,7 +775,7 @@ impl MachineState {
|
||||
i += 1;
|
||||
} else {
|
||||
let tr = self.tr;
|
||||
let val = self.trail[tr - 1].clone();
|
||||
let val = self.trail[tr - 1];
|
||||
self.trail[i] = val;
|
||||
self.trail.pop();
|
||||
self.tr -= 1;
|
||||
|
||||
@@ -17,6 +17,8 @@ use crate::prolog::ordered_float::OrderedFloat;
|
||||
use crate::prolog::read::{readline, PrologStream};
|
||||
use crate::prolog::rug::Integer;
|
||||
|
||||
use crate::ref_thread_local::RefThreadLocal;
|
||||
|
||||
use indexmap::{IndexMap, IndexSet};
|
||||
|
||||
use std::collections::VecDeque;
|
||||
@@ -679,7 +681,8 @@ impl MachineState {
|
||||
let c = self.int_to_char_code(&n, "atom_codes", 2)?;
|
||||
chars.push(c as char);
|
||||
}
|
||||
&Addr::Con(Constant::CharCode(c)) => chars.push(c as char),
|
||||
&Addr::Con(Constant::CharCode(c)) =>
|
||||
chars.push(c as char),
|
||||
_ => {
|
||||
let err = MachineError::type_error(
|
||||
ValidType::Integer,
|
||||
@@ -1018,8 +1021,14 @@ impl MachineState {
|
||||
tail
|
||||
};
|
||||
|
||||
let trail_ref = match old_addr {
|
||||
Addr::HeapCell(h) => TrailRef::AttrVarHeapLink(h),
|
||||
Addr::Lis(l) => TrailRef::AttrVarListLink(l1 + 1, l),
|
||||
_ => unreachable!()
|
||||
};
|
||||
|
||||
self.heap[l1 + 1] = HeapCellValue::Addr(tail);
|
||||
self.trail(TrailRef::AttrVarLink(l1 + 1, old_addr));
|
||||
self.trail(trail_ref);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1041,7 +1050,7 @@ impl MachineState {
|
||||
};
|
||||
|
||||
self.heap[h + 1] = HeapCellValue::Addr(tail);
|
||||
self.trail(TrailRef::AttrVarLink(h + 1, Addr::Lis(l)));
|
||||
self.trail(TrailRef::AttrVarListLink(h + 1, l));
|
||||
}
|
||||
_ => unreachable!(),
|
||||
}
|
||||
@@ -1255,6 +1264,19 @@ impl MachineState {
|
||||
_ => self.fail = true,
|
||||
}
|
||||
}
|
||||
&SystemClauseType::Maybe => {
|
||||
let result = {
|
||||
let mut rand = RANDOM_STATE.borrow_mut();
|
||||
|
||||
if rand.bits(1) == 0 {
|
||||
true
|
||||
} else {
|
||||
false
|
||||
}
|
||||
};
|
||||
|
||||
self.fail = result;
|
||||
}
|
||||
&SystemClauseType::OpDeclaration => {
|
||||
let priority = self[temp_v!(1)].clone();
|
||||
let specifier = self[temp_v!(2)].clone();
|
||||
@@ -1834,6 +1856,31 @@ impl MachineState {
|
||||
}
|
||||
&SystemClauseType::SetBall =>
|
||||
self.set_ball(),
|
||||
&SystemClauseType::SetSeed => {
|
||||
let seed = self.store(self.deref(self[temp_v!(1)].clone()));
|
||||
|
||||
let seed = match seed {
|
||||
Addr::Con(Constant::Integer(n)) =>
|
||||
n,
|
||||
Addr::Con(Constant::CharCode(c)) =>
|
||||
Integer::from(c),
|
||||
Addr::Con(Constant::Rational(r)) => {
|
||||
if r.denom() == &1 {
|
||||
r.numer().clone()
|
||||
} else {
|
||||
self.fail = true;
|
||||
return Ok(());
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
self.fail = true;
|
||||
return Ok(());
|
||||
}
|
||||
};
|
||||
|
||||
let mut rand = RANDOM_STATE.borrow_mut();
|
||||
rand.seed(&seed);
|
||||
}
|
||||
&SystemClauseType::SkipMaxList =>
|
||||
if let Err(err) = self.skip_max_list() {
|
||||
return Err(err);
|
||||
|
||||
Reference in New Issue
Block a user