* A revised, not-terrible module system (_done, I think_).
* Built-in predicates for list processing and top-level declarative
control (`setup_call_control/3`, `call_with_inference_limit/3`,
- etc.) (_IN REVISION_)
+ etc.) (_done_)
* Definite Clause Grammars
* Attributed variables using the SICStus Prolog interface and
semantics. Adding coroutines like `dif/2`, `freeze/2`, etc.
* `between/3`
* `call/1..62`
* `call_cleanup/2`
+* `call_with_inference_limit/3`
* `catch/3`
* `compare/3`
* `compound/1`
}
pub enum Declaration {
+ NonCountedBacktracking(ClauseName, usize), // name, arity
Module(ModuleDecl),
Op(OpDecl),
UseModule(ClauseName),
impl Constant {
pub fn to_atom(self) -> Option<ClauseName> {
match self {
- Constant::Atom(a) => Some(a),
+ Constant::Atom(a) => Some(a.defrock_brackets()),
_ => None
}
}
#[derive(Clone)]
pub enum ChoiceInstruction {
+ DefaultRetryMeElse(usize),
+ DefaultTrustMe,
RetryMeElse(usize),
TrustMe,
TryMeElse(usize)
pub struct CodeGenerator<TermMarker> {
marker: TermMarker,
- var_count: HashMap<Rc<Var>, usize>
+ var_count: HashMap<Rc<Var>, usize>,
+ non_counted_bt: bool
}
pub struct ConjunctInfo<'a> {
impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker>
{
- pub fn new() -> Self {
+ pub fn new(non_counted_bt: bool) -> Self {
CodeGenerator { marker: Allocator::new(),
- var_count: HashMap::new() }
+ var_count: HashMap::new(),
+ non_counted_bt }
}
pub fn take_vars(self) -> AllocVarDict {
subseqs
}
+ fn trust_me(&self) -> ChoiceInstruction {
+ if self.non_counted_bt {
+ ChoiceInstruction::DefaultTrustMe
+ } else {
+ ChoiceInstruction::TrustMe
+ }
+ }
+
+ fn retry_me_else(&self, offset: usize) -> ChoiceInstruction {
+ if self.non_counted_bt {
+ ChoiceInstruction::DefaultRetryMeElse(offset)
+ } else {
+ ChoiceInstruction::RetryMeElse(offset)
+ }
+ }
+
fn compile_pred_subseq<'b: 'a>(&mut self, clauses: &'b [PredicateClause])
-> Result<Code, ParserError>
{
if num_clauses > 1 {
let choice = match i {
0 => ChoiceInstruction::TryMeElse(clause_code.len() + 1),
- _ if i == num_clauses - 1 => ChoiceInstruction::TrustMe,
- _ => ChoiceInstruction::RetryMeElse(clause_code.len() + 1)
+ _ if i == num_clauses - 1 => self.trust_me(),
+ _ => self.retry_me_else(clause_code.len() + 1)
};
code_body.push(Line::Choice(choice));
if multi_seq {
let choice = match l {
0 => ChoiceInstruction::TryMeElse(code_segment.len() + 1),
- _ if r == clauses.len() => ChoiceInstruction::TrustMe,
- _ => ChoiceInstruction::RetryMeElse(code_segment.len() + 1)
+ _ if r == clauses.len() => self.trust_me(),
+ _ => self.retry_me_else(code_segment.len() + 1)
};
code.push(Line::Choice(choice));
use prolog::machine::*;
use prolog::toplevel::*;
-use std::collections::{HashMap, VecDeque};
+use std::collections::{HashMap, HashSet, VecDeque};
use std::mem;
#[allow(dead_code)]
}
// throw errors if declaration or query found.
-fn compile_relation(tl: &TopLevel) -> Result<Code, ParserError>
+fn compile_relation(tl: &TopLevel, non_counted_bt: bool) -> Result<Code, ParserError>
{
- let mut cg = CodeGenerator::<DebrayAllocator>::new();
+ let mut cg = CodeGenerator::<DebrayAllocator>::new(non_counted_bt);
match tl {
&TopLevel::Declaration(_) | &TopLevel::Query(_) =>
}
}
-fn compile_appendix(code: &mut Code, queue: Vec<TopLevel>) -> Result<(), ParserError>
+fn compile_appendix(code: &mut Code, queue: Vec<TopLevel>, non_counted_bt: bool) -> Result<(), ParserError>
{
for tl in queue.iter() {
set_first_index(code);
- code.append(&mut compile_relation(tl)?);
+ code.append(&mut compile_relation(tl, non_counted_bt)?);
}
Ok(())
fn compile_query(terms: Vec<QueryTerm>, queue: Vec<TopLevel>) -> Result<(Code, AllocVarDict), ParserError>
{
- let mut cg = CodeGenerator::<DebrayAllocator>::new();
+ let mut cg = CodeGenerator::<DebrayAllocator>::new(false); // count backtracking inferences.
let mut code = try!(cg.compile_query(&terms));
- compile_appendix(&mut code, queue)?;
+ compile_appendix(&mut code, queue, false)?;
Ok((code, cg.take_vars()))
}
Err(SessionError::NamelessEntry)
});
- let mut code = try_eval_session!(compile_relation(&tl));
- try_eval_session!(compile_appendix(&mut code, queue));
+ let mut code = try_eval_session!(compile_relation(&tl, false));
+ try_eval_session!(compile_appendix(&mut code, queue, false));
if !code.is_empty() {
wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap())
pub struct ListingCompiler<'a> {
wam: &'a mut Machine,
+ non_counted_bt_preds: HashSet<PredicateKey>,
module: Option<Module>
}
impl<'a> ListingCompiler<'a> {
pub fn new(wam: &'a mut Machine) -> Self {
- ListingCompiler { wam, module: None }
+ ListingCompiler { wam,
+ module: None,
+ non_counted_bt_preds: HashSet::new() }
}
fn get_module_name(&self) -> ClauseName {
cl.name().map(|name| (name, arity))
}).ok_or(SessionError::NamelessEntry)?;
+ let non_counted_bt = self.non_counted_bt_preds.contains(&(name.clone(), arity));
+
let p = code.len() + self.wam.code_size();
- let mut decl_code = compile_relation(&TopLevel::Predicate(decl))?;
+ let mut decl_code = compile_relation(&TopLevel::Predicate(decl), non_counted_bt)?;
- compile_appendix(&mut decl_code, Vec::from(queue))?;
+ compile_appendix(&mut decl_code, Vec::from(queue), non_counted_bt)?;
+// println!("\n{}/{}:\n", name.as_str(), arity);
+
let idx = code_dir.entry((name, arity)).or_insert(CodeIndex::default());
set_code_index!(idx, IndexPtr::Index(p), self.get_module_name());
+// print_code(&decl_code);
+
code.extend(decl_code.into_iter());
}
self.wam.add_batched_ops(op_dir);
}
}
+
+ fn add_non_counted_bt_flag(&mut self, name: ClauseName, arity: usize) {
+ self.non_counted_bt_preds.insert((name, arity));
+ }
}
fn use_module(module: &mut Option<Module>, submodule: &Module, indices: &mut MachineCodeIndices)
while let Some(decl) = try_eval_session!(worker.consume(&mut indices)) {
match decl {
+ Declaration::NonCountedBacktracking(name, arity) =>
+ compiler.add_non_counted_bt_flag(name, arity),
Declaration::Op(op_decl) =>
try_eval_session!(op_decl.submit(compiler.get_module_name(), &mut indices.op_dir)),
Declaration::UseModule(name) =>
impl fmt::Display for ChoiceInstruction {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
- match self {
+ match self {
&ChoiceInstruction::TryMeElse(offset) =>
write!(f, "try_me_else {}", offset),
+ &ChoiceInstruction::DefaultRetryMeElse(offset) =>
+ write!(f, "retry_me_else_by_default {}", offset),
&ChoiceInstruction::RetryMeElse(offset) =>
write!(f, "retry_me_else {}", offset),
+ &ChoiceInstruction::DefaultTrustMe =>
+ write!(f, "trust_me_by_default"),
&ChoiceInstruction::TrustMe =>
write!(f, "trust_me")
}
(:)/2, call_with_inference_limit/3, catch/3,
setup_call_cleanup/3, throw/1, true/0, false/0]).
+/* this is an implementation specific declarative operator used to implement call_with_inference_limit/3
+ and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice
+ instructions are unchanged. */
+:- op(700, fx, non_counted_backtracking).
+
% arithmetic operators.
:- op(700, xfx, is).
:- op(500, yfx, +).
% control operators.
-','(G1, G2) :- '$get_cp'(B), ','(G1, G2, B).
+','(G1, G2) :- '$get_b_value'(B), ','(G1, G2, B).
+:- non_counted_backtracking (,)/3.
','(!, ','(G1, G2), B) :- '$set_cp'(B), ','(G1, G2, B).
','(!, !, B) :- '$set_cp'(B).
','(!, G, B) :- '$set_cp'(B), G.
','(G, !, B) :- !, G, '$set_cp'(B).
','(G1, G2, _) :- G1, G2.
-;(G1, G2) :- '$get_cp'(B), ;(G1, G2, B).
+;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B).
+:- non_counted_backtracking (;)/3.
;(G1, G4, B) :- compound(G1), G1 = ->(G2, G3), (G2 -> G3 ; '$set_cp'(B), G4).
;(G1, G2, B) :- G1 == !, '$set_cp'(B), call(G2).
;(G1, G2, B) :- G2 == !, call(G2), '$set_cp'(B).
;(G, _, _) :- G.
;(_, G, _) :- G.
-G1 -> G2 :- '$get_cp'(B), ->(G1, G2, B).
+G1 -> G2 :- '$get_b_value'(B), ->(G1, G2, B).
+:- non_counted_backtracking (->)/3.
->(G1, G2, B) :- G2 == !, call(G1), !, '$set_cp'(B).
->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
setup_call_cleanup(S, G, C) :- '$get_b_value'(B),
S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
- ( var(C) -> throw(error(instantiation_error, setup_call_cleanup/3))
- ; scc_helper(C, G, 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 scc_helper/3.
scc_helper(C, G, Bb) :-
'$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
- ( '$check_cp'(Cp) -> '$reset_block'(Bb), run_cleaners_without_handling(Cp)
- ; true
+ ( '$check_cp'(Cp) -> '$reset_block'(Bb),
+ '$call_with_default_policy'(run_cleaners_without_handling(Cp))
+ ; '$call_with_default_policy'(true)
; '$reset_block'(NBb), '$fail').
scc_helper(_, _, Bb) :-
'$reset_block'(Bb), '$get_ball'(Ball),
- run_cleaners_with_handling, throw(Ball).
+ '$call_with_default_policy'(run_cleaners_with_handling),
+ '$erase_ball',
+ '$call_with_default_policy'(throw(Ball)).
scc_helper(_, _, _) :-
- '$get_cp'(Cp), run_cleaners_without_handling(Cp), '$fail'.
+ '$get_cp'(Cp),
+ '$call_with_default_policy'(run_cleaners_without_handling(Cp)),
+ '$fail'.
+:- non_counted_backtracking run_cleaners_with_handling/0.
run_cleaners_with_handling :-
- '$get_scc_cleaner'(C), '$get_level'(B), catch(C, _, true), '$set_cp_by_default'(B),
- run_cleaners_with_handling.
+ '$get_scc_cleaner'(C), '$get_level'(B),
+ '$call_with_default_policy'(catch(C, _, true)),
+ '$set_cp_by_default'(B),
+ '$call_with_default_policy'(run_cleaners_with_handling).
run_cleaners_with_handling :-
'$restore_cut_policy'.
+:- 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),
- run_cleaners_without_handling(Cp).
+ '$call_with_default_policy'(run_cleaners_without_handling(Cp)).
run_cleaners_without_handling(Cp) :-
'$set_cp_by_default'(Cp), '$restore_cut_policy'.
'$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
'$remove_call_policy_check'(B).
+:- non_counted_backtracking call_with_inference_limit/5.
call_with_inference_limit(G, L, R, Bb, B) :-
'$install_new_block'(NBb),
'$install_inference_counter'(B, L, Count0),
'$remove_inference_counter'(B, _),
( '$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)).
+:- non_counted_backtracking end_block/4.
end_block(_, Bb, NBb, L) :-
'$clean_up_block'(NBb),
'$reset_block'(Bb).
'$reset_block'(NBb),
'$fail'.
+:- non_counted_backtracking handle_ile/3.
handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
-handle_ile(B, _, _) :- '$remove_call_policy_check'(B), '$unwind_stack'. % throw(E).
+handle_ile(B, E, _) :-
+ '$remove_call_policy_check'(B),
+ '$call_with_default_policy'(throw(E)).
% exceptions.
-catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb).
+catch(G,C,R) :- '$get_current_block'(Bb), '$call_with_default_policy'(catch(G,C,R,Bb)).
-catch(G,C,R,Bb) :- '$install_new_block'(NBb), call(G), end_block(Bb, NBb).
-catch(G,C,R,Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), handle_ball(Ball, C, R).
+:- non_counted_backtracking catch/4.
+catch(G,C,R,Bb) :-
+ '$install_new_block'(NBb), call(G),
+ '$call_with_default_policy'(end_block(Bb, NBb)).
+catch(G,C,R,Bb) :-
+ '$reset_block'(Bb),
+ '$get_ball'(Ball),
+ '$call_with_default_policy'(handle_ball(Ball, C, R)).
+:- non_counted_backtracking end_block/2.
end_block(Bb, NBb) :- '$clean_up_block'(NBb), '$reset_block'(Bb).
end_block(Bb, NBb) :- '$reset_block'(NBb), '$fail'.
+:- non_counted_backtracking handle_ball/3.
handle_ball(C, C, R) :- !, '$erase_ball', call(R).
handle_ball(_, _, _) :- '$unwind_stack'.
pub trait CodeDirsAdapter<'a> {
fn get_code_index(&self, PredicateKey, ClauseName) -> Option<CodeIndex>;
fn get_op(&self, OpDirKey) -> Option<(Specifier, usize, ClauseName)>;
+ fn op_dir(&self) -> &OpDir;
}
impl<'a> CodeDirsAdapter<'a> for CodeDirs<'a> {
fn get_op(&self, key: OpDirKey) -> Option<(Specifier, usize, ClauseName)> {
self.op_dir.get(&key).cloned()
}
+
+ fn op_dir(&self) -> &OpDir {
+ &self.op_dir
+ }
}
impl<'a> CodeDirsAdapter<'a> for &'a Module {
fn get_op(&self, key: OpDirKey) -> Option<(Specifier, usize, ClauseName)> {
self.op_dir.get(&key).cloned()
}
+
+ fn op_dir(&self) -> &OpDir {
+ &self.op_dir
+ }
}
pub(super) struct DuplicateTerm<'a> {
}
fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType,
- code_dirs: CodeDirs<'a>)
+ code_dirs: Box<CodeDirsAdapter<'a> + 'a>)
-> CallResult
{
match ct {
&BuiltInClauseType::Read => {
let mut reader = Reader::new(machine_st);
- match reader.read_stdin(code_dirs.op_dir) {
+ match reader.read_stdin(code_dirs.op_dir()) {
Ok(offset) => {
let addr = reader.machine_st[temp_v!(1)].clone();
reader.machine_st.unify(addr, Addr::HeapCell(offset));
machine_st.p = CodePtr::CallN(arity, machine_st.p.local());
},
- ClauseType::BuiltIn(built_in) =>
- machine_st.setup_built_in_call(built_in),
+ ClauseType::BuiltIn(built_in) => {
+ machine_st.setup_built_in_call(built_in.clone());
+ self.call_builtin(machine_st, &built_in, code_dirs)?;
+ },
ClauseType::Inlined(inlined) =>
machine_st.execute_inlined(&inlined),
ClauseType::Op(..) | ClauseType::Named(..) =>
}
fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType,
- code_dirs: CodeDirs<'a>)
+ code_dirs: Box<CodeDirsAdapter<'a> + 'a>)
-> CallResult
{
self.prev_policy.call_builtin(machine_st, ct, code_dirs)?;
},
&ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => {
self.last_call = lco;
- try_or_fail!(self, call_policy.call_builtin(self, ct, code_dirs));
+ try_or_fail!(self, call_policy.call_builtin(self, ct, Box::new(code_dirs)));
},
&ControlInstruction::CallClause(ClauseType::Inlined(ref ct), ..) =>
self.execute_inlined(ct),
pub(super) fn execute_choice_instr(&mut self, instr: &ChoiceInstruction,
call_policy: &mut Box<CallPolicy>)
{
- match instr {
+ match instr {
&ChoiceInstruction::TryMeElse(offset) => {
let n = self.num_of_args;
let gi = self.next_global_index();
self.hb = self.heap.h;
self.p += 1;
},
+ &ChoiceInstruction::DefaultRetryMeElse(offset) => {
+ let mut call_policy = DefaultCallPolicy {};
+ try_or_fail!(self, call_policy.retry_me_else(self, offset))
+ },
+ &ChoiceInstruction::DefaultTrustMe => {
+ let mut call_policy = DefaultCallPolicy {};
+ try_or_fail!(self, call_policy.trust_me(self))
+ },
&ChoiceInstruction::RetryMeElse(offset) =>
try_or_fail!(self, call_policy.retry_me_else(self, offset)),
&ChoiceInstruction::TrustMe =>
fn setup_declaration(term: Term) -> Result<Declaration, ParserError>
{
match term {
- Term::Clause(_, name, terms, _) =>
+ Term::Clause(_, name, mut terms, _) =>
if name.as_str() == "op" && terms.len() == 3 {
Ok(Declaration::Op(setup_op_decl(terms)?))
} else if name.as_str() == "module" && terms.len() == 2 {
} else if name.as_str() == "use_module" && terms.len() == 2 {
let (name, exports) = setup_qualified_import(terms)?;
Ok(Declaration::UseQualifiedModule(name, exports))
+ } else if name.as_str() == "non_counted_backtracking" && terms.len() == 1 {
+ let (name, arity) = setup_predicate_export(*terms.pop().unwrap())?;
+ Ok(Declaration::NonCountedBacktracking(name, arity))
} else {
Err(ParserError::InconsistentEntry)
},
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 | _22])", "Pairs = [a-a | Pairs]"]]);
+ [["E = type_error(list, [a-a | _26])", "Pairs = [a-a | Pairs]"]]);
assert_prolog_success!(&mut wam, "?- keysort([], L).",
[["L = []"]]);
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, _13)"]]);
+ [["E = type_error(list, _17)"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [_|b]), error(E, _), true).",
- [["E = type_error(list, [_24 | b])"]]);
+ [["E = type_error(list, [_28 | 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).",
assert_prolog_success!(&mut wam, "?- sort([], L).",
[["L = []"]]);
assert_prolog_success!(&mut wam, "?- catch(sort(_, []), error(E, _), true).",
- [["E = type_error(list, _13)"]]);
+ [["E = type_error(list, _17)"]]);
assert_prolog_success!(&mut wam, "?- catch(sort([a,b,c], not_a_list), error(E, _), true).",
[["E = type_error(list, not_a_list)"]]);
assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).",
[["G = 2", "B = 3"]]);
-
- /*
+
assert_prolog_success!(&mut wam, "?- call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),writeq(S+G>B)), B=3, !), 100, R).",
[["G = 2", "B = 3", "R = !", "S = 1"]]);
assert_prolog_success!(&mut wam, "?- call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),writeq(S+G>B)), B=3, !), 10, R).",
[["S = _1", "G = _4", "B = _14", "R = inference_limit_exceeded"]]);
- */
}
#[test]
projects / scryer-prolog.git / commitdiff