add preliminary support for DCGs.

This commit is contained in:
Mark Thom
2018-10-07 00:07:12 -06:00
parent e7717d4f61
commit 59ad71fccc
7 changed files with 170 additions and 129 deletions

View File

@@ -100,10 +100,11 @@ fn compile_query(terms: Vec<QueryTerm>, queue: Vec<TopLevel>, flags: MachineFlag
fn compile_decl(wam: &mut Machine, compiler: &mut ListingCompiler, decl: Declaration)
-> Result<IndexStore, SessionError>
{
let flags = wam.machine_flags();
let mut indices = default_index_store!(wam.indices.atom_tbl.clone());
let wam_indices = &mut wam.indices;
compiler.process_decl(decl, wam_indices, &mut indices)?;
compiler.process_decl(decl, &mut wam.code_repo, wam_indices, &mut indices, flags)?;
Ok(indices)
}
@@ -251,13 +252,25 @@ impl ListingCompiler {
self.non_counted_bt_preds.insert((name, arity));
}
fn process_decl(&mut self, decl: Declaration, wam_indices: &mut IndexStore, indices: &mut IndexStore)
fn process_decl(&mut self, decl: Declaration, code_repo: &mut CodeRepo,
wam_indices: &mut IndexStore, indices: &mut IndexStore,
flags: MachineFlags)
-> Result<(), SessionError>
{
match decl {
Declaration::Hook(CompileTimeHook::TermExpansion, clause) =>
//Ok(wam.add_term_expansion_clause(clause)?),
Ok(()),
Declaration::Hook(CompileTimeHook::TermExpansion, clause, queue) => {
let key = (clause_name!("term_expansion"), 2);
let preds = code_repo.term_dir.entry(key).or_insert(Predicate(vec![]));
preds.0.push(clause);
let mut cg = CodeGenerator::<DebrayAllocator>::new(false, flags);
let mut code = cg.compile_predicate(&preds.0)?;
compile_appendix(&mut code, Vec::from(queue), false, flags)?;
Ok(code_repo.term_expanders = code)
},
Declaration::NonCountedBacktracking(name, arity) =>
Ok(self.add_non_counted_bt_flag(name, arity)),
Declaration::Op(op_decl) =>
@@ -300,13 +313,17 @@ impl ListingCompiler {
mem::swap(&mut worker.results, &mut toplevel_results);
worker.in_module = true;
self.process_decl(decl, worker.term_stream.indices, indices)?;
self.process_decl(decl, worker.term_stream.code_repo,
worker.term_stream.indices,
indices, flags)?;
if let &Some(ref module) = &self.module {
worker.term_stream.set_atom_tbl(module.atom_tbl.clone());
}
} else {
self.process_decl(decl, worker.term_stream.indices, indices)?;
self.process_decl(decl, worker.term_stream.code_repo,
worker.term_stream.indices,
indices, flags)?;
}
}

View File

@@ -115,6 +115,29 @@ fn is_numbered_var(ct: &ClauseType, arity: usize) -> bool {
}
}
impl MachineState {
pub fn numbervar(&self, addr: Addr) -> Option<Var> {
static CHAR_CODES: [char; 26] = ['A','B','C','D','E','F','G','H','I','J',
'K','L','M','N','O','P','Q','R','S','T',
'U','V','W','X','Y','Z'];
match self.store(self.deref(addr)) {
Addr::Con(Constant::Number(Number::Integer(ref n)))
if !n.is_negative() => {
let i = n.mod_floor(&BigInt::from(26)).to_usize().unwrap();
let j = n.div_floor(&BigInt::from(26));
Some(if j.is_zero() {
CHAR_CODES[i].to_string()
} else {
format!("{}{}", CHAR_CODES[i], j)
})
},
_ => None
}
}
}
fn print_op(ct: ClauseType, fixity: Fixity, state_stack: &mut Vec<TokenOrRedirect>) {
match fixity {
Fixity::Post => {
@@ -137,35 +160,17 @@ impl HCValueFormatter for WriteqFormatter {
fn format_clause(&self, iter: &mut HCPreOrderIterator, arity: usize,
ct: ClauseType, state_stack: &mut Vec<TokenOrRedirect>)
{
static CHAR_CODES: [char; 26] = ['A','B','C','D','E','F','G','H','I','J',
'K','L','M','N','O','P','Q','R','S','T',
'U','V','W','X','Y','Z'];
if let Some(fixity) = ct.fixity() {
return print_op(ct, fixity, state_stack);
} else if is_numbered_var(&ct, arity) {
let addr = iter.stack().last().cloned().unwrap();
// 7.10.4
match iter.machine_st.store(iter.machine_st.deref(addr)) {
Addr::Con(Constant::Number(Number::Integer(ref n))) if !n.is_negative() => {
iter.stack().pop();
let i = n.mod_floor(&BigInt::from(26)).to_usize().unwrap();
let j = n.div_floor(&BigInt::from(26));
let mut result = if j.is_zero() {
CHAR_CODES[i].to_string()
} else {
format!("{}{}", CHAR_CODES[i], j)
};
state_stack.push(TokenOrRedirect::NumberedVar(result));
return;
}
_ => {}
};
if let Some(var) = iter.machine_st.numbervar(addr) {
iter.stack().pop();
state_stack.push(TokenOrRedirect::NumberedVar(var));
return;
}
}
self.format_struct(arity, ct.name(), state_stack);

View File

@@ -1184,7 +1184,7 @@ impl SubModuleUser for Module {
}
pub enum Declaration {
Hook(CompileTimeHook, PredicateClause),
Hook(CompileTimeHook, PredicateClause, VecDeque<TopLevel>),
Module(ModuleDecl),
NonCountedBacktracking(ClauseName, usize), // name, arity
Op(OpDecl),

66
src/prolog/lib/dcgs.pl Normal file
View File

@@ -0,0 +1,66 @@
:- module(dcgs, [(-->)/2, phrase/2, phrase/3]).
:- use_module(library(lists), [append/3]).
:- op(1200, xfx, -->).
phrase(G, Ls0) :-
nonvar(G), G = [_|_], !, append(G, _, Ls0).
phrase(G, Ls0) :-
nonvar(G), G = (G1, G2), !, phrase(G1, Ls0, Ls1), phrase(G2, Ls1).
phrase(G, Ls0) :-
call(G, Ls0, _).
phrase(G, Ls0, Ls1) :-
nonvar(G), G = [_|_], !, append(G, Ls1, Ls0).
phrase(G, Ls0, Ls2) :-
nonvar(G), G = (G1, G2), !,
phrase(G1, Ls0, Ls1), phrase(G2, Ls1, Ls2).
phrase(G, Ls0, Ls1) :-
call(G, Ls0, Ls1).
term_expansion(Term0, (ModHead :- ModBody)) :-
nonvar(Term0),
Term0 = (Head, [SC | SCs] --> Body),
!,
nonvar(Head),
Head =.. [RuleName | Args],
append(Args, ['$VAR'(0), '$VAR'(N)], ModArgs),
ModHead =.. [RuleName | ModArgs],
nonvar(Body),
expand_body(Body, ModBody1, 0, N1),
expand_body_term([SC | SCs], ModBody2, N1, N),
ModBody = (ModBody1, ModBody2).
term_expansion(Term0, (ModHead :- ModBody)) :-
nonvar(Term0),
Term0 = (Head --> Body),
nonvar(Head),
Head =.. [RuleName | Args],
append(Args, ['$VAR'(0), '$VAR'(N)], ModArgs),
ModHead =.. [RuleName | ModArgs],
nonvar(Body),
expand_body(Body, ModBody, 0, N).
expand_body((Term, Terms), (ModTerm, ModTerms), N0, N) :-
!, expand_body_term(Term, ModTerm, N0, N1),
expand_body(Terms, ModTerms, N1, N).
expand_body(Term, ModTerm, N0, N) :-
expand_body_term(Term, ModTerm, N0, N).
expand_body_term([], true, N, N) :- !.
expand_body_term([Arg|Args], ModTerm, N0, N) :-
!, N is N0 + 1,
append([Arg|Args], '$VAR'(N), ModArgs),
ModTerm = ('$VAR'(N0) = ModArgs).
expand_body_term(CommaTerm, ModTerm, N, N) :-
CommaTerm =.. [{} | BodyTerms], !,
comma_ify(BodyTerms, ModTerm).
expand_body_term(GrammarRule, ModTerm, N0, N) :-
GrammarRule =.. [Name | Args],
N is N0 + 1,
append(Args, ['$VAR'(N0), '$VAR'(N)], ModArgs),
ModTerm =.. [Name | ModArgs].
comma_ify([Term], Term) :- !.
comma_ify([Term | Args], (Term, Terms)) :-
comma_ify(Terms, Args).

View File

@@ -1,9 +1,7 @@
use prolog_parser::ast::*;
use prolog_parser::tabled_rc::*;
use prolog::codegen::*;
use prolog::compile::*;
use prolog::debray_allocator::*;
use prolog::heap_print::*;
use prolog::instructions::*;
@@ -105,7 +103,8 @@ impl IndexStore {
pub struct CodeRepo {
cached_query: Option<Code>,
pub(super) term_expanders: Code,
pub(super) code: Code
pub(super) code: Code,
pub(super) term_dir: TermDir
}
impl CodeRepo {
@@ -114,7 +113,8 @@ impl CodeRepo {
CodeRepo {
cached_query: None,
term_expanders: Code::new(),
code: Code::new()
code: Code::new(),
term_dir: TermDir::new()
}
}
@@ -174,8 +174,7 @@ impl MachinePolicies {
pub struct Machine {
pub(super) machine_st: MachineState,
pub(super) policies: MachinePolicies,
pub(super) indices: IndexStore,
term_dir: TermDir,
pub(super) indices: IndexStore,
pub(super) code_repo: CodeRepo
}
@@ -255,7 +254,6 @@ impl Machine {
machine_st: MachineState::new(),
policies: MachinePolicies::new(),
indices: IndexStore::new(),
term_dir: TermDir::new(),
code_repo: CodeRepo::new()
};
@@ -342,21 +340,6 @@ impl Machine {
self.code_repo.code.len()
}
#[inline]
pub(super)
fn add_term_expansion_clause(&mut self, clause: PredicateClause) -> Result<(), ParserError>
{
let key = (clause_name!("term_expansion"), 2);
let preds = self.term_dir.entry(key).or_insert(Predicate(vec![]));
preds.0.push(clause);
let mut cg = CodeGenerator::<DebrayAllocator>::new(false, self.machine_st.flags);
let code = cg.compile_predicate(&preds.0)?;
Ok(self.code_repo.term_expanders = code)
}
fn fail(&mut self, heap_locs: &HeapVarDict) -> EvalSession
{
if self.machine_st.ball.stub.len() > 0 {

View File

@@ -1,21 +1,20 @@
use prolog_parser::ast::*;
use prolog_parser::parser::*;
use prolog::heap_iter::*;
use prolog::instructions::HeapCellValue;
use prolog::machine::*;
use prolog::read::*;
use std::cell::Cell;
use std::io::Read;
pub struct TermStream<'a, R: Read> {
stack: Vec<Term>,
pub(crate) indices: &'a mut IndexStore,
policies: &'a mut MachinePolicies,
code_repo: &'a mut CodeRepo,
pub(crate) code_repo: &'a mut CodeRepo,
parser: Parser<R>,
in_module: bool
in_module: bool,
flags: MachineFlags
}
impl<'a, R: Read> TermStream<'a, R> {
@@ -30,7 +29,8 @@ impl<'a, R: Read> TermStream<'a, R> {
policies,
code_repo,
parser: Parser::new(src, atom_tbl, flags),
in_module: false
in_module: false,
flags
}
}
@@ -38,7 +38,7 @@ impl<'a, R: Read> TermStream<'a, R> {
pub fn set_atom_tbl(&mut self, atom_tbl: TabledData<Atom>) {
self.parser.set_atom_tbl(atom_tbl);
}
#[inline]
pub fn add_to_top(&mut self, buf: &str) {
self.parser.add_to_top(buf);
@@ -49,11 +49,6 @@ impl<'a, R: Read> TermStream<'a, R> {
Ok(self.stack.is_empty() && self.parser.eof()?)
}
#[inline]
pub fn empty_tokens(&mut self) {
self.parser.reset();
}
fn enqueue_term(&mut self, term: Term) -> Result<(), ParserError> {
match term {
Term::Cons(_, head, tail) => {
@@ -77,17 +72,29 @@ impl<'a, R: Read> TermStream<'a, R> {
}
}
fn parse_expansion_output(&mut self, term_string: &str, op_dir: &OpDir) -> Result<Term, ParserError> {
let mut parser = Parser::new(term_string.trim().as_bytes(), self.indices.atom_tbl.clone(), self.flags);
parser.read_term(composite_op!(self.in_module,
&self.indices.op_dir,
op_dir))
}
pub fn read_term(&mut self, machine_st: &mut MachineState, op_dir: &OpDir)
-> Result<Term, ParserError>
{
loop {
while let Some(term) = self.stack.pop() {
match machine_st.try_expand_term(self.indices, self.policies, self.code_repo, &term)? {
Some(term) => self.enqueue_term(term)?,
match machine_st.try_expand_term(self.indices, self.policies, self.code_repo, &term)?
{
Some(term_string) => {
let term = self.parse_expansion_output(term_string.as_str(), op_dir)?;
self.enqueue_term(term)?
},
None => return Ok(term)
};
}
self.parser.reset();
let term = self.parser.read_term(composite_op!(self.in_module,
&self.indices.op_dir,
op_dir))?;
@@ -99,7 +106,7 @@ impl<'a, R: Read> TermStream<'a, R> {
impl MachineState {
fn try_expand_term(&mut self, indices: &mut IndexStore, policies: &mut MachinePolicies,
code_repo: &mut CodeRepo, term: &Term)
-> Result<Option<Term>, ParserError>
-> Result<Option<String>, ParserError>
{
let term_h = write_term_to_heap(term, self);
let h = self.heap.h;
@@ -117,55 +124,13 @@ impl MachineState {
self.reset();
Ok(None)
} else {
let term = read_term_from_heap(&self, Addr::HeapCell(h))?;
self.reset();
Ok(Some(term))
let mut output = self.print_term(Addr::HeapCell(h),
WriteqFormatter {},
PrinterOutputter::new());
output.push_char('.');
self.reset();
Ok(Some(output.result()))
}
}
}
pub fn read_term_from_heap(machine_st: &MachineState, addr: Addr) -> Result<Term, ParserError>
{
let pre_order_iter = HCPreOrderIterator::new(machine_st, addr);
let post_order_iter = HCPostOrderIterator::new(pre_order_iter);
let mut stack = vec![];
for value in post_order_iter {
match value {
HeapCellValue::NamedStr(arity, ref name, fixity)
if stack.len() >= arity => {
let stack_len = stack.len();
let subterms: Vec<_> = stack.drain(stack_len - arity ..).collect();
stack.push(Box::new(Term::Clause(Cell::default(), name.clone(), subterms,
fixity)));
},
HeapCellValue::Addr(Addr::Con(constant)) =>
stack.push(Box::new(Term::Constant(Cell::default(), constant))),
HeapCellValue::Addr(Addr::Lis(_))
if stack.len() >= 2 => {
let stack_len = stack.len();
let (head, tail) = {
let mut iter = stack.drain(stack_len - 2 ..);
(iter.next().unwrap(), iter.next().unwrap())
};
stack.push(Box::new(Term::Cons(Cell::default(), head, tail)));
},
HeapCellValue::Addr(Addr::HeapCell(h)) =>
stack.push(Box::new(Term::Var(Cell::default(), Rc::new(format!("_{}", h))))),
HeapCellValue::Addr(Addr::StackCell(fr, sc)) =>
stack.push(Box::new(Term::Var(Cell::default(), Rc::new(format!("_{}_{}", sc, fr))))),
_ => return Err(ParserError::IncompleteReduction)
}
}
if let Some(term) = stack.pop() {
if stack.is_empty() {
return Ok(*term);
}
}
Err(ParserError::IncompleteReduction)
}

View File

@@ -85,6 +85,8 @@ fn is_term_expansion(name: &ClauseName, terms: &Vec<Box<Term>>) -> bool {
false
}
type CompileTimeHookCompileInfo = (CompileTimeHook, PredicateClause, VecDeque<TopLevel>);
fn setup_fact(term: Term) -> Result<Term, ParserError>
{
match term {
@@ -621,16 +623,21 @@ impl RelationWorker {
}
fn setup_hook(&mut self, indices: &mut CompositeIndices, term: Term)
-> Result<(CompileTimeHook, PredicateClause), ParserError>
-> Result<CompileTimeHookCompileInfo, ParserError>
{
match term {
Term::Clause(r, name, terms, _) =>
if name.as_str() == "term_expansion" && terms.len() == 2 {
let term = Term::Clause(r, name, terms, None);
Ok((CompileTimeHook::TermExpansion, PredicateClause::Fact(term)))
let term = setup_fact(Term::Clause(r, name, terms, None))?;
Ok((CompileTimeHook::TermExpansion, PredicateClause::Fact(term),
VecDeque::from(vec![])))
} else if name.as_str() == ":-" {
let rule = self.setup_rule(indices, terms, false)?;
Ok((CompileTimeHook::TermExpansion, PredicateClause::Rule(rule)))
let rule = self.setup_rule(indices, terms, true)?;
let results_queue = self.parse_queue(indices)?;
Ok((CompileTimeHook::TermExpansion, PredicateClause::Rule(rule),
results_queue))
} else {
Err(ParserError::InvalidHook)
},
@@ -638,7 +645,8 @@ impl RelationWorker {
}
}
fn setup_rule(&mut self, indices: &mut CompositeIndices, mut terms: Vec<Box<Term>>, blocks_cuts: bool)
fn setup_rule(&mut self, indices: &mut CompositeIndices, mut terms: Vec<Box<Term>>,
blocks_cuts: bool)
-> Result<Rule, ParserError>
{
let post_head_terms = terms.drain(1..).collect();
@@ -662,9 +670,9 @@ impl RelationWorker {
Term::Clause(r, name, mut terms, fixity) =>
if is_term_expansion(&name, &terms) {
let term = Term::Clause(r, name, terms, fixity);
let (hook, clauses) = self.setup_hook(indices, term)?;
let (hook, clause, queue) = self.setup_hook(indices, term)?;
Ok(TopLevel::Declaration(Declaration::Hook(hook, clauses)))
Ok(TopLevel::Declaration(Declaration::Hook(hook, clause, queue)))
} else if name.as_str() == "?-" {
Ok(TopLevel::Query(try!(self.setup_query(indices, terms, blocks_cuts))))
} else if name.as_str() == ":-" && terms.len() > 1 {
@@ -702,7 +710,7 @@ impl RelationWorker {
queue.push_back(clauses);
}
Ok(queue)
}
@@ -766,16 +774,13 @@ impl<'a, R: Read> TopLevelBatchWorker<'a, R> {
let mut preds = vec![];
while !self.term_stream.eof()? {
// empty the parser stack of token descriptions.
self.term_stream.empty_tokens();
let mut new_rel_worker = RelationWorker::new();
let term = self.term_stream.read_term(machine_st, &indices.op_dir)?;
let mut indices =
composite_indices!(self.in_module, indices,
&mut self.term_stream.indices.code_dir);
let tl = new_rel_worker.try_term_to_tl(&mut indices, term, true)?;
// if is_consistent returns false, preds is non-empty.