From f16c2a6e991fc67218bc0db6ebafee110ff43d4a Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 7 Dec 2019 19:21:09 -0700 Subject: [PATCH 1/6] update tests --- src/tests/builtins.pl | 1 + src/tests/call_with_inference_limit.pl | 54 ++++++++++++++++++++++++++ src/tests/facts.pl | 2 + src/tests/predicates.pl | 1 + src/tests/rules.pl | 2 + src/tests/setup_call_cleanup.pl | 1 + 6 files changed, 61 insertions(+) create mode 100644 src/tests/call_with_inference_limit.pl diff --git a/src/tests/builtins.pl b/src/tests/builtins.pl index 9b3760d1..6b4c63b6 100644 --- a/src/tests/builtins.pl +++ b/src/tests/builtins.pl @@ -1,3 +1,4 @@ +:- module(tests_on_builtins, []). :- use_module(library(lists)). :- use_module(library(non_iso)). diff --git a/src/tests/call_with_inference_limit.pl b/src/tests/call_with_inference_limit.pl new file mode 100644 index 00000000..c16c7291 --- /dev/null +++ b/src/tests/call_with_inference_limit.pl @@ -0,0 +1,54 @@ +:- module(tests_on_call_with_inference_limit, []). + +:- use_module(library(lists)). +:- use_module(library(non_iso)). + +:- dynamic(f/1). +:- dynamic(g/1). + +test_queries_on_call_with_inference_limit :- + catch(call_with_inference_limit(throw(error), 0, inference_limit_exceeded), + error, + true), + catch(call_with_inference_limit(throw(error), 1, inference_limit_exceeded), + error, + true), + \+ call_with_inference_limit(g(X), 5, R), + maplist(assertz, [g(1), g(2), g(3), g(4), g(5)]), + findall([R,X], + call_with_inference_limit(g(X), 10, R), + [[true, 1], + [true, 2], + [true, 3], + [true, 4], + [!, 5]]), + findall([R,X], + (call_with_inference_limit(g(X), 10, R), call(true)), + [[true, 1], + [true, 2], + [true, 3], + [true, 4], + [!, 5]]), + findall([R,X], + (call_with_inference_limit(g(X), 4, R), call(true)), + [[true, 1], + [true, 2], + [inference_limit_exceeded, _]]), + findall([X,R1,R2], + (call_with_inference_limit(g(X), 4, R1), + call_with_inference_limit(g(X), 5, R2)), + [[1,true,!], + [2,true,!], + [3,true,!], + [4,true,!], + [5,!,!]]), + \+ \+ assertz((f(X) :- call_with_inference_limit(g(X), 8, _))), + findall([R,X], + call_with_inference_limit(f(X), 12, R), + [[true,1], + [true,2], + [true,3], + [true,4], + [!,5]]). + +:- initialization(test_queries_on_call_with_inference_limit). diff --git a/src/tests/facts.pl b/src/tests/facts.pl index 7c33ac7e..a81f6814 100644 --- a/src/tests/facts.pl +++ b/src/tests/facts.pl @@ -1,3 +1,5 @@ +:- module(tests_on_facts, []). + :- dynamic(p/2). :- dynamic(p/3). diff --git a/src/tests/predicates.pl b/src/tests/predicates.pl index 27249766..44d0b064 100644 --- a/src/tests/predicates.pl +++ b/src/tests/predicates.pl @@ -1,3 +1,4 @@ +:- module(test_on_predicates, []). :- dynamic(p/2). :- dynamic(p/3). diff --git a/src/tests/rules.pl b/src/tests/rules.pl index 45bfaf6d..600daaf6 100644 --- a/src/tests/rules.pl +++ b/src/tests/rules.pl @@ -1,3 +1,5 @@ +:- module(tests_on_rules, []). + :- dynamic(p/3). :- dynamic(p/2). :- dynamic(q/2). diff --git a/src/tests/setup_call_cleanup.pl b/src/tests/setup_call_cleanup.pl index b3c6a9bb..8f15ae4b 100644 --- a/src/tests/setup_call_cleanup.pl +++ b/src/tests/setup_call_cleanup.pl @@ -1,3 +1,4 @@ +:- module(test_on_setup_call_cleanup, []). :- use_module(library(non_iso)). From 2be7070e1a91f1b315d544add68aee0a28e2747f Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 8 Dec 2019 00:17:55 -0700 Subject: [PATCH 2/6] revert arithmetic code --- src/prolog/arithmetic.rs | 61 ++-- src/prolog/codegen.rs | 38 +-- src/prolog/machine/machine_state.rs | 4 +- src/prolog/machine/machine_state_impl.rs | 10 +- src/prolog/machine/mod.rs | 2 +- src/prolog/machine/stack.rs | 387 +++++++++++++++++++++++ 6 files changed, 429 insertions(+), 73 deletions(-) create mode 100644 src/prolog/machine/stack.rs diff --git a/src/prolog/arithmetic.rs b/src/prolog/arithmetic.rs index 1bd4d7c9..4c126d77 100644 --- a/src/prolog/arithmetic.rs +++ b/src/prolog/arithmetic.rs @@ -1,6 +1,5 @@ use prolog_parser::ast::*; -use crate::prolog::allocator::Allocator; use crate::prolog::clause_types::*; use crate::prolog::fixtures::*; use crate::prolog::forms::*; @@ -70,7 +69,7 @@ impl<'a> ArithInstructionIterator<'a> { pub enum ArithTermRef<'a> { Constant(&'a Constant), Op(ClauseName, usize), // name, arity. - Var(Level, &'a Cell, Rc), + Var(&'a Cell, Rc), } impl<'a> Iterator for ArithInstructionIterator<'a> { @@ -97,8 +96,8 @@ impl<'a> Iterator for ArithInstructionIterator<'a> { } } TermIterState::Constant(_, _, c) => return Some(Ok(ArithTermRef::Constant(c))), - TermIterState::Var(lvl, cell, var) => { - return Some(Ok(ArithTermRef::Var(lvl, cell, var.clone()))) + TermIterState::Var(_, cell, var) => { + return Some(Ok(ArithTermRef::Var(cell, var.clone()))) } _ => return Some(Err(ArithmeticError::NonEvaluableFunctor(atom!("'.'"), 2))), }; @@ -108,10 +107,10 @@ impl<'a> Iterator for ArithInstructionIterator<'a> { } } -pub struct ArithmeticEvaluator { +pub struct ArithmeticEvaluator<'a> { + bindings: &'a AllocVarDict, interm: Vec, interm_c: usize, - arg_c: usize } pub trait ArithmeticTermIter<'a> { @@ -128,12 +127,12 @@ impl<'a> ArithmeticTermIter<'a> for &'a Term { } } -impl ArithmeticEvaluator { - pub fn new(target_int: usize, arg_c: usize) -> Self { +impl<'a> ArithmeticEvaluator<'a> { + pub fn new(bindings: &'a AllocVarDict, target_int: usize) -> Self { ArithmeticEvaluator { + bindings, interm: Vec::new(), interm_c: target_int, - arg_c } } @@ -284,33 +283,27 @@ impl ArithmeticEvaluator { Ok(()) } - pub fn eval<'a, Iter, TermMarker>( - &mut self, - marker: &mut TermMarker, - src: Iter, - term_loc: GenContext, - ) -> Result + pub fn eval(&mut self, src: Iter) -> Result where Iter: ArithmeticTermIter<'a>, - TermMarker: Allocator<'a> { let mut code = vec![]; for term_ref in src.iter()? { match term_ref? { ArithTermRef::Constant(c) => self.push_constant(c)?, - ArithTermRef::Var(lvl, cell, name) => { - match marker.bindings().get(&name) { - Some(&VarData::Temp(_, t, _)) if t != 0 => {}, - Some(&VarData::Perm(p)) if p != 0 => {}, - _ => return Err(ArithmeticError::UninstantiatedVar), - } + ArithTermRef::Var(cell, name) => { + let r = if cell.get().norm().reg_num() == 0 { + match self.bindings.get(&name) { + Some(&VarData::Temp(_, t, _)) if t != 0 => RegType::Temp(t), + Some(&VarData::Perm(p)) if p != 0 => RegType::Perm(p), + _ => return Err(ArithmeticError::UninstantiatedVar), + } + } else { + cell.get().norm() + }; - let mut target = vec![]; - marker.mark_var(name.clone(), lvl, cell, term_loc, &mut target); - code.extend(target.into_iter().map(Line::Query)); - - self.interm.push(ArithmeticTerm::Reg(cell.get().norm())); + self.interm.push(ArithmeticTerm::Reg(r)); } ArithTermRef::Op(name, arity) => { code.push(Line::Arithmetic(self.instr_from_clause(name, arity)?)); @@ -318,22 +311,8 @@ impl ArithmeticEvaluator { } } - if let GenContext::Last(_) = term_loc { - self.tempify_perm_reg(); - } - Ok((code, self.interm.pop())) } - - fn tempify_perm_reg(&mut self) { - if let Some(interm) = self.interm.pop() { - if let ArithmeticTerm::Reg(RegType::Perm(_)) = interm { - self.interm.push(ArithmeticTerm::Reg(RegType::Temp(self.arg_c))); - } else { - self.interm.push(interm); - } - } - } } // integer division rounding function -- 9.1.3.1. diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index dacf055e..0b5d6f63 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -360,10 +360,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator { self.mark_non_callable(name.clone(), 2, term_loc, vr, code); } - self.marker.reset_arg(2); - - let (mut lcode, at_1) = self.call_arith_eval(terms[0].as_ref(), 1, term_loc, 1)?; - let (mut rcode, at_2) = self.call_arith_eval(terms[1].as_ref(), 2, term_loc, 2)?; + let (mut lcode, at_1) = self.call_arith_eval(terms[0].as_ref(), 1)?; + let (mut rcode, at_2) = self.call_arith_eval(terms[1].as_ref(), 2)?; code.append(&mut lcode); code.append(&mut rcode); @@ -498,14 +496,12 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator { } fn call_arith_eval( - &mut self, + &self, term: &'a Term, target_int: usize, - term_loc: GenContext, - arg_c: usize ) -> Result { - let mut evaluator = ArithmeticEvaluator::new(target_int, arg_c); - evaluator.eval(&mut self.marker, term, term_loc) + let mut evaluator = ArithmeticEvaluator::new(self.marker.bindings(), target_int); + evaluator.eval(term) } fn compile_is_call( @@ -515,17 +511,20 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator { term_loc: GenContext, use_default_call_policy: bool, ) -> Result<(), ParserError> { - self.marker.reset_arg(2); + let (mut acode, at) = self.call_arith_eval(terms[1].as_ref(), 1)?; + code.append(&mut acode); Ok(match terms[0].as_ref() { &Term::Var(ref vr, ref name) => { let mut target = vec![]; - self.marker.mark_var(name.clone(), Level::Shallow, vr, term_loc, &mut target); - code.extend(target.into_iter().map(Line::Query)); + self.marker.reset_arg(2); + self.marker + .mark_var(name.clone(), Level::Shallow, vr, term_loc, &mut target); - let (acode, at) = self.call_arith_eval(terms[1].as_ref(), 1, term_loc, 2)?; - code.extend(acode.into_iter()); + if !target.is_empty() { + code.extend(target.into_iter().map(Line::Query)); + } if use_default_call_policy { code.push(is_call_by_default!(temp_v!(1), at.unwrap_or(interm!(1)))) @@ -534,9 +533,6 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator { } } &Term::Constant(_, ref c @ Constant::Integer(_)) => { - let (acode, at) = self.call_arith_eval(terms[1].as_ref(), 1, term_loc, 2)?; - code.extend(acode.into_iter()); - code.push(Line::Query(put_constant!( Level::Shallow, c.clone(), @@ -550,9 +546,6 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator { } } &Term::Constant(_, ref c @ Constant::Float(_)) => { - let (acode, at) = self.call_arith_eval(terms[1].as_ref(), 1, term_loc, 2)?; - code.extend(acode.into_iter()); - code.push(Line::Query(put_constant!( Level::Shallow, c.clone(), @@ -566,9 +559,6 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator { } } &Term::Constant(_, ref c @ Constant::Rational(_)) => { - let (acode, at) = self.call_arith_eval(terms[1].as_ref(), 1, term_loc, 2)?; - code.extend(acode.into_iter()); - code.push(Line::Query(put_constant!( Level::Shallow, c.clone(), @@ -584,7 +574,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator { _ => code.push(fail!()), }) } - + #[inline] fn compile_unblocked_cut(&mut self, code: &mut Code, cell: &'a Cell) { let r = self.marker.get(Rc::new(String::from("!"))); diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 1e3086d5..6c6ec160 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -421,7 +421,7 @@ pub(crate) trait CallPolicy: Any { machine_st.e = machine_st.stack.index_or_frame(b).prelude.e; machine_st.cp = machine_st.stack.index_or_frame(b).prelude.cp; - machine_st.stack.index_or_frame_mut(b).prelude.bp = machine_st.p.clone() + offset; + machine_st.stack.index_or_frame_mut(b).prelude.bp = machine_st.p.local() + offset; let old_tr = machine_st.stack.index_or_frame(b).prelude.tr; let curr_tr = machine_st.tr; @@ -467,7 +467,7 @@ pub(crate) trait CallPolicy: Any { machine_st.e = machine_st.stack.index_or_frame(b).prelude.e; machine_st.cp = machine_st.stack.index_or_frame(b).prelude.cp; - machine_st.stack.index_or_frame_mut(b).prelude.bp = machine_st.p.clone() + 1; + machine_st.stack.index_or_frame_mut(b).prelude.bp = machine_st.p.local() + 1; let old_tr = machine_st.stack.index_or_frame(b).prelude.tr; let curr_tr = machine_st.tr; diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index a23a4357..0af5e578 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -2081,7 +2081,7 @@ impl MachineState { self.stack.truncate_to_frame(self.b); } } - + pub(crate) fn is_cyclic_term(&self, addr: Addr) -> bool { let mut seen = IndexSet::new(); let mut fail = false; @@ -3105,7 +3105,7 @@ impl MachineState { and_frame.prelude.e = self.e; and_frame.prelude.cp = self.cp; - + self.e = e; self.p += 1; } @@ -3113,7 +3113,7 @@ impl MachineState { pub(super) fn deallocate(&mut self) { let e = self.e; let frame = self.stack.index_and_frame(e); - + self.cp = frame.prelude.cp; self.e = frame.prelude.e; @@ -3240,7 +3240,7 @@ impl MachineState { or_frame.prelude.e = self.e; or_frame.prelude.cp = self.cp; or_frame.prelude.b = self.b; - or_frame.prelude.bp = self.p.clone() + 1; + or_frame.prelude.bp = self.p.local() + 1; or_frame.prelude.tr = self.tr; or_frame.prelude.pstr_tr = self.pstr_tr; or_frame.prelude.h = self.heap.h; @@ -3279,7 +3279,7 @@ impl MachineState { or_frame.prelude.e = self.e; or_frame.prelude.cp = self.cp; or_frame.prelude.b = self.b; - or_frame.prelude.bp = self.p.clone() + offset; + or_frame.prelude.bp = self.p.local() + offset; or_frame.prelude.tr = self.tr; or_frame.prelude.pstr_tr = self.pstr_tr; or_frame.prelude.h = self.heap.h; diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 97d69a25..5e613c7c 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -739,7 +739,7 @@ impl MachineState { let b = self.b; self.b0 = self.stack.index_or_frame(b).prelude.b0; - self.p = self.stack.index_or_frame(b).prelude.bp.clone(); + self.p = CodePtr::Local(self.stack.index_or_frame(b).prelude.bp); if let CodePtr::Local(LocalCodePtr::TopLevel(_, p)) = self.p { self.fail = p == 0; diff --git a/src/prolog/machine/stack.rs b/src/prolog/machine/stack.rs new file mode 100644 index 00000000..12fce174 --- /dev/null +++ b/src/prolog/machine/stack.rs @@ -0,0 +1,387 @@ +use crate::prolog::machine::machine_indices::*; + +use core::marker::PhantomData; + +use std::alloc; +use std::mem; +use std::ops::{Index, IndexMut}; +use std::ptr; + +const STACK_ALIGN: usize = mem::align_of::(); +const INIT_STACK_SIZE: usize = 10 * 1024 * 1024; + +const fn prelude_size() -> usize { + let size = mem::size_of::(); + let align = mem::align_of::(); + + (size & !(align - 1)) + align +} + +/* The Stack is dropped manually at the discretion of the WAM, despite + having no Drop implementation. That's because it needs to know whether + the top frame is an AND frame or an OR frame. The WAM can + tell it. */ +pub struct Stack { + size: usize, + base: *const u8, + top: *const u8, + _marker: PhantomData, +} + +impl Drop for Stack { + fn drop(&mut self) { + self.drop_in_place(); + self.deallocate(); + } +} + +#[derive(Clone, Copy)] +pub struct FramePrelude { + is_or_frame: u8, + pub num_cells: usize, +} + +pub struct AndFramePrelude { + pub univ_prelude: FramePrelude, + pub e: usize, + pub cp: LocalCodePtr, + pub interrupt_cp: LocalCodePtr, +} + +pub struct AndFrame { + pub prelude: AndFramePrelude, + _marker: PhantomData, +} + +impl AndFrame { + pub fn size_of(num_cells: usize) -> usize { + prelude_size::() + num_cells * mem::size_of::() + } +} + +impl Index for AndFrame { + type Output = Addr; + + fn index(&self, index: usize) -> &Self::Output { + let prelude_offset = prelude_size::(); + let index_offset = (index - 1) * mem::size_of::(); + + unsafe { + let ptr = mem::transmute::<&AndFrame, *const u8>(self); + let ptr = ptr as usize + prelude_offset + index_offset; + + &*(ptr as *const Addr) + } + } +} + +impl IndexMut for AndFrame { + fn index_mut(&mut self, index: usize) -> &mut Self::Output { + let prelude_offset = prelude_size::(); + let index_offset = (index - 1) * mem::size_of::(); + + unsafe { + let ptr = mem::transmute::<&mut AndFrame, *const u8>(self); + let ptr = ptr as usize + prelude_offset + index_offset; + + &mut *(ptr as *mut Addr) + } + } +} + +impl Drop for AndFrame { + fn drop(&mut self) { + let prelude_offset = prelude_size::(); + + unsafe { + let ptr = mem::transmute::<&mut AndFrame, *const u8>(self); + let ptr = ptr as usize + prelude_offset; + + for idx in 0 .. self.prelude.univ_prelude.num_cells { + let index_offset = idx * mem::size_of::(); + let ptr = (ptr + index_offset) as *mut Addr; + + ptr::drop_in_place(ptr); + } + } + } +} + +pub struct OrFramePrelude { + pub univ_prelude: FramePrelude, + pub e: usize, + pub cp: LocalCodePtr, + pub b: usize, + pub bp: LocalCodePtr, + pub tr: usize, + pub pstr_tr: usize, + pub h: usize, + pub b0: usize, + pub attr_var_init_queue_b: usize, + pub attr_var_init_bindings_b: usize, +} + +pub struct OrFrame { + pub prelude: OrFramePrelude, + _marker: PhantomData +} + +impl Index for OrFrame { + type Output = Addr; + + fn index(&self, index: usize) -> &Self::Output { + let prelude_offset = prelude_size::(); + let index_offset = index * mem::size_of::(); + + unsafe { + let ptr = mem::transmute::<&OrFrame, *const u8>(self); + let ptr = ptr as usize + prelude_offset + index_offset; + + &*(ptr as *const Addr) + } + } +} + +impl IndexMut for OrFrame { + fn index_mut(&mut self, index: usize) -> &mut Self::Output { + let prelude_offset = prelude_size::(); + let index_offset = index * mem::size_of::(); + + unsafe { + let ptr = mem::transmute::<&mut OrFrame, *const u8>(self); + let ptr = ptr as usize + prelude_offset + index_offset; + + &mut *(ptr as *mut Addr) + } + } +} + +impl Drop for OrFrame { + fn drop(&mut self) { + let prelude_offset = prelude_size::(); + + unsafe { + let ptr = mem::transmute::<&mut OrFrame, *const u8>(self); + let ptr = ptr as usize + prelude_offset; + + for idx in 0 .. self.prelude.univ_prelude.num_cells { + let index_offset = idx * mem::size_of::(); + let ptr = (ptr + index_offset) as *mut Addr; + + ptr::drop_in_place(ptr); + } + } + } +} + +impl OrFrame { + pub fn size_of(num_cells: usize) -> usize { + prelude_size::() + num_cells * mem::size_of::() + } +} + +impl Stack { + pub fn new() -> Self { + let mut stack = Stack { size: 0, base: ptr::null(), top: ptr::null(), + _marker: PhantomData }; + + unsafe { stack.grow(); } + stack + } + + fn empty_stack() -> Self { + Stack { size: 0, base: ptr::null(), top: ptr::null(), + _marker: PhantomData } + } + + #[inline] + pub fn take(&mut self) -> Stack { + mem::replace(self, Stack::empty_stack()) + } + + #[inline] + fn free_space(&self) -> usize { + debug_assert!(self.top >= self.base, + "self.top = {:?} < {:?} = self.base", + self.top, self.base); + + self.size - (self.top as usize - self.base as usize) + } + + unsafe fn grow(&mut self) { + if self.size == 0 { + let layout = alloc::Layout::from_size_align_unchecked(INIT_STACK_SIZE, STACK_ALIGN); + + self.base = alloc::alloc(layout) as *const _; + self.top = self.base as *const _; + self.size = INIT_STACK_SIZE; + + self.top = self.top.offset(mem::align_of::() as isize); + } else { + let layout = alloc::Layout::from_size_align_unchecked(self.size, STACK_ALIGN); + let top_dist = self.top as usize - self.base as usize; + + self.base = alloc::realloc(self.base as *mut _, layout, self.size*2) as *const _; + self.top = (self.base as usize + top_dist) as *const _; + self.size *= 2; + } + } + + #[inline] + unsafe fn new_frame_ptr(&mut self, frame_size: usize) -> *const u8 { + loop { + if self.free_space() >= frame_size { + return (self.top as usize + frame_size) as *const _; + } else { + self.grow(); + } + } + } + + pub fn allocate_and_frame(&mut self, num_cells: usize) -> usize { + let frame_size = AndFrame::size_of(num_cells); + + unsafe { + let new_top = self.new_frame_ptr(frame_size); + + for idx in 0 .. num_cells { + let offset = prelude_size::() + idx * mem::size_of::(); + ptr::write((self.top as usize + offset) as *mut Addr, Addr::HeapCell(0)); + } + + let and_frame = &mut *(self.top as *mut AndFrame); + + and_frame.prelude.univ_prelude.is_or_frame = 0; + and_frame.prelude.univ_prelude.num_cells = num_cells; + + let e = self.top as usize - self.base as usize; + self.top = new_top; + e + } + } + + pub fn allocate_or_frame(&mut self, num_cells: usize) -> usize { + let frame_size = OrFrame::size_of(num_cells); + + unsafe { + let new_top = self.new_frame_ptr(frame_size); + + for idx in 0 .. num_cells { + let offset = prelude_size::() + idx * mem::size_of::(); + ptr::write((self.top as usize + offset) as *mut Addr, Addr::HeapCell(0)); + } + + let or_frame = &mut *(self.top as *mut OrFrame); + + or_frame.prelude.univ_prelude.is_or_frame = 1; + or_frame.prelude.univ_prelude.num_cells = num_cells; + + let b = self.top as usize - self.base as usize; + self.top = new_top; + b + } + } + + #[inline] + pub fn index_and_frame(&self, e: usize) -> &AndFrame { + unsafe { + let ptr = self.base as usize + e; + &*(ptr as *const AndFrame) + } + } + + #[inline] + pub fn index_and_frame_mut(&mut self, e: usize) -> &mut AndFrame { + unsafe { + let ptr = self.base as usize + e; + &mut *(ptr as *mut AndFrame) + } + } + + #[inline] + pub fn index_or_frame(&self, b: usize) -> &OrFrame { + unsafe { + let ptr = self.base as usize + b; + &*(ptr as *const OrFrame) + } + } + + #[inline] + pub fn index_or_frame_mut(&mut self, b: usize) -> &mut OrFrame { + unsafe { + let ptr = self.base as usize + b; + &mut *(ptr as *mut OrFrame) + } + } + + pub fn deallocate(&mut self) { + unsafe { + let layout = alloc::Layout::from_size_align_unchecked(self.size, STACK_ALIGN); + alloc::dealloc(self.base as *mut u8, layout); + + self.top = ptr::null(); + self.base = ptr::null(); + self.size = 0; + } + } + + pub fn truncate_to_frame(&mut self, b: usize) { + if b == 0 { + self.truncate(mem::align_of::()); + } else { + let univ_prelude = self.index_or_frame(b).prelude.univ_prelude; + let size = OrFrame::size_of(univ_prelude.num_cells); + + self.truncate(b + size); + } + } + + fn truncate(&mut self, b: usize) { + let mut b = b + self.base as usize; + let base = b; + + unsafe { + while b as *const _ < self.top { + let univ_prelude = ptr::read(b as *const FramePrelude); + + let offset = if univ_prelude.is_or_frame == 0 { + let frame_ptr = b as *mut AndFrame; + let frame = &mut *frame_ptr; + let size_of_frame = AndFrame::size_of(frame.prelude.univ_prelude.num_cells); + + ptr::drop_in_place(frame_ptr); + ptr::write(frame_ptr, mem::zeroed::()); + + b + size_of_frame + } else { + debug_assert!(univ_prelude.is_or_frame == 1); + + let frame_ptr = b as *mut OrFrame; + let frame = &mut *frame_ptr; + let size_of_frame = OrFrame::size_of(frame.prelude.univ_prelude.num_cells); + + ptr::drop_in_place(frame_ptr); + ptr::write(frame_ptr, mem::zeroed::()); + + b + size_of_frame + }; + + b = offset; + } + + if base < self.top as usize { + self.top = base as *const _; + } + } + } + + pub fn drop_in_place(&mut self) { + self.truncate(mem::align_of::()); + + debug_assert!(if self.top.is_null() { + self.top == self.base + } else { + self.top as usize == self.base as usize + mem::align_of::() + }); + } +} From 923c9d4ad8d84f3a10676143120761d8257f4bd0 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 8 Dec 2019 11:43:22 -0700 Subject: [PATCH 3/6] remove zeroing out from Stack::truncate --- src/prolog/machine/stack.rs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/prolog/machine/stack.rs b/src/prolog/machine/stack.rs index 12fce174..17ca25ef 100644 --- a/src/prolog/machine/stack.rs +++ b/src/prolog/machine/stack.rs @@ -17,10 +17,6 @@ const fn prelude_size() -> usize { (size & !(align - 1)) + align } -/* The Stack is dropped manually at the discretion of the WAM, despite - having no Drop implementation. That's because it needs to know whether - the top frame is an AND frame or an OR frame. The WAM can - tell it. */ pub struct Stack { size: usize, base: *const u8, @@ -350,7 +346,6 @@ impl Stack { let size_of_frame = AndFrame::size_of(frame.prelude.univ_prelude.num_cells); ptr::drop_in_place(frame_ptr); - ptr::write(frame_ptr, mem::zeroed::()); b + size_of_frame } else { @@ -361,7 +356,6 @@ impl Stack { let size_of_frame = OrFrame::size_of(frame.prelude.univ_prelude.num_cells); ptr::drop_in_place(frame_ptr); - ptr::write(frame_ptr, mem::zeroed::()); b + size_of_frame }; From b0fa45cd335e7db8e88925a5d309c80ae98081ae Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 8 Dec 2019 11:44:01 -0700 Subject: [PATCH 4/6] correct odd accidental change to clpb.pl --- src/prolog/lib/clpb.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/prolog/lib/clpb.pl b/src/prolog/lib/clpb.pl index 2d9ba8f8..3fa9c719 100644 --- a/src/prolog/lib/clpb.pl +++ b/src/prolog/lib/clpb.pl @@ -1184,7 +1184,7 @@ indomain(1). % Examples: % % == -% ?- +% ?- sat(A =< B), Vs = [A,B], sat_count(+[1|Vs], Count). % Vs = [A, B], % Count = 3, % sat(A=:=A*B). @@ -1195,7 +1195,7 @@ indomain(1). % Vs = [...], % CountOr = 1329227995784915872903807060280344575, % CountAnd = 1. -% ==sat(A =< B), Vs = [A,B], sat_count(+[1|Vs], Count). +% == sat_count(Sat0, N) :- catch((parse_sat(Sat0, Sat), From 196784bd09f8b56a7352abe5546883161448f1e4 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Tue, 10 Dec 2019 21:36:02 -0700 Subject: [PATCH 5/6] change goal and term expansions, change call/N to use goal expansions --- README.md | 2 +- src/prolog/clause_types.rs | 10 +- src/prolog/iterators.rs | 19 --- src/prolog/lib/atts.pl | 11 +- src/prolog/lib/builtins.pl | 144 ++++++++++++++++++----- src/prolog/lib/dcgs.pl | 7 +- src/prolog/lib/non_iso.pl | 23 +++- src/prolog/machine/code_repo.rs | 29 ++++- src/prolog/machine/compile.rs | 68 +++++++++-- src/prolog/machine/machine_indices.rs | 19 ++- src/prolog/machine/machine_state.rs | 118 +++++++++++-------- src/prolog/machine/machine_state_impl.rs | 76 +----------- src/prolog/machine/mod.rs | 5 +- src/prolog/machine/modules.rs | 12 +- src/prolog/machine/system_calls.rs | 79 ++++++++++++- src/prolog/machine/term_expansion.rs | 11 +- src/prolog/machine/toplevel.rs | 12 +- src/prolog/macros.rs | 2 +- src/prolog/toplevel.pl | 18 +-- src/prolog/write.rs | 2 + 20 files changed, 424 insertions(+), 243 deletions(-) diff --git a/README.md b/README.md index 2d060807..d5d387aa 100644 --- a/README.md +++ b/README.md @@ -166,7 +166,7 @@ The following predicates are built-in to Scryer. * `bb_get/2` * `bb_put/2` * `between/3` -* `call/1..62` +* `call/1..17` * `call_cleanup/2` * `call_with_inference_limit/3` * `call_residue_vars/2` diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index 006ea3d4..e2175735 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -159,10 +159,12 @@ pub enum SystemClauseType { AbolishModuleClause, AssertDynamicPredicateToBack, AssertDynamicPredicateToFront, + AtEndOfExpansion, AtomChars, AtomCodes, AtomLength, CallAttributeGoals, + CallN, CharCode, CharsToNumber, ClearAttrVarBindings, @@ -261,10 +263,12 @@ impl SystemClauseType { &SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"), &SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"), &SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"), + &SystemClauseType::AtEndOfExpansion => clause_name!("$at_end_of_expansion"), &SystemClauseType::AtomChars => clause_name!("$atom_chars"), &SystemClauseType::AtomCodes => clause_name!("$atom_codes"), &SystemClauseType::AtomLength => clause_name!("$atom_length"), &SystemClauseType::CallAttributeGoals => clause_name!("$call_attribute_goals"), + &SystemClauseType::CallN => clause_name!("$call"), &SystemClauseType::CharCode => clause_name!("$char_code"), &SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"), &SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"), @@ -388,6 +392,7 @@ impl SystemClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { ("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause), + ("$at_end_of_expansion", 0) => Some(SystemClauseType::AtEndOfExpansion), ("$atom_chars", 2) => Some(SystemClauseType::AtomChars), ("$atom_codes", 2) => Some(SystemClauseType::AtomCodes), ("$atom_length", 2) => Some(SystemClauseType::AtomLength), @@ -396,6 +401,7 @@ impl SystemClauseType { ("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack), ("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront), ("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack), + ("$call", 1) => Some(SystemClauseType::CallN), ("$call_attribute_goals", 2) => Some(SystemClauseType::CallAttributeGoals), ("$char_code", 2) => Some(SystemClauseType::CharCode), ("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber), @@ -522,7 +528,6 @@ pub enum BuiltInClauseType { #[derive(Clone, PartialEq, Eq)] pub enum ClauseType { BuiltIn(BuiltInClauseType), - CallN, Hook(CompileTimeHook), Inlined(InlinedClauseType), Named(ClauseName, usize, CodeIndex), // name, arity, index. @@ -589,7 +594,6 @@ impl ClauseType { pub fn name(&self) -> ClauseName { match self { - &ClauseType::CallN => clause_name!("call"), &ClauseType::BuiltIn(ref built_in) => built_in.name(), &ClauseType::Hook(ref hook) => hook.name(), &ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()), @@ -610,8 +614,6 @@ impl ClauseType { .unwrap_or_else(|| { if let Some(spec) = spec { ClauseType::Op(name, spec, CodeIndex::default()) - } else if name.as_str() == "call" { - ClauseType::CallN } else { ClauseType::Named(name, arity, CodeIndex::default()) } diff --git a/src/prolog/iterators.rs b/src/prolog/iterators.rs index 2dd4ea7b..48c72aa5 100644 --- a/src/prolog/iterators.rs +++ b/src/prolog/iterators.rs @@ -123,12 +123,6 @@ impl<'a> QueryIterator<'a> { fn new(term: &'a QueryTerm) -> Self { match term { - &QueryTerm::Clause(ref cell, ClauseType::CallN, ref terms, _) => { - let state = TermIterState::Clause(Level::Root, 1, cell, ClauseType::CallN, terms); - QueryIterator { - state_stack: vec![state], - } - } &QueryTerm::Clause(ref cell, ref ct, ref terms, _) => { let state = TermIterState::Clause(Level::Root, 0, cell, ct.clone(), terms); QueryIterator { @@ -173,9 +167,6 @@ impl<'a> Iterator for QueryIterator<'a> { TermIterState::Clause(lvl, child_num, cell, ct, child_terms) => { if child_num == child_terms.len() { match ct { - ClauseType::CallN => { - self.push_subterm(Level::Shallow, child_terms[0].as_ref()) - } ClauseType::Named(..) | ClauseType::Op(..) => { return match lvl { Level::Root => None, @@ -454,16 +445,6 @@ impl<'a> ChunkedIterator<'a> { ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), ..)) => { result.push(term) } - ChunkedTerm::BodyTerm(&QueryTerm::Clause( - _, - ClauseType::CallN, - ref subterms, - _, - )) => { - result.push(term); - arity = subterms.len() + 1; - break; - } ChunkedTerm::BodyTerm(qt) => { result.push(term); arity = qt.arity(); diff --git a/src/prolog/lib/atts.pl b/src/prolog/lib/atts.pl index 71115639..1522e0ce 100644 --- a/src/prolog/lib/atts.pl +++ b/src/prolog/lib/atts.pl @@ -56,14 +56,15 @@ '$del_attr'(Ls0, V, Attr) :- Ls0 = [Att | Ls1], nonvar(Att), - ( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr) - ; '$enqueue_attr_var'(V), - '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr) + ( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr) + ; '$enqueue_attr_var'(V), + '$del_attr_head'(V), + '$del_attr'(Ls1, V, Attr) ). '$del_attr_step'(Ls1, V, Attr) :- - ( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr) - ; true ). + ( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr) + ; true ). %% assumptions: Ls0 is a list, Ls1 is its tail; %% the head of Ls0 can be ignored. diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index f0a75453..34f1fcb6 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -43,7 +43,11 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- (:)/7, (:)/8, (:)/9, (:)/10, (:)/11, (:)/12, abolish/1, asserta/1, assertz/1, atom_chars/2, atom_codes/2, atom_concat/3, atom_length/2, - bagof/3, catch/3, char_code/2, clause/2, + bagof/3, call/1, call/2, call/3, call/4, + call/5, call/6, call/7, call/8, call/9, + call/10, call/11, call/12, call/13, + call/14, call/15, call/16, call/17, + catch/3, char_code/2, clause/2, current_op/3, current_predicate/1, current_prolog_flag/2, expand_goal/2, expand_term/2, fail/0, false/0, findall/3, @@ -55,6 +59,76 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- true/0, unify_with_occurs_check/2, write/1, write_canonical/1, write_term/2, writeq/1]). + +%% call/{1..17} + +call(Goal) :- + ( '$module_of'(Module, Goal), + Module:goal_expansion(Goal, ExpandedGoal) -> + true + ; Goal = ExpandedGoal + ), + '$call'(ExpandedGoal). + +'$call_body'(Goal, As) :- + Goal =.. F, + lists:append(F, As, Fs), + ExpandedGoal0 =.. Fs, + ( '$module_of'(Module, ExpandedGoal0), + Module:goal_expansion(ExpandedGoal0, ExpandedGoal1) -> + true + ; ExpandedGoal1 = ExpandedGoal0 + ), + '$call'(ExpandedGoal1). + +call(Goal, A1) :- + '$call_body'(Goal, [A1]). + +call(Goal, A1, A2) :- + '$call_body'(Goal, [A1, A2]). + +call(Goal, A1, A2, A3) :- + '$call_body'(Goal, [A1, A2, A3]). + +call(Goal, A1, A2, A3, A4) :- + '$call_body'(Goal, [A1, A2, A3, A4]). + +call(Goal, A1, A2, A3, A4, A5) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5]). + +call(Goal, A1, A2, A3, A4, A5, A6) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15]). + +call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16) :- + '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16]). + % the maximum arity flag. needs to be replaced with % current_prolog_flag(max_arity, MAX_ARITY). max_arity(255). @@ -177,13 +251,13 @@ set_prolog_flag(Flag, _) :- fail :- '$fail'. -\+ G :- G, !, false. +\+ G :- call(G), !, false. \+ _. X \= X :- !, false. _ \= _. -once(G) :- G, !. +once(G) :- call(G), !. repeat. repeat :- repeat. @@ -200,13 +274,14 @@ comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)). '$set_cp'(B), '$call_with_default_policy'(comma_errors(G1, G2, B)). ','(!, Atom, B) :- Atom == !, '$set_cp'(B). -','(!, G, B) :- '$set_cp'(B), G. +','(!, G, B) :- '$set_cp'(B), call(G). ','(G, CF, B) :- compound(CF), '$call_with_default_policy'(CF = ','(G1, G2)), - !, G, + !, + call(G), '$call_with_default_policy'(comma_errors(G1, G2, B)). -','(G, Atom, B) :- Atom == !, !, G, '$set_cp'(B). -','(G1, G2, _) :- G1, G2. +','(G, Atom, B) :- Atom == !, !, call(G), '$set_cp'(B). +','(G1, G2, _) :- call(G1), call(G2). ;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B). @@ -214,37 +289,47 @@ comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)). ;(G1, G4, B) :- compound(G1), '$call_with_default_policy'(G1 = ->(G2, G3)), !, - (G2 -> G3 ; '$set_cp'(B), G4). -;(G1, G2, B) :- G1 == !, '$set_cp'(B), G2. -;(G1, G2, B) :- G2 == !, G1, '$set_cp'(B). -;(G, _, _) :- G. -;(_, G, _) :- G. + ( call(G2) -> call(G3) + ; '$set_cp'(B), + call(G4) + ). +;(G1, G2, B) :- G1 == !, '$set_cp'(B), call(G2). +;(G1, G2, B) :- G2 == !, call(G1), '$set_cp'(B). +;(G, _, _) :- call(G). +;(_, G, _) :- call(G). G1 -> G2 :- '$get_b_value'(B), '$call_with_default_policy'(->(G1, G2, B)). :- non_counted_backtracking (->)/3. -->(G1, G2, B) :- G2 == !, G1, '$set_cp'(B). -->(G1, G2, B) :- G1, '$set_cp'(B), G2. +->(G1, G2, B) :- G2 == !, call(G1), '$set_cp'(B). +->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2). % univ. :- non_counted_backtracking univ_errors/3. univ_errors(Term, List, N) :- '$skip_max_list'(N, -1, List, R), - ( var(R) -> ( var(Term), throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a) - ; true ) - ; R \== [] -> throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b) - ; List = [H|T] -> ( var(H), var(Term), % R == [] => List is a proper list. - throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c) - ; T \== [], nonvar(H), \+ atom(H), - throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d) - ; compound(H), T == [], - throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e) - ; var(Term), max_arity(M), N - 1 > M, - throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g) - ; true ) - ; var(Term) -> throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f) - ; true ). + ( var(R) -> + ( var(Term), throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a) + ; true + ) + ; R \== [] -> + throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b) + ; List = [H|T] -> + ( var(H), var(Term), % R == [] => List is a proper list. + throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c) + ; T \== [], nonvar(H), \+ atom(H), + throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d) + ; compound(H), T == [], + throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e) + ; var(Term), max_arity(M), N - 1 > M, + throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g) + ; true + ) + ; var(Term) -> + throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f) + ; true + ). Term =.. List :- '$call_with_default_policy'(univ_errors(Term, List, N)), '$call_with_default_policy'(univ_worker(Term, List, N)). @@ -371,7 +456,8 @@ catch(G,C,R) :- '$get_current_block'(Bb), '$call_with_default_policy'(catch(G,C, :- non_counted_backtracking catch/4. catch(G,C,R,Bb) :- - '$install_new_block'(NBb), call(G), + '$install_new_block'(NBb), + call(G), '$call_with_default_policy'(end_block(Bb, NBb)). catch(G,C,R,Bb) :- '$reset_block'(Bb), diff --git a/src/prolog/lib/dcgs.pl b/src/prolog/lib/dcgs.pl index 2ee8baac..e144cd0d 100644 --- a/src/prolog/lib/dcgs.pl +++ b/src/prolog/lib/dcgs.pl @@ -4,8 +4,9 @@ :- use_module(library(lists), [append/3]). -user:term_expansion(Term0, (Head :- Body)) :- - dcg_rule(Term0, Term), +user:term_expansion(Term0, Term) :- + nonvar(Term0), + dcg_rule(Term0, (Head :- Body)), Term = (Head :- Body). phrase(GRBody, S0) :- @@ -33,7 +34,7 @@ phrase_((A ; B), S0, S) :- %% phrase_((A | B), S0, S) :- %% ( phrase(A, S0, S) ; phrase(B, S0, S) ). phrase_({G}, S0, S) :- - ( G, S0 = S ). + ( call(G), S0 = S ). phrase_(call(G), S0, S) :- call(G, S0, S). phrase_((A -> B), S0, S) :- diff --git a/src/prolog/lib/non_iso.pl b/src/prolog/lib/non_iso.pl index b4f9394d..22f0001e 100644 --- a/src/prolog/lib/non_iso.pl +++ b/src/prolog/lib/non_iso.pl @@ -46,8 +46,11 @@ call_cleanup(G, C) :- setup_call_cleanup(true, G, C). % setup_call_cleanup. -setup_call_cleanup(S, G, C) :- '$get_b_value'(B), - S, '$set_cp_by_default'(B), '$get_current_block'(Bb), +setup_call_cleanup(S, G, C) :- + '$get_b_value'(B), + call(S), + '$set_cp_by_default'(B), + '$get_current_block'(Bb), ( '$call_with_default_policy'(var(C)) -> throw(error(instantiation_error, setup_call_cleanup/3)) ; '$call_with_default_policy'(scc_helper(C, G, Bb)) @@ -83,10 +86,14 @@ run_cleaners_with_handling :- :- non_counted_backtracking run_cleaners_without_handling/1. run_cleaners_without_handling(Cp) :- - '$get_scc_cleaner'(C), '$get_level'(B), C, '$set_cp_by_default'(B), + '$get_scc_cleaner'(C), + '$get_level'(B), + call(C), + '$set_cp_by_default'(B), '$call_with_default_policy'(run_cleaners_without_handling(Cp)). run_cleaners_without_handling(Cp) :- - '$set_cp_by_default'(Cp), '$restore_cut_policy'. + '$set_cp_by_default'(Cp), + '$restore_cut_policy'. % call_with_inference_limit @@ -123,8 +130,12 @@ call_with_inference_limit(G, L, R, Bb, B) :- call_with_inference_limit(_, _, R, Bb, B) :- '$reset_block'(Bb), '$remove_inference_counter'(B, _), - ( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp) - ; '$remove_call_policy_check'(B), '$fail' ), + ( '$get_ball'(Ball), + '$get_level'(Cp), + '$set_cp_by_default'(Cp) + ; '$remove_call_policy_check'(B), + '$fail' + ), '$erase_ball', '$call_with_default_policy'(handle_ile(B, Ball, R)). diff --git a/src/prolog/machine/code_repo.rs b/src/prolog/machine/code_repo.rs index fee126e9..073a79d0 100644 --- a/src/prolog/machine/code_repo.rs +++ b/src/prolog/machine/code_repo.rs @@ -134,12 +134,33 @@ impl CodeRepo { ); Some(RefOrOwned::Owned(call_clause)) } - &CodePtr::CallN(arity, _, last_call) => { - let call_clause = call_clause!(ClauseType::CallN, arity, 0, last_call); - Some(RefOrOwned::Owned(call_clause)) - } &CodePtr::VerifyAttrInterrupt(p) => Some(RefOrOwned::Borrowed(&self.code[p])), &CodePtr::DynamicTransaction(..) => None, } } + + pub(super) + fn at_end_of_hook(&self, hook: CompileTimeHook, cp: LocalCodePtr) -> bool { + match hook { + CompileTimeHook::UserGoalExpansion | CompileTimeHook::GoalExpansion => { + let len = self.goal_expanders.len(); + + if len > 0 { + cp == LocalCodePtr::UserGoalExpansion(len - 1) + } else { + true + } + } + CompileTimeHook::UserTermExpansion | CompileTimeHook::TermExpansion => { + let len = self.term_expanders.len(); + + if len > 0 { + cp == LocalCodePtr::UserTermExpansion(len - 1) + } else { + true + } + } + } + } + } diff --git a/src/prolog/machine/compile.rs b/src/prolog/machine/compile.rs index 75b03d35..b67c5d71 100644 --- a/src/prolog/machine/compile.rs +++ b/src/prolog/machine/compile.rs @@ -83,7 +83,7 @@ fn load_module( // this impromptu definition (namely, its exports) will be filled out later. let module_decl = ModuleDecl { name: listing_src, exports: vec![] }; - let mut module = Module::new(module_decl, wam.indices.atom_tbl.clone()); + let mut module = Module::new(module_decl, wam.indices.atom_tbl.clone()); let module_name = module.module_decl.name.clone(); module.is_impromptu_module = true; @@ -201,6 +201,24 @@ pub fn compile_appendix( Ok(()) } +fn append_trivial_goal(name: &ClauseName, pred: &mut Predicate) +{ + let var = Box::new(Term::Var(Cell::default(), Rc::new(String::from("X")))); + let body = QueryTerm::Clause( + Cell::default(), + ClauseType::from(clause_name!("$at_end_of_expansion"), 0, None), + vec![], + false + ); + + let rule = Rule { + head: (name.clone(), vec![var.clone(), var], body), + clauses: vec![] + }; + + pred.0.push(PredicateClause::Rule(rule, 0, 0)); +} + impl CodeRepo { pub fn compile_hook( &mut self, @@ -209,13 +227,17 @@ impl CodeRepo { ) -> Result<(), ParserError> { let key = (hook.name(), hook.arity()); - match self.term_dir.get(&key) { - Some(preds) => { + match self.term_dir.get_mut(&key) { + Some(ref mut preds) => { + append_trivial_goal(&key.0, &mut preds.0); + let mut cg = CodeGenerator::::new(false, flags); let mut code = cg.compile_predicate(&(preds.0).0)?; compile_appendix(&mut code, &preds.1, false, flags)?; + (preds.0).0.pop(); + Ok(match hook { CompileTimeHook::UserTermExpansion | CompileTimeHook::TermExpansion => { self.term_expanders = code @@ -225,7 +247,26 @@ impl CodeRepo { } }) } - None => Ok(()), + None => Ok(match hook { + CompileTimeHook::UserTermExpansion | CompileTimeHook::TermExpansion => { + if self.term_expanders.is_empty() { + let mut preds = Predicate::new(); + append_trivial_goal(&key.0, &mut preds); + + let mut cg = CodeGenerator::::new(false, flags); + self.term_expanders = cg.compile_predicate(&preds.0)?; + } + } + CompileTimeHook::UserGoalExpansion | CompileTimeHook::GoalExpansion => { + if self.goal_expanders.is_empty() { + let mut preds = Predicate::new(); + append_trivial_goal(&key.0, &mut preds); + + let mut cg = CodeGenerator::::new(false, flags); + self.goal_expanders = cg.compile_predicate(&preds.0)?; + } + } + }) } } } @@ -649,8 +690,8 @@ impl ListingCompiler { let idx = code_dir .entry((name.clone(), arity)) .or_insert(CodeIndex::default()); - - set_code_index!(idx, IndexPtr::Index(p), self.get_module_name()); + + set_code_index!(idx, IndexPtr::Index(p), self.get_module_name()); self.localize_self_calls(name, arity, &mut decl_code, p); code.extend(decl_code.into_iter()); @@ -728,7 +769,7 @@ impl ListingCompiler { ), ); - op_decl.submit(self.get_module_name(), spec, &mut indices.op_dir) + op_decl.submit(self.get_module_name(), spec, &mut indices.op_dir) } fn process_decl( @@ -749,7 +790,7 @@ impl ListingCompiler { .code_repo .compile_hook(hook, flags) .map_err(SessionError::from); - + wam.code_repo.truncate_terms(key, len, queue_len); result @@ -940,13 +981,16 @@ fn compile_work_impl( if let Some(ref mut module) = &mut compiler.module { // compile the module-level goal and term expansions and store // their locations to the module's code_dir. - let decls = module.take_local_expansions(); - + let mut decls = module.take_local_expansions(); + if !decls.is_empty() { + append_trivial_goal(&clause_name!("term_expansion"), &mut decls[0].0); + append_trivial_goal(&clause_name!("goal_expansion"), &mut decls[1].0); + results.worker_results.extend(decls.into_iter()); } } - + let module_code = compiler.generate_code( results.worker_results, wam, @@ -999,7 +1043,7 @@ fn compile_work_impl( wam.indices.use_module(&mut wam.code_repo, wam.machine_st.flags, &module)?; wam.indices.insert_module(module); - } else { + } else { add_module_code(wam, module, module_code, indices); } diff --git a/src/prolog/machine/machine_indices.rs b/src/prolog/machine/machine_indices.rs index 10afcbe4..dac06a40 100644 --- a/src/prolog/machine/machine_indices.rs +++ b/src/prolog/machine/machine_indices.rs @@ -211,6 +211,8 @@ pub enum IndexPtr { DynamicUndefined, // a predicate, declared as dynamic, whose location in code is as yet undefined. Undefined, Index(usize), + UserGoalExpansion, + UserTermExpansion } #[derive(Clone, Ord, PartialOrd, Eq, PartialEq)] @@ -309,7 +311,6 @@ pub enum REPLCodePtr { #[derive(Clone, PartialEq)] pub enum CodePtr { BuiltInClause(BuiltInClauseType, LocalCodePtr), // local is the successor call. - CallN(usize, LocalCodePtr, bool), // arity, local, last call. Local(LocalCodePtr), DynamicTransaction(DynamicTransactionType, LocalCodePtr), // the type of transaction, the return pointer. REPL(REPLCodePtr, LocalCodePtr), // the REPL code, the return pointer. @@ -320,7 +321,6 @@ impl CodePtr { pub fn local(&self) -> LocalCodePtr { match self { &CodePtr::BuiltInClause(_, ref local) - | &CodePtr::CallN(_, ref local, _) | &CodePtr::Local(ref local) => local.clone(), &CodePtr::VerifyAttrInterrupt(p) => LocalCodePtr::DirEntry(p), &CodePtr::REPL(_, p) | &CodePtr::DynamicTransaction(_, p) => p, @@ -418,7 +418,7 @@ impl Add for CodePtr { | p @ CodePtr::VerifyAttrInterrupt(_) | p @ CodePtr::DynamicTransaction(..) => p, CodePtr::Local(local) => CodePtr::Local(local + rhs), - CodePtr::CallN(_, local, _) | CodePtr::BuiltInClause(_, local) => { + CodePtr::BuiltInClause(_, local) => { CodePtr::Local(local + rhs) } } @@ -491,6 +491,19 @@ impl IndexStore { } } + pub fn add_term_and_goal_expansion_indices(&mut self) { + self.code_dir.insert((clause_name!("term_expansion"), 2), + CodeIndex(Rc::new(RefCell::new( + (IndexPtr::UserTermExpansion, + clause_name!("user")) + )))); + self.code_dir.insert((clause_name!("goal_expansion"), 2), + CodeIndex(Rc::new(RefCell::new( + (IndexPtr::UserGoalExpansion, + clause_name!("user")) + )))); + } + #[inline] pub fn remove_clause_subsection(&mut self, module: ClauseName, name: ClauseName, arity: usize) { self.dynamic_code_dir.swap_remove(&(module, name, arity)); diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 6c6ec160..0d856817 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -261,6 +261,7 @@ pub struct MachineState { pub(super) last_call: bool, pub(crate) heap_locs: HeapVarDict, pub(crate) flags: MachineFlags, + pub(crate) at_end_of_expansion: LocalCodePtr } impl MachineState { @@ -316,17 +317,17 @@ impl MachineState { Ok(codes) } - pub(super) fn call_at_index(&mut self, arity: usize, p: usize) { + pub(super) fn call_at_index(&mut self, arity: usize, p: LocalCodePtr) { self.cp.assign_if_local(self.p.clone() + 1); self.num_of_args = arity; self.b0 = self.b; - self.p = dir_entry!(p); + self.p = CodePtr::Local(p); } - pub(super) fn execute_at_index(&mut self, arity: usize, p: usize) { + pub(super) fn execute_at_index(&mut self, arity: usize, p: LocalCodePtr) { self.num_of_args = arity; self.b0 = self.b; - self.p = dir_entry!(p); + self.p = CodePtr::Local(p); } pub(super) fn module_lookup( @@ -342,9 +343,9 @@ impl MachineState { match idx.0.borrow().0 { IndexPtr::Index(compiled_tl_index) => { if last_call { - self.execute_at_index(arity, compiled_tl_index); + self.execute_at_index(arity, dir_entry!(compiled_tl_index)); } else { - self.call_at_index(arity, compiled_tl_index); + self.call_at_index(arity, dir_entry!(compiled_tl_index)); } return Ok(()); @@ -353,6 +354,24 @@ impl MachineState { self.fail = true; return Ok(()); } + IndexPtr::UserTermExpansion => { + if last_call { + self.execute_at_index(arity, LocalCodePtr::UserTermExpansion(0)); + } else { + self.call_at_index(arity, LocalCodePtr::UserTermExpansion(0)); + } + + return Ok(()); + } + IndexPtr::UserGoalExpansion => { + if last_call { + self.execute_at_index(arity, LocalCodePtr::UserGoalExpansion(0)); + } else { + self.call_at_index(arity, LocalCodePtr::UserGoalExpansion(0)); + } + + return Ok(()); + } _ => {} } } @@ -390,9 +409,9 @@ fn try_in_situ( ) -> CallResult { if let Some(p) = try_in_situ_lookup(name.clone(), arity, indices) { if last_call { - machine_st.execute_at_index(arity, p); + machine_st.execute_at_index(arity, LocalCodePtr::DirEntry(p)); } else { - machine_st.call_at_index(arity, p); + machine_st.call_at_index(arity, LocalCodePtr::DirEntry(p)); } machine_st.p = in_situ_dir_entry!(p); @@ -619,7 +638,13 @@ pub(crate) trait CallPolicy: Any { IndexPtr::Undefined => return try_in_situ(machine_st, name, arity, indices, false), IndexPtr::Index(compiled_tl_index) => { - machine_st.call_at_index(arity, compiled_tl_index) + machine_st.call_at_index(arity, LocalCodePtr::DirEntry(compiled_tl_index)) + } + IndexPtr::UserTermExpansion => { + machine_st.call_at_index(arity, LocalCodePtr::UserTermExpansion(0)); + } + IndexPtr::UserGoalExpansion => { + machine_st.call_at_index(arity, LocalCodePtr::UserGoalExpansion(0)); } } @@ -640,7 +665,13 @@ pub(crate) trait CallPolicy: Any { IndexPtr::Undefined => return try_in_situ(machine_st, name, arity, indices, true), IndexPtr::Index(compiled_tl_index) => { - machine_st.execute_at_index(arity, compiled_tl_index) + machine_st.execute_at_index(arity, dir_entry!(compiled_tl_index)) + } + IndexPtr::UserTermExpansion => { + machine_st.execute_at_index(arity, LocalCodePtr::UserTermExpansion(0)); + } + IndexPtr::UserGoalExpansion => { + machine_st.execute_at_index(arity, LocalCodePtr::UserGoalExpansion(0)); } } @@ -834,49 +865,39 @@ pub(crate) trait CallPolicy: Any { fn call_n( &mut self, machine_st: &mut MachineState, + name: ClauseName, arity: usize, indices: &mut IndexStore, parsing_stream: &mut PrologStream, ) -> CallResult { - if let Some((name, arity)) = machine_st.setup_call_n(arity) { - match ClauseType::from(name.clone(), arity, None) { - ClauseType::CallN => { - machine_st.handle_internal_call_n(arity); + match ClauseType::from(name.clone(), arity, None) { + ClauseType::BuiltIn(built_in) => { + machine_st.setup_built_in_call(built_in.clone()); + self.call_builtin(machine_st, &built_in, indices, parsing_stream)?; + } + ClauseType::Inlined(inlined) => { + machine_st.execute_inlined(&inlined); - if machine_st.fail { - return Ok(()); - } + if machine_st.last_call { + machine_st.p = CodePtr::Local(machine_st.cp); + } + } + ClauseType::Op(..) | ClauseType::Named(..) => { + let module = name.owning_module(); - machine_st.p = CodePtr::CallN(arity, machine_st.p.local(), machine_st.last_call); + if let Some(idx) = indices.get_code_index((name.clone(), arity), module) { + self.context_call(machine_st, name, arity, idx, indices)?; + } else { + try_in_situ(machine_st, name, arity, indices, machine_st.last_call)?; } - ClauseType::BuiltIn(built_in) => { - machine_st.setup_built_in_call(built_in.clone()); - self.call_builtin(machine_st, &built_in, indices, parsing_stream)?; - } - ClauseType::Inlined(inlined) => { - machine_st.execute_inlined(&inlined); + } + ClauseType::Hook(_) | ClauseType::System(_) => { + let name = Addr::Con(Constant::Atom(name, None)); + let stub = MachineError::functor_stub(clause_name!("call"), arity + 1); - if machine_st.last_call { - machine_st.p = CodePtr::Local(machine_st.cp); - } - } - ClauseType::Op(..) | ClauseType::Named(..) => { - let module = name.owning_module(); - - if let Some(idx) = indices.get_code_index((name.clone(), arity), module) { - self.context_call(machine_st, name, arity, idx, indices)?; - } else { - try_in_situ(machine_st, name, arity, indices, machine_st.last_call)?; - } - } - ClauseType::Hook(_) | ClauseType::System(_) => { - let name = Addr::Con(Constant::Atom(name, None)); - let stub = MachineError::functor_stub(clause_name!("call"), arity + 1); - - return Err(machine_st - .error_form(MachineError::type_error(ValidType::Callable, name), stub)); - } - }; + return Err(machine_st + .error_form(MachineError::type_error(ValidType::Callable, name), stub)); + } } Ok(()) @@ -932,12 +953,13 @@ impl CallPolicy for CWILCallPolicy { fn call_n( &mut self, machine_st: &mut MachineState, + name: ClauseName, arity: usize, indices: &mut IndexStore, parsing_stream: &mut PrologStream, ) -> CallResult { self.prev_policy - .call_n(machine_st, arity, indices, parsing_stream)?; + .call_n(machine_st, name, arity, indices, parsing_stream)?; self.increment(machine_st) } } @@ -1093,10 +1115,10 @@ impl SCCCutPolicy { if let Some(&(_, b_cutoff, prev_block)) = self.cont_pts.last() { if machine_st.b < b_cutoff { let (idx, arity) = if machine_st.block < prev_block { - (self.r_c_w_h, 0) + (dir_entry!(self.r_c_w_h), 0) } else { machine_st[temp_v!(1)] = Addr::Con(Constant::Usize(b_cutoff)); - (self.r_c_wo_h, 1) + (dir_entry!(self.r_c_wo_h), 1) }; if machine_st.last_call { diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 0af5e578..34497a17 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -75,6 +75,7 @@ impl MachineState { last_call: false, heap_locs: HeapVarDict::new(), flags: MachineFlags::default(), + at_end_of_expansion: LocalCodePtr::TopLevel(0, 0), } } @@ -105,6 +106,7 @@ impl MachineState { last_call: false, heap_locs: HeapVarDict::new(), flags: MachineFlags::default(), + at_end_of_expansion: LocalCodePtr::TopLevel(0, 0), } } @@ -1988,22 +1990,6 @@ impl MachineState { } } - pub(super) fn handle_internal_call_n(&mut self, arity: usize) { - let arity = arity + 1; - let pred = self.registers[1].clone(); - - for i in 2..arity { - self.registers[i - 1] = self.registers[i].clone(); - } - - if arity > 1 { - self.registers[arity - 1] = pred; - return; - } - - self.fail = true; - } - pub(super) fn set_ball(&mut self) { self.ball.reset(); @@ -2017,59 +2003,6 @@ impl MachineState { ); } - pub(super) fn setup_call_n(&mut self, arity: usize) -> Option { - let stub = MachineError::functor_stub(clause_name!("call"), arity + 1); - let addr = self.store(self.deref(self.registers[arity].clone())); - - let (name, narity) = match addr { - Addr::Str(a) => { - let result = self.heap[a].clone(); - - if let HeapCellValue::NamedStr(narity, name, _) = result { - if narity + arity > 63 { - let representation_error = self.error_form( - MachineError::representation_error(RepFlag::MaxArity), - stub, - ); - - self.throw_exception(representation_error); - return None; - } - - for i in (1 .. arity).rev() { - self.registers[i + narity] = self.registers[i].clone(); - } - - for i in 1 .. narity + 1 { - self.registers[i] = self.heap[a + i].as_addr(a + i); - } - - (name, narity) - } else { - self.fail = true; - return None; - } - } - Addr::Con(Constant::Atom(name, _)) => (name, 0), - Addr::HeapCell(_) | Addr::StackCell(_, _) => { - let instantiation_error = - self.error_form(MachineError::instantiation_error(), stub); - self.throw_exception(instantiation_error); - - return None; - } - _ => { - let type_error = - self.error_form(MachineError::type_error(ValidType::Callable, addr), stub); - self.throw_exception(type_error); - - return None; - } - }; - - Some((name, arity + narity - 1)) - } - pub(super) fn unwind_stack(&mut self) { self.b = self.block; self.truncate_stack(); @@ -3154,10 +3087,6 @@ impl MachineState { self, call_policy.call_builtin(self, ct, indices, parsing_stream) ), - &ClauseType::CallN => try_or_fail!( - self, - call_policy.call_n(self, arity, indices, parsing_stream) - ), &ClauseType::Hook(ref hook) => try_or_fail!(self, call_policy.compile_hook(self, hook)), &ClauseType::Inlined(ref ct) => { self.execute_inlined(ct); @@ -3375,6 +3304,7 @@ impl MachineState { self.mode = MachineMode::Write; self.registers = vec![Addr::HeapCell(0); MAX_ARITY + 1]; // self.registers[0] is never used. self.block = 0; + self.at_end_of_expansion = LocalCodePtr::TopLevel(0, 0); self.ball.reset(); self.heap_locs.clear(); diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 5e613c7c..b33373ca 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -272,7 +272,8 @@ impl Machine { self.run_query(); } - pub fn new(prolog_stream: PrologStream) -> Self { + pub fn new(prolog_stream: PrologStream) -> Self + { let mut wam = Machine { machine_st: MachineState::new(), inner_heap: Heap::with_capacity(256 * 256), @@ -285,6 +286,8 @@ impl Machine { let atom_tbl = wam.indices.atom_tbl.clone(); + wam.indices.add_term_and_goal_expansion_indices(); + compile_listing( &mut wam, parsing_stream(BUILTINS.as_bytes()), diff --git a/src/prolog/machine/modules.rs b/src/prolog/machine/modules.rs index 508eb77d..0ed1c437 100644 --- a/src/prolog/machine/modules.rs +++ b/src/prolog/machine/modules.rs @@ -108,17 +108,7 @@ impl Module { let goal_expansions = mem::replace(&mut self.local_goal_expansions, (Predicate::new(), VecDeque::new())); - let mut result = vec![]; - - if !(term_expansions.0).0.is_empty() { - result.push(term_expansions); - } - - if !(goal_expansions.0).0.is_empty() { - result.push(goal_expansions); - } - - result + vec![term_expansions, goal_expansions] } } diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index fb702df3..7e026d13 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -618,6 +618,9 @@ impl MachineState { self.p = CodePtr::DynamicTransaction(trans_type, p); return Ok(()); } + &SystemClauseType::AtEndOfExpansion => { + self.at_end_of_expansion = self.p.local(); + } &SystemClauseType::AtomChars => { let a1 = self[temp_v!(1)].clone(); @@ -753,13 +756,71 @@ impl MachineState { let p = self.attr_var_init.project_attrs_loc; if self.last_call { - self.execute_at_index(2, p); + self.execute_at_index(2, dir_entry!(p)); } else { - self.call_at_index(2, p); + self.call_at_index(2, dir_entry!(p)); } return Ok(()); } + &SystemClauseType::CallN => { + let (name, arity) = match self.store(self.deref(self[temp_v!(1)].clone())) { + Addr::Str(a) => { + let result = self.heap[a].clone(); + + if let HeapCellValue::NamedStr(arity, name, _) = result { + if arity > MAX_ARITY { + let stub = MachineError::functor_stub( + clause_name!("$call"), + 1, + ); + + return Err(self.error_form( + MachineError::representation_error(RepFlag::MaxArity), + stub, + )); + } + + for i in 1 .. arity + 1 { + self.registers[i] = self.heap[a + i].as_addr(a + i); + } + + (name, arity) + } else { + unreachable!() + } + } + Addr::Con(Constant::Atom(name, _)) => + (name, 0), + Addr::HeapCell(_) | Addr::StackCell(_, _) => { + let stub = MachineError::functor_stub( + clause_name!("$call"), + 1, + ); + + return Err(self.error_form(MachineError::instantiation_error(), stub)); + } + addr => { + let stub = MachineError::functor_stub( + clause_name!("$call"), + 1, + ); + + return Err(self.error_form( + MachineError::type_error(ValidType::Callable, addr), + stub, + )); + } + }; + + return call_policy.call_n( + self, + name, + arity, + indices, + current_input_stream, + ); + } &SystemClauseType::CharsToNumber => { let stub = MachineError::functor_stub(clause_name!("number_chars"), 2); @@ -991,7 +1052,10 @@ impl MachineState { match subsection { Some(dynamic_predicate_info) => { - self.execute_at_index(2, dynamic_predicate_info.clauses_subsection_p); + self.execute_at_index( + 2, + dir_entry!(dynamic_predicate_info.clauses_subsection_p) + ); return Ok(()); } None => self.fail = true, @@ -1626,7 +1690,9 @@ impl MachineState { self.unify(target, module); } - _ => self.fail = true, + _ => { + unreachable!() + } }, _ => self.fail = true, }; @@ -1925,7 +1991,10 @@ impl MachineState { match subsection { Some(dynamic_predicate_info) => { - self.execute_at_index(2, dynamic_predicate_info.clauses_subsection_p); + self.execute_at_index( + 2, + dir_entry!(dynamic_predicate_info.clauses_subsection_p) + ); return Ok(()); } _ => unreachable!(), diff --git a/src/prolog/machine/term_expansion.rs b/src/prolog/machine/term_expansion.rs index f322f712..f7ae72f3 100644 --- a/src/prolog/machine/term_expansion.rs +++ b/src/prolog/machine/term_expansion.rs @@ -343,7 +343,7 @@ impl MachineState { // this prevents clashes between underscored variable names // in the same query. fn reset_with_heap_preservation(&mut self) { - let heap = self.heap.take(); + let heap = self.heap.take(); self.reset(); self.heap = heap; } @@ -364,6 +364,9 @@ impl MachineState { let code = vec![call_clause!(ClauseType::Hook(hook), 2, 0, true)]; wam.code_repo.cached_query = code; + self.cp = LocalCodePtr::TopLevel(0, 0); + self.at_end_of_expansion = self.cp; + self.query_stepper( &mut wam.indices, &mut wam.policies, @@ -371,8 +374,8 @@ impl MachineState { &mut readline::input_stream(), ); - if self.fail { - self.reset_with_heap_preservation(); + if self.fail || wam.code_repo.at_end_of_hook(hook, self.at_end_of_expansion) { + self.reset_with_heap_preservation(); None } else { let TermWriteResult { var_dict, .. } = term_write_result; @@ -380,7 +383,7 @@ impl MachineState { self.heap_locs = var_dict; let output = self.print_with_locs(Addr::HeapCell(h), &wam.indices.op_dir); - self.reset_with_heap_preservation(); + self.reset_with_heap_preservation(); Some(output.result()) } } diff --git a/src/prolog/machine/toplevel.rs b/src/prolog/machine/toplevel.rs index ea91d1e6..de779b9e 100644 --- a/src/prolog/machine/toplevel.rs +++ b/src/prolog/machine/toplevel.rs @@ -693,13 +693,11 @@ impl RelationWorker { let ct = indices.get_clause_type(name, terms.len(), fixity); Ok(QueryTerm::Clause(Cell::default(), ct, terms, false)) } - }, - Term::Var(..) => Ok(QueryTerm::Clause( - Cell::default(), - ClauseType::CallN, - vec![Box::new(term)], - false, - )), + } + arg @ Term::Var(..) => { + let ct = ClauseType::Named(clause_name!("call"), 1, CodeIndex::default()); + Ok(QueryTerm::Clause(Cell::default(), ct, vec![Box::new(arg)], false)) + } _ => Err(ParserError::InadmissibleQueryTerm), } } diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 0db02999..1d11a902 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -217,7 +217,7 @@ macro_rules! return_from_clause { macro_rules! dir_entry { ($idx:expr) => { - CodePtr::Local(LocalCodePtr::DirEntry($idx)) + LocalCodePtr::DirEntry($idx) }; } diff --git a/src/prolog/toplevel.pl b/src/prolog/toplevel.pl index cf561645..902537ee 100644 --- a/src/prolog/toplevel.pl +++ b/src/prolog/toplevel.pl @@ -39,14 +39,14 @@ !. '$submit_query_and_print_results'(Term0, VarList) :- - ( expand_goals(Term0, Term) -> true - ; Term = Term0 + ( expand_goal(Term0, Term) -> true + ; Term0 = Term ), ( '$get_b_value'(B), call(Term), '$write_eqs_and_read_input'(B, VarList), ! % clear attribute goal lists, which may be populated by % copy_term/3 prior to failure. - ; '$clear_attribute_goals', write('false.'), nl + ; '$clear_attribute_goals', write('false.'), nl ). '$needs_bracketing'(Value, Op) :- @@ -239,18 +239,22 @@ use_module(Module, QualifiedExports) :- user:term_expansion(Term0, (:- initialization(ExpandedGoals))) :- nonvar(Term0), Term0 = (:- initialization(Goals)), - expand_goals(Goals, ExpandedGoals), - Goals \== ExpandedGoals. + expand_goals(Goals, ExpandedGoals). + + +module_expand_goal(UnexpandedGoals, ExpandedGoals) :- + '$module_of'(Module, UnexpandedGoals), + Module:goal_expansion(UnexpandedGoals, ExpandedGoals). expand_goals(UnexpandedGoals, ExpandedGoals) :- nonvar(UnexpandedGoals), var(ExpandedGoals), - ( expand_goal(UnexpandedGoals, Goals) -> true + ( expand_goal(UnexpandedGoals, Goals) -> + true ; Goals = UnexpandedGoals ), ( Goals = (Goal0, Goals0) -> ( expand_goal(Goal0, Goal1) -> - Expanded = true, expand_goals(Goals0, Goals1), thread_goals(Goal1, ExpandedGoals, Goals1, (',')) ; expand_goals(Goals0, Goals1), diff --git a/src/prolog/write.rs b/src/prolog/write.rs index 2d552522..23c8076c 100644 --- a/src/prolog/write.rs +++ b/src/prolog/write.rs @@ -45,6 +45,8 @@ impl fmt::Display for IndexPtr { &IndexPtr::DynamicUndefined => write!(f, "undefined"), &IndexPtr::Undefined => write!(f, "undefined"), &IndexPtr::Index(i) => write!(f, "{}", i), + &IndexPtr::UserTermExpansion => write!(f, "user:term_expansion"), + &IndexPtr::UserGoalExpansion => write!(f, "user:goal_expansion"), } } } From 02d8b1441decd8a3bb77bea8171f32e65462c363 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Wed, 11 Dec 2019 21:42:15 -0700 Subject: [PATCH 6/6] expand goals inside (\+)/1 --- README.md | 2 +- src/prolog/clause_types.rs | 10 ++- src/prolog/iterators.rs | 19 ++++++ src/prolog/lib/builtins.pl | 75 +---------------------- src/prolog/machine/code_repo.rs | 29 ++------- src/prolog/machine/compile.rs | 1 + src/prolog/machine/machine_errors.rs | 1 + src/prolog/machine/machine_indices.rs | 14 +++-- src/prolog/machine/machine_state.rs | 65 +++++++++++--------- src/prolog/machine/machine_state_impl.rs | 78 +++++++++++++++++++++++- src/prolog/machine/system_calls.rs | 72 ++++------------------ src/prolog/machine/term_expansion.rs | 4 +- src/prolog/machine/toplevel.rs | 30 +++++++-- src/prolog/toplevel.pl | 24 +++++--- 14 files changed, 212 insertions(+), 212 deletions(-) diff --git a/README.md b/README.md index d5d387aa..2d060807 100644 --- a/README.md +++ b/README.md @@ -166,7 +166,7 @@ The following predicates are built-in to Scryer. * `bb_get/2` * `bb_put/2` * `between/3` -* `call/1..17` +* `call/1..62` * `call_cleanup/2` * `call_with_inference_limit/3` * `call_residue_vars/2` diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index e2175735..9dbb43ca 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -164,7 +164,6 @@ pub enum SystemClauseType { AtomCodes, AtomLength, CallAttributeGoals, - CallN, CharCode, CharsToNumber, ClearAttrVarBindings, @@ -209,6 +208,7 @@ pub enum SystemClauseType { LiftedHeapLength, ModuleAssertDynamicPredicateToFront, ModuleAssertDynamicPredicateToBack, + ModuleExists, ModuleOf, ModuleRetractClause, NoSuchPredicate, @@ -268,7 +268,6 @@ impl SystemClauseType { &SystemClauseType::AtomCodes => clause_name!("$atom_codes"), &SystemClauseType::AtomLength => clause_name!("$atom_length"), &SystemClauseType::CallAttributeGoals => clause_name!("$call_attribute_goals"), - &SystemClauseType::CallN => clause_name!("$call"), &SystemClauseType::CharCode => clause_name!("$char_code"), &SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"), &SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"), @@ -343,6 +342,7 @@ impl SystemClauseType { clause_name!("$module_assertz") } &SystemClauseType::ModuleHeadIsDynamic => clause_name!("$module_head_is_dynamic"), + &SystemClauseType::ModuleExists => clause_name!("$module_exists"), &SystemClauseType::ModuleOf => clause_name!("$module_of"), &SystemClauseType::NoSuchPredicate => clause_name!("$no_such_predicate"), &SystemClauseType::NumberToChars => clause_name!("$number_to_chars"), @@ -401,7 +401,6 @@ impl SystemClauseType { ("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack), ("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront), ("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack), - ("$call", 1) => Some(SystemClauseType::CallN), ("$call_attribute_goals", 2) => Some(SystemClauseType::CallAttributeGoals), ("$char_code", 2) => Some(SystemClauseType::CharCode), ("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber), @@ -449,6 +448,7 @@ impl SystemClauseType { ("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter), ("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength), ("$maybe", 0) => Some(SystemClauseType::Maybe), + ("$module_exists", 1) => Some(SystemClauseType::ModuleExists), ("$module_of", 2) => Some(SystemClauseType::ModuleOf), ("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause), ("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic), @@ -528,6 +528,7 @@ pub enum BuiltInClauseType { #[derive(Clone, PartialEq, Eq)] pub enum ClauseType { BuiltIn(BuiltInClauseType), + CallN, Hook(CompileTimeHook), Inlined(InlinedClauseType), Named(ClauseName, usize, CodeIndex), // name, arity, index. @@ -595,6 +596,7 @@ impl ClauseType { pub fn name(&self) -> ClauseName { match self { &ClauseType::BuiltIn(ref built_in) => built_in.name(), + &ClauseType::CallN => clause_name!("call"), &ClauseType::Hook(ref hook) => hook.name(), &ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()), &ClauseType::Op(ref name, ..) => name.clone(), @@ -614,6 +616,8 @@ impl ClauseType { .unwrap_or_else(|| { if let Some(spec) = spec { ClauseType::Op(name, spec, CodeIndex::default()) + } else if name.as_str() == "call" { + ClauseType::CallN } else { ClauseType::Named(name, arity, CodeIndex::default()) } diff --git a/src/prolog/iterators.rs b/src/prolog/iterators.rs index 48c72aa5..183f28d5 100644 --- a/src/prolog/iterators.rs +++ b/src/prolog/iterators.rs @@ -123,6 +123,12 @@ impl<'a> QueryIterator<'a> { fn new(term: &'a QueryTerm) -> Self { match term { + &QueryTerm::Clause(ref cell, ClauseType::CallN, ref terms, _) => { + let state = TermIterState::Clause(Level::Root, 1, cell, ClauseType::CallN, terms); + QueryIterator { + state_stack: vec![state], + } + } &QueryTerm::Clause(ref cell, ref ct, ref terms, _) => { let state = TermIterState::Clause(Level::Root, 0, cell, ct.clone(), terms); QueryIterator { @@ -167,6 +173,9 @@ impl<'a> Iterator for QueryIterator<'a> { TermIterState::Clause(lvl, child_num, cell, ct, child_terms) => { if child_num == child_terms.len() { match ct { + ClauseType::CallN => { + self.push_subterm(Level::Shallow, child_terms[0].as_ref()) + } ClauseType::Named(..) | ClauseType::Op(..) => { return match lvl { Level::Root => None, @@ -445,6 +454,16 @@ impl<'a> ChunkedIterator<'a> { ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), ..)) => { result.push(term) } + ChunkedTerm::BodyTerm(&QueryTerm::Clause( + _, + ClauseType::CallN, + ref subterms, + _, + )) => { + result.push(term); + arity = subterms.len() + 1; + break; + } ChunkedTerm::BodyTerm(qt) => { result.push(term); arity = qt.arity(); diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 34f1fcb6..d6e524dc 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -43,11 +43,7 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- (:)/7, (:)/8, (:)/9, (:)/10, (:)/11, (:)/12, abolish/1, asserta/1, assertz/1, atom_chars/2, atom_codes/2, atom_concat/3, atom_length/2, - bagof/3, call/1, call/2, call/3, call/4, - call/5, call/6, call/7, call/8, call/9, - call/10, call/11, call/12, call/13, - call/14, call/15, call/16, call/17, - catch/3, char_code/2, clause/2, + bagof/3, catch/3, char_code/2, clause/2, current_op/3, current_predicate/1, current_prolog_flag/2, expand_goal/2, expand_term/2, fail/0, false/0, findall/3, @@ -60,75 +56,6 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- write_canonical/1, write_term/2, writeq/1]). -%% call/{1..17} - -call(Goal) :- - ( '$module_of'(Module, Goal), - Module:goal_expansion(Goal, ExpandedGoal) -> - true - ; Goal = ExpandedGoal - ), - '$call'(ExpandedGoal). - -'$call_body'(Goal, As) :- - Goal =.. F, - lists:append(F, As, Fs), - ExpandedGoal0 =.. Fs, - ( '$module_of'(Module, ExpandedGoal0), - Module:goal_expansion(ExpandedGoal0, ExpandedGoal1) -> - true - ; ExpandedGoal1 = ExpandedGoal0 - ), - '$call'(ExpandedGoal1). - -call(Goal, A1) :- - '$call_body'(Goal, [A1]). - -call(Goal, A1, A2) :- - '$call_body'(Goal, [A1, A2]). - -call(Goal, A1, A2, A3) :- - '$call_body'(Goal, [A1, A2, A3]). - -call(Goal, A1, A2, A3, A4) :- - '$call_body'(Goal, [A1, A2, A3, A4]). - -call(Goal, A1, A2, A3, A4, A5) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5]). - -call(Goal, A1, A2, A3, A4, A5, A6) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15]). - -call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16) :- - '$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16]). - % the maximum arity flag. needs to be replaced with % current_prolog_flag(max_arity, MAX_ARITY). max_arity(255). diff --git a/src/prolog/machine/code_repo.rs b/src/prolog/machine/code_repo.rs index 073a79d0..fee126e9 100644 --- a/src/prolog/machine/code_repo.rs +++ b/src/prolog/machine/code_repo.rs @@ -134,33 +134,12 @@ impl CodeRepo { ); Some(RefOrOwned::Owned(call_clause)) } + &CodePtr::CallN(arity, _, last_call) => { + let call_clause = call_clause!(ClauseType::CallN, arity, 0, last_call); + Some(RefOrOwned::Owned(call_clause)) + } &CodePtr::VerifyAttrInterrupt(p) => Some(RefOrOwned::Borrowed(&self.code[p])), &CodePtr::DynamicTransaction(..) => None, } } - - pub(super) - fn at_end_of_hook(&self, hook: CompileTimeHook, cp: LocalCodePtr) -> bool { - match hook { - CompileTimeHook::UserGoalExpansion | CompileTimeHook::GoalExpansion => { - let len = self.goal_expanders.len(); - - if len > 0 { - cp == LocalCodePtr::UserGoalExpansion(len - 1) - } else { - true - } - } - CompileTimeHook::UserTermExpansion | CompileTimeHook::TermExpansion => { - let len = self.term_expanders.len(); - - if len > 0 { - cp == LocalCodePtr::UserTermExpansion(len - 1) - } else { - true - } - } - } - } - } diff --git a/src/prolog/machine/compile.rs b/src/prolog/machine/compile.rs index b67c5d71..d2403a87 100644 --- a/src/prolog/machine/compile.rs +++ b/src/prolog/machine/compile.rs @@ -94,6 +94,7 @@ fn load_module( results.and_then(|results| compile_work_impl(&mut compiler, wam, indices, results)) .or_else(|e| { + wam.indices.take_module(module_name.clone()); compiler.print_error(&e); Err(e) })?; diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index 6ef4ed9f..0b3507a1 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -80,6 +80,7 @@ impl MachineError { ], SharedOpDesc::new(400, YFX) )); + stub.append(&mut functor!( ":", 2, diff --git a/src/prolog/machine/machine_indices.rs b/src/prolog/machine/machine_indices.rs index dac06a40..41d7a553 100644 --- a/src/prolog/machine/machine_indices.rs +++ b/src/prolog/machine/machine_indices.rs @@ -236,7 +236,7 @@ impl CodeIndex { module_name )))) } - + #[inline] pub fn module_name(&self) -> ClauseName { self.0.borrow().1.clone() @@ -311,6 +311,7 @@ pub enum REPLCodePtr { #[derive(Clone, PartialEq)] pub enum CodePtr { BuiltInClause(BuiltInClauseType, LocalCodePtr), // local is the successor call. + CallN(usize, LocalCodePtr, bool), // arity, local, last call. Local(LocalCodePtr), DynamicTransaction(DynamicTransactionType, LocalCodePtr), // the type of transaction, the return pointer. REPL(REPLCodePtr, LocalCodePtr), // the REPL code, the return pointer. @@ -321,6 +322,7 @@ impl CodePtr { pub fn local(&self) -> LocalCodePtr { match self { &CodePtr::BuiltInClause(_, ref local) + | &CodePtr::CallN(_, ref local, _) | &CodePtr::Local(ref local) => local.clone(), &CodePtr::VerifyAttrInterrupt(p) => LocalCodePtr::DirEntry(p), &CodePtr::REPL(_, p) | &CodePtr::DynamicTransaction(_, p) => p, @@ -418,7 +420,7 @@ impl Add for CodePtr { | p @ CodePtr::VerifyAttrInterrupt(_) | p @ CodePtr::DynamicTransaction(..) => p, CodePtr::Local(local) => CodePtr::Local(local + rhs), - CodePtr::BuiltInClause(_, local) => { + CodePtr::BuiltInClause(_, local) | CodePtr::CallN(_, local, _) => { CodePtr::Local(local + rhs) } } @@ -467,7 +469,7 @@ pub struct IndexStore { pub(super) op_dir: OpDir, } -impl IndexStore { +impl IndexStore { pub fn predicate_exists( &self, name: ClauseName, @@ -492,18 +494,18 @@ impl IndexStore { } pub fn add_term_and_goal_expansion_indices(&mut self) { - self.code_dir.insert((clause_name!("term_expansion"), 2), + self.code_dir.insert((clause_name!("term_expansion"), 2), CodeIndex(Rc::new(RefCell::new( (IndexPtr::UserTermExpansion, clause_name!("user")) )))); - self.code_dir.insert((clause_name!("goal_expansion"), 2), + self.code_dir.insert((clause_name!("goal_expansion"), 2), CodeIndex(Rc::new(RefCell::new( (IndexPtr::UserGoalExpansion, clause_name!("user")) )))); } - + #[inline] pub fn remove_clause_subsection(&mut self, module: ClauseName, name: ClauseName, arity: usize) { self.dynamic_code_dir.swap_remove(&(module, name, arity)); diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 0d856817..fef46e6b 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -261,7 +261,7 @@ pub struct MachineState { pub(super) last_call: bool, pub(crate) heap_locs: HeapVarDict, pub(crate) flags: MachineFlags, - pub(crate) at_end_of_expansion: LocalCodePtr + pub(crate) at_end_of_expansion: bool } impl MachineState { @@ -865,39 +865,49 @@ pub(crate) trait CallPolicy: Any { fn call_n( &mut self, machine_st: &mut MachineState, - name: ClauseName, arity: usize, indices: &mut IndexStore, parsing_stream: &mut PrologStream, ) -> CallResult { - match ClauseType::from(name.clone(), arity, None) { - ClauseType::BuiltIn(built_in) => { - machine_st.setup_built_in_call(built_in.clone()); - self.call_builtin(machine_st, &built_in, indices, parsing_stream)?; - } - ClauseType::Inlined(inlined) => { - machine_st.execute_inlined(&inlined); - - if machine_st.last_call { - machine_st.p = CodePtr::Local(machine_st.cp); + if let Some((name, arity)) = machine_st.setup_call_n(arity) { + match ClauseType::from(name.clone(), arity, None) { + ClauseType::BuiltIn(built_in) => { + machine_st.setup_built_in_call(built_in.clone()); + self.call_builtin(machine_st, &built_in, indices, parsing_stream)?; } - } - ClauseType::Op(..) | ClauseType::Named(..) => { - let module = name.owning_module(); + ClauseType::CallN => { + machine_st.handle_internal_call_n(arity); - if let Some(idx) = indices.get_code_index((name.clone(), arity), module) { - self.context_call(machine_st, name, arity, idx, indices)?; - } else { - try_in_situ(machine_st, name, arity, indices, machine_st.last_call)?; + if machine_st.fail { + return Ok(()); + } + + machine_st.p = CodePtr::CallN(arity, machine_st.p.local(), machine_st.last_call); } - } - ClauseType::Hook(_) | ClauseType::System(_) => { - let name = Addr::Con(Constant::Atom(name, None)); - let stub = MachineError::functor_stub(clause_name!("call"), arity + 1); + ClauseType::Inlined(inlined) => { + machine_st.execute_inlined(&inlined); - return Err(machine_st - .error_form(MachineError::type_error(ValidType::Callable, name), stub)); - } + if machine_st.last_call { + machine_st.p = CodePtr::Local(machine_st.cp); + } + } + ClauseType::Op(..) | ClauseType::Named(..) => { + let module = name.owning_module(); + + if let Some(idx) = indices.get_code_index((name.clone(), arity), module) { + self.context_call(machine_st, name, arity, idx, indices)?; + } else { + try_in_situ(machine_st, name, arity, indices, machine_st.last_call)?; + } + } + ClauseType::Hook(_) | ClauseType::System(_) => { + let name = Addr::Con(Constant::Atom(name, None)); + let stub = MachineError::functor_stub(clause_name!("call"), arity + 1); + + return Err(machine_st + .error_form(MachineError::type_error(ValidType::Callable, name), stub)); + } + }; } Ok(()) @@ -953,13 +963,12 @@ impl CallPolicy for CWILCallPolicy { fn call_n( &mut self, machine_st: &mut MachineState, - name: ClauseName, arity: usize, indices: &mut IndexStore, parsing_stream: &mut PrologStream, ) -> CallResult { self.prev_policy - .call_n(machine_st, name, arity, indices, parsing_stream)?; + .call_n(machine_st, arity, indices, parsing_stream)?; self.increment(machine_st) } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 34497a17..6588c270 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -75,7 +75,7 @@ impl MachineState { last_call: false, heap_locs: HeapVarDict::new(), flags: MachineFlags::default(), - at_end_of_expansion: LocalCodePtr::TopLevel(0, 0), + at_end_of_expansion: false } } @@ -106,7 +106,7 @@ impl MachineState { last_call: false, heap_locs: HeapVarDict::new(), flags: MachineFlags::default(), - at_end_of_expansion: LocalCodePtr::TopLevel(0, 0), + at_end_of_expansion: false } } @@ -2003,6 +2003,75 @@ impl MachineState { ); } + pub(super) fn handle_internal_call_n(&mut self, arity: usize) { + let arity = arity + 1; + let pred = self.registers[1].clone(); + + for i in 2..arity { + self.registers[i - 1] = self.registers[i].clone(); + } + + if arity > 1 { + self.registers[arity - 1] = pred; + return; + } + + self.fail = true; + } + + pub(super) fn setup_call_n(&mut self, arity: usize) -> Option { + let stub = MachineError::functor_stub(clause_name!("call"), arity + 1); + let addr = self.store(self.deref(self.registers[arity].clone())); + + let (name, narity) = match addr { + Addr::Str(a) => { + let result = self.heap[a].clone(); + + if let HeapCellValue::NamedStr(narity, name, _) = result { + if narity + arity > 63 { + let representation_error = self.error_form( + MachineError::representation_error(RepFlag::MaxArity), + stub, + ); + + self.throw_exception(representation_error); + return None; + } + + for i in (1 .. arity).rev() { + self.registers[i + narity] = self.registers[i].clone(); + } + + for i in 1 .. narity + 1 { + self.registers[i] = self.heap[a + i].as_addr(a + i); + } + + (name, narity) + } else { + self.fail = true; + return None; + } + } + Addr::Con(Constant::Atom(name, _)) => (name, 0), + Addr::HeapCell(_) | Addr::StackCell(_, _) => { + let instantiation_error = + self.error_form(MachineError::instantiation_error(), stub); + self.throw_exception(instantiation_error); + + return None; + } + _ => { + let type_error = + self.error_form(MachineError::type_error(ValidType::Callable, addr), stub); + self.throw_exception(type_error); + + return None; + } + }; + + Some((name, arity + narity - 1)) + } + pub(super) fn unwind_stack(&mut self) { self.b = self.block; self.truncate_stack(); @@ -3087,6 +3156,10 @@ impl MachineState { self, call_policy.call_builtin(self, ct, indices, parsing_stream) ), + &ClauseType::CallN => try_or_fail!( + self, + call_policy.call_n(self, arity, indices, parsing_stream) + ), &ClauseType::Hook(ref hook) => try_or_fail!(self, call_policy.compile_hook(self, hook)), &ClauseType::Inlined(ref ct) => { self.execute_inlined(ct); @@ -3304,7 +3377,6 @@ impl MachineState { self.mode = MachineMode::Write; self.registers = vec![Addr::HeapCell(0); MAX_ARITY + 1]; // self.registers[0] is never used. self.block = 0; - self.at_end_of_expansion = LocalCodePtr::TopLevel(0, 0); self.ball.reset(); self.heap_locs.clear(); diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 7e026d13..cf790d46 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -619,7 +619,9 @@ impl MachineState { return Ok(()); } &SystemClauseType::AtEndOfExpansion => { - self.at_end_of_expansion = self.p.local(); + if self.cp == LocalCodePtr::TopLevel(0, 0) { + self.at_end_of_expansion = true; + } } &SystemClauseType::AtomChars => { let a1 = self[temp_v!(1)].clone(); @@ -763,64 +765,6 @@ impl MachineState { return Ok(()); } - &SystemClauseType::CallN => { - let (name, arity) = match self.store(self.deref(self[temp_v!(1)].clone())) { - Addr::Str(a) => { - let result = self.heap[a].clone(); - - if let HeapCellValue::NamedStr(arity, name, _) = result { - if arity > MAX_ARITY { - let stub = MachineError::functor_stub( - clause_name!("$call"), - 1, - ); - - return Err(self.error_form( - MachineError::representation_error(RepFlag::MaxArity), - stub, - )); - } - - for i in 1 .. arity + 1 { - self.registers[i] = self.heap[a + i].as_addr(a + i); - } - - (name, arity) - } else { - unreachable!() - } - } - Addr::Con(Constant::Atom(name, _)) => - (name, 0), - Addr::HeapCell(_) | Addr::StackCell(_, _) => { - let stub = MachineError::functor_stub( - clause_name!("$call"), - 1, - ); - - return Err(self.error_form(MachineError::instantiation_error(), stub)); - } - addr => { - let stub = MachineError::functor_stub( - clause_name!("$call"), - 1, - ); - - return Err(self.error_form( - MachineError::type_error(ValidType::Callable, addr), - stub, - )); - } - }; - - return call_policy.call_n( - self, - name, - arity, - indices, - current_input_stream, - ); - } &SystemClauseType::CharsToNumber => { let stub = MachineError::functor_stub(clause_name!("number_chars"), 2); @@ -1673,6 +1617,16 @@ impl MachineState { } }; } + &SystemClauseType::ModuleExists => { + let module = self.store(self.deref(self[temp_v!(1)].clone())); + + match module { + Addr::Con(Constant::Atom(ref name, _)) => { + self.fail = !indices.modules.contains_key(name); + } + _ => unreachable!() + }; + } &SystemClauseType::ModuleOf => { let module = self.store(self.deref(self[temp_v!(2)].clone())); diff --git a/src/prolog/machine/term_expansion.rs b/src/prolog/machine/term_expansion.rs index f7ae72f3..2d417b66 100644 --- a/src/prolog/machine/term_expansion.rs +++ b/src/prolog/machine/term_expansion.rs @@ -365,7 +365,7 @@ impl MachineState { wam.code_repo.cached_query = code; self.cp = LocalCodePtr::TopLevel(0, 0); - self.at_end_of_expansion = self.cp; + self.at_end_of_expansion = false; self.query_stepper( &mut wam.indices, @@ -374,7 +374,7 @@ impl MachineState { &mut readline::input_stream(), ); - if self.fail || wam.code_repo.at_end_of_hook(hook, self.at_end_of_expansion) { + if self.fail || self.at_end_of_expansion { self.reset_with_heap_preservation(); None } else { diff --git a/src/prolog/machine/toplevel.rs b/src/prolog/machine/toplevel.rs index de779b9e..872d0e5b 100644 --- a/src/prolog/machine/toplevel.rs +++ b/src/prolog/machine/toplevel.rs @@ -678,6 +678,26 @@ impl RelationWorker { self.queue.push_back(clauses); Ok(QueryTerm::Jump(stub)) } + ("\\+", 1) => { + terms.push(Box::new(Term::Constant( + Cell::default(), + Constant::Atom(clause_name!("$fail"), None) + ))); + + let conq = Term::Constant( + Cell::default(), + Constant::Atom(clause_name!("true"), None) + ); + + let prec = Term::Clause(Cell::default(), clause_name!("->"), terms, None); + let terms = vec![Box::new(prec), Box::new(conq)]; + + let term = Term::Clause(Cell::default(), clause_name!(";"), terms, None); + let (stub, clauses) = self.fabricate_disjunct(term); + + self.queue.push_back(clauses); + Ok(QueryTerm::Jump(stub)) + } ("$get_level", 1) => { if let Term::Var(_, ref var) = *terms[0] { Ok(QueryTerm::GetLevelAndUnify(Cell::default(), var.clone())) @@ -694,10 +714,12 @@ impl RelationWorker { Ok(QueryTerm::Clause(Cell::default(), ct, terms, false)) } } - arg @ Term::Var(..) => { - let ct = ClauseType::Named(clause_name!("call"), 1, CodeIndex::default()); - Ok(QueryTerm::Clause(Cell::default(), ct, vec![Box::new(arg)], false)) - } + Term::Var(..) => Ok(QueryTerm::Clause( + Cell::default(), + ClauseType::CallN, + vec![Box::new(term)], + false, + )), _ => Err(ParserError::InadmissibleQueryTerm), } } diff --git a/src/prolog/toplevel.pl b/src/prolog/toplevel.pl index 902537ee..4db95bbd 100644 --- a/src/prolog/toplevel.pl +++ b/src/prolog/toplevel.pl @@ -39,7 +39,7 @@ !. '$submit_query_and_print_results'(Term0, VarList) :- - ( expand_goal(Term0, Term) -> true + ( expand_goals(Term0, Term) -> true ; Term0 = Term ), ( '$get_b_value'(B), call(Term), '$write_eqs_and_read_input'(B, VarList), @@ -235,26 +235,33 @@ use_module(Module, QualifiedExports) :- ; throw(error(instantiation_error, use_module/2)) ). + % expand goals in initialization directives. user:term_expansion(Term0, (:- initialization(ExpandedGoals))) :- nonvar(Term0), Term0 = (:- initialization(Goals)), - expand_goals(Goals, ExpandedGoals). + expand_goals(Goals, ExpandedGoals), + Goals \== ExpandedGoals. -module_expand_goal(UnexpandedGoals, ExpandedGoals) :- - '$module_of'(Module, UnexpandedGoals), - Module:goal_expansion(UnexpandedGoals, ExpandedGoals). +'$module_expand_goal'(UnexpandedGoals, ExpandedGoals) :- + ( '$module_of'(Module, UnexpandedGoals), + '$module_exists'(Module), + Module:goal_expansion(UnexpandedGoals, ExpandedGoals), + UnexpandedGoals \== ExpandedGoals -> + true + ; user:goal_expansion(UnexpandedGoals, ExpandedGoals) + ). expand_goals(UnexpandedGoals, ExpandedGoals) :- nonvar(UnexpandedGoals), var(ExpandedGoals), - ( expand_goal(UnexpandedGoals, Goals) -> + ( '$module_expand_goal'(UnexpandedGoals, Goals) -> true ; Goals = UnexpandedGoals ), ( Goals = (Goal0, Goals0) -> - ( expand_goal(Goal0, Goal1) -> + ( expand_goals(Goal0, Goal1) -> expand_goals(Goals0, Goals1), thread_goals(Goal1, ExpandedGoals, Goals1, (',')) ; expand_goals(Goals0, Goals1), @@ -268,6 +275,9 @@ expand_goals(UnexpandedGoals, ExpandedGoals) :- expand_goals(Goals0, ExpandedGoals0), expand_goals(Goals1, ExpandedGoals1), ExpandedGoals = (ExpandedGoals0 ; ExpandedGoals1) + ; Goals = (\+ Goals0) -> + expand_goals(Goals0, Goals1), + ExpandedGoals = (\+ Goals1) ; thread_goals(Goals, ExpandedGoals, (',')) ; Goals = ExpandedGoals ).