* `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`
AbolishModuleClause,
AssertDynamicPredicateToBack,
AssertDynamicPredicateToFront,
+ AtEndOfExpansion,
AtomChars,
AtomCodes,
AtomLength,
CallAttributeGoals,
+ CallN,
CharCode,
CharsToNumber,
ClearAttrVarBindings,
&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"),
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
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),
("$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),
#[derive(Clone, PartialEq, Eq)]
pub enum ClauseType {
BuiltIn(BuiltInClauseType),
- CallN,
Hook(CompileTimeHook),
Inlined(InlinedClauseType),
Named(ClauseName, usize, CodeIndex), // name, arity, index.
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()),
.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())
}
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 {
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,
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();
'$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.
(:)/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,
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).
fail :- '$fail'.
-\+ G :- G, !, false.
+\+ G :- call(G), !, false.
\+ _.
X \= X :- !, false.
_ \= _.
-once(G) :- G, !.
+once(G) :- call(G), !.
repeat.
repeat :- repeat.
'$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).
;(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)).
:- 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),
:- 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) :-
%% 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) :-
% 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))
:- 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
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)).
);
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
+ }
+ }
+ }
+ }
+
}
// 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;
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,
) -> 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::<DebrayAllocator>::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
}
})
}
- 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::<DebrayAllocator>::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::<DebrayAllocator>::new(false, flags);
+ self.goal_expanders = cg.compile_predicate(&preds.0)?;
+ }
+ }
+ })
}
}
}
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());
),
);
- 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(
.code_repo
.compile_hook(hook, flags)
.map_err(SessionError::from);
-
+
wam.code_repo.truncate_terms(key, len, queue_len);
result
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,
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);
}
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)]
#[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.
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,
| 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)
}
}
}
}
+ 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));
pub(super) last_call: bool,
pub(crate) heap_locs: HeapVarDict,
pub(crate) flags: MachineFlags,
+ pub(crate) at_end_of_expansion: LocalCodePtr
}
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(
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(());
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(());
+ }
_ => {}
}
}
) -> 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);
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));
}
}
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));
}
}
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);
-
- if machine_st.fail {
- return Ok(());
- }
-
- machine_st.p = CodePtr::CallN(arity, machine_st.p.local(), 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);
+ 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 machine_st.last_call {
+ machine_st.p = CodePtr::Local(machine_st.cp);
}
- ClauseType::Op(..) | ClauseType::Named(..) => {
- let module = name.owning_module();
+ }
+ 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)?;
- }
+ 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);
+ }
+ 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(())
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)
}
}
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 {
last_call: false,
heap_locs: HeapVarDict::new(),
flags: MachineFlags::default(),
+ at_end_of_expansion: LocalCodePtr::TopLevel(0, 0),
}
}
last_call: false,
heap_locs: HeapVarDict::new(),
flags: MachineFlags::default(),
+ at_end_of_expansion: LocalCodePtr::TopLevel(0, 0),
}
}
}
}
- 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();
);
}
- pub(super) fn setup_call_n(&mut self, arity: usize) -> Option<PredicateKey> {
- 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();
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);
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();
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),
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()),
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]
}
}
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();
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);
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,
self.unify(target, module);
}
- _ => self.fail = true,
+ _ => {
+ unreachable!()
+ }
},
_ => self.fail = true,
};
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!(),
// 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;
}
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,
&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;
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())
}
}
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),
}
}
macro_rules! dir_entry {
($idx:expr) => {
- CodePtr::Local(LocalCodePtr::DirEntry($idx))
+ LocalCodePtr::DirEntry($idx)
};
}
!.
'$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) :-
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),
&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"),
}
}
}
projects / scryer-prolog.git / commitdiff