From: Mark Thom Date: Mon, 13 Aug 2018 05:14:28 +0000 (-0600) Subject: get rid of dynamic lookup for X-Git-Tag: v0.8.110~431 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=c1ad5cd33fcd62f4e8ccd789eaee1b5eaf2a20ce;p=scryer-prolog.git get rid of dynamic lookup for $call_with_default_policy. --- diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 996a8f81..47f06da5 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -676,7 +676,8 @@ impl CompareTermQT { pub type JumpStub = Vec; pub enum QueryTerm { - Clause(Cell, ClauseType, Vec>), + // register, clause type, subterms, use default call policy. + Clause(Cell, ClauseType, Vec>, bool), BlockedCut, // a cut which is 'blocked by letters', like the P term in P -> Q. UnblockedCut(Cell), GetLevelAndUnify(Cell, Rc), @@ -684,9 +685,16 @@ pub enum QueryTerm { } impl QueryTerm { + pub fn set_default_caller(&mut self) { + match self { + &mut QueryTerm::Clause(_, _, _, ref mut use_default_cp) => *use_default_cp = true, + _ => {} + }; + } + pub fn arity(&self) -> usize { match self { - &QueryTerm::Clause(_, _, ref subterms) => subterms.len(), + &QueryTerm::Clause(_, _, ref subterms, ..) => subterms.len(), &QueryTerm::BlockedCut | &QueryTerm::UnblockedCut(..) => 0, &QueryTerm::Jump(ref vars) => vars.len(), &QueryTerm::GetLevelAndUnify(..) => 1, @@ -1338,7 +1346,8 @@ pub enum ArithmeticInstruction { #[derive(Clone)] pub enum ControlInstruction { Allocate(usize), // num_frames. - CallClause(ClauseType, usize, usize, bool), // name, arity, perm_vars after threshold, last call. + // name, arity, perm_vars after threshold, last call, use default call policy. + CallClause(ClauseType, usize, usize, bool, bool), Deallocate, JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call. Proceed diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index 392cb49c..741c1eb7 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -219,7 +219,9 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator match qt { &QueryTerm::Jump(ref vars) => code.push(jmp_call!(vars.len(), 0, pvs)), - &QueryTerm::Clause(_, ref ct, ref terms) => + &QueryTerm::Clause(_, ref ct, ref terms, true) => + code.push(call_clause_by_default!(ct.clone(), terms.len(), pvs)), + &QueryTerm::Clause(_, ref ct, ref terms, false) => code.push(call_clause!(ct.clone(), terms.len(), pvs)), _ => {} } @@ -232,8 +234,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator match code.last_mut() { Some(&mut Line::Control(ref mut ctrl)) => match ctrl.clone() { - ControlInstruction::CallClause(ct, arity, pvs, false) => - *ctrl = ControlInstruction::CallClause(ct, arity, pvs, true), + ControlInstruction::CallClause(ct, arity, pvs, false, use_default_cp) => + *ctrl = ControlInstruction::CallClause(ct, arity, pvs, true, use_default_cp), ControlInstruction::JmpBy(arity, offset, pvs, false) => *ctrl = ControlInstruction::JmpBy(arity, offset, pvs, true), ControlInstruction::Proceed => {}, @@ -416,7 +418,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator if !target.is_empty() { code.push(Line::Query(target)); } - + code.push(get_level_and_unify!(cell.get().norm())); }, &QueryTerm::UnblockedCut(ref cell) => @@ -427,7 +429,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator } else { Line::Cut(CutInstruction::Cut(perm_v!(1))) }), - &QueryTerm::Clause(_, ClauseType::BuiltIn(BuiltInClauseType::Is(..)), ref terms) + &QueryTerm::Clause(_, ClauseType::BuiltIn(BuiltInClauseType::Is(..)), + ref terms, use_default_call_policy) => { let (mut acode, at) = self.call_arith_eval(terms[1].as_ref(), 1)?; @@ -445,20 +448,29 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(Line::Query(target)); } - code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1)))); + if use_default_call_policy { + code.push(is_call_by_default!(temp_v!(1), at.unwrap_or(interm!(1)))); + } else { + code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1)))); + } }, &Term::Constant(_, ref c @ Constant::Number(_)) => { code.push(query![put_constant!(Level::Shallow, c.clone(), temp_v!(1))]); - code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1)))); + + if use_default_call_policy { + code.push(is_call_by_default!(temp_v!(1), at.unwrap_or(interm!(1)))); + } else { + code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1)))); + } }, _ => { code.push(fail!()); } } }, - &QueryTerm::Clause(_, ClauseType::Inlined(ref ct), ref terms) => + &QueryTerm::Clause(_, ClauseType::Inlined(ref ct), ref terms, _) => try!(self.compile_inlined(ct, terms, term_loc, code)), _ => { let num_perm_vars = if chunk_num == 0 { @@ -496,7 +508,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator // add a proceed to bookend any trailing cuts. match toc { &QueryTerm::BlockedCut | &QueryTerm::UnblockedCut(..) => code.push(proceed!()), - &QueryTerm::Clause(_, ClauseType::Inlined(..), _) => code.push(proceed!()), + &QueryTerm::Clause(_, ClauseType::Inlined(..), ..) => code.push(proceed!()), _ => {} }; @@ -688,7 +700,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator ChoiceInstruction::RetryMeElse(offset) } } - + fn compile_pred_subseq<'b: 'a>(&mut self, clauses: &'b [PredicateClause]) -> Result { diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 5276b698..4df60064 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -152,10 +152,14 @@ impl fmt::Display for ControlInstruction { match self { &ControlInstruction::Allocate(num_cells) => write!(f, "allocate {}", num_cells), - &ControlInstruction::CallClause(ref ct, arity, pvs, true) => + &ControlInstruction::CallClause(ref ct, arity, pvs, true, true) => + write!(f, "call_with_default_policy {}/{}, {}", ct, arity, pvs), + &ControlInstruction::CallClause(ref ct, arity, pvs, false, true) => + write!(f, "execute_with_default_policy {}/{}, {}", ct, arity, pvs), + &ControlInstruction::CallClause(ref ct, arity, pvs, true, false) => write!(f, "execute {}/{}, {}", ct, arity, pvs), - &ControlInstruction::CallClause(ref ct, arity, pvs, false) => - write!(f, "call {}/{}, {}", ct, arity, pvs), + &ControlInstruction::CallClause(ref ct, arity, pvs, false, false) => + write!(f, "call {}/{}, {}", ct, arity, pvs), &ControlInstruction::Deallocate => write!(f, "deallocate"), &ControlInstruction::JmpBy(arity, offset, pvs, false) => diff --git a/src/prolog/iterators.rs b/src/prolog/iterators.rs index 852cb535..e6581b30 100644 --- a/src/prolog/iterators.rs +++ b/src/prolog/iterators.rs @@ -42,12 +42,12 @@ impl<'a> QueryIterator<'a> { } fn new(term: &'a QueryTerm) -> Self { - match term { - &QueryTerm::Clause(ref cell, ClauseType::CallN, ref terms) => { + 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) => { + &QueryTerm::Clause(ref cell, ref ct, ref terms, _) => { let state = TermIterState::Clause(Level::Root, 0, cell, ct.clone(), terms); QueryIterator { state_stack: vec![state] } }, @@ -351,9 +351,9 @@ impl<'a> ChunkedIterator<'a> }, ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) => result.push(term), - ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), _)) => + ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), ..)) => result.push(term), - ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::CallN, ref subterms)) => + ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::CallN, ref subterms, _)) => { result.push(term); arity = subterms.len() + 1; diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 65f54a5d..df4301bd 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1811,6 +1811,38 @@ impl MachineState { self.p += 1; } + fn handle_call_clause<'a>(&mut self, code_dirs: CodeDirs<'a>, + call_policy: &mut Box, + cut_policy: &mut Box, + ct: &ClauseType, + arity: usize, + lco: bool, + use_default_cp: bool) + { + let mut default_call_policy: Box = Box::new(DefaultCallPolicy {}); + let call_policy = if use_default_cp { + &mut default_call_policy + } else { + call_policy + }; + + self.last_call = lco; + + match ct { + &ClauseType::BuiltIn(ref ct) => + try_or_fail!(self, call_policy.call_builtin(self, ct, Box::new(code_dirs))), + &ClauseType::CallN => + try_or_fail!(self, call_policy.call_n(self, arity, Box::new(code_dirs))), + &ClauseType::Inlined(ref ct) => + self.execute_inlined(ct), + &ClauseType::Named(ref name, ref idx) | &ClauseType::Op(ref name, _, ref idx) => + try_or_fail!(self, call_policy.context_call(self, name.clone(), arity, idx.clone(), + Box::new(code_dirs))), + &ClauseType::System(ref ct) => + try_or_fail!(self, self.system_call(ct, code_dirs, call_policy, cut_policy)) + }; + } + pub(super) fn execute_ctrl_instr<'a>(&mut self, code_dirs: CodeDirs<'a>, call_policy: &mut Box, cut_policy: &mut Box, @@ -1819,26 +1851,9 @@ impl MachineState { match instr { &ControlInstruction::Allocate(num_cells) => self.allocate(num_cells), - &ControlInstruction::CallClause(ClauseType::CallN, arity, _, lco) => { - self.last_call = lco; - try_or_fail!(self, call_policy.call_n(self, arity, Box::new(code_dirs))); - }, - &ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => { - self.last_call = lco; - try_or_fail!(self, call_policy.call_builtin(self, ct, Box::new(code_dirs))); - }, - &ControlInstruction::CallClause(ClauseType::Inlined(ref ct), ..) => - self.execute_inlined(ct), - &ControlInstruction::CallClause(ClauseType::Named(ref name, ref idx), arity, _, lco) - | &ControlInstruction::CallClause(ClauseType::Op(ref name, _, ref idx), arity, _, lco) => { - self.last_call = lco; - try_or_fail!(self, call_policy.context_call(self, name.clone(), arity, idx.clone(), - Box::new(code_dirs))); - }, - &ControlInstruction::CallClause(ClauseType::System(ref ct), _, _, lco) => { - self.last_call = lco; - try_or_fail!(self, self.system_call(ct, code_dirs, call_policy, cut_policy)); - }, + &ControlInstruction::CallClause(ref ct, arity, _, lco, use_default_cp) => + self.handle_call_clause(code_dirs, call_policy, cut_policy, ct, arity, lco, + use_default_cp), &ControlInstruction::Deallocate => self.deallocate(), &ControlInstruction::JmpBy(arity, offset, _, lco) => { if !lco { diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index fc287fc7..5ed338ec 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -136,10 +136,19 @@ macro_rules! is_var { macro_rules! call_clause { ($ct:expr, $arity:expr, $pvs:expr) => ( - Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, false)) + Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, false, false)) ); ($ct:expr, $arity:expr, $pvs:expr, $lco:expr) => ( - Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, $lco)) + Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, $lco, false)) + ) +} + +macro_rules! call_clause_by_default { + ($ct:expr, $arity:expr, $pvs:expr) => ( + Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, false, true)) + ); + ($ct:expr, $arity:expr, $pvs:expr, $lco:expr) => ( + Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, $lco, true)) ) } @@ -155,6 +164,12 @@ macro_rules! is_call { ) } +macro_rules! is_call_by_default { + ($r:expr, $at:expr) => ( + call_clause_by_default!(ClauseType::BuiltIn(BuiltInClauseType::Is($r, $at)), 2, 0) + ) +} + macro_rules! set_cp { ($r:expr) => ( call_clause!(ClauseType::System(SystemClauseType::SetCutPoint($r)), 1, 0) diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 40619881..9419905e 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -295,7 +295,8 @@ fn module_resolution_call(mod_name: Term, body: Term) -> Result Ok(QueryTerm::UnblockedCut(Cell::default())), @@ -446,10 +447,11 @@ impl RelationWorker { } } else { let ct = indices.lookup(name, terms.len(), fixity); - Ok(QueryTerm::Clause(Cell::default(), ct, terms)) + Ok(QueryTerm::Clause(Cell::default(), ct, terms, false)) }, - Term::Var(_, _) => - Ok(QueryTerm::Clause(Cell::default(), ClauseType::CallN, vec![Box::new(term)])), + Term::Var(..) => + Ok(QueryTerm::Clause(Cell::default(), ClauseType::CallN, vec![Box::new(term)], + false)), _ => Err(ParserError::InadmissibleQueryTerm) } @@ -479,6 +481,24 @@ impl RelationWorker { } } + fn pre_query_term(&mut self, idx: &mut MachineCodeIndices, term: Term) + -> Result + { + match term { + Term::Clause(r, name, mut subterms, fixity) => + if subterms.len() == 1 && name.as_str() == "$call_with_default_policy" { + self.to_query_term(idx, *subterms.pop().unwrap()) + .map(|mut query_term| { + query_term.set_default_caller(); + query_term + }) + } else { + self.to_query_term(idx, Term::Clause(r, name, subterms, fixity)) + }, + _ => self.to_query_term(idx, term) + } + } + fn setup_query(&mut self, idx: &mut MachineCodeIndices, terms: Vec>, blocks_cuts: bool) -> Result, ParserError> { @@ -507,7 +527,7 @@ impl RelationWorker { mark_cut_variable(&mut subterm); } - query_terms.push(try!(self.to_query_term(idx, subterm))); + query_terms.push(self.pre_query_term(idx, subterm)?); } } diff --git a/src/tests.rs b/src/tests.rs index e5843f84..48a06593 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1519,7 +1519,7 @@ fn test_queries_on_builtins() assert_prolog_failure!(&mut wam, "?- Pairs = [a-a|Pairs], keysort(Pairs, _)."); assert_prolog_success!(&mut wam, "?- Pairs = [a-a|Pairs], catch(keysort(Pairs, _), error(E, _), true).", - [["E = type_error(list, [a-a | _26])", "Pairs = [a-a | Pairs]"]]); + [["E = type_error(list, [a-a | _22])", "Pairs = [a-a | Pairs]"]]); assert_prolog_success!(&mut wam, "?- keysort([], L).", [["L = []"]]); @@ -1528,9 +1528,9 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).", [["Pat = type_error(list, [a | a])"]]); assert_prolog_success!(&mut wam, "?- catch(keysort(_, _), error(E, _), true).", - [["E = type_error(list, _17)"]]); + [["E = type_error(list, _13)"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [_|b]), error(E, _), true).", - [["E = type_error(list, [_28 | b])"]]); + [["E = type_error(list, [_24 | b])"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [a-b,c-d,a]), error(E, _), true).", [["E = type_error(pair, a)"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a], [a-b]), error(E, _), true).", @@ -1543,7 +1543,7 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- sort([], L).", [["L = []"]]); assert_prolog_success!(&mut wam, "?- catch(sort(_, []), error(E, _), true).", - [["E = type_error(list, _17)"]]); + [["E = type_error(list, _13)"]]); assert_prolog_success!(&mut wam, "?- catch(sort([a,b,c], not_a_list), error(E, _), true).", [["E = type_error(list, not_a_list)"]]);