From 59ad71fcccff7150ae3aa8d151f36f9b72f69d77 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 7 Oct 2018 00:07:12 -0600 Subject: [PATCH] add preliminary support for DCGs. --- src/prolog/compile.rs | 31 +++++++--- src/prolog/heap_print.rs | 51 +++++++++------- src/prolog/instructions.rs | 2 +- src/prolog/lib/dcgs.pl | 66 +++++++++++++++++++++ src/prolog/machine/mod.rs | 27 ++------- src/prolog/machine/term_expansion.rs | 89 +++++++++------------------- src/prolog/toplevel.rs | 31 ++++++---- 7 files changed, 169 insertions(+), 128 deletions(-) create mode 100644 src/prolog/lib/dcgs.pl diff --git a/src/prolog/compile.rs b/src/prolog/compile.rs index c931aa32..eff9d2e8 100644 --- a/src/prolog/compile.rs +++ b/src/prolog/compile.rs @@ -100,10 +100,11 @@ fn compile_query(terms: Vec, queue: Vec, flags: MachineFlag fn compile_decl(wam: &mut Machine, compiler: &mut ListingCompiler, decl: Declaration) -> Result { + 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::::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)?; } } diff --git a/src/prolog/heap_print.rs b/src/prolog/heap_print.rs index 94549c4b..d4b816f6 100644 --- a/src/prolog/heap_print.rs +++ b/src/prolog/heap_print.rs @@ -115,6 +115,29 @@ fn is_numbered_var(ct: &ClauseType, arity: usize) -> bool { } } +impl MachineState { + pub fn numbervar(&self, addr: Addr) -> Option { + 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) { 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) { - 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); diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs index 33217e20..cfba0177 100644 --- a/src/prolog/instructions.rs +++ b/src/prolog/instructions.rs @@ -1184,7 +1184,7 @@ impl SubModuleUser for Module { } pub enum Declaration { - Hook(CompileTimeHook, PredicateClause), + Hook(CompileTimeHook, PredicateClause, VecDeque), Module(ModuleDecl), NonCountedBacktracking(ClauseName, usize), // name, arity Op(OpDecl), diff --git a/src/prolog/lib/dcgs.pl b/src/prolog/lib/dcgs.pl new file mode 100644 index 00000000..f2640a28 --- /dev/null +++ b/src/prolog/lib/dcgs.pl @@ -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). diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 8f0f85db..b4c21f11 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -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, 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::::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 { diff --git a/src/prolog/machine/term_expansion.rs b/src/prolog/machine/term_expansion.rs index 97a148ba..eb1e9be4 100644 --- a/src/prolog/machine/term_expansion.rs +++ b/src/prolog/machine/term_expansion.rs @@ -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, pub(crate) indices: &'a mut IndexStore, policies: &'a mut MachinePolicies, - code_repo: &'a mut CodeRepo, + pub(crate) code_repo: &'a mut CodeRepo, parser: Parser, - 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) { 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 { + 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 { 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, ParserError> + -> Result, 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('.'); -pub fn read_term_from_heap(machine_st: &MachineState, addr: Addr) -> Result -{ - 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); + self.reset(); + Ok(Some(output.result())) } } - - Err(ParserError::IncompleteReduction) } diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 908f6e8e..4bcaf691 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -85,6 +85,8 @@ fn is_term_expansion(name: &ClauseName, terms: &Vec>) -> bool { false } +type CompileTimeHookCompileInfo = (CompileTimeHook, PredicateClause, VecDeque); + fn setup_fact(term: Term) -> Result { match term { @@ -621,16 +623,21 @@ impl RelationWorker { } fn setup_hook(&mut self, indices: &mut CompositeIndices, term: Term) - -> Result<(CompileTimeHook, PredicateClause), ParserError> + -> Result { 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>, blocks_cuts: bool) + fn setup_rule(&mut self, indices: &mut CompositeIndices, mut terms: Vec>, + blocks_cuts: bool) -> Result { 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. -- 2.54.0