rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

complete call_with_inference_limit/3

Browse Source
This commit is contained in:
Mark Thom
2018-08-09 00:31:41 -06:00
parent 3fef717677
commit 0cc4aa77ed
10 changed files with 146 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@@ -29,7 +29,7 @@ Extend rusty-wam to include the following, among other features:
* A revised, not-terrible module system (_done, I think_). * A revised, not-terrible module system (_done, I think_).
* Built-in predicates for list processing and top-level declarative * Built-in predicates for list processing and top-level declarative
control (`setup_call_control/3`, `call_with_inference_limit/3`, control (`setup_call_control/3`, `call_with_inference_limit/3`,
etc.) (_IN REVISION_) etc.) (_done_)
* Definite Clause Grammars * Definite Clause Grammars
* Attributed variables using the SICStus Prolog interface and * Attributed variables using the SICStus Prolog interface and
semantics. Adding coroutines like `dif/2`, `freeze/2`, etc. semantics. Adding coroutines like `dif/2`, `freeze/2`, etc.
@@ -131,6 +131,7 @@ The following predicates are built-in to rusty-wam.
* `between/3` * `between/3`
* `call/1..62` * `call/1..62`
* `call_cleanup/2` * `call_cleanup/2`
* `call_with_inference_limit/3`
* `catch/3` * `catch/3`
* `compare/3` * `compare/3`
* `compound/1` * `compound/1`

5
src/prolog/ast.rs
View File

@@ -262,6 +262,7 @@ pub trait SubModuleUser {
} }
pub enum Declaration { pub enum Declaration {
NonCountedBacktracking(ClauseName, usize), // name, arity
Module(ModuleDecl), Module(ModuleDecl),
Op(OpDecl), Op(OpDecl),
UseModule(ClauseName), UseModule(ClauseName),
@@ -538,7 +539,7 @@ pub enum Constant {
impl Constant { impl Constant {
pub fn to_atom(self) -> Option<ClauseName> { pub fn to_atom(self) -> Option<ClauseName> {
match self { match self {
Constant::Atom(a) => Some(a), Constant::Atom(a) => Some(a.defrock_brackets()),
_ => None _ => None
} }
} }
@@ -1042,6 +1043,8 @@ impl<'a> TermRef<'a> {
#[derive(Clone)] #[derive(Clone)]
pub enum ChoiceInstruction { pub enum ChoiceInstruction {
DefaultRetryMeElse(usize),
DefaultTrustMe,
RetryMeElse(usize), RetryMeElse(usize),
TrustMe, TrustMe,
TryMeElse(usize) TryMeElse(usize)

32
src/prolog/codegen.rs
View File

@@ -13,7 +13,8 @@ use std::vec::Vec;
pub struct CodeGenerator<TermMarker> { pub struct CodeGenerator<TermMarker> {
marker: TermMarker, marker: TermMarker,
var_count: HashMap<Rc<Var>, usize> var_count: HashMap<Rc<Var>, usize>,
non_counted_bt: bool
} }
pub struct ConjunctInfo<'a> { pub struct ConjunctInfo<'a> {
@@ -43,9 +44,10 @@ impl<'a> ConjunctInfo<'a>
impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker>
{ {
pub fn new() -> Self { pub fn new(non_counted_bt: bool) -> Self {
CodeGenerator { marker: Allocator::new(), CodeGenerator { marker: Allocator::new(),
var_count: HashMap::new() } var_count: HashMap::new(),
non_counted_bt }
} }
pub fn take_vars(self) -> AllocVarDict { pub fn take_vars(self) -> AllocVarDict {
@@ -671,6 +673,22 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker>
subseqs 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]) fn compile_pred_subseq<'b: 'a>(&mut self, clauses: &'b [PredicateClause])
-> Result<Code, ParserError> -> Result<Code, ParserError>
{ {
@@ -692,8 +710,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker>
if num_clauses > 1 { if num_clauses > 1 {
let choice = match i { let choice = match i {
0 => ChoiceInstruction::TryMeElse(clause_code.len() + 1), 0 => ChoiceInstruction::TryMeElse(clause_code.len() + 1),
_ if i == num_clauses - 1 => ChoiceInstruction::TrustMe, _ if i == num_clauses - 1 => self.trust_me(),
_ => ChoiceInstruction::RetryMeElse(clause_code.len() + 1) _ => self.retry_me_else(clause_code.len() + 1)
}; };
code_body.push(Line::Choice(choice)); code_body.push(Line::Choice(choice));
@@ -726,8 +744,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker>
if multi_seq { if multi_seq {
let choice = match l { let choice = match l {
0 => ChoiceInstruction::TryMeElse(code_segment.len() + 1), 0 => ChoiceInstruction::TryMeElse(code_segment.len() + 1),
_ if r == clauses.len() => ChoiceInstruction::TrustMe, _ if r == clauses.len() => self.trust_me(),
_ => ChoiceInstruction::RetryMeElse(code_segment.len() + 1) _ => self.retry_me_else(code_segment.len() + 1)
}; };
code.push(Line::Choice(choice)); code.push(Line::Choice(choice));

39
src/prolog/compile.rs
View File

@@ -4,7 +4,7 @@ use prolog::codegen::*;
use prolog::machine::*; use prolog::machine::*;
use prolog::toplevel::*; use prolog::toplevel::*;
use std::collections::{HashMap, VecDeque}; use std::collections::{HashMap, HashSet, VecDeque};
use std::mem; use std::mem;
#[allow(dead_code)] #[allow(dead_code)]
@@ -48,9 +48,9 @@ pub fn parse_code(wam: &mut Machine, buffer: &str) -> Result<TopLevelPacket, Par
} }
// throw errors if declaration or query found. // 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 { match tl {
&TopLevel::Declaration(_) | &TopLevel::Query(_) => &TopLevel::Declaration(_) | &TopLevel::Query(_) =>
@@ -82,11 +82,11 @@ fn set_first_index(code: &mut Code)
} }
} }
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() { for tl in queue.iter() {
set_first_index(code); set_first_index(code);
code.append(&mut compile_relation(tl)?); code.append(&mut compile_relation(tl, non_counted_bt)?);
} }
Ok(()) Ok(())
@@ -94,10 +94,10 @@ fn compile_appendix(code: &mut Code, queue: Vec<TopLevel>) -> Result<(), ParserE
fn compile_query(terms: Vec<QueryTerm>, queue: Vec<TopLevel>) -> Result<(Code, AllocVarDict), ParserError> 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)); let mut code = try!(cg.compile_query(&terms));
compile_appendix(&mut code, queue)?; compile_appendix(&mut code, queue, false)?;
Ok((code, cg.take_vars())) Ok((code, cg.take_vars()))
} }
@@ -122,8 +122,8 @@ fn compile_decl(wam: &mut Machine, tl: TopLevel, queue: Vec<TopLevel>) -> EvalSe
Err(SessionError::NamelessEntry) Err(SessionError::NamelessEntry)
}); });
let mut code = try_eval_session!(compile_relation(&tl)); let mut code = try_eval_session!(compile_relation(&tl, false));
try_eval_session!(compile_appendix(&mut code, queue)); try_eval_session!(compile_appendix(&mut code, queue, false));
if !code.is_empty() { if !code.is_empty() {
wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap()) wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap())
@@ -149,12 +149,15 @@ pub fn compile_packet(wam: &mut Machine, tl: TopLevelPacket) -> EvalSession
pub struct ListingCompiler<'a> { pub struct ListingCompiler<'a> {
wam: &'a mut Machine, wam: &'a mut Machine,
non_counted_bt_preds: HashSet<PredicateKey>,
module: Option<Module> module: Option<Module>
} }
impl<'a> ListingCompiler<'a> { impl<'a> ListingCompiler<'a> {
pub fn new(wam: &'a mut Machine) -> Self { 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 { fn get_module_name(&self) -> ClauseName {
@@ -174,14 +177,20 @@ impl<'a> ListingCompiler<'a> {
cl.name().map(|name| (name, arity)) cl.name().map(|name| (name, arity))
}).ok_or(SessionError::NamelessEntry)?; }).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 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()); let idx = code_dir.entry((name, 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());
// print_code(&decl_code);
code.extend(decl_code.into_iter()); code.extend(decl_code.into_iter());
} }
@@ -202,6 +211,10 @@ impl<'a> ListingCompiler<'a> {
self.wam.add_batched_ops(op_dir); 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) fn use_module(module: &mut Option<Module>, submodule: &Module, indices: &mut MachineCodeIndices)
@@ -231,6 +244,8 @@ fn compile_listing(wam: &mut Machine, src_str: &str, mut indices: MachineCodeInd
while let Some(decl) = try_eval_session!(worker.consume(&mut indices)) { while let Some(decl) = try_eval_session!(worker.consume(&mut indices)) {
match decl { match decl {
Declaration::NonCountedBacktracking(name, arity) =>
compiler.add_non_counted_bt_flag(name, arity),
Declaration::Op(op_decl) => Declaration::Op(op_decl) =>
try_eval_session!(op_decl.submit(compiler.get_module_name(), &mut indices.op_dir)), try_eval_session!(op_decl.submit(compiler.get_module_name(), &mut indices.op_dir)),
Declaration::UseModule(name) => Declaration::UseModule(name) =>

6
src/prolog/io.rs
View File

@@ -183,11 +183,15 @@ impl fmt::Display for IndexedChoiceInstruction {
impl fmt::Display for ChoiceInstruction { impl fmt::Display for ChoiceInstruction {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self { match self {
&ChoiceInstruction::TryMeElse(offset) => &ChoiceInstruction::TryMeElse(offset) =>
write!(f, "try_me_else {}", offset), write!(f, "try_me_else {}", offset),
&ChoiceInstruction::DefaultRetryMeElse(offset) =>
write!(f, "retry_me_else_by_default {}", offset),
&ChoiceInstruction::RetryMeElse(offset) => &ChoiceInstruction::RetryMeElse(offset) =>
write!(f, "retry_me_else {}", offset), write!(f, "retry_me_else {}", offset),
&ChoiceInstruction::DefaultTrustMe =>
write!(f, "trust_me_by_default"),
&ChoiceInstruction::TrustMe => &ChoiceInstruction::TrustMe =>
write!(f, "trust_me") write!(f, "trust_me")
} }

64
src/prolog/lib/builtins.pl
View File

@@ -8,6 +8,11 @@
(:)/2, call_with_inference_limit/3, catch/3, (:)/2, call_with_inference_limit/3, catch/3,
setup_call_cleanup/3, throw/1, true/0, false/0]). 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. % arithmetic operators.
:- op(700, xfx, is). :- op(700, xfx, is).
:- op(500, yfx, +). :- op(500, yfx, +).
@@ -67,8 +72,9 @@ false :- '$fail'.
% control operators. % 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). ','(!, ','(G1, G2), B) :- '$set_cp'(B), ','(G1, G2, B).
','(!, !, B) :- '$set_cp'(B). ','(!, !, B) :- '$set_cp'(B).
','(!, G, B) :- '$set_cp'(B), G. ','(!, G, B) :- '$set_cp'(B), G.
@@ -76,16 +82,18 @@ false :- '$fail'.
','(G, !, B) :- !, G, '$set_cp'(B). ','(G, !, B) :- !, G, '$set_cp'(B).
','(G1, G2, _) :- G1, G2. ','(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, 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) :- G1 == !, '$set_cp'(B), call(G2).
;(G1, G2, B) :- G2 == !, call(G2), '$set_cp'(B). ;(G1, G2, B) :- G2 == !, call(G2), '$set_cp'(B).
;(G, _, _) :- G. ;(G, _, _) :- G.
;(_, 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) :- G2 == !, call(G1), !, '$set_cp'(B).
->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2). ->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
@@ -152,29 +160,39 @@ univ_worker(Term, List, _) :-
setup_call_cleanup(S, G, C) :- '$get_b_value'(B), setup_call_cleanup(S, G, C) :- '$get_b_value'(B),
S, '$set_cp_by_default'(B), '$get_current_block'(Bb), S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
( var(C) -> throw(error(instantiation_error, setup_call_cleanup/3)) ( '$call_with_default_policy'(var(C)) -> throw(error(instantiation_error, setup_call_cleanup/3))
; scc_helper(C, G, Bb) ). ; '$call_with_default_policy'(scc_helper(C, G, Bb)) ).
:- non_counted_backtracking scc_helper/3.
scc_helper(C, G, Bb) :- scc_helper(C, G, Bb) :-
'$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G), '$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
( '$check_cp'(Cp) -> '$reset_block'(Bb), run_cleaners_without_handling(Cp) ( '$check_cp'(Cp) -> '$reset_block'(Bb),
; true '$call_with_default_policy'(run_cleaners_without_handling(Cp))
; '$call_with_default_policy'(true)
; '$reset_block'(NBb), '$fail'). ; '$reset_block'(NBb), '$fail').
scc_helper(_, _, Bb) :- scc_helper(_, _, Bb) :-
'$reset_block'(Bb), '$get_ball'(Ball), '$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(_, _, _) :- 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 :- run_cleaners_with_handling :-
'$get_scc_cleaner'(C), '$get_level'(B), catch(C, _, true), '$set_cp_by_default'(B), '$get_scc_cleaner'(C), '$get_level'(B),
run_cleaners_with_handling. '$call_with_default_policy'(catch(C, _, true)),
'$set_cp_by_default'(B),
'$call_with_default_policy'(run_cleaners_with_handling).
run_cleaners_with_handling :- run_cleaners_with_handling :-
'$restore_cut_policy'. '$restore_cut_policy'.
:- non_counted_backtracking run_cleaners_without_handling/1.
run_cleaners_without_handling(Cp) :- 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), 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) :- run_cleaners_without_handling(Cp) :-
'$set_cp_by_default'(Cp), '$restore_cut_policy'. '$set_cp_by_default'(Cp), '$restore_cut_policy'.
@@ -186,6 +204,7 @@ call_with_inference_limit(G, L, R) :-
'$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)), '$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
'$remove_call_policy_check'(B). '$remove_call_policy_check'(B).
:- non_counted_backtracking call_with_inference_limit/5.
call_with_inference_limit(G, L, R, Bb, B) :- call_with_inference_limit(G, L, R, Bb, B) :-
'$install_new_block'(NBb), '$install_new_block'(NBb),
'$install_inference_counter'(B, L, Count0), '$install_inference_counter'(B, L, Count0),
@@ -199,8 +218,10 @@ call_with_inference_limit(_, _, R, Bb, B) :-
'$remove_inference_counter'(B, _), '$remove_inference_counter'(B, _),
( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp) ( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp)
; '$remove_call_policy_check'(B), '$fail' ), ; '$remove_call_policy_check'(B), '$fail' ),
'$erase_ball',
'$call_with_default_policy'(handle_ile(B, Ball, R)). '$call_with_default_policy'(handle_ile(B, Ball, R)).
:- non_counted_backtracking end_block/4.
end_block(_, Bb, NBb, L) :- end_block(_, Bb, NBb, L) :-
'$clean_up_block'(NBb), '$clean_up_block'(NBb),
'$reset_block'(Bb). '$reset_block'(Bb).
@@ -209,19 +230,30 @@ end_block(B, Bb, NBb, L) :-
'$reset_block'(NBb), '$reset_block'(NBb),
'$fail'. '$fail'.
:- non_counted_backtracking handle_ile/3.
handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !. 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. % 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). :- non_counted_backtracking catch/4.
catch(G,C,R,Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), handle_ball(Ball, C, R). 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) :- '$clean_up_block'(NBb), '$reset_block'(Bb).
end_block(Bb, NBb) :- '$reset_block'(NBb), '$fail'. 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(C, C, R) :- !, '$erase_ball', call(R).
handle_ball(_, _, _) :- '$unwind_stack'. handle_ball(_, _, _) :- '$unwind_stack'.

21
src/prolog/machine/machine_state.rs
View File

@@ -85,6 +85,7 @@ impl<'a> CodeDirs<'a> {
pub trait CodeDirsAdapter<'a> { pub trait CodeDirsAdapter<'a> {
fn get_code_index(&self, PredicateKey, ClauseName) -> Option<CodeIndex>; fn get_code_index(&self, PredicateKey, ClauseName) -> Option<CodeIndex>;
fn get_op(&self, OpDirKey) -> Option<(Specifier, usize, ClauseName)>; fn get_op(&self, OpDirKey) -> Option<(Specifier, usize, ClauseName)>;
fn op_dir(&self) -> &OpDir;
} }
impl<'a> CodeDirsAdapter<'a> for CodeDirs<'a> { impl<'a> CodeDirsAdapter<'a> for CodeDirs<'a> {
@@ -95,6 +96,10 @@ impl<'a> CodeDirsAdapter<'a> for CodeDirs<'a> {
fn get_op(&self, key: OpDirKey) -> Option<(Specifier, usize, ClauseName)> { fn get_op(&self, key: OpDirKey) -> Option<(Specifier, usize, ClauseName)> {
self.op_dir.get(&key).cloned() self.op_dir.get(&key).cloned()
} }
fn op_dir(&self) -> &OpDir {
&self.op_dir
}
} }
impl<'a> CodeDirsAdapter<'a> for &'a Module { impl<'a> CodeDirsAdapter<'a> for &'a Module {
@@ -107,6 +112,10 @@ impl<'a> CodeDirsAdapter<'a> for &'a Module {
fn get_op(&self, key: OpDirKey) -> Option<(Specifier, usize, ClauseName)> { fn get_op(&self, key: OpDirKey) -> Option<(Specifier, usize, ClauseName)> {
self.op_dir.get(&key).cloned() self.op_dir.get(&key).cloned()
} }
fn op_dir(&self) -> &OpDir {
&self.op_dir
}
} }
pub(super) struct DuplicateTerm<'a> { pub(super) struct DuplicateTerm<'a> {
@@ -506,7 +515,7 @@ pub(crate) trait CallPolicy: Any {
} }
fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType,
code_dirs: CodeDirs<'a>) code_dirs: Box<CodeDirsAdapter<'a> + 'a>)
-> CallResult -> CallResult
{ {
match ct { match ct {
@@ -552,7 +561,7 @@ pub(crate) trait CallPolicy: Any {
&BuiltInClauseType::Read => { &BuiltInClauseType::Read => {
let mut reader = Reader::new(machine_st); 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) => { Ok(offset) => {
let addr = reader.machine_st[temp_v!(1)].clone(); let addr = reader.machine_st[temp_v!(1)].clone();
reader.machine_st.unify(addr, Addr::HeapCell(offset)); reader.machine_st.unify(addr, Addr::HeapCell(offset));
@@ -658,8 +667,10 @@ pub(crate) trait CallPolicy: Any {
machine_st.p = CodePtr::CallN(arity, machine_st.p.local()); machine_st.p = CodePtr::CallN(arity, machine_st.p.local());
}, },
ClauseType::BuiltIn(built_in) => ClauseType::BuiltIn(built_in) => {
machine_st.setup_built_in_call(built_in), machine_st.setup_built_in_call(built_in.clone());
self.call_builtin(machine_st, &built_in, code_dirs)?;
},
ClauseType::Inlined(inlined) => ClauseType::Inlined(inlined) =>
machine_st.execute_inlined(&inlined), machine_st.execute_inlined(&inlined),
ClauseType::Op(..) | ClauseType::Named(..) => ClauseType::Op(..) | ClauseType::Named(..) =>
@@ -720,7 +731,7 @@ impl CallPolicy for CWILCallPolicy {
} }
fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType,
code_dirs: CodeDirs<'a>) code_dirs: Box<CodeDirsAdapter<'a> + 'a>)
-> CallResult -> CallResult
{ {
self.prev_policy.call_builtin(machine_st, ct, code_dirs)?; self.prev_policy.call_builtin(machine_st, ct, code_dirs)?;

12
src/prolog/machine/machine_state_impl.rs
View File

@@ -1825,7 +1825,7 @@ impl MachineState {
}, },
&ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => { &ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => {
self.last_call = 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), ..) => &ControlInstruction::CallClause(ClauseType::Inlined(ref ct), ..) =>
self.execute_inlined(ct), self.execute_inlined(ct),
@@ -1892,7 +1892,7 @@ impl MachineState {
pub(super) fn execute_choice_instr(&mut self, instr: &ChoiceInstruction, pub(super) fn execute_choice_instr(&mut self, instr: &ChoiceInstruction,
call_policy: &mut Box<CallPolicy>) call_policy: &mut Box<CallPolicy>)
{ {
match instr { match instr {
&ChoiceInstruction::TryMeElse(offset) => { &ChoiceInstruction::TryMeElse(offset) => {
let n = self.num_of_args; let n = self.num_of_args;
let gi = self.next_global_index(); let gi = self.next_global_index();
@@ -1917,6 +1917,14 @@ impl MachineState {
self.hb = self.heap.h; self.hb = self.heap.h;
self.p += 1; 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) => &ChoiceInstruction::RetryMeElse(offset) =>
try_or_fail!(self, call_policy.retry_me_else(self, offset)), try_or_fail!(self, call_policy.retry_me_else(self, offset)),
&ChoiceInstruction::TrustMe => &ChoiceInstruction::TrustMe =>

5
src/prolog/toplevel.rs
View File

@@ -139,7 +139,7 @@ fn setup_qualified_import(mut terms: Vec<Box<Term>>) -> Result<UseModuleExport,
fn setup_declaration(term: Term) -> Result<Declaration, ParserError> fn setup_declaration(term: Term) -> Result<Declaration, ParserError>
{ {
match term { match term {
Term::Clause(_, name, terms, _) => Term::Clause(_, name, mut terms, _) =>
if name.as_str() == "op" && terms.len() == 3 { if name.as_str() == "op" && terms.len() == 3 {
Ok(Declaration::Op(setup_op_decl(terms)?)) Ok(Declaration::Op(setup_op_decl(terms)?))
} else if name.as_str() == "module" && terms.len() == 2 { } else if name.as_str() == "module" && terms.len() == 2 {
@@ -149,6 +149,9 @@ fn setup_declaration(term: Term) -> Result<Declaration, ParserError>
} else if name.as_str() == "use_module" && terms.len() == 2 { } else if name.as_str() == "use_module" && terms.len() == 2 {
let (name, exports) = setup_qualified_import(terms)?; let (name, exports) = setup_qualified_import(terms)?;
Ok(Declaration::UseQualifiedModule(name, exports)) 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 { } else {
Err(ParserError::InconsistentEntry) Err(ParserError::InconsistentEntry)
}, },

12
src/tests.rs
View File

@@ -1519,7 +1519,7 @@ fn test_queries_on_builtins()
assert_prolog_failure!(&mut wam, "?- Pairs = [a-a|Pairs], keysort(Pairs, _)."); 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).", 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).", assert_prolog_success!(&mut wam, "?- keysort([], L).",
[["L = []"]]); [["L = []"]]);
@@ -1528,9 +1528,9 @@ fn test_queries_on_builtins()
assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).", assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).",
[["Pat = type_error(list, [a | a])"]]); [["Pat = type_error(list, [a | a])"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort(_, _), error(E, _), true).", 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).", 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).", assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [a-b,c-d,a]), error(E, _), true).",
[["E = type_error(pair, a)"]]); [["E = type_error(pair, a)"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([a], [a-b]), error(E, _), true).", assert_prolog_success!(&mut wam, "?- catch(keysort([a], [a-b]), error(E, _), true).",
@@ -1543,19 +1543,17 @@ fn test_queries_on_builtins()
assert_prolog_success!(&mut wam, "?- sort([], L).", assert_prolog_success!(&mut wam, "?- sort([], L).",
[["L = []"]]); [["L = []"]]);
assert_prolog_success!(&mut wam, "?- catch(sort(_, []), error(E, _), true).", 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).", assert_prolog_success!(&mut wam, "?- catch(sort([a,b,c], not_a_list), error(E, _), true).",
[["E = type_error(list, not_a_list)"]]); [["E = type_error(list, not_a_list)"]]);
assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).", assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).",
[["G = 2", "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).", 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"]]); [["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).", 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"]]); [["S = _1", "G = _4", "B = _14", "R = inference_limit_exceeded"]]);
*/
} }
#[test] #[test]