4 Commits

Author SHA1 Message Date
Mark Thom
ab9a14cc6a add randomness predicates, small but consequential changes to TrailRef 2019-10-17 00:21:21 -06:00
Mark Thom
a641822a1b Merge pull request #206 from triska/master
weighted_maximum/3 now works
2019-10-16 16:17:05 -03:00
Markus Triska
145fee0d36 weighted_maximum/3 now works 2019-10-16 19:18:38 +02:00
Markus Triska
567af2648c support must_be(var, ...) 2019-10-16 19:18:38 +02:00
8 changed files with 111 additions and 22 deletions

View File

@@ -1,6 +1,6 @@
[package] [package]
name = "scryer-prolog" name = "scryer-prolog"
version = "0.8.112" version = "0.8.113"
authors = ["Mark Thom <markjordanthom@gmail.com>"] authors = ["Mark Thom <markjordanthom@gmail.com>"]
build = "build.rs" build = "build.rs"
repository = "https://github.com/mthom/scryer-prolog" repository = "https://github.com/mthom/scryer-prolog"

View File

@@ -2,6 +2,7 @@ use prolog_parser::ast::*;
use crate::prolog::forms::Number; use crate::prolog::forms::Number;
use crate::prolog::machine::machine_indices::*; use crate::prolog::machine::machine_indices::*;
use crate::prolog::rug::rand::RandState;
use ref_thread_local::RefThreadLocal; use ref_thread_local::RefThreadLocal;
@@ -81,6 +82,10 @@ pub enum InlinedClauseType {
IsVar(RegType), IsVar(RegType),
} }
ref_thread_local! {
pub static managed RANDOM_STATE: RandState<'static> = RandState::new();
}
ref_thread_local! { ref_thread_local! {
pub static managed CLAUSE_TYPE_FORMS: BTreeMap<(&'static str, usize), ClauseType> = { pub static managed CLAUSE_TYPE_FORMS: BTreeMap<(&'static str, usize), ClauseType> = {
let mut m = BTreeMap::new(); let mut m = BTreeMap::new();
@@ -223,12 +228,14 @@ pub enum SystemClauseType {
GetCutPoint, GetCutPoint,
GetDoubleQuotes, GetDoubleQuotes,
InstallNewBlock, InstallNewBlock,
Maybe,
ResetBlock, ResetBlock,
ReturnFromAttributeGoals, ReturnFromAttributeGoals,
ReturnFromVerifyAttr, ReturnFromVerifyAttr,
SetBall, SetBall,
SetCutPointByDefault(RegType), SetCutPointByDefault(RegType),
SetDoubleQuotes, SetDoubleQuotes,
SetSeed,
SkipMaxList, SkipMaxList,
Succeed, Succeed,
TermVariables, TermVariables,
@@ -319,6 +326,7 @@ impl SystemClauseType {
clause_name!("$install_inference_counter") clause_name!("$install_inference_counter")
} }
&SystemClauseType::LiftedHeapLength => clause_name!("$lh_length"), &SystemClauseType::LiftedHeapLength => clause_name!("$lh_length"),
&SystemClauseType::Maybe => clause_name!("maybe"),
&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"),
@@ -329,6 +337,7 @@ impl SystemClauseType {
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"), &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"), &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"), &SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
&SystemClauseType::SetSeed => clause_name!("$set_seed"),
&SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"), &SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"),
&SystemClauseType::StoreGlobalVarWithOffset => { &SystemClauseType::StoreGlobalVarWithOffset => {
clause_name!("$store_global_var_with_offset") clause_name!("$store_global_var_with_offset")
@@ -417,6 +426,7 @@ impl SystemClauseType {
("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner), ("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner),
("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter), ("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter),
("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength), ("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength),
("$maybe", 0) => Some(SystemClauseType::Maybe),
("$module_of", 2) => Some(SystemClauseType::ModuleOf), ("$module_of", 2) => Some(SystemClauseType::ModuleOf),
("$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),
@@ -450,6 +460,7 @@ impl SystemClauseType {
("$set_ball", 1) => Some(SystemClauseType::SetBall), ("$set_ball", 1) => Some(SystemClauseType::SetBall),
("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))), ("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes), ("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes),
("$set_seed", 1) => Some(SystemClauseType::SetSeed),
("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList), ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar), ("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar),
("$store_global_var_with_offset", 2) => Some(SystemClauseType::StoreGlobalVarWithOffset), ("$store_global_var_with_offset", 2) => Some(SystemClauseType::StoreGlobalVarWithOffset),

View File

@@ -34,7 +34,7 @@
:- use_module(library(lists)). :- use_module(library(lists)).
:- use_module(library(non_iso)). :- use_module(library(non_iso)).
:- use_module(library(dcgs)). :- use_module(library(dcgs)).
%:- use_module(library(types)). :- use_module(library(error), []).
:- attribute :- attribute
clpb/1, clpb/1,
@@ -77,8 +77,8 @@ must_be(list(What), Where, Term) :- !,
must_be(ground, _, Term) :- !, must_be(ground, _, Term) :- !,
functor(Term, _, _). functor(Term, _, _).
must_be(Type, Goal-Arg, Term) :- must_be(Type, _, Term) :-
must_be(Term, Type, Goal, Arg). error:must_be(Type, Term).
clpz_list(Nil, _) :- Nil == []. clpz_list(Nil, _) :- Nil == [].
clpz_list(Ls, Where) :- clpz_list(Ls, Where) :-
@@ -87,7 +87,6 @@ clpz_list(Ls, Where) :-
; Ls = [_|Rest], ; Ls = [_|Rest],
clpz_list(Rest, Where) clpz_list(Rest, Where)
). ).
instantiation_error(Term) :- instantiation_error(Term, unknown(Term)-1). instantiation_error(Term) :- instantiation_error(Term, unknown(Term)-1).
@@ -139,7 +138,10 @@ partition(Pred, Ls0, As, Bs) :-
include(Pred, Ls0, As), include(Pred, Ls0, As),
exclude(Pred, Ls0, Bs). 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. Pairs.

View File

@@ -33,6 +33,10 @@ must_be(Type, Term) :-
must_be_(Type, _) :- must_be_(Type, _) :-
var(Type), var(Type),
instantiation_error(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_(integer, Term) :- check_(integer, integer, Term).
must_be_(atom, Term) :- check_(atom, atom, Term). must_be_(atom, Term) :- check_(atom, atom, Term).
must_be_(list, Term) :- check_(ilist, list, Term). must_be_(list, Term) :- check_(ilist, list, Term).
@@ -52,6 +56,7 @@ type(type).
type(integer). type(integer).
type(atom). type(atom).
type(list). type(list).
type(var).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
can_be(Type, Term) can_be(Type, Term)

View File

@@ -4,8 +4,8 @@
%% ?- use_module(library(non_iso)). %% ?- use_module(library(non_iso)).
:- module(non_iso, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2, :- module(non_iso, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
call_with_inference_limit/3, forall/2, call_with_inference_limit/3, forall/2, maybe/0,
setup_call_cleanup/3, variant/2]). set_random/1, setup_call_cleanup/3, variant/2]).
forall(Generate, Test) :- forall(Generate, Test) :-
\+ (Generate, \+ Test). \+ (Generate, \+ Test).
@@ -125,3 +125,16 @@ call_with_inference_limit(_, _, R, Bb, B) :-
'$call_with_default_policy'(handle_ile(B, Ball, R)). '$call_with_default_policy'(handle_ile(B, Ball, R)).
variant(X, Y) :- '$variant'(X, Y). 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))
).

View File

@@ -178,10 +178,11 @@ impl From<Ref> for Addr {
} }
} }
#[derive(Clone)] #[derive(Clone, Copy)]
pub enum TrailRef { pub enum TrailRef {
Ref(Ref), Ref(Ref),
AttrVarLink(usize, Addr), AttrVarHeapLink(usize),
AttrVarListLink(usize, usize),
} }
impl From<Ref> for TrailRef { impl From<Ref> for TrailRef {

View File

@@ -648,9 +648,15 @@ impl MachineState {
self.tr += 1; self.tr += 1;
} }
} }
TrailRef::AttrVarLink(h, prev_addr) => { TrailRef::AttrVarHeapLink(h) => {
if h < self.hb { 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; self.tr += 1;
} }
} }
@@ -680,7 +686,7 @@ impl MachineState {
// additions, now that deleted attributes can be undeleted by // additions, now that deleted attributes can be undeleted by
// backtracking. // backtracking.
for i in (a1..a2).rev() { for i in (a1..a2).rev() {
match self.trail[i].clone() { match self.trail[i] {
TrailRef::Ref(Ref::HeapCell(h)) => { TrailRef::Ref(Ref::HeapCell(h)) => {
self.heap[h] = HeapCellValue::Addr(Addr::HeapCell(h)) self.heap[h] = HeapCellValue::Addr(Addr::HeapCell(h))
} }
@@ -690,8 +696,11 @@ impl MachineState {
TrailRef::Ref(Ref::StackCell(fr, sc)) => { TrailRef::Ref(Ref::StackCell(fr, sc)) => {
self.and_stack[fr][sc] = Addr::StackCell(fr, sc) self.and_stack[fr][sc] = Addr::StackCell(fr, sc)
} }
TrailRef::AttrVarLink(h, prev_addr) => { TrailRef::AttrVarHeapLink(h) => {
self.heap[h] = HeapCellValue::Addr(prev_addr) 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; let mut i = self.or_stack[b].tr;
while i < self.tr { while i < self.tr {
let tr_i = self.trail[i].clone(); let tr_i = self.trail[i];
let hb = self.hb; let hb = self.hb;
match tr_i { match tr_i {
TrailRef::Ref(Ref::AttrVar(tr_i)) TrailRef::Ref(Ref::AttrVar(tr_i))
| TrailRef::Ref(Ref::HeapCell(tr_i)) | TrailRef::Ref(Ref::HeapCell(tr_i))
| TrailRef::AttrVarLink(tr_i, _) => { | TrailRef::AttrVarHeapLink(tr_i)
| TrailRef::AttrVarListLink(tr_i, _) => {
if tr_i < hb { if tr_i < hb {
i += 1; i += 1;
} else { } else {
@@ -765,7 +775,7 @@ impl MachineState {
i += 1; i += 1;
} else { } else {
let tr = self.tr; let tr = self.tr;
let val = self.trail[tr - 1].clone(); let val = self.trail[tr - 1];
self.trail[i] = val; self.trail[i] = val;
self.trail.pop(); self.trail.pop();
self.tr -= 1; self.tr -= 1;

View File

@@ -17,6 +17,8 @@ use crate::prolog::ordered_float::OrderedFloat;
use crate::prolog::read::{readline, PrologStream}; use crate::prolog::read::{readline, PrologStream};
use crate::prolog::rug::Integer; use crate::prolog::rug::Integer;
use crate::ref_thread_local::RefThreadLocal;
use indexmap::{IndexMap, IndexSet}; use indexmap::{IndexMap, IndexSet};
use std::collections::VecDeque; use std::collections::VecDeque;
@@ -679,7 +681,8 @@ impl MachineState {
let c = self.int_to_char_code(&n, "atom_codes", 2)?; let c = self.int_to_char_code(&n, "atom_codes", 2)?;
chars.push(c as char); 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( let err = MachineError::type_error(
ValidType::Integer, ValidType::Integer,
@@ -1018,8 +1021,14 @@ impl MachineState {
tail 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.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.heap[h + 1] = HeapCellValue::Addr(tail);
self.trail(TrailRef::AttrVarLink(h + 1, Addr::Lis(l))); self.trail(TrailRef::AttrVarListLink(h + 1, l));
} }
_ => unreachable!(), _ => unreachable!(),
} }
@@ -1255,6 +1264,19 @@ impl MachineState {
_ => self.fail = true, _ => 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 => { &SystemClauseType::OpDeclaration => {
let priority = self[temp_v!(1)].clone(); let priority = self[temp_v!(1)].clone();
let specifier = self[temp_v!(2)].clone(); let specifier = self[temp_v!(2)].clone();
@@ -1834,6 +1856,31 @@ impl MachineState {
} }
&SystemClauseType::SetBall => &SystemClauseType::SetBall =>
self.set_ball(), 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 => &SystemClauseType::SkipMaxList =>
if let Err(err) = self.skip_max_list() { if let Err(err) = self.skip_max_list() {
return Err(err); return Err(err);