pub(crate) trait CopierTarget: IndexMut<usize, Output=HeapCellValue>
{
- fn source(&self) -> usize;
fn threshold(&self) -> usize;
fn push(&mut self, HeapCellValue);
fn store(&self, Addr) -> Addr;
fn new(target: T) -> Self {
CopyTermState {
trail: vec![],
- scan: target.source(),
+ scan: 0,
old_h: target.threshold(),
target
}
}
fn copy_term_impl(&mut self, addr: Addr) {
+ self.scan = self.target.threshold();
self.target.push(HeapCellValue::Addr(addr));
while self.scan < self.target.threshold() {
--- /dev/null
+use prolog_parser::ast::*;
+
+use prolog::instructions::*;
+
+use std::ops::{Index, IndexMut};
+
+pub struct Heap {
+ heap: Vec<HeapCellValue>,
+ pub h: usize,
+}
+
+impl Heap {
+ pub fn with_capacity(cap: usize) -> Self {
+ Heap { heap: Vec::with_capacity(cap),
+ h: 0 }
+ }
+
+ pub fn push(&mut self, val: HeapCellValue) {
+ self.heap.push(val);
+ self.h += 1;
+ }
+
+ pub fn truncate(&mut self, h: usize) {
+ self.h = h;
+ self.heap.truncate(h);
+ }
+
+ pub fn len(&self) -> usize {
+ self.heap.len()
+ }
+
+ pub fn append(&mut self, vals: Vec<HeapCellValue>) {
+ let n = vals.len();
+
+ self.heap.extend(vals.into_iter());
+ self.h += n;
+ }
+
+ pub fn clear(&mut self) {
+ self.heap.clear();
+ self.h = 0;
+ }
+
+ pub fn to_list<Iter: Iterator<Item=Addr>>(&mut self, values: Iter) -> usize {
+ let head_addr = self.h;
+
+ for value in values {
+ let h = self.h;
+
+ self.push(HeapCellValue::Addr(Addr::Lis(h+1)));
+ self.push(HeapCellValue::Addr(value));
+ }
+
+ self.push(HeapCellValue::Addr(Addr::Con(Constant::EmptyList)));
+ head_addr
+ }
+}
+
+impl Index<usize> for Heap {
+ type Output = HeapCellValue;
+
+ fn index(&self, index: usize) -> &Self::Output {
+ &self.heap[index]
+ }
+}
+
+impl IndexMut<usize> for Heap {
+ fn index_mut(&mut self, index: usize) -> &mut Self::Output {
+ &mut self.heap[index]
+ }
+}
use std::cell::{Cell, RefCell};
use std::collections::{BTreeSet, HashMap, VecDeque};
use std::cmp::Ordering;
-use std::ops::{Add, AddAssign, Index, IndexMut, Sub};
+use std::ops::{Add, AddAssign, Sub, SubAssign};
use std::rc::Rc;
#[derive(Clone, PartialEq)]
#[derive(Copy, Clone, PartialEq)]
pub enum SystemClauseType {
CheckCutPoint,
+ CopyToLiftedHeap,
DeleteAttribute,
DeleteHeadAttribute,
DynamicModuleResolution,
EnqueueAttributedVar,
ExpandGoal,
ExpandTerm,
+ TruncateIfNoLiftedHeapGrowth,
GetAttributedVariableList,
GetAttrVarQueueDelimiter,
- GetAttrVarQueueBeyond,
+ GetAttrVarQueueBeyond,
GetBValue,
+ GetLiftedHeapFromOffset,
GetSCCCleaner,
InstallSCCCleaner,
InstallInferenceCounter,
+ LiftedHeapLength,
ModuleOf,
RedoAttrVarBindings,
RemoveCallPolicyCheck,
impl SystemClauseType {
pub fn name(&self) -> ClauseName {
- match self {
+ match self {
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
+ &SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
&SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
&SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"),
&SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"),
&SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
&SystemClauseType::ExpandGoal => clause_name!("$expand_goal"),
+ &SystemClauseType::TruncateIfNoLiftedHeapGrowth => clause_name!("$truncate_if_no_lh_growth"),
&SystemClauseType::GetAttributedVariableList => clause_name!("$get_attr_list"),
&SystemClauseType::GetAttrVarQueueDelimiter => clause_name!("$get_attr_var_queue_delim"),
&SystemClauseType::GetAttrVarQueueBeyond => clause_name!("$get_attr_var_queue_beyond"),
+ &SystemClauseType::GetLiftedHeapFromOffset => clause_name!("$get_lh_from_offset"),
&SystemClauseType::GetBValue => clause_name!("$get_b_value"),
&SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"),
&SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"),
&SystemClauseType::InstallSCCCleaner => clause_name!("$install_scc_cleaner"),
&SystemClauseType::InstallInferenceCounter => clause_name!("$install_inference_counter"),
+ &SystemClauseType::LiftedHeapLength => clause_name!("$lh_length"),
&SystemClauseType::ModuleOf => clause_name!("$module_of"),
&SystemClauseType::RedoAttrVarBindings => clause_name!("$redo_attr_var_bindings"),
&SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"),
}
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
- match (name, arity) {
+ match (name, arity) {
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
+ ("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap),
("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute),
("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution),
("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar),
("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),
("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal),
+ ("$truncate_if_no_lh_growth", 1) => Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth),
("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList),
("$get_b_value", 1) => Some(SystemClauseType::GetBValue),
+ ("$get_lh_from_offset", 2) => Some(SystemClauseType::GetLiftedHeapFromOffset),
("$get_double_quotes", 1) => Some(SystemClauseType::GetDoubleQuotes),
("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner),
("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner),
("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter),
+ ("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength),
("$module_of", 2) => Some(SystemClauseType::ModuleOf),
("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings),
("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck),
}
}
+impl SubAssign<usize> for Addr {
+ fn sub_assign(&mut self, rhs: usize) {
+ *self = self.clone() - rhs;
+ }
+}
+
impl From<Ref> for Addr {
fn from(r: Ref) -> Self {
match r {
}
}
-pub struct Heap {
- heap: Vec<HeapCellValue>,
- pub h: usize
-}
-
-impl Heap {
- pub fn with_capacity(cap: usize) -> Self {
- Heap { heap: Vec::with_capacity(cap), h: 0 }
- }
-
- pub fn push(&mut self, val: HeapCellValue) {
- self.heap.push(val);
- self.h += 1;
- }
-
- pub fn truncate(&mut self, h: usize) {
- self.h = h;
- self.heap.truncate(h);
- }
-
- pub fn len(&self) -> usize {
- self.heap.len()
- }
-
- pub fn append(&mut self, vals: Vec<HeapCellValue>) {
- let n = vals.len();
-
- self.heap.extend(vals.into_iter());
- self.h += n;
- }
-
- pub fn clear(&mut self) {
- self.heap.clear();
- self.h = 0;
- }
-
- pub fn to_list<Iter: Iterator<Item=Addr>>(&mut self, values: Iter) -> usize {
- let head_addr = self.h;
-
- for value in values {
- let h = self.h;
-
- self.push(HeapCellValue::Addr(Addr::Lis(h+1)));
- self.push(HeapCellValue::Addr(value));
- }
-
- self.push(HeapCellValue::Addr(Addr::Con(Constant::EmptyList)));
- head_addr
- }
-}
-
-impl Index<usize> for Heap {
- type Output = HeapCellValue;
-
- fn index(&self, index: usize) -> &Self::Output {
- &self.heap[index]
- }
-}
-
-impl IndexMut<usize> for Heap {
- fn index_mut(&mut self, index: usize) -> &mut Self::Output {
- &mut self.heap[index]
- }
-}
-
pub type Registers = Vec<Addr>;
pub enum TermIterState<'a> {
(=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2,
(=@=)/2, (\=@=)/2, (:)/2, call_with_inference_limit/3,
catch/3, current_prolog_flag/2, expand_goal/2, expand_term/2,
- set_prolog_flag/2, setup_call_cleanup/3, term_variables/2,
- throw/1, true/0, false/0, write/1, write_canonical/1,
- writeq/1, write_term/2]).
+ findall/3, set_prolog_flag/2, 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
handle_ball(_, _, _) :- '$unwind_stack'.
throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'.
+
+:- non_counted_backtracking '$iterate_find_all'/4.
+'$iterate_find_all'(Template, Goal, _, LhOffset) :-
+ call(Goal),
+ '$copy_to_lh'(LhOffset, Template),
+ '$fail'.
+'$iterate_find_all'(_, _, Solutions, LhOffset) :-
+ '$truncate_if_no_lh_growth'(LhOffset),
+ '$get_lh_from_offset'(LhOffset, Solutions).
+
+findall(Template, Goal, Solutions) :-
+ '$skip_max_list'(_, -1, Solutions, R),
+ ( nonvar(R), R \== [], throw(error(type_error(list, Solutions), findall/3))
+ ; true
+ ),
+ '$lh_length'(LhLength),
+ '$call_with_default_policy'('$iterate_find_all'(Template, Goal, Solutions, LhLength)).
use prolog::instructions::*;
use prolog::and_stack::*;
use prolog::copier::*;
+use prolog::heap::*;
use prolog::machine::{AttrVarInitializer, IndexStore};
use prolog::machine::machine_errors::*;
use prolog::num::{BigInt, BigUint, Zero, One};
// the ordinary, heap term copier, used by duplicate_term.
impl<'a> CopierTarget for CopyTerm<'a> {
- fn source(&self) -> usize {
- self.state.heap.h
- }
-
fn threshold(&self) -> usize {
self.state.heap.h
}
}
pub(super) struct CopyBallTerm<'a> {
- state: &'a mut MachineState,
- heap_boundary: usize
+ and_stack: &'a mut AndStack,
+ heap: &'a mut Heap,
+ heap_boundary: usize,
+ stub: &'a mut MachineStub,
}
impl<'a> CopyBallTerm<'a> {
- pub(super) fn new(state: &'a mut MachineState) -> Self {
- let hb = state.heap.len();
- CopyBallTerm { state, heap_boundary: hb }
+ pub(super) fn new(and_stack: &'a mut AndStack, heap: &'a mut Heap, stub: &'a mut MachineStub) -> Self
+ {
+ let hb = heap.len();
+ CopyBallTerm { and_stack, heap, heap_boundary: hb, stub }
}
}
fn index(&self, index: usize) -> &Self::Output {
if index < self.heap_boundary {
- &self.state.heap[index]
+ &self.heap[index]
} else {
let index = index - self.heap_boundary;
- &self.state.ball.stub[index]
+ &self.stub[index]
}
}
}
impl<'a> IndexMut<usize> for CopyBallTerm<'a> {
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
if index < self.heap_boundary {
- &mut self.state.heap[index]
+ &mut self.heap[index]
} else {
let index = index - self.heap_boundary;
- &mut self.state.ball.stub[index]
+ &mut self.stub[index]
}
}
}
// the ordinary, heap term copier, used by duplicate_term.
impl<'a> CopierTarget for CopyBallTerm<'a> {
- fn source(&self) -> usize {
- self.heap_boundary
- }
-
fn threshold(&self) -> usize {
- self.heap_boundary + self.state.ball.stub.len()
+ self.heap_boundary + self.stub.len()
}
- fn push(&mut self, hcv: HeapCellValue) {
- self.state.ball.stub.push(hcv);
+ fn push(&mut self, value: HeapCellValue) {
+ self.stub.push(value);
}
fn store(&self, addr: Addr) -> Addr {
match addr {
- Addr::HeapCell(hc) if hc < self.heap_boundary =>
- self.state.heap[hc].as_addr(hc),
- Addr::HeapCell(hc) => {
- let index = hc - self.heap_boundary;
- self.state.ball.stub[index].as_addr(hc)
+ Addr::HeapCell(h) | Addr::AttrVar(h) if h < self.heap_boundary =>
+ self.heap[h].as_addr(h),
+ Addr::HeapCell(h) | Addr::AttrVar(h) => {
+ let index = h - self.heap_boundary;
+ self.stub[index].as_addr(h)
},
Addr::StackCell(fr, sc) =>
- self.state.and_stack[fr][sc].clone(),
+ self.and_stack[fr][sc].clone(),
addr => addr
}
}
}
fn stack(&mut self) -> &mut AndStack {
- &mut self.state.and_stack
+ self.and_stack
}
}
pub(super) hb: usize,
pub(super) block: usize, // an offset into the OR stack.
pub(super) ball: Ball,
+ pub(super) lifted_heap: Vec<HeapCellValue>,
pub(super) interms: Vec<Number>, // intermediate numbers.
pub(super) last_call: bool,
pub(crate) flags: MachineFlags
}
},
&BuiltInClauseType::CopyTerm => {
- machine_st.duplicate_term();
+ machine_st.copy_term();
return_from_clause!(machine_st.last_call, machine_st)
},
&BuiltInClauseType::Eq => {
use prolog::instructions::*;
use prolog::and_stack::*;
use prolog::copier::*;
+use prolog::heap::*;
use prolog::heap_iter::*;
use prolog::heap_print::*;
use prolog::machine::{AttrVarInitializer, IndexStore};
cp: LocalCodePtr::default(),
attr_var_init: AttrVarInitializer::new(0, 0),
fail: false,
- heap: Heap::with_capacity(256),
+ heap: Heap::with_capacity(1024),
mode: MachineMode::Write,
and_stack: AndStack::new(),
or_stack: OrStack::new(),
hb: 0,
block: 0,
ball: Ball::new(),
+ lifted_heap: Vec::with_capacity(1024),
interms: vec![Number::default(); 256],
last_call: false,
flags: MachineFlags::default()
pub(super) fn set_ball(&mut self) {
let addr = self[temp_v!(1)].clone();
self.ball.boundary = self.heap.h;
- copy_term(CopyBallTerm::new(self), addr);
+ copy_term(CopyBallTerm::new(&mut self.and_stack, &mut self.heap, &mut self.ball.stub), addr);
}
pub(super) fn setup_call_n(&mut self, arity: usize) -> Option<PredicateKey>
}
}
- pub(super) fn copy_and_align_ball_to_heap(&mut self) -> usize {
+ pub(super) fn copy_and_align_ball_to_heap(&mut self, from: usize) -> usize {
let diff = self.heap_ball_boundary_diff();
- for heap_value in self.ball.stub.iter().cloned() {
+ for index in from .. self.ball.stub.len() {
+ let heap_value = self.ball.stub[index].clone();
+
self.heap.push(match heap_value {
HeapCellValue::Addr(addr) => HeapCellValue::Addr(addr - diff),
_ => heap_value
}
}
- pub(super) fn duplicate_term(&mut self) {
+ pub(super) fn copy_term(&mut self) {
let old_h = self.heap.h;
let a1 = self[temp_v!(1)].clone();
self.block = 0;
self.ball.reset();
+ self.lifted_heap.clear();
}
}
{
if self.machine_st.ball.stub.len() > 0 {
let h = self.machine_st.heap.h;
- self.machine_st.copy_and_align_ball_to_heap();
+ self.machine_st.copy_and_align_ball_to_heap(0);
let error_str = self.machine_st.print_exception(Addr::HeapCell(h),
&heap_locs,
use prolog_parser::ast::*;
+use prolog::copier::*;
use prolog::heap_iter::*;
use prolog::heap_print::*;
use prolog::instructions::*;
}
}
- pub(super) fn system_call(&mut self, ct: &SystemClauseType,
+ fn copy_findall_solution(&mut self, lh_offset: usize, copy_target: Addr) -> usize
+ {
+ let threshold = self.lifted_heap.len() - lh_offset;
+ let mut copy_ball_term = CopyBallTerm::new(&mut self.and_stack, &mut self.heap,
+ &mut self.lifted_heap);
+
+ copy_ball_term.push(HeapCellValue::Addr(Addr::Lis(threshold + 1)));
+ copy_ball_term.push(HeapCellValue::Addr(Addr::HeapCell(threshold + 3)));
+ copy_ball_term.push(HeapCellValue::Addr(Addr::HeapCell(threshold + 2)));
+
+ copy_term(copy_ball_term, copy_target);
+ threshold + lh_offset + 2
+ }
+
+ pub(super) fn system_call(&mut self,
+ ct: &SystemClauseType,
indices: &IndexStore,
call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>)
-> CallResult
{
match ct {
+ &SystemClauseType::LiftedHeapLength => {
+ let a1 = self[temp_v!(1)].clone();
+ let lh_len = Addr::Con(Constant::Usize(self.lifted_heap.len()));
+
+ self.unify(a1, lh_len);
+ },
&SystemClauseType::CheckCutPoint => {
let addr = self.store(self.deref(self[temp_v!(1)].clone()));
_ => self.fail = true
};
},
+ &SystemClauseType::CopyToLiftedHeap =>
+ // now, stagger everything down by the length of the heap + lh offset.
+ match self.store(self.deref(self[temp_v!(1)].clone())) {
+ Addr::Con(Constant::Usize(lh_offset)) => {
+ let copy_target = self[temp_v!(2)].clone();
+
+ let old_threshold = self.copy_findall_solution(lh_offset, copy_target);
+ let new_threshold = self.lifted_heap.len() - lh_offset;
+
+ self.lifted_heap[old_threshold] = HeapCellValue::Addr(Addr::HeapCell(new_threshold));
+
+ for index in old_threshold + 1 .. self.lifted_heap.len() {
+ match &mut self.lifted_heap[index] {
+ &mut HeapCellValue::Addr(ref mut addr) =>
+ *addr -= self.heap.len() + lh_offset,
+ _ => {}
+ }
+ }
+ },
+ _ => self.fail = true
+ },
&SystemClauseType::DeleteAttribute => {
let ls0 = self.store(self.deref(self[temp_v!(1)].clone()));
self.p = CodePtr::Local(LocalCodePtr::UserTermExpansion(0));
return Ok(());
},
+ &SystemClauseType::TruncateIfNoLiftedHeapGrowth =>
+ match self.store(self.deref(self[temp_v!(1)].clone())) {
+ Addr::Con(Constant::Usize(lh_offset)) => {
+ if lh_offset >= self.lifted_heap.len() {
+ self.lifted_heap.truncate(lh_offset);
+ } else {
+ self.lifted_heap.push(HeapCellValue::Addr(Addr::Con(Constant::EmptyList)));
+ }
+ },
+ _ =>
+ self.fail = true
+ },
&SystemClauseType::GetAttributedVariableList => {
let attr_var = self.store(self.deref(self[temp_v!(1)].clone()));
let mut attr_var_list = match attr_var {
match self.store(self.deref(addr)) {
Addr::Con(Constant::Usize(b)) => {
let iter = self.gather_attr_vars_created_since(b);
-
- let var_list_addr = Addr::HeapCell(self.heap.to_list(iter));
+
+ let var_list_addr = Addr::HeapCell(self.heap.to_list(iter));
let list_addr = self[temp_v!(2)].clone();
-
- self.unify(var_list_addr, list_addr);
+
+ self.unify(var_list_addr, list_addr);
},
_ => self.fail = true
}
},
+ &SystemClauseType::GetLiftedHeapFromOffset => {
+ let lh_offset = self[temp_v!(1)].clone();
+
+ match self.store(self.deref(lh_offset)) {
+ Addr::Con(Constant::Usize(lh_offset)) =>
+ if lh_offset >= self.lifted_heap.len() {
+ let solutions = self[temp_v!(2)].clone();
+ self.unify(solutions, Addr::Con(Constant::EmptyList));
+ } else {
+ let h = self.heap.h;
+
+ for index in lh_offset .. self.lifted_heap.len() {
+ match self.lifted_heap[index].clone() {
+ HeapCellValue::Addr(addr) =>
+ self.heap.push(HeapCellValue::Addr(addr + h)),
+ value =>
+ self.heap.push(value)
+ }
+ }
+
+ self.lifted_heap.truncate(lh_offset);
+
+ let solutions = self[temp_v!(2)].clone();
+ self.unify(Addr::HeapCell(h), solutions);
+ },
+ _ => self.fail = true
+ }
+ },
&SystemClauseType::GetDoubleQuotes => {
let a1 = self[temp_v!(1)].clone();
let h = self.heap.h;
if self.ball.stub.len() > 0 {
- self.copy_and_align_ball_to_heap();
+ self.copy_and_align_ball_to_heap(0);
} else {
self.fail = true;
return Ok(());
extern crate prolog_parser;
#[macro_use] pub mod instructions;
+pub mod heap;
mod and_stack;
#[macro_use] mod macros;
#[macro_use] mod allocator;
[["X = f(((a,b),c))"]]);
assert_prolog_success!(&mut wam, "?- X = f(((a,b),(c, d))).",
[["X = f(((a,b),c,d))"]]);
+
+ assert_prolog_success!(&mut wam, "?- findall(X, (X = 1 ; X = 2), S).",
+ [["S = [1, 2]", "X = _0"]]);
+ assert_prolog_success!(&mut wam, "?- findall(X+Y, (X = 1), S).",
+ [["S = [1+_18]", "X = _1", "Y = _2"]]);
+ assert_prolog_success!(&mut wam, "?- findall(X, false, S).",
+ [["S = []", "X = _0"]]);
+ assert_prolog_success!(&mut wam, "?- findall(X, (X = 1 ; X = 1), S).",
+ [["S = [1, 1]", "X = _0"]]);
+ assert_prolog_failure!(&mut wam, "?- findall(X, (X = 2 ; X = 1), [1, 2]).");
+ assert_prolog_success!(&mut wam, "?- findall(X, (X = 1 ; X = 2), [X, Y]).",
+ [["X = 1", "Y = 2"]]);
+ assert_prolog_success!(&mut wam, "?- catch(findall(X, 4, S), error(type_error(callable, 4), _), true).",
+ [["S = _3", "X = _1"]]);
}
#[test]
projects / scryer-prolog.git / commitdiff