incorporate term_expansion phase in compilation

This commit is contained in:
Mark Thom
2018-09-18 22:44:03 -06:00
parent 78ef18ad75
commit 908972eff1
10 changed files with 211 additions and 89 deletions

View File

@@ -39,8 +39,7 @@ fn prolog_repl() {
wam.clear();
continue;
},
Err(e) =>
print(&mut wam, EvalSession::from(e))
Err(e) => print(&mut wam, EvalSession::from(e))
};
wam.reset();

View File

@@ -337,10 +337,22 @@ pub enum BuiltInClauseType {
Sort,
}
#[derive(Clone, Copy)]
pub enum CompileTimeHook {
TermExpansion
}
impl CompileTimeHook {
pub fn name(self) -> ClauseName {
clause_name!("term_expansion")
}
}
#[derive(Clone)]
pub enum ClauseType {
BuiltIn(BuiltInClauseType),
CallN,
Hook(CompileTimeHook),
Inlined(InlinedClauseType),
Named(ClauseName, CodeIndex),
Op(ClauseName, Fixity, CodeIndex),
@@ -442,6 +454,7 @@ impl ClauseType {
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()),
&ClauseType::Op(ref name, ..) => name.clone(),
&ClauseType::Named(ref name, ..) => name.clone(),
@@ -840,7 +853,7 @@ impl CodePtr {
match self {
&CodePtr::BuiltInClause(_, ref local)
| &CodePtr::CallN(_, ref local)
| &CodePtr::Local(ref local) => local.clone()
| &CodePtr::Local(ref local) => local.clone()
}
}
}
@@ -849,6 +862,7 @@ impl CodePtr {
pub enum LocalCodePtr {
DirEntry(usize, ClauseName), // offset, resident module name.
TopLevel(usize, usize), // chunk_num, offset.
UserTermExpansion(usize)
}
impl LocalCodePtr {
@@ -901,7 +915,8 @@ impl Add<usize> for LocalCodePtr {
fn add(self, rhs: usize) -> Self::Output {
match self {
LocalCodePtr::DirEntry(p, name) => LocalCodePtr::DirEntry(p + rhs, name),
LocalCodePtr::TopLevel(cn, p) => LocalCodePtr::TopLevel(cn, p + rhs)
LocalCodePtr::TopLevel(cn, p) => LocalCodePtr::TopLevel(cn, p + rhs),
LocalCodePtr::UserTermExpansion(p) => LocalCodePtr::UserTermExpansion(p + rhs)
}
}
}
@@ -909,8 +924,9 @@ impl Add<usize> for LocalCodePtr {
impl AddAssign<usize> for LocalCodePtr {
fn add_assign(&mut self, rhs: usize) {
match self {
&mut LocalCodePtr::DirEntry(ref mut p, _) |
&mut LocalCodePtr::TopLevel(_, ref mut p) => *p += rhs
&mut LocalCodePtr::UserTermExpansion(ref mut p)
| &mut LocalCodePtr::DirEntry(ref mut p, _)
| &mut LocalCodePtr::TopLevel(_, ref mut p) => *p += rhs
}
}
}

View File

@@ -10,8 +10,6 @@ numbervars(Term, NewTerm, N) :-
numbervars(Term, NewTerm, N1, N2) :-
var(Term), !, NewTerm = '$VAR'(N1), N2 is N1 + 1.
numbervars([Arg | Args], NewTerms, N1, N2) :- !,
fold_numbervars([Arg | Args], NewTerms, N1, N2).
numbervars(Term, NewTerm, N1, N2) :- compound(Term), !,
Term =.. [Name | Args],
NewTerm =.. [Name | NewArgs],

View File

@@ -527,7 +527,7 @@ pub(crate) trait CallPolicy: Any {
machine_st.fail = !machine_st.is_cyclic_term(addr);
return_from_clause!(machine_st.last_call, machine_st)
},
&BuiltInClauseType::Read => {
&BuiltInClauseType::Read => {
match machine_st.read(stdin(), &indices.op_dir) {
Ok(offset) => {
let addr = machine_st[temp_v!(1)].clone();
@@ -642,6 +642,17 @@ pub(crate) trait CallPolicy: Any {
}
}
fn compile_hook(&mut self, machine_st: &mut MachineState, _: &CompileTimeHook) -> CallResult
{
machine_st.cp = LocalCodePtr::TopLevel(0, 0);
machine_st.num_of_args = 2;
machine_st.b0 = machine_st.b;
machine_st.p = CodePtr::Local(LocalCodePtr::UserTermExpansion(0));
Ok(())
}
fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize,
indices: MachineCodeIndices<'a>) //code_dirs: CodeDirs)
-> CallResult
@@ -674,7 +685,7 @@ pub(crate) trait CallPolicy: Any {
return Err(machine_st.error_form(MachineError::existence_error(h, name, arity),
stub));
},
ClauseType::System(_) => {
ClauseType::Hook(_) | ClauseType::System(_) => {
let name = Addr::Con(Constant::Atom(name, None));
let stub = MachineError::functor_stub(clause_name!("call"), arity + 1);

View File

@@ -196,7 +196,7 @@ impl MachineState {
self.fail = true;
},
(Addr::Lis(a1), Addr::Con(Constant::String(ref mut s)))
| (Addr::Con(Constant::String(ref mut s)), Addr::Lis(a1))
| (Addr::Con(Constant::String(ref mut s)), Addr::Lis(a1))
if self.flags.double_quotes.is_chars() => {
if let Some(c) = s.head() {
pdl.push(Addr::Con(Constant::String(s.tail())));
@@ -233,7 +233,7 @@ impl MachineState {
self.fail = true;
},
(Addr::Con(Constant::EmptyList), Addr::Con(Constant::String(ref s)))
| (Addr::Con(Constant::String(ref s)), Addr::Con(Constant::EmptyList))
| (Addr::Con(Constant::String(ref s)), Addr::Con(Constant::EmptyList))
if self.flags.double_quotes.is_chars() => {
if s.is_expandable() && s.is_empty() {
s.set_non_expandable();
@@ -314,7 +314,7 @@ impl MachineState {
}
}
}
fn trail(&mut self, r: Ref) {
match r {
Ref::HeapCell(hc) =>
@@ -1457,7 +1457,7 @@ impl MachineState {
for (v1, v2) in iter {
match (v1, v2) {
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Con(Constant::String(_))))
| (HeapCellValue::Addr(Addr::Con(Constant::String(_))), HeapCellValue::Addr(Addr::Lis(_)))
| (HeapCellValue::Addr(Addr::Con(Constant::String(_))), HeapCellValue::Addr(Addr::Lis(_)))
if self.flags.double_quotes.is_chars() => {},
(HeapCellValue::Addr(Addr::Con(Constant::EmptyList)),
HeapCellValue::Addr(Addr::Con(Constant::String(ref s))))
@@ -1577,7 +1577,7 @@ impl MachineState {
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) =>
continue,
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::NamedStr(ar, n, _))
| (HeapCellValue::NamedStr(ar, n, _), HeapCellValue::Addr(Addr::Lis(_))) =>
| (HeapCellValue::NamedStr(ar, n, _), HeapCellValue::Addr(Addr::Lis(_))) =>
if ar == 2 && n.as_str() == "." {
continue;
} else if ar < 2 {
@@ -2045,7 +2045,7 @@ impl MachineState {
self.p += 1;
}
fn handle_call_clause<'a>(&mut self, indices: MachineCodeIndices<'a>,
call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>,
@@ -2068,6 +2068,8 @@ impl MachineState {
try_or_fail!(self, call_policy.call_builtin(self, ct, indices)),
&ClauseType::CallN =>
try_or_fail!(self, call_policy.call_n(self, arity, indices)),
&ClauseType::Hook(ref hook) =>
try_or_fail!(self, call_policy.compile_hook(self, hook)),
&ClauseType::Inlined(ref ct) =>
self.execute_inlined(ct),
&ClauseType::Named(ref name, ref idx) | &ClauseType::Op(ref name, _, ref idx) =>
@@ -2087,8 +2089,8 @@ impl MachineState {
&ControlInstruction::Allocate(num_cells) =>
self.allocate(num_cells),
&ControlInstruction::CallClause(ref ct, arity, _, lco, use_default_cp) =>
self.handle_call_clause(indices, call_policy, cut_policy, ct, arity, lco,
use_default_cp),
self.handle_call_clause(indices, call_policy, cut_policy,
ct, arity, lco, use_default_cp),
&ControlInstruction::Deallocate => self.deallocate(),
&ControlInstruction::JmpBy(arity, offset, _, lco) => {
if !lco {

View File

@@ -7,6 +7,7 @@ use prolog::heap_print::*;
mod machine_errors;
pub(super) mod machine_state;
pub(super) mod term_expansion;
#[macro_use] mod machine_state_impl;
mod system_calls;
@@ -53,7 +54,8 @@ pub struct Machine {
code: Code,
pub(super) code_dir: Rc<RefCell<CodeDir>>,
pub(super) op_dir: OpDir,
// term_dir: TermDir,
term_dir: TermDir,
term_expanders: Code,
pub(super) modules: ModuleDir,
cached_query: Option<Code>
}
@@ -80,7 +82,8 @@ impl Index<LocalCodePtr> for Machine {
&None => panic!("Out-of-bounds top level index.")
}
},
LocalCodePtr::DirEntry(p, _) => &self.code[p]
LocalCodePtr::DirEntry(p, _) => &self.code[p],
LocalCodePtr::UserTermExpansion(p) => &self.term_expanders[p]
}
}
}
@@ -115,6 +118,7 @@ impl<'a> SubModuleUser for MachineCodeIndices<'a> {
static LISTS: &str = include_str!("../lib/lists.pl");
static CONTROL: &str = include_str!("../lib/control.pl");
static QUEUES: &str = include_str!("../lib/queues.pl");
static NUMVARS: &str = include_str!("../lib/numbervars.pl");
impl Machine {
pub fn new() -> Self {
@@ -125,7 +129,8 @@ impl Machine {
code: Code::new(),
code_dir: Rc::new(RefCell::new(CodeDir::new())),
op_dir: default_op_dir(),
// term_dir: TermDir::new(),
term_dir: TermDir::new(),
term_expanders: Code::new(),
modules: HashMap::new(),
cached_query: None
};
@@ -137,6 +142,7 @@ impl Machine {
compile_user_module(&mut wam, LISTS.as_bytes());
compile_user_module(&mut wam, CONTROL.as_bytes());
compile_user_module(&mut wam, QUEUES.as_bytes());
compile_user_module(&mut wam, NUMVARS.as_bytes());
wam
}
@@ -245,6 +251,12 @@ impl Machine {
fn lookup_instr(&self, p: CodePtr) -> Option<Line> {
match p {
CodePtr::Local(LocalCodePtr::UserTermExpansion(p)) =>
if p < self.term_expanders.len() {
Some(self.term_expanders[p].clone())
} else {
None
},
CodePtr::Local(LocalCodePtr::TopLevel(_, p)) =>
match &self.cached_query {
&Some(ref cq) => Some(cq[p].clone()),
@@ -340,6 +352,8 @@ impl Machine {
match self.ms.p {
CodePtr::Local(LocalCodePtr::DirEntry(p, _)) if p < self.code.len() => {},
CodePtr::Local(LocalCodePtr::UserTermExpansion(p)) if p < self.term_expanders.len() => {},
CodePtr::Local(LocalCodePtr::UserTermExpansion(_)) => self.ms.fail = true,
CodePtr::Local(_) => break,
_ => {}
};

View File

@@ -0,0 +1,141 @@
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<R: Read> {
stack: Vec<Term>,
parser: Parser<R>,
in_module: bool
}
impl<R: Read> TermStream<R> {
pub fn new(src: R, atom_tbl: TabledData<Atom>, flags: MachineFlags) -> Self {
TermStream {
stack: Vec::new(),
parser: Parser::new(src, atom_tbl, flags),
in_module: false
}
}
#[inline]
pub fn eof(&mut self) -> Result<bool, ParserError> {
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) => {
let mut terms = vec![*head];
let mut tail = *tail;
while let Term::Cons(_, head, next_tail) = tail {
terms.push(*head);
tail = *next_tail;
}
if let Term::Constant(_, Constant::EmptyList) = tail {
Ok(self.stack.extend(terms.into_iter().rev()))
} else {
Err(ParserError::ExpectedTopLevelTerm)
}
},
Term::Clause(..) | Term::Constant(_, Constant::Atom(..)) =>
Ok(self.stack.push(term)),
_ => Err(ParserError::ExpectedTopLevelTerm)
}
}
pub fn read_term(&mut self, wam: &mut Machine, op_dir: &OpDir) -> Result<Term, ParserError>
{
loop {
while let Some(term) = self.stack.pop() {
match wam.try_expand_term(&term)? {
Some(term) => self.enqueue_term(term)?,
None => return Ok(term)
};
}
let term = self.parser.read_term(composite_op!(self.in_module, &wam.op_dir, op_dir))?;
self.stack.push(term);
}
}
}
impl Machine {
fn try_expand_term(&mut self, term: &Term) -> Result<Option<Term>, ParserError> {
let term_h = write_term_to_heap(term, &mut self.ms);
let h = self.ms.heap.h;
self.ms[temp_v!(1)] = Addr::HeapCell(term_h);
self.ms.heap.push(HeapCellValue::Addr(Addr::HeapCell(h)));
self.ms[temp_v!(2)] = Addr::HeapCell(h);
let code = vec![call_clause!(ClauseType::Hook(CompileTimeHook::TermExpansion), 2, 0, true)];
self.submit_query(code, AllocVarDict::new());
if self.failed() {
self.reset();
Ok(None)
} else {
Ok(Some(read_term_from_heap(&self.ms, Addr::HeapCell(h))?))
}
}
}
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

@@ -1,54 +0,0 @@
use prolog_parser::ast::*;
use prolog::heap_iter::*;
use prolog::instructions::*;
use prolog::machine::machine_state::MachineState;
use std::cell::Cell;
use std::rc::Rc;
pub fn term_write(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 mut iter = stack.drain(stack_len - 2 ..);
let head = iter.next().unwrap();
let tail = 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

@@ -57,7 +57,7 @@ impl MachineState {
let mut parser = Parser::new(inner, self.atom_tbl.clone(), self.flags);
let term = parser.read_term(composite_op!(op_dir))?;
Ok(write_term_to_heap(term, self))
Ok(write_term_to_heap(&term, self))
}
}
@@ -77,13 +77,13 @@ fn modify_head_of_queue(machine_st: &mut MachineState, queue: &mut SubtermDeque,
}
}
fn write_term_to_heap(term: Term, machine_st: &mut MachineState) -> usize {
pub(crate) fn write_term_to_heap(term: &Term, machine_st: &mut MachineState) -> usize {
let h = machine_st.heap.h;
let mut queue = SubtermDeque::new();
let mut var_dict = HeapVarDict::new();
for term in breadth_first_iter(&term, true) {
for term in breadth_first_iter(term, true) {
let h = machine_st.heap.h;
match &term {

View File

@@ -5,6 +5,7 @@ use prolog_parser::tabled_rc::*;
use prolog::instructions::*;
use prolog::iterators::*;
use prolog::machine::*;
use prolog::machine::term_expansion::*;
use prolog::num::*;
use std::collections::{HashSet, VecDeque};
@@ -691,7 +692,7 @@ fn consume_term<'a>(static_code_dir: Rc<RefCell<CodeDir>>, term: Term,
}
pub struct TopLevelBatchWorker<R: Read> {
parser: Parser<R>,
term_stream: TermStream<R>,
rel_worker: RelationWorker,
static_code_dir: Rc<RefCell<CodeDir>>,
pub results: Vec<(Predicate, VecDeque<TopLevel>)>,
@@ -703,19 +704,13 @@ impl<R: Read> TopLevelBatchWorker<R> {
static_code_dir: Rc<RefCell<CodeDir>>)
-> Self
{
TopLevelBatchWorker { parser: Parser::new(inner, atom_tbl, flags),
TopLevelBatchWorker { term_stream: TermStream::new(inner, atom_tbl, flags),
rel_worker: RelationWorker::new(),
static_code_dir,
results: vec![],
in_module: false }
}
#[inline]
fn read_term(&mut self, static_op_dir: &OpDir, op_dir: &OpDir) -> Result<Term, ParserError> {
let composite_op = composite_op!(self.in_module, op_dir, static_op_dir);
self.parser.read_term(composite_op)
}
pub
fn consume<'a, 'b : 'a>(&mut self, wam: &mut Machine, indices: &'a mut MachineCodeIndices<'b>)
-> Result<Option<Declaration>, SessionError>
@@ -724,11 +719,11 @@ impl<R: Read> TopLevelBatchWorker<R> {
let mut indices = composite_indices!(self.in_module, indices,
self.static_code_dir.clone());
while !self.parser.eof()? {
self.parser.reset(); // empty the parser stack of token descriptions.
while !self.term_stream.eof()? {
self.term_stream.empty_tokens(); // empty the parser stack of token descriptions.
let mut new_rel_worker = RelationWorker::new();
let term = self.read_term(&wam.op_dir, &indices.local.op_dir)?;
let term = self.term_stream.read_term(wam, &indices.local.op_dir)?;
let tl = new_rel_worker.try_term_to_tl(&mut indices, term, true)?;