From 02d8b1441decd8a3bb77bea8171f32e65462c363 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Wed, 11 Dec 2019 21:42:15 -0700 Subject: [PATCH] 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 | 63 +++++++++++-------- 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, 211 insertions(+), 211 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 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::CallN => { + machine_st.handle_internal_call_n(arity); - if machine_st.last_call { - machine_st.p = CodePtr::Local(machine_st.cp); + if machine_st.fail { + return Ok(()); + } + + machine_st.p = CodePtr::CallN(arity, machine_st.p.local(), machine_st.last_call); } - } - ClauseType::Op(..) | ClauseType::Named(..) => { - let module = name.owning_module(); + ClauseType::Inlined(inlined) => { + machine_st.execute_inlined(&inlined); - 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.last_call { + machine_st.p = CodePtr::Local(machine_st.cp); + } } - } - ClauseType::Hook(_) | ClauseType::System(_) => { - let name = Addr::Con(Constant::Atom(name, None)); - let stub = MachineError::functor_stub(clause_name!("call"), arity + 1); + ClauseType::Op(..) | ClauseType::Named(..) => { + let module = name.owning_module(); - return Err(machine_st - .error_form(MachineError::type_error(ValidType::Callable, name), stub)); - } + 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 ). -- 2.54.0